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 --logs DAYS purge entries from action_logs older than DAYS days.
84 Defaults to 180 days if no days specified.
85 --searchhistory DAYS purge entries from search_history older than DAYS days.
86 Defaults to 30 days if no days specified
87 --list-invites DAYS purge (unaccepted) list share invites older than DAYS
88 days. Defaults to 14 days if no days specified.
89 --restrictions DAYS purge patrons restrictions expired since more than DAYS days.
90 Defaults to 30 days if no days specified.
91 --all-restrictions purge all expired patrons restrictions.
92 --del-exp-selfreg Delete expired self registration accounts
93 --del-unv-selfreg DAYS Delete unverified self registrations older than DAYS
94 --unique-holidays DAYS Delete all unique holidays older than DAYS
95 --temp-uploads Delete temporary uploads.
96 --temp-uploads-days DAYS Override the corresponding preference value.
97 --uploads-missing FLAG Delete upload records for missing files when FLAG is true, count them otherwise
98 --oauth-tokens Delete expired OAuth2 tokens
99 --statistics DAYS Purge statistics entries more than DAYS days old.
100 This table is used to build reports, make sure you are aware of the consequences of this before using it!
101 --deleted-catalog DAYS Purge catalog records deleted more then DAYS days ago
102 (from tables deleteditems, deletedbiblioitems, deletedbiblio_metadata and deletedbiblio).
103 --deleted-patrons DAYS Purge patrons deleted more than DAYS days ago.
104 --old-issues DAYS Purge checkouts (old_issues) returned more than DAYS days ago.
105 --old-reserves DAYS Purge reserves (old_reserves) more than DAYS old.
106 --transfers DAYS Purge transfers completed more than DAYS day ago.
107 --pseudo-transactions DAYS Purge the pseudonymized transactions that have been originally created more than DAYS days ago
108 DAYS is optional and can be replaced by:
109 --pseudo-transactions-from YYYY-MM-DD and/or --pseudo-transactions-to YYYY-MM-DD
110 --labels DAYS Purge item label batches last added to more than DAYS days ago.
111 --cards DAY Purge card creator batches last added to more than DAYS days ago.
112 --return-claims Purge all resolved return claims older than the number of days specified in
113 the system preference CleanUpDatabaseReturnClaims.
130 my $pListShareInvites;
137 my $special_holidays_days;
139 my $temp_uploads_days;
148 my ( $pPseudoTransactions, $pPseudoTransactionsFrom, $pPseudoTransactionsTo );
150 my $lock_days = C4::Context->preference('LockExpiredDelay');
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 'messages:i' => \$pMessages,
167 'fees:i' => \$fees_days,
168 'searchhistory:i' => \$pSearchhistory,
169 'list-invites:i' => \$pListShareInvites,
170 'restrictions:i' => \$pDebarments,
171 'all-restrictions' => \$allDebarments,
172 'del-exp-selfreg' => \$pExpSelfReg,
173 'del-unv-selfreg' => \$pUnvSelfReg,
174 'unique-holidays:i' => \$special_holidays_days,
175 'temp-uploads' => \$temp_uploads,
176 'temp-uploads-days:i' => \$temp_uploads_days,
177 'uploads-missing:i' => \$uploads_missing,
178 'oauth-tokens' => \$oauth_tokens,
179 'statistics:i' => \$pStatistics,
180 'deleted-catalog:i' => \$pDeletedCatalog,
181 'deleted-patrons:i' => \$pDeletedPatrons,
182 'old-issues:i' => \$pOldIssues,
183 'old-reserves:i' => \$pOldReserves,
184 'transfers:i' => \$pTransfers,
185 'pseudo-transactions:i' => \$pPseudoTransactions,
186 'pseudo-transactions-from:s' => \$pPseudoTransactionsFrom,
187 'pseudo-transactions-to:s' => \$pPseudoTransactionsTo,
188 'labels' => \$labels,
190 'return-claims' => \$return_claims,
194 $sessions = 1 if $sess_days && $sess_days > 0;
195 $pImport = DEFAULT_IMPORT_PURGEDAYS if defined($pImport) && $pImport == 0;
196 $pLogs = DEFAULT_LOGS_PURGEDAYS if defined($pLogs) && $pLogs == 0;
197 $zebraqueue_days = DEFAULT_ZEBRAQ_PURGEDAYS if defined($zebraqueue_days) && $zebraqueue_days == 0;
198 $mail = DEFAULT_MAIL_PURGEDAYS if defined($mail) && $mail == 0;
199 $pSearchhistory = DEFAULT_SEARCHHISTORY_PURGEDAYS if defined($pSearchhistory) && $pSearchhistory == 0;
200 $pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0;
201 $pDebarments = DEFAULT_DEBARMENTS_PURGEDAYS if defined($pDebarments) && $pDebarments == 0;
202 $pMessages = DEFAULT_MESSAGES_PURGEDAYS if defined($pMessages) && $pMessages == 0;
217 || $pListShareInvites
222 || $special_holidays_days
224 || defined $uploads_missing
232 || defined $pPseudoTransactions
233 || $pPseudoTransactionsFrom
234 || $pPseudoTransactionsTo
236 || defined $lock_days && $lock_days ne q{}
241 print "You did not specify any cleanup work for the script to do.\n\n";
245 if ($pDebarments && $allDebarments) {
246 print "You can not specify both --restrictions and --all-restrictions.\n\n";
250 say "Confirm flag not passed, running in dry-run mode..." unless $confirm;
252 cronlogaction() unless $confirm;
254 my $dbh = C4::Context->dbh();
258 if ( $sessions && !$sess_days ) {
260 say "Session purge triggered.";
261 $sth = $dbh->prepare(q{ SELECT COUNT(*) FROM sessions });
262 $sth->execute() or die $dbh->errstr;
263 my @count_arr = $sth->fetchrow_array;
264 say $confirm ? "$count_arr[0] entries will be deleted." : "$count_arr[0] entries would be deleted.";
267 $sth = $dbh->prepare(q{ TRUNCATE sessions });
268 $sth->execute() or die $dbh->errstr;
271 print "Done with session purge.\n";
274 elsif ( $sessions && $sess_days > 0 ) {
275 print "Session purge triggered with days>$sess_days.\n" if $verbose;
276 RemoveOldSessions() if $confirm;
277 print "Done with session purge with days>$sess_days.\n" if $verbose;
280 if ($zebraqueue_days) {
282 print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
283 $sth = $dbh->prepare(
285 SELECT id,biblio_auth_number,server,time
287 WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY)
290 $sth->execute($zebraqueue_days) or die $dbh->errstr;
291 $sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? });
292 while ( my $record = $sth->fetchrow_hashref ) {
294 $sth2->execute( $record->{id} ) or die $dbh->errstr;
299 say $confirm ? "$count records were deleted." : "$count records would have been deleted.";
300 say "Done with zebraqueue purge.";
306 print "Mail queue purge triggered for $mail days.\n" if $verbose;
307 $sth = $dbh->prepare(
309 DELETE FROM message_queue
310 WHERE time_queued < date_sub(curdate(), INTERVAL ? DAY)
314 $sth->execute($mail) or die $dbh->errstr;
318 say $confirm ? "$count messages were deleted from the mail queue." : "Message from message_queue would have been deleted";
319 say "Done with message_queue purge.";
324 print "Purging completed entries from need_merge_authorities.\n" if $verbose;
326 $sth = $dbh->prepare(q{ DELETE FROM need_merge_authorities WHERE done=1 });
327 $sth->execute() or die $dbh->errstr;
329 print "Done with purging need_merge_authorities.\n" if $verbose;
333 print "Purging records from import tables.\n" if $verbose;
334 PurgeImportTables() if $confirm;
335 print "Done with purging import tables.\n" if $verbose;
339 print "Purging Z39.50 records from import tables.\n" if $verbose;
340 PurgeZ3950() if $confirm;
341 print "Done with purging Z39.50 records from import tables.\n" if $verbose;
345 print "Purging records from action_logs.\n" if $verbose;
346 $sth = $dbh->prepare(
348 DELETE FROM action_logs
349 WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY)
353 $sth->execute($pLogs) or die $dbh->errstr;
355 print "Done with purging action_logs.\n" if $verbose;
359 print "Purging messages older than $pMessages days.\n" if $verbose;
360 my $messages = Koha::Patron::Messages->filter_by_last_update(
361 { timestamp_column_name => 'message_date', days => $pMessages } );
362 my $count = $messages->count;
363 $messages->delete if $confirm;
366 ? sprintf( "Done with purging %d messages", $count )
367 : sprintf( "%d messages would have been removed", $count );
372 print "Purging records from accountlines.\n" if $verbose;
373 purge_zero_balance_fees( $fees_days ) if $confirm;
374 print "Done purging records from accountlines.\n" if $verbose;
377 if ($pSearchhistory) {
378 print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;
379 C4::Search::History::delete({ interval => $pSearchhistory }) if $confirm;
380 print "Done with purging search_history.\n" if $verbose;
383 if ($pListShareInvites) {
384 print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;
385 $sth = $dbh->prepare(
387 DELETE FROM virtualshelfshares
388 WHERE invitekey IS NOT NULL
389 AND (sharedate + INTERVAL ? DAY) < NOW()
393 $sth->execute($pListShareInvites);
395 print "Done with purging unaccepted list share invites.\n" if $verbose;
399 print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
400 my $count = PurgeDebarments($pDebarments, $confirm);
402 say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
403 say "Done with restrictions purge.";
408 print "All expired patrons restrictions purge triggered.\n" if $verbose;
409 my $count = PurgeDebarments(0, $confirm);
411 say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
412 say "Done with all restrictions purge.";
416 # Lock expired patrons?
417 if( defined $lock_days && $lock_days ne q{} ) {
418 say "Start locking expired patrons" if $verbose;
419 my $expired_patrons = Koha::Patrons->filter_by_expiration_date({ days => $lock_days })->search({ login_attempts => { '!=' => -1 } });
420 my $count = $expired_patrons->count;
421 $expired_patrons->lock({ remove => 1 }) if $confirm;
423 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("Found %d patrons", $count);
427 # Handle unsubscribe requests from GDPR consent form, depends on UnsubscribeReflectionDelay preference
428 say "Start lock unsubscribed, anonymize and delete" if $verbose;
429 my $unsubscribed_patrons = Koha::Patrons->search_unsubscribed;
430 my $count = $unsubscribed_patrons->count;
431 $unsubscribed_patrons->lock( { expire => 1, remove => 1 } ) if $confirm;
432 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("%d patrons would have been locked", $count) if $verbose;
434 # Anonymize patron data, depending on PatronAnonymizeDelay
435 my $anonymize_candidates = Koha::Patrons->search_anonymize_candidates( { locked => 1 } );
436 $count = $anonymize_candidates->count;
437 $anonymize_candidates->anonymize if $confirm;
438 say $confirm ? sprintf("Anonymized %d patrons", $count) : sprintf("%d patrons would have been anonymized", $count) if $verbose;
440 # Remove patron data, depending on PatronRemovalDelay (will raise an exception if problem encountered
441 my $anonymized_patrons = Koha::Patrons->search_anonymized;
442 $count = $anonymized_patrons->count;
444 $anonymized_patrons->delete( { move => 1 } );
450 say $confirm ? sprintf("Deleted %d patrons", $count) : sprintf("%d patrons would have been deleted", $count);
453 # FIXME The output for dry-run mode needs to be improved
454 # But non trivial changes to C4::Members need to be done before.
457 DeleteExpiredSelfRegs();
458 } elsif ( $verbose ) {
459 say "self-registered borrowers may be deleted";
464 DeleteUnverifiedSelfRegs( $pUnvSelfReg );
465 } elsif ( $verbose ) {
466 say "unverified self-registrations may be deleted";
470 if ($special_holidays_days) {
472 DeleteSpecialHolidays( abs($special_holidays_days) );
473 } elsif ( $verbose ) {
474 say "self-registered borrowers may be deleted";
478 if( $temp_uploads ) {
479 # Delete temporary uploads, governed by a pref (unless you override)
480 print "Purging temporary uploads.\n" if $verbose;
482 Koha::UploadedFiles->delete_temporary({
483 defined($temp_uploads_days)
484 ? ( override_pref => $temp_uploads_days )
488 print "Done purging temporary uploads.\n" if $verbose;
491 if( defined $uploads_missing ) {
492 print "Looking for missing uploads\n" if $verbose;
494 my $keep = $uploads_missing == 1 ? 0 : 1;
495 my $count = Koha::UploadedFiles->delete_missing({ keep_record => $keep });
497 print "Counted $count missing uploaded files\n";
499 print "Removed $count records for missing uploads\n";
502 # FIXME need to create a filter_by_missing method (then call ->delete) instead of delete_missing
503 say "Dry-run mode cannot guess how many uploads would have been deleted";
508 require Koha::OAuthAccessTokens;
510 my $tokens = Koha::OAuthAccessTokens->search({ expires => { '<=', time } });
511 my $count = $tokens->count;
512 $tokens->delete if $confirm;
515 ? sprintf( "Removed %d expired OAuth2 tokens", $count )
516 : sprintf( "%d expired OAuth tokens would have been removed", $count );
521 print "Purging statistics older than $pStatistics days.\n" if $verbose;
522 my $statistics = Koha::Statistics->filter_by_last_update(
523 { timestamp_column_name => 'datetime', days => $pStatistics } );
524 my $count = $statistics->count;
525 $statistics->delete if $confirm;
528 ? sprintf( "Done with purging %d statistics", $count )
529 : sprintf( "%d statistics would have been removed", $count );
533 if( $return_claims && ( my $days = C4::Context->preference('CleanUpDatabaseReturnClaims') )) {
534 print "Purging return claims older than $days days.\n" if $verbose;
536 $return_claims = Koha::Checkouts::ReturnClaims->filter_by_last_update(
538 timestamp_column_name => 'resolved_on',
543 my $count = $return_claims->count;
544 $return_claims->delete if $confirm;
548 ? sprintf "Done with purging %d resolved return claims.", $count
549 : sprintf "%d resolved return claims would have been purged.", $count;
553 if ($pDeletedCatalog) {
554 print "Purging deleted catalog older than $pDeletedCatalog days.\n"
556 my $old_items = Koha::Old::Items->filter_by_last_update( { days => $pDeletedCatalog } );
557 my $old_biblioitems = Koha::Old::Biblioitems->filter_by_last_update( { days => $pDeletedCatalog } );
558 my $old_biblios = Koha::Old::Biblios->filter_by_last_update( { days => $pDeletedCatalog } );
559 my ( $c_i, $c_bi, $c_b ) =
560 ( $old_items->count, $old_biblioitems->count, $old_biblios->count );
563 $old_biblioitems->delete;
564 $old_biblios->delete;
569 ? "Done with purging deleted catalog (%d items, %d biblioitems, %d biblios)."
570 : "Deleted catalog would have been removed (%d items, %d biblioitems, %d biblios).",
575 if ($pDeletedPatrons) {
576 print "Purging deleted patrons older than $pDeletedPatrons days.\n" if $verbose;
577 my $old_patrons = Koha::Old::Patrons->filter_by_last_update(
578 { timestamp_column_name => 'updated_on', days => $pDeletedPatrons } );
579 my $count = $old_patrons->count;
580 $old_patrons->delete if $confirm;
583 ? sprintf "Done with purging %d deleted patrons.", $count
584 : sprintf "%d deleted patrons would have been purged.", $count;
589 print "Purging old checkouts older than $pOldIssues days.\n" if $verbose;
590 my $old_checkouts = Koha::Old::Checkouts->filter_by_last_update( { days => $pOldIssues } );
591 my $count = $old_checkouts->count;
592 $old_checkouts->delete if $confirm;
595 ? sprintf "Done with purging %d old checkouts.", $count
596 : sprintf "%d old checkouts would have been purged.", $count;
601 print "Purging old reserves older than $pOldReserves days.\n" if $verbose;
602 my $old_reserves = Koha::Old::Holds->filter_by_last_update( { days => $pOldReserves } );
603 my $count = $old_reserves->count;
604 $old_reserves->delete if $verbose;
607 ? sprintf "Done with purging %d old reserves.", $count
608 : sprintf "%d old reserves would have been purged.", $count;
613 print "Purging arrived item transfers older than $pTransfers days.\n" if $verbose;
614 my $transfers = Koha::Item::Transfers->filter_by_last_update(
616 timestamp_column_name => 'datearrived',
620 my $count = $transfers->count;
621 $transfers->delete if $verbose;
624 ? sprintf "Done with purging %d transfers.", $count
625 : sprintf "%d transfers would have been purged.", $count;
629 if (defined $pPseudoTransactions or $pPseudoTransactionsFrom or $pPseudoTransactionsTo ) {
630 print "Purging pseudonymized transactions\n" if $verbose;
631 my $anonymized_transactions = Koha::PseudonymizedTransactions->filter_by_last_update(
633 timestamp_column_name => 'datetime',
634 ( defined $pPseudoTransactions ? ( days => $pPseudoTransactions ) : () ),
635 ( $pPseudoTransactionsFrom ? ( from => $pPseudoTransactionsFrom ) : () ),
636 ( $pPseudoTransactionsTo ? ( to => $pPseudoTransactionsTo ) : () ),
639 my $count = $anonymized_transactions->count;
640 $anonymized_transactions->delete if $confirm;
643 ? sprintf "Done with purging %d pseudonymized transactions.", $count
644 : sprintf "%d pseudonymized transactions would have been purged.", $count;
649 print "Purging item label batches last added to more than $labels days ago.\n" if $verbose;
650 my $count = PurgeCreatorBatches($labels, 'labels', $confirm);
653 ? sprintf "Done with purging %d item label batches last added to more than %d days ago.\n", $count, $labels
654 : sprintf "%d item label batches would have been purged.", $count;
659 print "Purging card creator batches last added to more than $cards days ago.\n" if $verbose;
660 my $count = PurgeCreatorBatches($labels, 'patroncards', $confirm);
663 ? sprintf "Done with purging %d card creator batches last added to more than %d days ago.\n", $count, $labels
664 : sprintf "%d card creator batches would have been purged.", $count;
670 sub RemoveOldSessions {
671 my ( $id, $a_session, $limit, $lasttime );
672 $limit = time() - 24 * 3600 * $sess_days;
674 $sth = $dbh->prepare(q{ SELECT id, a_session FROM sessions });
675 $sth->execute or die $dbh->errstr;
676 $sth->bind_columns( \$id, \$a_session );
677 $sth2 = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? });
680 while ( $sth->fetch ) {
682 if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
685 elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
688 if ( $lasttime && $lasttime < $limit ) {
689 $sth2->execute($id) or die $dbh->errstr;
694 print "$count sessions were deleted.\n";
698 sub PurgeImportTables {
700 #First purge import_records
701 #Delete cascades to import_biblios, import_items and import_record_matches
702 $sth = $dbh->prepare(
704 DELETE FROM import_records
705 WHERE upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
708 $sth->execute($pImport) or die $dbh->errstr;
710 # Now purge import_batches
711 # Timestamp cannot be used here without care, because records are added
712 # continuously to batches without updating timestamp (Z39.50 search).
713 # So we only delete older empty batches.
714 # This delete will therefore not have a cascading effect.
715 $sth = $dbh->prepare(
718 FROM import_batches ba
719 LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
720 WHERE re.import_record_id IS NULL AND
721 ba.upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
724 $sth->execute($pImport) or die $dbh->errstr;
728 $sth = $dbh->prepare(
730 DELETE FROM import_batches
731 WHERE batch_type = 'z3950'
734 $sth->execute() or die $dbh->errstr;
737 sub PurgeDebarments {
738 require Koha::Patron::Debarments;
739 my ( $days, $doit ) = @_;
741 $sth = $dbh->prepare(
743 SELECT borrower_debarment_id
744 FROM borrower_debarments
745 WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
748 $sth->execute($days) or die $dbh->errstr;
749 while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
750 Koha::Patron::Debarments::DelDebarment($borrower_debarment_id) if $doit;
756 sub PurgeCreatorBatches {
757 require C4::Labels::Batch;
758 my ( $days, $creator, $doit ) = @_;
760 $sth = $dbh->prepare(
762 SELECT batch_id, branch_code FROM creator_batches
765 FROM (SELECT batch_id
769 HAVING max(timestamp) <= date_sub(curdate(),interval ? day)) a)
772 $sth->execute( $creator, $days ) or die $dbh->errstr;
773 while ( my ( $batch_id, $branch_code ) = $sth->fetchrow_array ) {
774 C4::Labels::Batch::delete(
775 batch_id => $batch_id,
776 branch_code => $branch_code
783 sub DeleteExpiredSelfRegs {
784 my $cnt= C4::Members::DeleteExpiredOpacRegistrations();
785 print "Removed $cnt expired self-registered borrowers\n" if $verbose;
788 sub DeleteUnverifiedSelfRegs {
789 my $cnt= C4::Members::DeleteUnverifiedOpacRegistrations( $_[0] );
790 print "Removed $cnt unverified self-registrations\n" if $verbose;
793 sub DeleteSpecialHolidays {
796 my $sth = $dbh->prepare(q{
797 DELETE FROM special_holidays
798 WHERE DATE( CONCAT( year, '-', month, '-', day ) ) < DATE_SUB( CAST(NOW() AS DATE), INTERVAL ? DAY );
800 my $count = $sth->execute( $days ) + 0;
801 print "Removed $count unique holidays\n" if $verbose;