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;
31 use Koha::Script -cron;
34 use C4::Search::History;
35 use Getopt::Long qw( GetOptions );
36 use C4::Log qw( cronlogaction );
37 use C4::Accounts qw( purge_zero_balance_fees );
38 use Koha::UploadedFiles;
39 use Koha::Old::Biblios;
41 use Koha::Old::Biblioitems;
42 use Koha::Old::Checkouts;
44 use Koha::Old::Patrons;
45 use Koha::Item::Transfers;
46 use Koha::PseudonymizedTransactions;
47 use Koha::Patron::Messages;
48 use Koha::Patron::Debarments qw( DelDebarment );
52 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]
54 -h --help prints this help message, and exits, ignoring all
56 --confirm Confirmation flag, the script will be running in dry-run mode is not set.
57 --sessions purge the sessions table. If you use this while users
58 are logged into Koha, they will have to reconnect.
59 --sessdays DAYS purge only sessions older than DAYS days.
60 -v --verbose will cause the script to give you a bit more information
62 --zebraqueue DAYS purge completed zebraqueue entries older than DAYS days.
63 Defaults to 30 days if no days specified.
64 -m --mail DAYS purge items from the mail queue that are older than DAYS days.
65 Defaults to 30 days if no days specified.
66 --merged purged completed entries from need_merge_authorities.
67 --messages DAYS purge entries from messages table older than DAYS days.
68 Defaults to 365 days if no days specified.
69 --import DAYS purge records from import tables older than DAYS days.
70 Defaults to 60 days if no days specified.
71 --z3950 purge records from import tables that are the result
73 --fees DAYS purge entries accountlines older than DAYS days, where
74 amountoutstanding is 0 or NULL.
75 In the case of --fees, DAYS must be greater than
77 --log-modules Specify which action log modules to trim. Repeatable.
78 --preserve-logs Specify which action logs to exclude. Repeatable.
79 --logs DAYS purge entries from action_logs older than DAYS days.
80 Defaults to 180 days if no days specified.
81 --searchhistory DAYS purge entries from search_history older than DAYS days.
82 Defaults to 30 days if no days specified
83 --list-invites DAYS purge (unaccepted) list share invites older than DAYS
84 days. Defaults to 14 days if no days specified.
85 --restrictions DAYS purge patrons restrictions expired since more than DAYS days.
86 Defaults to 30 days if no days specified.
87 --all-restrictions purge all expired patrons restrictions.
88 --del-exp-selfreg Delete expired self registration accounts
89 --del-unv-selfreg DAYS Delete unverified self registrations older than DAYS
90 --unique-holidays DAYS Delete all unique holidays older than DAYS
91 --temp-uploads Delete temporary uploads.
92 --temp-uploads-days DAYS Override the corresponding preference value.
93 --uploads-missing FLAG Delete upload records for missing files when FLAG is true, count them otherwise
94 --oauth-tokens Delete expired OAuth2 tokens
95 --statistics DAYS Purge statistics entries more than DAYS days old.
96 This table is used to build reports, make sure you are aware of the consequences of this before using it!
97 --deleted-catalog DAYS Purge catalog records deleted more then DAYS days ago
98 (from tables deleteditems, deletedbiblioitems, deletedbiblio_metadata and deletedbiblio).
99 --deleted-patrons DAYS Purge patrons deleted more than DAYS days ago.
100 --old-issues DAYS Purge checkouts (old_issues) returned more than DAYS days ago.
101 --old-reserves DAYS Purge reserves (old_reserves) more than DAYS old.
102 --transfers DAYS Purge transfers completed more than DAYS day ago.
103 --pseudo-transactions DAYS Purge the pseudonymized transactions that have been originally created more than DAYS days ago
104 DAYS is optional and can be replaced by:
105 --pseudo-transactions-from YYYY-MM-DD and/or --pseudo-transactions-to YYYY-MM-DD
106 --labels DAYS Purge item label batches last added to more than DAYS days ago.
107 --cards DAY Purge card creator batches last added to more than DAYS days ago.
108 --return-claims Purge all resolved return claims older than the number of days specified in
109 the system preference CleanUpDatabaseReturnClaims.
126 my $pListShareInvites;
133 my $special_holidays_days;
135 my $temp_uploads_days;
144 my ( $pPseudoTransactions, $pPseudoTransactionsFrom, $pPseudoTransactionsTo );
146 my $lock_days = C4::Context->preference('LockExpiredDelay');
152 my $command_line_options = join(" ",@ARGV);
156 'confirm' => \$confirm,
157 'sessions' => \$sessions,
158 'sessdays:i' => \$sess_days,
159 'v|verbose' => \$verbose,
160 'm|mail:i' => \$mail,
161 'zebraqueue:i' => \$zebraqueue_days,
162 'merged' => \$purge_merged,
163 'import:i' => \$pImport,
166 'log-module:s' => \@log_modules,
167 'preserve-log:s' => \@preserve_logs,
168 'messages:i' => \$pMessages,
169 'fees:i' => \$fees_days,
170 'searchhistory:i' => \$pSearchhistory,
171 'list-invites:i' => \$pListShareInvites,
172 'restrictions:i' => \$pDebarments,
173 'all-restrictions' => \$allDebarments,
174 'del-exp-selfreg' => \$pExpSelfReg,
175 'del-unv-selfreg:i' => \$pUnvSelfReg,
176 'unique-holidays:i' => \$special_holidays_days,
177 'temp-uploads' => \$temp_uploads,
178 'temp-uploads-days:i' => \$temp_uploads_days,
179 'uploads-missing:i' => \$uploads_missing,
180 'oauth-tokens' => \$oauth_tokens,
181 'statistics:i' => \$pStatistics,
182 'deleted-catalog:i' => \$pDeletedCatalog,
183 'deleted-patrons:i' => \$pDeletedPatrons,
184 'old-issues:i' => \$pOldIssues,
185 'old-reserves:i' => \$pOldReserves,
186 'transfers:i' => \$pTransfers,
187 'pseudo-transactions:i' => \$pPseudoTransactions,
188 'pseudo-transactions-from:s' => \$pPseudoTransactionsFrom,
189 'pseudo-transactions-to:s' => \$pPseudoTransactionsTo,
190 'labels' => \$labels,
192 'return-claims' => \$return_claims,
196 $sessions = 1 if $sess_days && $sess_days > 0;
197 $pImport = DEFAULT_IMPORT_PURGEDAYS if defined($pImport) && $pImport == 0;
198 $pLogs = DEFAULT_LOGS_PURGEDAYS if defined($pLogs) && $pLogs == 0;
199 $zebraqueue_days = DEFAULT_ZEBRAQ_PURGEDAYS if defined($zebraqueue_days) && $zebraqueue_days == 0;
200 $mail = DEFAULT_MAIL_PURGEDAYS if defined($mail) && $mail == 0;
201 $pSearchhistory = DEFAULT_SEARCHHISTORY_PURGEDAYS if defined($pSearchhistory) && $pSearchhistory == 0;
202 $pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0;
203 $pDebarments = DEFAULT_DEBARMENTS_PURGEDAYS if defined($pDebarments) && $pDebarments == 0;
204 $pMessages = DEFAULT_MESSAGES_PURGEDAYS if defined($pMessages) && $pMessages == 0;
219 || $pListShareInvites
224 || $special_holidays_days
226 || defined $uploads_missing
234 || defined $pPseudoTransactions
235 || $pPseudoTransactionsFrom
236 || $pPseudoTransactionsTo
238 || defined $lock_days && $lock_days ne q{}
243 print "You did not specify any cleanup work for the script to do.\n\n";
247 if ($pDebarments && $allDebarments) {
248 print "You can not specify both --restrictions and --all-restrictions.\n\n";
252 say "Confirm flag not passed, running in dry-run mode..." unless $confirm;
254 cronlogaction({ info => $command_line_options });
256 my $dbh = C4::Context->dbh();
260 if ( $sessions && !$sess_days ) {
262 say "Session purge triggered.";
263 $sth = $dbh->prepare(q{ SELECT COUNT(*) FROM sessions });
264 $sth->execute() or die $dbh->errstr;
265 my @count_arr = $sth->fetchrow_array;
266 say $confirm ? "$count_arr[0] entries will be deleted." : "$count_arr[0] entries would be deleted.";
269 $sth = $dbh->prepare(q{ TRUNCATE sessions });
270 $sth->execute() or die $dbh->errstr;
273 print "Done with session purge.\n";
276 elsif ( $sessions && $sess_days > 0 ) {
277 print "Session purge triggered with days>$sess_days.\n" if $verbose;
278 RemoveOldSessions() if $confirm;
279 print "Done with session purge with days>$sess_days.\n" if $verbose;
282 if ($zebraqueue_days) {
284 print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
285 $sth = $dbh->prepare(
287 SELECT id,biblio_auth_number,server,time
289 WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY)
292 $sth->execute($zebraqueue_days) or die $dbh->errstr;
293 $sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? });
294 while ( my $record = $sth->fetchrow_hashref ) {
296 $sth2->execute( $record->{id} ) or die $dbh->errstr;
301 say $confirm ? "$count records were deleted." : "$count records would have been deleted.";
302 say "Done with zebraqueue purge.";
308 print "Mail queue purge triggered for $mail days.\n" if $verbose;
309 $sth = $dbh->prepare(
311 DELETE FROM message_queue
312 WHERE time_queued < date_sub(curdate(), INTERVAL ? DAY)
316 $sth->execute($mail) or die $dbh->errstr;
320 say $confirm ? "$count messages were deleted from the mail queue." : "Message from message_queue would have been deleted";
321 say "Done with message_queue purge.";
326 print "Purging completed entries from need_merge_authorities.\n" if $verbose;
328 $sth = $dbh->prepare(q{ DELETE FROM need_merge_authorities WHERE done=1 });
329 $sth->execute() or die $dbh->errstr;
331 print "Done with purging need_merge_authorities.\n" if $verbose;
335 print "Purging records from import tables.\n" if $verbose;
336 PurgeImportTables() if $confirm;
337 print "Done with purging import tables.\n" if $verbose;
341 print "Purging Z39.50 records from import tables.\n" if $verbose;
342 PurgeZ3950() if $confirm;
343 print "Done with purging Z39.50 records from import tables.\n" if $verbose;
347 print "Purging records from action_logs.\n" if $verbose;
349 DELETE FROM action_logs
350 WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY)
352 my @query_params = ();
353 if( @preserve_logs ){
354 $log_query .= " AND module NOT IN (" . join(',',('?') x @preserve_logs ) . ")";
355 push @query_params, @preserve_logs;
358 $log_query .= " AND module IN (" . join(',',('?') x @log_modules ) . ")";
359 push @query_params, @log_modules;
361 $sth = $dbh->prepare( $log_query );
363 $sth->execute($pLogs, @query_params) or die $dbh->errstr;
365 print "Done with purging action_logs.\n" if $verbose;
369 print "Purging messages older than $pMessages days.\n" if $verbose;
370 my $messages = Koha::Patron::Messages->filter_by_last_update(
371 { timestamp_column_name => 'message_date', days => $pMessages } );
372 my $count = $messages->count;
373 $messages->delete if $confirm;
376 ? sprintf( "Done with purging %d messages", $count )
377 : sprintf( "%d messages would have been removed", $count );
382 print "Purging records from accountlines.\n" if $verbose;
383 purge_zero_balance_fees( $fees_days ) if $confirm;
384 print "Done purging records from accountlines.\n" if $verbose;
387 if ($pSearchhistory) {
388 print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;
389 C4::Search::History::delete({ interval => $pSearchhistory }) if $confirm;
390 print "Done with purging search_history.\n" if $verbose;
393 if ($pListShareInvites) {
394 print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;
395 $sth = $dbh->prepare(
397 DELETE FROM virtualshelfshares
398 WHERE invitekey IS NOT NULL
399 AND (sharedate + INTERVAL ? DAY) < NOW()
403 $sth->execute($pListShareInvites);
405 print "Done with purging unaccepted list share invites.\n" if $verbose;
409 print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
410 my $count = PurgeDebarments($pDebarments, $confirm);
412 say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
413 say "Done with restrictions purge.";
418 print "All expired patrons restrictions purge triggered.\n" if $verbose;
419 my $count = PurgeDebarments(0, $confirm);
421 say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
422 say "Done with all restrictions purge.";
426 # Lock expired patrons?
427 if( defined $lock_days && $lock_days ne q{} ) {
428 say "Start locking expired patrons" if $verbose;
429 my $expired_patrons = Koha::Patrons->filter_by_expiration_date({ days => $lock_days })->search({ login_attempts => { '!=' => -1 } });
430 my $count = $expired_patrons->count;
431 $expired_patrons->lock({ remove => 1 }) if $confirm;
433 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("Found %d patrons", $count);
437 # Handle unsubscribe requests from GDPR consent form, depends on UnsubscribeReflectionDelay preference
438 say "Start lock unsubscribed, anonymize and delete" if $verbose;
439 my $unsubscribed_patrons = Koha::Patrons->search_unsubscribed;
440 my $count = $unsubscribed_patrons->count;
441 $unsubscribed_patrons->lock( { expire => 1, remove => 1 } ) if $confirm;
442 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("%d patrons would have been locked", $count) if $verbose;
444 # Anonymize patron data, depending on PatronAnonymizeDelay
445 my $anonymize_candidates = Koha::Patrons->search_anonymize_candidates( { locked => 1 } );
446 $count = $anonymize_candidates->count;
447 $anonymize_candidates->anonymize if $confirm;
448 say $confirm ? sprintf("Anonymized %d patrons", $count) : sprintf("%d patrons would have been anonymized", $count) if $verbose;
450 # Remove patron data, depending on PatronRemovalDelay (will raise an exception if problem encountered
451 my $anonymized_patrons = Koha::Patrons->search_anonymized;
452 $count = $anonymized_patrons->count;
454 $anonymized_patrons->delete( { move => 1 } );
460 say $confirm ? sprintf("Deleted %d patrons", $count) : sprintf("%d patrons would have been deleted", $count);
463 # FIXME The output for dry-run mode needs to be improved
464 # But non trivial changes to C4::Members need to be done before.
467 DeleteExpiredSelfRegs();
468 } elsif ( $verbose ) {
469 say "self-registered borrowers may be deleted";
474 DeleteUnverifiedSelfRegs( $pUnvSelfReg );
475 } elsif ( $verbose ) {
476 say "unverified self-registrations may be deleted";
480 if ($special_holidays_days) {
482 DeleteSpecialHolidays( abs($special_holidays_days) );
483 } elsif ( $verbose ) {
484 say "self-registered borrowers may be deleted";
488 if( $temp_uploads ) {
489 # Delete temporary uploads, governed by a pref (unless you override)
490 print "Purging temporary uploads.\n" if $verbose;
492 Koha::UploadedFiles->delete_temporary({
493 defined($temp_uploads_days)
494 ? ( override_pref => $temp_uploads_days )
498 print "Done purging temporary uploads.\n" if $verbose;
501 if( defined $uploads_missing ) {
502 print "Looking for missing uploads\n" if $verbose;
504 my $keep = $uploads_missing == 1 ? 0 : 1;
505 my $count = Koha::UploadedFiles->delete_missing({ keep_record => $keep });
507 print "Counted $count missing uploaded files\n";
509 print "Removed $count records for missing uploads\n";
512 # FIXME need to create a filter_by_missing method (then call ->delete) instead of delete_missing
513 say "Dry-run mode cannot guess how many uploads would have been deleted";
518 require Koha::OAuthAccessTokens;
520 my $tokens = Koha::OAuthAccessTokens->search({ expires => { '<=', time } });
521 my $count = $tokens->count;
522 $tokens->delete if $confirm;
525 ? sprintf( "Removed %d expired OAuth2 tokens", $count )
526 : sprintf( "%d expired OAuth tokens would have been removed", $count );
531 print "Purging statistics older than $pStatistics days.\n" if $verbose;
532 my $statistics = Koha::Statistics->filter_by_last_update(
533 { timestamp_column_name => 'datetime', days => $pStatistics } );
534 my $count = $statistics->count;
535 $statistics->delete if $confirm;
538 ? sprintf( "Done with purging %d statistics", $count )
539 : sprintf( "%d statistics would have been removed", $count );
543 if( $return_claims && ( my $days = C4::Context->preference('CleanUpDatabaseReturnClaims') )) {
544 print "Purging return claims older than $days days.\n" if $verbose;
546 $return_claims = Koha::Checkouts::ReturnClaims->filter_by_last_update(
548 timestamp_column_name => 'resolved_on',
553 my $count = $return_claims->count;
554 $return_claims->delete if $confirm;
558 ? sprintf "Done with purging %d resolved return claims.", $count
559 : sprintf "%d resolved return claims would have been purged.", $count;
563 if ($pDeletedCatalog) {
564 print "Purging deleted catalog older than $pDeletedCatalog days.\n"
566 my $old_items = Koha::Old::Items->filter_by_last_update( { days => $pDeletedCatalog } );
567 my $old_biblioitems = Koha::Old::Biblioitems->filter_by_last_update( { days => $pDeletedCatalog } );
568 my $old_biblios = Koha::Old::Biblios->filter_by_last_update( { days => $pDeletedCatalog } );
569 my ( $c_i, $c_bi, $c_b ) =
570 ( $old_items->count, $old_biblioitems->count, $old_biblios->count );
573 $old_biblioitems->delete;
574 $old_biblios->delete;
579 ? "Done with purging deleted catalog (%d items, %d biblioitems, %d biblios)."
580 : "Deleted catalog would have been removed (%d items, %d biblioitems, %d biblios).",
585 if ($pDeletedPatrons) {
586 print "Purging deleted patrons older than $pDeletedPatrons days.\n" if $verbose;
587 my $old_patrons = Koha::Old::Patrons->filter_by_last_update(
588 { timestamp_column_name => 'updated_on', days => $pDeletedPatrons } );
589 my $count = $old_patrons->count;
590 $old_patrons->delete if $confirm;
593 ? sprintf "Done with purging %d deleted patrons.", $count
594 : sprintf "%d deleted patrons would have been purged.", $count;
599 print "Purging old checkouts older than $pOldIssues days.\n" if $verbose;
600 my $old_checkouts = Koha::Old::Checkouts->filter_by_last_update( { days => $pOldIssues } );
601 my $count = $old_checkouts->count;
602 $old_checkouts->delete if $confirm;
605 ? sprintf "Done with purging %d old checkouts.", $count
606 : sprintf "%d old checkouts would have been purged.", $count;
611 print "Purging old reserves older than $pOldReserves days.\n" if $verbose;
612 my $old_reserves = Koha::Old::Holds->filter_by_last_update( { days => $pOldReserves } );
613 my $count = $old_reserves->count;
614 $old_reserves->delete if $confirm;
617 ? sprintf "Done with purging %d old reserves.", $count
618 : sprintf "%d old reserves would have been purged.", $count;
623 print "Purging arrived item transfers older than $pTransfers days.\n" if $verbose;
624 my $transfers = Koha::Item::Transfers->filter_by_last_update(
626 timestamp_column_name => 'datearrived',
630 my $count = $transfers->count;
631 $transfers->delete if $confirm;
634 ? sprintf "Done with purging %d transfers.", $count
635 : sprintf "%d transfers would have been purged.", $count;
639 if (defined $pPseudoTransactions or $pPseudoTransactionsFrom or $pPseudoTransactionsTo ) {
640 print "Purging pseudonymized transactions\n" if $verbose;
641 my $anonymized_transactions = Koha::PseudonymizedTransactions->filter_by_last_update(
643 timestamp_column_name => 'datetime',
644 ( defined $pPseudoTransactions ? ( days => $pPseudoTransactions ) : () ),
645 ( $pPseudoTransactionsFrom ? ( from => $pPseudoTransactionsFrom ) : () ),
646 ( $pPseudoTransactionsTo ? ( to => $pPseudoTransactionsTo ) : () ),
649 my $count = $anonymized_transactions->count;
650 $anonymized_transactions->delete if $confirm;
653 ? sprintf "Done with purging %d pseudonymized transactions.", $count
654 : sprintf "%d pseudonymized transactions would have been purged.", $count;
659 print "Purging item label batches last added to more than $labels days ago.\n" if $verbose;
660 my $count = PurgeCreatorBatches($labels, 'labels', $confirm);
663 ? sprintf "Done with purging %d item label batches last added to more than %d days ago.\n", $count, $labels
664 : sprintf "%d item label batches would have been purged.", $count;
669 print "Purging card creator batches last added to more than $cards days ago.\n" if $verbose;
670 my $count = PurgeCreatorBatches($labels, 'patroncards', $confirm);
673 ? sprintf "Done with purging %d card creator batches last added to more than %d days ago.\n", $count, $labels
674 : sprintf "%d card creator batches would have been purged.", $count;
678 cronlogaction({ action => 'End', info => "COMPLETED" });
682 sub RemoveOldSessions {
683 my ( $id, $a_session, $limit, $lasttime );
684 $limit = time() - 24 * 3600 * $sess_days;
686 $sth = $dbh->prepare(q{ SELECT id, a_session FROM sessions });
687 $sth->execute or die $dbh->errstr;
688 $sth->bind_columns( \$id, \$a_session );
689 $sth2 = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? });
692 while ( $sth->fetch ) {
694 if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
697 elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
700 if ( $lasttime && $lasttime < $limit ) {
701 $sth2->execute($id) or die $dbh->errstr;
706 print "$count sessions were deleted.\n";
710 sub PurgeImportTables {
712 #First purge import_records
713 #Delete cascades to import_biblios, import_items and import_record_matches
714 $sth = $dbh->prepare(
716 DELETE FROM import_records
717 WHERE upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
720 $sth->execute($pImport) or die $dbh->errstr;
722 # Now purge import_batches
723 # Timestamp cannot be used here without care, because records are added
724 # continuously to batches without updating timestamp (Z39.50 search).
725 # So we only delete older empty batches.
726 # This delete will therefore not have a cascading effect.
727 $sth = $dbh->prepare(
730 FROM import_batches ba
731 LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
732 WHERE re.import_record_id IS NULL AND
733 ba.upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
736 $sth->execute($pImport) or die $dbh->errstr;
740 $sth = $dbh->prepare(
742 DELETE FROM import_batches
743 WHERE batch_type = 'z3950'
746 $sth->execute() or die $dbh->errstr;
749 sub PurgeDebarments {
750 require Koha::Patron::Debarments;
751 my ( $days, $doit ) = @_;
753 $sth = $dbh->prepare(
755 SELECT borrower_debarment_id
756 FROM borrower_debarments
757 WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
760 $sth->execute($days) or die $dbh->errstr;
761 while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
762 Koha::Patron::Debarments::DelDebarment($borrower_debarment_id) if $doit;
768 sub PurgeCreatorBatches {
769 require C4::Labels::Batch;
770 my ( $days, $creator, $doit ) = @_;
772 $sth = $dbh->prepare(
774 SELECT batch_id, branch_code FROM creator_batches
777 FROM (SELECT batch_id
781 HAVING max(timestamp) <= date_sub(curdate(),interval ? day)) a)
784 $sth->execute( $creator, $days ) or die $dbh->errstr;
785 while ( my ( $batch_id, $branch_code ) = $sth->fetchrow_array ) {
786 C4::Labels::Batch::delete(
787 batch_id => $batch_id,
788 branch_code => $branch_code
795 sub DeleteExpiredSelfRegs {
796 my $cnt= C4::Members::DeleteExpiredOpacRegistrations();
797 print "Removed $cnt expired self-registered borrowers\n" if $verbose;
800 sub DeleteUnverifiedSelfRegs {
801 my $cnt= C4::Members::DeleteUnverifiedOpacRegistrations( $_[0] );
802 print "Removed $cnt unverified self-registrations\n" if $verbose;
805 sub DeleteSpecialHolidays {
808 my $sth = $dbh->prepare(q{
809 DELETE FROM special_holidays
810 WHERE DATE( CONCAT( year, '-', month, '-', day ) ) < DATE_SUB( CAST(NOW() AS DATE), INTERVAL ? DAY );
812 my $count = $sth->execute( $days ) + 0;
813 print "Removed $count unique holidays\n" if $verbose;