3 # Copyright 2009 PTFS, Inc.
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 use constant DEFAULT_ZEBRAQ_PURGEDAYS => 30;
23 use constant DEFAULT_MAIL_PURGEDAYS => 30;
24 use constant DEFAULT_IMPORT_PURGEDAYS => 60;
25 use constant DEFAULT_LOGS_PURGEDAYS => 180;
26 use constant DEFAULT_MESSAGES_PURGEDAYS => 365;
27 use constant DEFAULT_SEARCHHISTORY_PURGEDAYS => 30;
28 use constant DEFAULT_SHARE_INVITATION_EXPIRY_DAYS => 14;
29 use constant DEFAULT_DEBARMENTS_PURGEDAYS => 30;
32 # find Koha's Perl modules
33 # test carefully before changing this
35 eval { require "$FindBin::Bin/../kohalib.pl" };
38 use Koha::Script -cron;
41 use C4::Search::History;
42 use Getopt::Long qw( GetOptions );
43 use C4::Log qw( cronlogaction );
44 use C4::Accounts qw( purge_zero_balance_fees );
45 use Koha::UploadedFiles;
46 use Koha::Old::Biblios;
48 use Koha::Old::Biblioitems;
49 use Koha::Old::Checkouts;
51 use Koha::Old::Patrons;
52 use Koha::Item::Transfers;
53 use Koha::PseudonymizedTransactions;
54 use Koha::Patron::Messages;
55 use Koha::Patron::Debarments qw( DelDebarment );
59 Usage: $0 [-h|--help] [--confirm] [--sessions] [--sessdays DAYS] [-v|--verbose] [--zebraqueue DAYS] [-m|--mail] [--merged] [--import DAYS] [--logs DAYS] [--searchhistory DAYS] [--restrictions DAYS] [--all-restrictions] [--fees DAYS] [--temp-uploads] [--temp-uploads-days DAYS] [--uploads-missing 0|1 ] [--statistics DAYS] [--deleted-catalog DAYS] [--deleted-patrons DAYS] [--old-issues DAYS] [--old-reserves DAYS] [--transfers DAYS] [--labels DAYS] [--cards DAYS]
61 -h --help prints this help message, and exits, ignoring all
63 --confirm Confirmation flag, the script will be running in dry-run mode is not set.
64 --sessions purge the sessions table. If you use this while users
65 are logged into Koha, they will have to reconnect.
66 --sessdays DAYS purge only sessions older than DAYS days.
67 -v --verbose will cause the script to give you a bit more information
69 --zebraqueue DAYS purge completed zebraqueue entries older than DAYS days.
70 Defaults to 30 days if no days specified.
71 -m --mail DAYS purge items from the mail queue that are older than DAYS days.
72 Defaults to 30 days if no days specified.
73 --merged purged completed entries from need_merge_authorities.
74 --messages DAYS purge entries from messages table older than DAYS days.
75 Defaults to 365 days if no days specified.
76 --import DAYS purge records from import tables older than DAYS days.
77 Defaults to 60 days if no days specified.
78 --z3950 purge records from import tables that are the result
80 --fees DAYS purge entries accountlines older than DAYS days, where
81 amountoutstanding is 0 or NULL.
82 In the case of --fees, DAYS must be greater than
84 --log-modules Specify which action log modules to trim. Repeatable.
85 --preserve-logs Specify which action logs to exclude. Repeatable.
86 --logs DAYS purge entries from action_logs older than DAYS days.
87 Defaults to 180 days if no days specified.
88 --searchhistory DAYS purge entries from search_history older than DAYS days.
89 Defaults to 30 days if no days specified
90 --list-invites DAYS purge (unaccepted) list share invites older than DAYS
91 days. Defaults to 14 days if no days specified.
92 --restrictions DAYS purge patrons restrictions expired since more than DAYS days.
93 Defaults to 30 days if no days specified.
94 --all-restrictions purge all expired patrons restrictions.
95 --del-exp-selfreg Delete expired self registration accounts
96 --del-unv-selfreg DAYS Delete unverified self registrations older than DAYS
97 --unique-holidays DAYS Delete all unique holidays older than DAYS
98 --temp-uploads Delete temporary uploads.
99 --temp-uploads-days DAYS Override the corresponding preference value.
100 --uploads-missing FLAG Delete upload records for missing files when FLAG is true, count them otherwise
101 --oauth-tokens Delete expired OAuth2 tokens
102 --statistics DAYS Purge statistics entries more than DAYS days old.
103 This table is used to build reports, make sure you are aware of the consequences of this before using it!
104 --deleted-catalog DAYS Purge catalog records deleted more then DAYS days ago
105 (from tables deleteditems, deletedbiblioitems, deletedbiblio_metadata and deletedbiblio).
106 --deleted-patrons DAYS Purge patrons deleted more than DAYS days ago.
107 --old-issues DAYS Purge checkouts (old_issues) returned more than DAYS days ago.
108 --old-reserves DAYS Purge reserves (old_reserves) more than DAYS old.
109 --transfers DAYS Purge transfers completed more than DAYS day ago.
110 --pseudo-transactions DAYS Purge the pseudonymized transactions that have been originally created more than DAYS days ago
111 DAYS is optional and can be replaced by:
112 --pseudo-transactions-from YYYY-MM-DD and/or --pseudo-transactions-to YYYY-MM-DD
113 --labels DAYS Purge item label batches last added to more than DAYS days ago.
114 --cards DAY Purge card creator batches last added to more than DAYS days ago.
115 --return-claims Purge all resolved return claims older than the number of days specified in
116 the system preference CleanUpDatabaseReturnClaims.
133 my $pListShareInvites;
140 my $special_holidays_days;
142 my $temp_uploads_days;
151 my ( $pPseudoTransactions, $pPseudoTransactionsFrom, $pPseudoTransactionsTo );
153 my $lock_days = C4::Context->preference('LockExpiredDelay');
161 'confirm' => \$confirm,
162 'sessions' => \$sessions,
163 'sessdays:i' => \$sess_days,
164 'v|verbose' => \$verbose,
165 'm|mail:i' => \$mail,
166 'zebraqueue:i' => \$zebraqueue_days,
167 'merged' => \$purge_merged,
168 'import:i' => \$pImport,
171 'log-module:s' => \@log_modules,
172 'preserve-log:s' => \@preserve_logs,
173 'messages:i' => \$pMessages,
174 'fees:i' => \$fees_days,
175 'searchhistory:i' => \$pSearchhistory,
176 'list-invites:i' => \$pListShareInvites,
177 'restrictions:i' => \$pDebarments,
178 'all-restrictions' => \$allDebarments,
179 'del-exp-selfreg' => \$pExpSelfReg,
180 'del-unv-selfreg' => \$pUnvSelfReg,
181 'unique-holidays:i' => \$special_holidays_days,
182 'temp-uploads' => \$temp_uploads,
183 'temp-uploads-days:i' => \$temp_uploads_days,
184 'uploads-missing:i' => \$uploads_missing,
185 'oauth-tokens' => \$oauth_tokens,
186 'statistics:i' => \$pStatistics,
187 'deleted-catalog:i' => \$pDeletedCatalog,
188 'deleted-patrons:i' => \$pDeletedPatrons,
189 'old-issues:i' => \$pOldIssues,
190 'old-reserves:i' => \$pOldReserves,
191 'transfers:i' => \$pTransfers,
192 'pseudo-transactions:i' => \$pPseudoTransactions,
193 'pseudo-transactions-from:s' => \$pPseudoTransactionsFrom,
194 'pseudo-transactions-to:s' => \$pPseudoTransactionsTo,
195 'labels' => \$labels,
197 'return-claims' => \$return_claims,
201 $sessions = 1 if $sess_days && $sess_days > 0;
202 $pImport = DEFAULT_IMPORT_PURGEDAYS if defined($pImport) && $pImport == 0;
203 $pLogs = DEFAULT_LOGS_PURGEDAYS if defined($pLogs) && $pLogs == 0;
204 $zebraqueue_days = DEFAULT_ZEBRAQ_PURGEDAYS if defined($zebraqueue_days) && $zebraqueue_days == 0;
205 $mail = DEFAULT_MAIL_PURGEDAYS if defined($mail) && $mail == 0;
206 $pSearchhistory = DEFAULT_SEARCHHISTORY_PURGEDAYS if defined($pSearchhistory) && $pSearchhistory == 0;
207 $pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0;
208 $pDebarments = DEFAULT_DEBARMENTS_PURGEDAYS if defined($pDebarments) && $pDebarments == 0;
209 $pMessages = DEFAULT_MESSAGES_PURGEDAYS if defined($pMessages) && $pMessages == 0;
224 || $pListShareInvites
229 || $special_holidays_days
231 || defined $uploads_missing
239 || defined $pPseudoTransactions
240 || $pPseudoTransactionsFrom
241 || $pPseudoTransactionsTo
243 || defined $lock_days && $lock_days ne q{}
248 print "You did not specify any cleanup work for the script to do.\n\n";
252 if ($pDebarments && $allDebarments) {
253 print "You can not specify both --restrictions and --all-restrictions.\n\n";
257 say "Confirm flag not passed, running in dry-run mode..." unless $confirm;
259 cronlogaction() unless $confirm;
261 my $dbh = C4::Context->dbh();
265 if ( $sessions && !$sess_days ) {
267 say "Session purge triggered.";
268 $sth = $dbh->prepare(q{ SELECT COUNT(*) FROM sessions });
269 $sth->execute() or die $dbh->errstr;
270 my @count_arr = $sth->fetchrow_array;
271 say $confirm ? "$count_arr[0] entries will be deleted." : "$count_arr[0] entries would be deleted.";
274 $sth = $dbh->prepare(q{ TRUNCATE sessions });
275 $sth->execute() or die $dbh->errstr;
278 print "Done with session purge.\n";
281 elsif ( $sessions && $sess_days > 0 ) {
282 print "Session purge triggered with days>$sess_days.\n" if $verbose;
283 RemoveOldSessions() if $confirm;
284 print "Done with session purge with days>$sess_days.\n" if $verbose;
287 if ($zebraqueue_days) {
289 print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
290 $sth = $dbh->prepare(
292 SELECT id,biblio_auth_number,server,time
294 WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY)
297 $sth->execute($zebraqueue_days) or die $dbh->errstr;
298 $sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? });
299 while ( my $record = $sth->fetchrow_hashref ) {
301 $sth2->execute( $record->{id} ) or die $dbh->errstr;
306 say $confirm ? "$count records were deleted." : "$count records would have been deleted.";
307 say "Done with zebraqueue purge.";
313 print "Mail queue purge triggered for $mail days.\n" if $verbose;
314 $sth = $dbh->prepare(
316 DELETE FROM message_queue
317 WHERE time_queued < date_sub(curdate(), INTERVAL ? DAY)
321 $sth->execute($mail) or die $dbh->errstr;
325 say $confirm ? "$count messages were deleted from the mail queue." : "Message from message_queue would have been deleted";
326 say "Done with message_queue purge.";
331 print "Purging completed entries from need_merge_authorities.\n" if $verbose;
333 $sth = $dbh->prepare(q{ DELETE FROM need_merge_authorities WHERE done=1 });
334 $sth->execute() or die $dbh->errstr;
336 print "Done with purging need_merge_authorities.\n" if $verbose;
340 print "Purging records from import tables.\n" if $verbose;
341 PurgeImportTables() if $confirm;
342 print "Done with purging import tables.\n" if $verbose;
346 print "Purging Z39.50 records from import tables.\n" if $verbose;
347 PurgeZ3950() if $confirm;
348 print "Done with purging Z39.50 records from import tables.\n" if $verbose;
352 print "Purging records from action_logs.\n" if $verbose;
354 DELETE FROM action_logs
355 WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY)
357 my @query_params = ();
358 if( @preserve_logs ){
359 $log_query .= " AND module NOT IN (" . join(',',('?') x @preserve_logs ) . ")";
360 push @query_params, @preserve_logs;
363 $log_query .= " AND module IN (" . join(',',('?') x @log_modules ) . ")";
364 push @query_params, @log_modules;
366 $sth = $dbh->prepare( $log_query );
368 $sth->execute($pLogs, @query_params) or die $dbh->errstr;
370 print "Done with purging action_logs.\n" if $verbose;
374 print "Purging messages older than $pMessages days.\n" if $verbose;
375 my $messages = Koha::Patron::Messages->filter_by_last_update(
376 { timestamp_column_name => 'message_date', days => $pMessages } );
377 my $count = $messages->count;
378 $messages->delete if $confirm;
381 ? sprintf( "Done with purging %d messages", $count )
382 : sprintf( "%d messages would have been removed", $count );
387 print "Purging records from accountlines.\n" if $verbose;
388 purge_zero_balance_fees( $fees_days ) if $confirm;
389 print "Done purging records from accountlines.\n" if $verbose;
392 if ($pSearchhistory) {
393 print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;
394 C4::Search::History::delete({ interval => $pSearchhistory }) if $confirm;
395 print "Done with purging search_history.\n" if $verbose;
398 if ($pListShareInvites) {
399 print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;
400 $sth = $dbh->prepare(
402 DELETE FROM virtualshelfshares
403 WHERE invitekey IS NOT NULL
404 AND (sharedate + INTERVAL ? DAY) < NOW()
408 $sth->execute($pListShareInvites);
410 print "Done with purging unaccepted list share invites.\n" if $verbose;
414 print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
415 my $count = PurgeDebarments($pDebarments, $confirm);
417 say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
418 say "Done with restrictions purge.";
423 print "All expired patrons restrictions purge triggered.\n" if $verbose;
424 my $count = PurgeDebarments(0, $confirm);
426 say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
427 say "Done with all restrictions purge.";
431 # Lock expired patrons?
432 if( defined $lock_days && $lock_days ne q{} ) {
433 say "Start locking expired patrons" if $verbose;
434 my $expired_patrons = Koha::Patrons->filter_by_expiration_date({ days => $lock_days })->search({ login_attempts => { '!=' => -1 } });
435 my $count = $expired_patrons->count;
436 $expired_patrons->lock({ remove => 1 }) if $confirm;
438 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("Found %d patrons", $count);
442 # Handle unsubscribe requests from GDPR consent form, depends on UnsubscribeReflectionDelay preference
443 say "Start lock unsubscribed, anonymize and delete" if $verbose;
444 my $unsubscribed_patrons = Koha::Patrons->search_unsubscribed;
445 my $count = $unsubscribed_patrons->count;
446 $unsubscribed_patrons->lock( { expire => 1, remove => 1 } ) if $confirm;
447 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("%d patrons would have been locked", $count) if $verbose;
449 # Anonymize patron data, depending on PatronAnonymizeDelay
450 my $anonymize_candidates = Koha::Patrons->search_anonymize_candidates( { locked => 1 } );
451 $count = $anonymize_candidates->count;
452 $anonymize_candidates->anonymize if $confirm;
453 say $confirm ? sprintf("Anonymized %d patrons", $count) : sprintf("%d patrons would have been anonymized", $count) if $verbose;
455 # Remove patron data, depending on PatronRemovalDelay (will raise an exception if problem encountered
456 my $anonymized_patrons = Koha::Patrons->search_anonymized;
457 $count = $anonymized_patrons->count;
459 $anonymized_patrons->delete( { move => 1 } );
465 say $confirm ? sprintf("Deleted %d patrons", $count) : sprintf("%d patrons would have been deleted", $count);
468 # FIXME The output for dry-run mode needs to be improved
469 # But non trivial changes to C4::Members need to be done before.
472 DeleteExpiredSelfRegs();
473 } elsif ( $verbose ) {
474 say "self-registered borrowers may be deleted";
479 DeleteUnverifiedSelfRegs( $pUnvSelfReg );
480 } elsif ( $verbose ) {
481 say "unverified self-registrations may be deleted";
485 if ($special_holidays_days) {
487 DeleteSpecialHolidays( abs($special_holidays_days) );
488 } elsif ( $verbose ) {
489 say "self-registered borrowers may be deleted";
493 if( $temp_uploads ) {
494 # Delete temporary uploads, governed by a pref (unless you override)
495 print "Purging temporary uploads.\n" if $verbose;
497 Koha::UploadedFiles->delete_temporary({
498 defined($temp_uploads_days)
499 ? ( override_pref => $temp_uploads_days )
503 print "Done purging temporary uploads.\n" if $verbose;
506 if( defined $uploads_missing ) {
507 print "Looking for missing uploads\n" if $verbose;
509 my $keep = $uploads_missing == 1 ? 0 : 1;
510 my $count = Koha::UploadedFiles->delete_missing({ keep_record => $keep });
512 print "Counted $count missing uploaded files\n";
514 print "Removed $count records for missing uploads\n";
517 # FIXME need to create a filter_by_missing method (then call ->delete) instead of delete_missing
518 say "Dry-run mode cannot guess how many uploads would have been deleted";
523 require Koha::OAuthAccessTokens;
525 my $tokens = Koha::OAuthAccessTokens->search({ expires => { '<=', time } });
526 my $count = $tokens->count;
527 $tokens->delete if $confirm;
530 ? sprintf( "Removed %d expired OAuth2 tokens", $count )
531 : sprintf( "%d expired OAuth tokens would have been removed", $count );
536 print "Purging statistics older than $pStatistics days.\n" if $verbose;
537 my $statistics = Koha::Statistics->filter_by_last_update(
538 { timestamp_column_name => 'datetime', days => $pStatistics } );
539 my $count = $statistics->count;
540 $statistics->delete if $confirm;
543 ? sprintf( "Done with purging %d statistics", $count )
544 : sprintf( "%d statistics would have been removed", $count );
548 if( $return_claims && ( my $days = C4::Context->preference('CleanUpDatabaseReturnClaims') )) {
549 print "Purging return claims older than $days days.\n" if $verbose;
551 $return_claims = Koha::Checkouts::ReturnClaims->filter_by_last_update(
553 timestamp_column_name => 'resolved_on',
558 my $count = $return_claims->count;
559 $return_claims->delete if $confirm;
563 ? sprintf "Done with purging %d resolved return claims.", $count
564 : sprintf "%d resolved return claims would have been purged.", $count;
568 if ($pDeletedCatalog) {
569 print "Purging deleted catalog older than $pDeletedCatalog days.\n"
571 my $old_items = Koha::Old::Items->filter_by_last_update( { days => $pDeletedCatalog } );
572 my $old_biblioitems = Koha::Old::Biblioitems->filter_by_last_update( { days => $pDeletedCatalog } );
573 my $old_biblios = Koha::Old::Biblios->filter_by_last_update( { days => $pDeletedCatalog } );
574 my ( $c_i, $c_bi, $c_b ) =
575 ( $old_items->count, $old_biblioitems->count, $old_biblios->count );
578 $old_biblioitems->delete;
579 $old_biblios->delete;
584 ? "Done with purging deleted catalog (%d items, %d biblioitems, %d biblios)."
585 : "Deleted catalog would have been removed (%d items, %d biblioitems, %d biblios).",
590 if ($pDeletedPatrons) {
591 print "Purging deleted patrons older than $pDeletedPatrons days.\n" if $verbose;
592 my $old_patrons = Koha::Old::Patrons->filter_by_last_update(
593 { timestamp_column_name => 'updated_on', days => $pDeletedPatrons } );
594 my $count = $old_patrons->count;
595 $old_patrons->delete if $confirm;
598 ? sprintf "Done with purging %d deleted patrons.", $count
599 : sprintf "%d deleted patrons would have been purged.", $count;
604 print "Purging old checkouts older than $pOldIssues days.\n" if $verbose;
605 my $old_checkouts = Koha::Old::Checkouts->filter_by_last_update( { days => $pOldIssues } );
606 my $count = $old_checkouts->count;
607 $old_checkouts->delete if $confirm;
610 ? sprintf "Done with purging %d old checkouts.", $count
611 : sprintf "%d old checkouts would have been purged.", $count;
616 print "Purging old reserves older than $pOldReserves days.\n" if $verbose;
617 my $old_reserves = Koha::Old::Holds->filter_by_last_update( { days => $pOldReserves } );
618 my $count = $old_reserves->count;
619 $old_reserves->delete if $confirm;
622 ? sprintf "Done with purging %d old reserves.", $count
623 : sprintf "%d old reserves would have been purged.", $count;
628 print "Purging arrived item transfers older than $pTransfers days.\n" if $verbose;
629 my $transfers = Koha::Item::Transfers->filter_by_last_update(
631 timestamp_column_name => 'datearrived',
635 my $count = $transfers->count;
636 $transfers->delete if $confirm;
639 ? sprintf "Done with purging %d transfers.", $count
640 : sprintf "%d transfers would have been purged.", $count;
644 if (defined $pPseudoTransactions or $pPseudoTransactionsFrom or $pPseudoTransactionsTo ) {
645 print "Purging pseudonymized transactions\n" if $verbose;
646 my $anonymized_transactions = Koha::PseudonymizedTransactions->filter_by_last_update(
648 timestamp_column_name => 'datetime',
649 ( defined $pPseudoTransactions ? ( days => $pPseudoTransactions ) : () ),
650 ( $pPseudoTransactionsFrom ? ( from => $pPseudoTransactionsFrom ) : () ),
651 ( $pPseudoTransactionsTo ? ( to => $pPseudoTransactionsTo ) : () ),
654 my $count = $anonymized_transactions->count;
655 $anonymized_transactions->delete if $confirm;
658 ? sprintf "Done with purging %d pseudonymized transactions.", $count
659 : sprintf "%d pseudonymized transactions would have been purged.", $count;
664 print "Purging item label batches last added to more than $labels days ago.\n" if $verbose;
665 my $count = PurgeCreatorBatches($labels, 'labels', $confirm);
668 ? sprintf "Done with purging %d item label batches last added to more than %d days ago.\n", $count, $labels
669 : sprintf "%d item label batches would have been purged.", $count;
674 print "Purging card creator batches last added to more than $cards days ago.\n" if $verbose;
675 my $count = PurgeCreatorBatches($labels, 'patroncards', $confirm);
678 ? sprintf "Done with purging %d card creator batches last added to more than %d days ago.\n", $count, $labels
679 : sprintf "%d card creator batches would have been purged.", $count;
685 sub RemoveOldSessions {
686 my ( $id, $a_session, $limit, $lasttime );
687 $limit = time() - 24 * 3600 * $sess_days;
689 $sth = $dbh->prepare(q{ SELECT id, a_session FROM sessions });
690 $sth->execute or die $dbh->errstr;
691 $sth->bind_columns( \$id, \$a_session );
692 $sth2 = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? });
695 while ( $sth->fetch ) {
697 if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
700 elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
703 if ( $lasttime && $lasttime < $limit ) {
704 $sth2->execute($id) or die $dbh->errstr;
709 print "$count sessions were deleted.\n";
713 sub PurgeImportTables {
715 #First purge import_records
716 #Delete cascades to import_biblios, import_items and import_record_matches
717 $sth = $dbh->prepare(
719 DELETE FROM import_records
720 WHERE upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
723 $sth->execute($pImport) or die $dbh->errstr;
725 # Now purge import_batches
726 # Timestamp cannot be used here without care, because records are added
727 # continuously to batches without updating timestamp (Z39.50 search).
728 # So we only delete older empty batches.
729 # This delete will therefore not have a cascading effect.
730 $sth = $dbh->prepare(
733 FROM import_batches ba
734 LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
735 WHERE re.import_record_id IS NULL AND
736 ba.upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
739 $sth->execute($pImport) or die $dbh->errstr;
743 $sth = $dbh->prepare(
745 DELETE FROM import_batches
746 WHERE batch_type = 'z3950'
749 $sth->execute() or die $dbh->errstr;
752 sub PurgeDebarments {
753 require Koha::Patron::Debarments;
754 my ( $days, $doit ) = @_;
756 $sth = $dbh->prepare(
758 SELECT borrower_debarment_id
759 FROM borrower_debarments
760 WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
763 $sth->execute($days) or die $dbh->errstr;
764 while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
765 Koha::Patron::Debarments::DelDebarment($borrower_debarment_id) if $doit;
771 sub PurgeCreatorBatches {
772 require C4::Labels::Batch;
773 my ( $days, $creator, $doit ) = @_;
775 $sth = $dbh->prepare(
777 SELECT batch_id, branch_code FROM creator_batches
780 FROM (SELECT batch_id
784 HAVING max(timestamp) <= date_sub(curdate(),interval ? day)) a)
787 $sth->execute( $creator, $days ) or die $dbh->errstr;
788 while ( my ( $batch_id, $branch_code ) = $sth->fetchrow_array ) {
789 C4::Labels::Batch::delete(
790 batch_id => $batch_id,
791 branch_code => $branch_code
798 sub DeleteExpiredSelfRegs {
799 my $cnt= C4::Members::DeleteExpiredOpacRegistrations();
800 print "Removed $cnt expired self-registered borrowers\n" if $verbose;
803 sub DeleteUnverifiedSelfRegs {
804 my $cnt= C4::Members::DeleteUnverifiedOpacRegistrations( $_[0] );
805 print "Removed $cnt unverified self-registrations\n" if $verbose;
808 sub DeleteSpecialHolidays {
811 my $sth = $dbh->prepare(q{
812 DELETE FROM special_holidays
813 WHERE DATE( CONCAT( year, '-', month, '-', day ) ) < DATE_SUB( CAST(NOW() AS DATE), INTERVAL ? DAY );
815 my $count = $sth->execute( $days ) + 0;
816 print "Removed $count unique holidays\n" if $verbose;