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;
58 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]
60 -h --help prints this help message, and exits, ignoring all
62 --confirm Confirmation flag, the script will be running in dry-run mode is not set.
63 --sessions purge the sessions table. If you use this while users
64 are logged into Koha, they will have to reconnect.
65 --sessdays DAYS purge only sessions older than DAYS days.
66 -v --verbose will cause the script to give you a bit more information
68 --zebraqueue DAYS purge completed zebraqueue entries older than DAYS days.
69 Defaults to 30 days if no days specified.
70 -m --mail DAYS purge items from the mail queue that are older than DAYS days.
71 Defaults to 30 days if no days specified.
72 --merged purged completed entries from need_merge_authorities.
73 --messages DAYS purge entries from messages table older than DAYS days.
74 Defaults to 365 days if no days specified.
75 --import DAYS purge records from import tables older than DAYS days.
76 Defaults to 60 days if no days specified.
77 --z3950 purge records from import tables that are the result
79 --fees DAYS purge entries accountlines older than DAYS days, where
80 amountoutstanding is 0 or NULL.
81 In the case of --fees, DAYS must be greater than
83 --log_modules Specify which action log modules to trim. Repeatable.
84 --preserve_logs Specify which action logs to exclude. Repeatable.
85 --logs DAYS purge entries from action_logs older than DAYS days.
86 Defaults to 180 days if no days specified.
87 --searchhistory DAYS purge entries from search_history older than DAYS days.
88 Defaults to 30 days if no days specified
89 --list-invites DAYS purge (unaccepted) list share invites older than DAYS
90 days. Defaults to 14 days if no days specified.
91 --restrictions DAYS purge patrons restrictions expired since more than DAYS days.
92 Defaults to 30 days if no days specified.
93 --all-restrictions purge all expired patrons restrictions.
94 --del-exp-selfreg Delete expired self registration accounts
95 --del-unv-selfreg DAYS Delete unverified self registrations older than DAYS
96 --unique-holidays DAYS Delete all unique holidays older than DAYS
97 --temp-uploads Delete temporary uploads.
98 --temp-uploads-days DAYS Override the corresponding preference value.
99 --uploads-missing FLAG Delete upload records for missing files when FLAG is true, count them otherwise
100 --oauth-tokens Delete expired OAuth2 tokens
101 --statistics DAYS Purge statistics entries more than DAYS days old.
102 This table is used to build reports, make sure you are aware of the consequences of this before using it!
103 --deleted-catalog DAYS Purge catalog records deleted more then DAYS days ago
104 (from tables deleteditems, deletedbiblioitems, deletedbiblio_metadata and deletedbiblio).
105 --deleted-patrons DAYS Purge patrons deleted more than DAYS days ago.
106 --old-issues DAYS Purge checkouts (old_issues) returned more than DAYS days ago.
107 --old-reserves DAYS Purge reserves (old_reserves) more than DAYS old.
108 --transfers DAYS Purge transfers completed more than DAYS day ago.
109 --pseudo-transactions DAYS Purge the pseudonymized transactions that have been originally created more than DAYS days ago
110 DAYS is optional and can be replaced by:
111 --pseudo-transactions-from YYYY-MM-DD and/or --pseudo-transactions-to YYYY-MM-DD
112 --labels DAYS Purge item label batches last added to more than DAYS days ago.
113 --cards DAY Purge card creator batches last added to more than DAYS days ago.
114 --return-claims Purge all resolved return claims older than the number of days specified in
115 the system preference CleanUpDatabaseReturnClaims.
132 my $pListShareInvites;
139 my $special_holidays_days;
141 my $temp_uploads_days;
150 my ( $pPseudoTransactions, $pPseudoTransactionsFrom, $pPseudoTransactionsTo );
152 my $lock_days = C4::Context->preference('LockExpiredDelay');
160 'confirm' => \$confirm,
161 'sessions' => \$sessions,
162 'sessdays:i' => \$sess_days,
163 'v|verbose' => \$verbose,
164 'm|mail:i' => \$mail,
165 'zebraqueue:i' => \$zebraqueue_days,
166 'merged' => \$purge_merged,
167 'import:i' => \$pImport,
170 'log_module:s' => \@log_modules,
171 'preserve_log:s' => \@preserve_logs,
172 'messages:i' => \$pMessages,
173 'fees:i' => \$fees_days,
174 'searchhistory:i' => \$pSearchhistory,
175 'list-invites:i' => \$pListShareInvites,
176 'restrictions:i' => \$pDebarments,
177 'all-restrictions' => \$allDebarments,
178 'del-exp-selfreg' => \$pExpSelfReg,
179 'del-unv-selfreg' => \$pUnvSelfReg,
180 'unique-holidays:i' => \$special_holidays_days,
181 'temp-uploads' => \$temp_uploads,
182 'temp-uploads-days:i' => \$temp_uploads_days,
183 'uploads-missing:i' => \$uploads_missing,
184 'oauth-tokens' => \$oauth_tokens,
185 'statistics:i' => \$pStatistics,
186 'deleted-catalog:i' => \$pDeletedCatalog,
187 'deleted-patrons:i' => \$pDeletedPatrons,
188 'old-issues:i' => \$pOldIssues,
189 'old-reserves:i' => \$pOldReserves,
190 'transfers:i' => \$pTransfers,
191 'pseudo-transactions:i' => \$pPseudoTransactions,
192 'pseudo-transactions-from:s' => \$pPseudoTransactionsFrom,
193 'pseudo-transactions-to:s' => \$pPseudoTransactionsTo,
194 'labels' => \$labels,
196 'return-claims' => \$return_claims,
200 $sessions = 1 if $sess_days && $sess_days > 0;
201 $pImport = DEFAULT_IMPORT_PURGEDAYS if defined($pImport) && $pImport == 0;
202 $pLogs = DEFAULT_LOGS_PURGEDAYS if defined($pLogs) && $pLogs == 0;
203 $zebraqueue_days = DEFAULT_ZEBRAQ_PURGEDAYS if defined($zebraqueue_days) && $zebraqueue_days == 0;
204 $mail = DEFAULT_MAIL_PURGEDAYS if defined($mail) && $mail == 0;
205 $pSearchhistory = DEFAULT_SEARCHHISTORY_PURGEDAYS if defined($pSearchhistory) && $pSearchhistory == 0;
206 $pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0;
207 $pDebarments = DEFAULT_DEBARMENTS_PURGEDAYS if defined($pDebarments) && $pDebarments == 0;
208 $pMessages = DEFAULT_MESSAGES_PURGEDAYS if defined($pMessages) && $pMessages == 0;
223 || $pListShareInvites
228 || $special_holidays_days
230 || defined $uploads_missing
238 || defined $pPseudoTransactions
239 || $pPseudoTransactionsFrom
240 || $pPseudoTransactionsTo
242 || defined $lock_days && $lock_days ne q{}
247 print "You did not specify any cleanup work for the script to do.\n\n";
251 if ($pDebarments && $allDebarments) {
252 print "You can not specify both --restrictions and --all-restrictions.\n\n";
256 say "Confirm flag not passed, running in dry-run mode..." unless $confirm;
258 cronlogaction() unless $confirm;
260 my $dbh = C4::Context->dbh();
264 if ( $sessions && !$sess_days ) {
266 say "Session purge triggered.";
267 $sth = $dbh->prepare(q{ SELECT COUNT(*) FROM sessions });
268 $sth->execute() or die $dbh->errstr;
269 my @count_arr = $sth->fetchrow_array;
270 say $confirm ? "$count_arr[0] entries will be deleted." : "$count_arr[0] entries would be deleted.";
273 $sth = $dbh->prepare(q{ TRUNCATE sessions });
274 $sth->execute() or die $dbh->errstr;
277 print "Done with session purge.\n";
280 elsif ( $sessions && $sess_days > 0 ) {
281 print "Session purge triggered with days>$sess_days.\n" if $verbose;
282 RemoveOldSessions() if $confirm;
283 print "Done with session purge with days>$sess_days.\n" if $verbose;
286 if ($zebraqueue_days) {
288 print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
289 $sth = $dbh->prepare(
291 SELECT id,biblio_auth_number,server,time
293 WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY)
296 $sth->execute($zebraqueue_days) or die $dbh->errstr;
297 $sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? });
298 while ( my $record = $sth->fetchrow_hashref ) {
300 $sth2->execute( $record->{id} ) or die $dbh->errstr;
305 say $confirm ? "$count records were deleted." : "$count records would have been deleted.";
306 say "Done with zebraqueue purge.";
312 print "Mail queue purge triggered for $mail days.\n" if $verbose;
313 $sth = $dbh->prepare(
315 DELETE FROM message_queue
316 WHERE time_queued < date_sub(curdate(), INTERVAL ? DAY)
320 $sth->execute($mail) or die $dbh->errstr;
324 say $confirm ? "$count messages were deleted from the mail queue." : "Message from message_queue would have been deleted";
325 say "Done with message_queue purge.";
330 print "Purging completed entries from need_merge_authorities.\n" if $verbose;
332 $sth = $dbh->prepare(q{ DELETE FROM need_merge_authorities WHERE done=1 });
333 $sth->execute() or die $dbh->errstr;
335 print "Done with purging need_merge_authorities.\n" if $verbose;
339 print "Purging records from import tables.\n" if $verbose;
340 PurgeImportTables() if $confirm;
341 print "Done with purging import tables.\n" if $verbose;
345 print "Purging Z39.50 records from import tables.\n" if $verbose;
346 PurgeZ3950() if $confirm;
347 print "Done with purging Z39.50 records from import tables.\n" if $verbose;
351 print "Purging records from action_logs.\n" if $verbose;
353 DELETE FROM action_logs
354 WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY)
356 my @query_params = ();
357 if( @preserve_logs ){
358 $log_query .= " AND module NOT IN (" . join(',',('?') x @preserve_logs ) . ")";
359 push @query_params, @preserve_logs;
362 $log_query .= " AND module IN (" . join(',',('?') x @log_modules ) . ")";
363 push @query_params, @log_modules;
365 $sth = $dbh->prepare( $log_query );
367 $sth->execute($pLogs, @query_params) or die $dbh->errstr;
369 print "Done with purging action_logs.\n" if $verbose;
373 print "Purging messages older than $pMessages days.\n" if $verbose;
374 my $messages = Koha::Patron::Messages->filter_by_last_update(
375 { timestamp_column_name => 'message_date', days => $pMessages } );
376 my $count = $messages->count;
377 $messages->delete if $confirm;
380 ? sprintf( "Done with purging %d messages", $count )
381 : sprintf( "%d messages would have been removed", $count );
386 print "Purging records from accountlines.\n" if $verbose;
387 purge_zero_balance_fees( $fees_days ) if $confirm;
388 print "Done purging records from accountlines.\n" if $verbose;
391 if ($pSearchhistory) {
392 print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;
393 C4::Search::History::delete({ interval => $pSearchhistory }) if $confirm;
394 print "Done with purging search_history.\n" if $verbose;
397 if ($pListShareInvites) {
398 print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;
399 $sth = $dbh->prepare(
401 DELETE FROM virtualshelfshares
402 WHERE invitekey IS NOT NULL
403 AND (sharedate + INTERVAL ? DAY) < NOW()
407 $sth->execute($pListShareInvites);
409 print "Done with purging unaccepted list share invites.\n" if $verbose;
413 print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
414 my $count = PurgeDebarments($pDebarments, $confirm);
416 say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
417 say "Done with restrictions purge.";
422 print "All expired patrons restrictions purge triggered.\n" if $verbose;
423 my $count = PurgeDebarments(0, $confirm);
425 say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
426 say "Done with all restrictions purge.";
430 # Lock expired patrons?
431 if( defined $lock_days && $lock_days ne q{} ) {
432 say "Start locking expired patrons" if $verbose;
433 my $expired_patrons = Koha::Patrons->filter_by_expiration_date({ days => $lock_days })->search({ login_attempts => { '!=' => -1 } });
434 my $count = $expired_patrons->count;
435 $expired_patrons->lock({ remove => 1 }) if $confirm;
437 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("Found %d patrons", $count);
441 # Handle unsubscribe requests from GDPR consent form, depends on UnsubscribeReflectionDelay preference
442 say "Start lock unsubscribed, anonymize and delete" if $verbose;
443 my $unsubscribed_patrons = Koha::Patrons->search_unsubscribed;
444 my $count = $unsubscribed_patrons->count;
445 $unsubscribed_patrons->lock( { expire => 1, remove => 1 } ) if $confirm;
446 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("%d patrons would have been locked", $count) if $verbose;
448 # Anonymize patron data, depending on PatronAnonymizeDelay
449 my $anonymize_candidates = Koha::Patrons->search_anonymize_candidates( { locked => 1 } );
450 $count = $anonymize_candidates->count;
451 $anonymize_candidates->anonymize if $confirm;
452 say $confirm ? sprintf("Anonymized %d patrons", $count) : sprintf("%d patrons would have been anonymized", $count) if $verbose;
454 # Remove patron data, depending on PatronRemovalDelay (will raise an exception if problem encountered
455 my $anonymized_patrons = Koha::Patrons->search_anonymized;
456 $count = $anonymized_patrons->count;
458 $anonymized_patrons->delete( { move => 1 } );
464 say $confirm ? sprintf("Deleted %d patrons", $count) : sprintf("%d patrons would have been deleted", $count);
467 # FIXME The output for dry-run mode needs to be improved
468 # But non trivial changes to C4::Members need to be done before.
471 DeleteExpiredSelfRegs();
472 } elsif ( $verbose ) {
473 say "self-registered borrowers may be deleted";
478 DeleteUnverifiedSelfRegs( $pUnvSelfReg );
479 } elsif ( $verbose ) {
480 say "unverified self-registrations may be deleted";
484 if ($special_holidays_days) {
486 DeleteSpecialHolidays( abs($special_holidays_days) );
487 } elsif ( $verbose ) {
488 say "self-registered borrowers may be deleted";
492 if( $temp_uploads ) {
493 # Delete temporary uploads, governed by a pref (unless you override)
494 print "Purging temporary uploads.\n" if $verbose;
496 Koha::UploadedFiles->delete_temporary({
497 defined($temp_uploads_days)
498 ? ( override_pref => $temp_uploads_days )
502 print "Done purging temporary uploads.\n" if $verbose;
505 if( defined $uploads_missing ) {
506 print "Looking for missing uploads\n" if $verbose;
508 my $keep = $uploads_missing == 1 ? 0 : 1;
509 my $count = Koha::UploadedFiles->delete_missing({ keep_record => $keep });
511 print "Counted $count missing uploaded files\n";
513 print "Removed $count records for missing uploads\n";
516 # FIXME need to create a filter_by_missing method (then call ->delete) instead of delete_missing
517 say "Dry-run mode cannot guess how many uploads would have been deleted";
522 require Koha::OAuthAccessTokens;
524 my $tokens = Koha::OAuthAccessTokens->search({ expires => { '<=', time } });
525 my $count = $tokens->count;
526 $tokens->delete if $confirm;
529 ? sprintf( "Removed %d expired OAuth2 tokens", $count )
530 : sprintf( "%d expired OAuth tokens would have been removed", $count );
535 print "Purging statistics older than $pStatistics days.\n" if $verbose;
536 my $statistics = Koha::Statistics->filter_by_last_update(
537 { timestamp_column_name => 'datetime', days => $pStatistics } );
538 my $count = $statistics->count;
539 $statistics->delete if $confirm;
542 ? sprintf( "Done with purging %d statistics", $count )
543 : sprintf( "%d statistics would have been removed", $count );
547 if( $return_claims && ( my $days = C4::Context->preference('CleanUpDatabaseReturnClaims') )) {
548 print "Purging return claims older than $days days.\n" if $verbose;
550 $return_claims = Koha::Checkouts::ReturnClaims->filter_by_last_update(
552 timestamp_column_name => 'resolved_on',
557 my $count = $return_claims->count;
558 $return_claims->delete if $confirm;
562 ? sprintf "Done with purging %d resolved return claims.", $count
563 : sprintf "%d resolved return claims would have been purged.", $count;
567 if ($pDeletedCatalog) {
568 print "Purging deleted catalog older than $pDeletedCatalog days.\n"
570 my $old_items = Koha::Old::Items->filter_by_last_update( { days => $pDeletedCatalog } );
571 my $old_biblioitems = Koha::Old::Biblioitems->filter_by_last_update( { days => $pDeletedCatalog } );
572 my $old_biblios = Koha::Old::Biblios->filter_by_last_update( { days => $pDeletedCatalog } );
573 my ( $c_i, $c_bi, $c_b ) =
574 ( $old_items->count, $old_biblioitems->count, $old_biblios->count );
577 $old_biblioitems->delete;
578 $old_biblios->delete;
583 ? "Done with purging deleted catalog (%d items, %d biblioitems, %d biblios)."
584 : "Deleted catalog would have been removed (%d items, %d biblioitems, %d biblios).",
589 if ($pDeletedPatrons) {
590 print "Purging deleted patrons older than $pDeletedPatrons days.\n" if $verbose;
591 my $old_patrons = Koha::Old::Patrons->filter_by_last_update(
592 { timestamp_column_name => 'updated_on', days => $pDeletedPatrons } );
593 my $count = $old_patrons->count;
594 $old_patrons->delete if $confirm;
597 ? sprintf "Done with purging %d deleted patrons.", $count
598 : sprintf "%d deleted patrons would have been purged.", $count;
603 print "Purging old checkouts older than $pOldIssues days.\n" if $verbose;
604 my $old_checkouts = Koha::Old::Checkouts->filter_by_last_update( { days => $pOldIssues } );
605 my $count = $old_checkouts->count;
606 $old_checkouts->delete if $confirm;
609 ? sprintf "Done with purging %d old checkouts.", $count
610 : sprintf "%d old checkouts would have been purged.", $count;
615 print "Purging old reserves older than $pOldReserves days.\n" if $verbose;
616 my $old_reserves = Koha::Old::Holds->filter_by_last_update( { days => $pOldReserves } );
617 my $count = $old_reserves->count;
618 $old_reserves->delete if $verbose;
621 ? sprintf "Done with purging %d old reserves.", $count
622 : sprintf "%d old reserves would have been purged.", $count;
627 print "Purging arrived item transfers older than $pTransfers days.\n" if $verbose;
628 my $transfers = Koha::Item::Transfers->filter_by_last_update(
630 timestamp_column_name => 'datearrived',
634 my $count = $transfers->count;
635 $transfers->delete if $verbose;
638 ? sprintf "Done with purging %d transfers.", $count
639 : sprintf "%d transfers would have been purged.", $count;
643 if (defined $pPseudoTransactions or $pPseudoTransactionsFrom or $pPseudoTransactionsTo ) {
644 print "Purging pseudonymized transactions\n" if $verbose;
645 my $anonymized_transactions = Koha::PseudonymizedTransactions->filter_by_last_update(
647 timestamp_column_name => 'datetime',
648 ( defined $pPseudoTransactions ? ( days => $pPseudoTransactions ) : () ),
649 ( $pPseudoTransactionsFrom ? ( from => $pPseudoTransactionsFrom ) : () ),
650 ( $pPseudoTransactionsTo ? ( to => $pPseudoTransactionsTo ) : () ),
653 my $count = $anonymized_transactions->count;
654 $anonymized_transactions->delete if $confirm;
657 ? sprintf "Done with purging %d pseudonymized transactions.", $count
658 : sprintf "%d pseudonymized transactions would have been purged.", $count;
663 print "Purging item label batches last added to more than $labels days ago.\n" if $verbose;
664 my $count = PurgeCreatorBatches($labels, 'labels', $confirm);
667 ? sprintf "Done with purging %d item label batches last added to more than %d days ago.\n", $count, $labels
668 : sprintf "%d item label batches would have been purged.", $count;
673 print "Purging card creator batches last added to more than $cards days ago.\n" if $verbose;
674 my $count = PurgeCreatorBatches($labels, 'patroncards', $confirm);
677 ? sprintf "Done with purging %d card creator batches last added to more than %d days ago.\n", $count, $labels
678 : sprintf "%d card creator batches would have been purged.", $count;
684 sub RemoveOldSessions {
685 my ( $id, $a_session, $limit, $lasttime );
686 $limit = time() - 24 * 3600 * $sess_days;
688 $sth = $dbh->prepare(q{ SELECT id, a_session FROM sessions });
689 $sth->execute or die $dbh->errstr;
690 $sth->bind_columns( \$id, \$a_session );
691 $sth2 = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? });
694 while ( $sth->fetch ) {
696 if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
699 elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
702 if ( $lasttime && $lasttime < $limit ) {
703 $sth2->execute($id) or die $dbh->errstr;
708 print "$count sessions were deleted.\n";
712 sub PurgeImportTables {
714 #First purge import_records
715 #Delete cascades to import_biblios, import_items and import_record_matches
716 $sth = $dbh->prepare(
718 DELETE FROM import_records
719 WHERE upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
722 $sth->execute($pImport) or die $dbh->errstr;
724 # Now purge import_batches
725 # Timestamp cannot be used here without care, because records are added
726 # continuously to batches without updating timestamp (Z39.50 search).
727 # So we only delete older empty batches.
728 # This delete will therefore not have a cascading effect.
729 $sth = $dbh->prepare(
732 FROM import_batches ba
733 LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
734 WHERE re.import_record_id IS NULL AND
735 ba.upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
738 $sth->execute($pImport) or die $dbh->errstr;
742 $sth = $dbh->prepare(
744 DELETE FROM import_batches
745 WHERE batch_type = 'z3950'
748 $sth->execute() or die $dbh->errstr;
751 sub PurgeDebarments {
752 require Koha::Patron::Debarments;
753 my ( $days, $doit ) = @_;
755 $sth = $dbh->prepare(
757 SELECT borrower_debarment_id
758 FROM borrower_debarments
759 WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
762 $sth->execute($days) or die $dbh->errstr;
763 while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
764 Koha::Patron::Debarments::DelDebarment($borrower_debarment_id) if $doit;
770 sub PurgeCreatorBatches {
771 require C4::Labels::Batch;
772 my ( $days, $creator, $doit ) = @_;
774 $sth = $dbh->prepare(
776 SELECT batch_id, branch_code FROM creator_batches
779 FROM (SELECT batch_id
783 HAVING max(timestamp) <= date_sub(curdate(),interval ? day)) a)
786 $sth->execute( $creator, $days ) or die $dbh->errstr;
787 while ( my ( $batch_id, $branch_code ) = $sth->fetchrow_array ) {
788 C4::Labels::Batch::delete(
789 batch_id => $batch_id,
790 branch_code => $branch_code
797 sub DeleteExpiredSelfRegs {
798 my $cnt= C4::Members::DeleteExpiredOpacRegistrations();
799 print "Removed $cnt expired self-registered borrowers\n" if $verbose;
802 sub DeleteUnverifiedSelfRegs {
803 my $cnt= C4::Members::DeleteUnverifiedOpacRegistrations( $_[0] );
804 print "Removed $cnt unverified self-registrations\n" if $verbose;
807 sub DeleteSpecialHolidays {
810 my $sth = $dbh->prepare(q{
811 DELETE FROM special_holidays
812 WHERE DATE( CONCAT( year, '-', month, '-', day ) ) < DATE_SUB( CAST(NOW() AS DATE), INTERVAL ? DAY );
814 my $count = $sth->execute( $days ) + 0;
815 print "Removed $count unique holidays\n" if $verbose;