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;
30 use constant DEFAULT_JOBS_PURGEDAYS => 1;
31 use constant DEFAULT_JOBS_PURGETYPES => qw{ update_elastic_index };
33 use Koha::Script -cron;
36 use C4::Search::History;
37 use Getopt::Long qw( GetOptions );
38 use C4::Log qw( cronlogaction );
39 use C4::Accounts qw( purge_zero_balance_fees );
40 use Koha::UploadedFiles;
41 use Koha::BackgroundJobs;
42 use Koha::Old::Biblios;
44 use Koha::Old::Biblioitems;
45 use Koha::Old::Checkouts;
47 use Koha::Old::Patrons;
48 use Koha::Item::Transfers;
49 use Koha::PseudonymizedTransactions;
50 use Koha::Patron::Messages;
51 use Koha::Patron::Debarments qw( DelDebarment );
55 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] [--bg-days DAYS [--bg-type TYPE] ]
57 -h --help prints this help message, and exits, ignoring all
59 --confirm Confirmation flag, the script will be running in dry-run mode is not set.
60 --sessions purge the sessions table. If you use this while users
61 are logged into Koha, they will have to reconnect.
62 --sessdays DAYS purge only sessions older than DAYS days.
63 -v --verbose will cause the script to give you a bit more information
65 --zebraqueue DAYS purge completed zebraqueue entries older than DAYS days.
66 Defaults to 30 days if no days specified.
67 -m --mail DAYS purge items from the mail queue that are older than DAYS days.
68 Defaults to 30 days if no days specified.
69 --merged purged completed entries from need_merge_authorities.
70 --messages DAYS purge entries from messages table older than DAYS days.
71 Defaults to 365 days if no days specified.
72 --import DAYS purge records from import tables older than DAYS days.
73 Defaults to 60 days if no days specified.
74 --z3950 purge records from import tables that are the result
76 --fees DAYS purge entries accountlines older than DAYS days, where
77 amountoutstanding is 0 or NULL.
78 In the case of --fees, DAYS must be greater than
80 --log-modules Specify which action log modules to trim. Repeatable.
81 --preserve-log Specify which action logs to exclude. Repeatable.
82 --logs DAYS purge entries from action_logs older than DAYS days.
83 Defaults to 180 days if no days specified.
84 --searchhistory DAYS purge entries from search_history older than DAYS days.
85 Defaults to 30 days if no days specified
86 --list-invites DAYS purge (unaccepted) list share invites older than DAYS
87 days. Defaults to 14 days if no days specified.
88 --restrictions DAYS purge patrons restrictions expired since more than DAYS days.
89 Defaults to 30 days if no days specified.
90 --all-restrictions purge all expired patrons restrictions.
91 --del-exp-selfreg Delete expired self registration accounts
92 --del-unv-selfreg DAYS Delete unverified self registrations older than DAYS
93 --unique-holidays DAYS Delete all unique holidays older than DAYS
94 --temp-uploads Delete temporary uploads.
95 --temp-uploads-days DAYS Override the corresponding preference value.
96 --uploads-missing FLAG Delete upload records for missing files when FLAG is true, count them otherwise
97 --oauth-tokens Delete expired OAuth2 tokens
98 --statistics DAYS Purge statistics entries more than DAYS days old.
99 This table is used to build reports, make sure you are aware of the consequences of this before using it!
100 --deleted-catalog DAYS Purge catalog records deleted more then DAYS days ago
101 (from tables deleteditems, deletedbiblioitems, deletedbiblio_metadata and deletedbiblio).
102 --deleted-patrons DAYS Purge patrons deleted more than DAYS days ago.
103 --old-issues DAYS Purge checkouts (old_issues) returned more than DAYS days ago.
104 --old-reserves DAYS Purge reserves (old_reserves) more than DAYS old.
105 --transfers DAYS Purge transfers completed more than DAYS day ago.
106 --pseudo-transactions DAYS Purge the pseudonymized transactions that have been originally created more than DAYS days ago
107 DAYS is optional and can be replaced by:
108 --pseudo-transactions-from YYYY-MM-DD and/or --pseudo-transactions-to YYYY-MM-DD
109 --labels DAYS Purge item label batches last added to more than DAYS days ago.
110 --cards DAY Purge card creator batches last added to more than DAYS days ago.
111 --return-claims Purge all resolved return claims older than the number of days specified in
112 the system preference CleanUpDatabaseReturnClaims.
113 --jobs-days DAYS Purge all finished background jobs this many days old. Defaults to 1 if no DAYS provided.
114 --jobs-type TYPES What type of background job to purge. Defaults to "update_elastic_index" if omitted
115 Specifying "all" will purge all types. Repeatable.
116 --reports DAYS Purge reports data saved more than DAYS days ago. The data is created by running runreport.pl with the --store-results option.
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');
162 my $command_line_options = join(" ",@ARGV);
166 'confirm' => \$confirm,
167 'sessions' => \$sessions,
168 'sessdays:i' => \$sess_days,
169 'v|verbose' => \$verbose,
170 'm|mail:i' => \$mail,
171 'zebraqueue:i' => \$zebraqueue_days,
172 'merged' => \$purge_merged,
173 'import:i' => \$pImport,
176 'log-module:s' => \@log_modules,
177 'preserve-log:s' => \@preserve_logs,
178 'messages:i' => \$pMessages,
179 'fees:i' => \$fees_days,
180 'searchhistory:i' => \$pSearchhistory,
181 'list-invites:i' => \$pListShareInvites,
182 'restrictions:i' => \$pDebarments,
183 'all-restrictions' => \$allDebarments,
184 'del-exp-selfreg' => \$pExpSelfReg,
185 'del-unv-selfreg:i' => \$pUnvSelfReg,
186 'unique-holidays:i' => \$special_holidays_days,
187 'temp-uploads' => \$temp_uploads,
188 'temp-uploads-days:i' => \$temp_uploads_days,
189 'uploads-missing:i' => \$uploads_missing,
190 'oauth-tokens' => \$oauth_tokens,
191 'statistics:i' => \$pStatistics,
192 'deleted-catalog:i' => \$pDeletedCatalog,
193 'deleted-patrons:i' => \$pDeletedPatrons,
194 'old-issues:i' => \$pOldIssues,
195 'old-reserves:i' => \$pOldReserves,
196 'transfers:i' => \$pTransfers,
197 'pseudo-transactions:i' => \$pPseudoTransactions,
198 'pseudo-transactions-from:s' => \$pPseudoTransactionsFrom,
199 'pseudo-transactions-to:s' => \$pPseudoTransactionsTo,
200 'labels' => \$labels,
202 'return-claims' => \$return_claims,
203 'jobs-type:s' => \@jobs_types,
204 'jobs-days:i' => \$jobs_days,
205 'reports:i' => \$reports,
209 $sessions = 1 if $sess_days && $sess_days > 0;
210 $pImport = DEFAULT_IMPORT_PURGEDAYS if defined($pImport) && $pImport == 0;
211 $pLogs = DEFAULT_LOGS_PURGEDAYS if defined($pLogs) && $pLogs == 0;
212 $zebraqueue_days = DEFAULT_ZEBRAQ_PURGEDAYS if defined($zebraqueue_days) && $zebraqueue_days == 0;
213 $mail = DEFAULT_MAIL_PURGEDAYS if defined($mail) && $mail == 0;
214 $pSearchhistory = DEFAULT_SEARCHHISTORY_PURGEDAYS if defined($pSearchhistory) && $pSearchhistory == 0;
215 $pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0;
216 $pDebarments = DEFAULT_DEBARMENTS_PURGEDAYS if defined($pDebarments) && $pDebarments == 0;
217 $pMessages = DEFAULT_MESSAGES_PURGEDAYS if defined($pMessages) && $pMessages == 0;
218 $jobs_days = DEFAULT_JOBS_PURGEDAYS if defined($jobs_days) && $jobs_days == 0;
219 @jobs_types = (DEFAULT_JOBS_PURGETYPES) if $jobs_days && @jobs_types == 0;
234 || $pListShareInvites
239 || $special_holidays_days
241 || defined $uploads_missing
249 || defined $pPseudoTransactions
250 || $pPseudoTransactionsFrom
251 || $pPseudoTransactionsTo
253 || defined $lock_days && $lock_days ne q{}
260 print "You did not specify any cleanup work for the script to do.\n\n";
264 if ($pDebarments && $allDebarments) {
265 print "You can not specify both --restrictions and --all-restrictions.\n\n";
269 say "Confirm flag not passed, running in dry-run mode..." unless $confirm;
271 cronlogaction({ info => $command_line_options });
273 my $dbh = C4::Context->dbh();
277 if ( $sessions && !$sess_days ) {
279 say "Session purge triggered.";
280 $sth = $dbh->prepare(q{ SELECT COUNT(*) FROM sessions });
281 $sth->execute() or die $dbh->errstr;
282 my @count_arr = $sth->fetchrow_array;
283 say $confirm ? "$count_arr[0] entries will be deleted." : "$count_arr[0] entries would be deleted.";
286 $sth = $dbh->prepare(q{ TRUNCATE sessions });
287 $sth->execute() or die $dbh->errstr;
290 print "Done with session purge.\n";
293 elsif ( $sessions && $sess_days > 0 ) {
294 print "Session purge triggered with days>$sess_days.\n" if $verbose;
295 RemoveOldSessions() if $confirm;
296 print "Done with session purge with days>$sess_days.\n" if $verbose;
299 if ($zebraqueue_days) {
301 print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
302 $sth = $dbh->prepare(
304 SELECT id,biblio_auth_number,server,time
306 WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY)
309 $sth->execute($zebraqueue_days) or die $dbh->errstr;
310 $sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? });
311 while ( my $record = $sth->fetchrow_hashref ) {
313 $sth2->execute( $record->{id} ) or die $dbh->errstr;
318 say $confirm ? "$count records were deleted." : "$count records would have been deleted.";
319 say "Done with zebraqueue purge.";
325 print "Mail queue purge triggered for $mail days.\n" if $verbose;
326 $sth = $dbh->prepare(
328 DELETE FROM message_queue
329 WHERE time_queued < date_sub(curdate(), INTERVAL ? DAY)
333 $sth->execute($mail) or die $dbh->errstr;
337 say $confirm ? "$count messages were deleted from the mail queue." : "Message from message_queue would have been deleted";
338 say "Done with message_queue purge.";
343 print "Purging completed entries from need_merge_authorities.\n" if $verbose;
345 $sth = $dbh->prepare(q{ DELETE FROM need_merge_authorities WHERE done=1 });
346 $sth->execute() or die $dbh->errstr;
348 print "Done with purging need_merge_authorities.\n" if $verbose;
352 print "Purging records from import tables.\n" if $verbose;
353 PurgeImportTables() if $confirm;
354 print "Done with purging import tables.\n" if $verbose;
358 print "Purging Z39.50 records from import tables.\n" if $verbose;
359 PurgeZ3950() if $confirm;
360 print "Done with purging Z39.50 records from import tables.\n" if $verbose;
364 print "Purging records from action_logs.\n" if $verbose;
366 DELETE FROM action_logs
367 WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY)
369 my @query_params = ();
370 if( @preserve_logs ){
371 $log_query .= " AND module NOT IN (" . join(',',('?') x @preserve_logs ) . ")";
372 push @query_params, @preserve_logs;
375 $log_query .= " AND module IN (" . join(',',('?') x @log_modules ) . ")";
376 push @query_params, @log_modules;
378 $sth = $dbh->prepare( $log_query );
380 $sth->execute($pLogs, @query_params) or die $dbh->errstr;
382 print "Done with purging action_logs.\n" if $verbose;
386 print "Purging messages older than $pMessages days.\n" if $verbose;
387 my $messages = Koha::Patron::Messages->filter_by_last_update(
388 { timestamp_column_name => 'message_date', days => $pMessages } );
389 my $count = $messages->count;
390 $messages->delete if $confirm;
393 ? sprintf( "Done with purging %d messages", $count )
394 : sprintf( "%d messages would have been removed", $count );
399 print "Purging records from accountlines.\n" if $verbose;
400 purge_zero_balance_fees( $fees_days ) if $confirm;
401 print "Done purging records from accountlines.\n" if $verbose;
404 if ($pSearchhistory) {
405 print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;
406 C4::Search::History::delete({ interval => $pSearchhistory }) if $confirm;
407 print "Done with purging search_history.\n" if $verbose;
410 if ($pListShareInvites) {
411 print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;
412 $sth = $dbh->prepare(
414 DELETE FROM virtualshelfshares
415 WHERE invitekey IS NOT NULL
416 AND (sharedate + INTERVAL ? DAY) < NOW()
420 $sth->execute($pListShareInvites);
422 print "Done with purging unaccepted list share invites.\n" if $verbose;
426 print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
427 my $count = PurgeDebarments($pDebarments, $confirm);
429 say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
430 say "Done with restrictions purge.";
435 print "All expired patrons restrictions purge triggered.\n" if $verbose;
436 my $count = PurgeDebarments(0, $confirm);
438 say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
439 say "Done with all restrictions purge.";
443 # Lock expired patrons?
444 if( defined $lock_days && $lock_days ne q{} ) {
445 say "Start locking expired patrons" if $verbose;
446 my $expired_patrons = Koha::Patrons->filter_by_expiration_date({ days => $lock_days })->search({ login_attempts => { '!=' => -1 } });
447 my $count = $expired_patrons->count;
448 $expired_patrons->lock({ remove => 1 }) if $confirm;
450 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("Found %d patrons", $count);
454 # Handle unsubscribe requests from GDPR consent form, depends on UnsubscribeReflectionDelay preference
455 say "Start lock unsubscribed, anonymize and delete" if $verbose;
456 my $unsubscribed_patrons = Koha::Patrons->search_unsubscribed;
457 my $count = $unsubscribed_patrons->count;
458 $unsubscribed_patrons->lock( { expire => 1, remove => 1 } ) if $confirm;
459 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("%d patrons would have been locked", $count) if $verbose;
461 # Anonymize patron data, depending on PatronAnonymizeDelay
462 my $anonymize_candidates = Koha::Patrons->search_anonymize_candidates( { locked => 1 } );
463 $count = $anonymize_candidates->count;
464 $anonymize_candidates->anonymize if $confirm;
465 say $confirm ? sprintf("Anonymized %d patrons", $count) : sprintf("%d patrons would have been anonymized", $count) if $verbose;
467 # Remove patron data, depending on PatronRemovalDelay (will raise an exception if problem encountered
468 my $anonymized_patrons = Koha::Patrons->search_anonymized;
469 $count = $anonymized_patrons->count;
471 $anonymized_patrons->delete( { move => 1 } );
477 say $confirm ? sprintf("Deleted %d patrons", $count) : sprintf("%d patrons would have been deleted", $count);
480 # FIXME The output for dry-run mode needs to be improved
481 # But non trivial changes to C4::Members need to be done before.
484 DeleteExpiredSelfRegs();
485 } elsif ( $verbose ) {
486 say "self-registered borrowers may be deleted";
491 DeleteUnverifiedSelfRegs( $pUnvSelfReg );
492 } elsif ( $verbose ) {
493 say "unverified self-registrations may be deleted";
497 if ($special_holidays_days) {
499 DeleteSpecialHolidays( abs($special_holidays_days) );
500 } elsif ( $verbose ) {
501 say "self-registered borrowers may be deleted";
505 if( $temp_uploads ) {
506 # Delete temporary uploads, governed by a pref (unless you override)
507 print "Purging temporary uploads.\n" if $verbose;
509 Koha::UploadedFiles->delete_temporary({
510 defined($temp_uploads_days)
511 ? ( override_pref => $temp_uploads_days )
515 print "Done purging temporary uploads.\n" if $verbose;
518 if( defined $uploads_missing ) {
519 print "Looking for missing uploads\n" if $verbose;
521 my $keep = $uploads_missing == 1 ? 0 : 1;
522 my $count = Koha::UploadedFiles->delete_missing({ keep_record => $keep });
524 print "Counted $count missing uploaded files\n";
526 print "Removed $count records for missing uploads\n";
529 # FIXME need to create a filter_by_missing method (then call ->delete) instead of delete_missing
530 say "Dry-run mode cannot guess how many uploads would have been deleted";
535 require Koha::OAuthAccessTokens;
537 my $tokens = Koha::OAuthAccessTokens->search({ expires => { '<=', time } });
538 my $count = $tokens->count;
539 $tokens->delete if $confirm;
542 ? sprintf( "Removed %d expired OAuth2 tokens", $count )
543 : sprintf( "%d expired OAuth tokens would have been removed", $count );
548 print "Purging statistics older than $pStatistics days.\n" if $verbose;
549 my $statistics = Koha::Statistics->filter_by_last_update(
550 { timestamp_column_name => 'datetime', days => $pStatistics } );
551 my $count = $statistics->count;
552 $statistics->delete if $confirm;
555 ? sprintf( "Done with purging %d statistics", $count )
556 : sprintf( "%d statistics would have been removed", $count );
560 if( $return_claims && ( my $days = C4::Context->preference('CleanUpDatabaseReturnClaims') )) {
561 print "Purging return claims older than $days days.\n" if $verbose;
563 $return_claims = Koha::Checkouts::ReturnClaims->filter_by_last_update(
565 timestamp_column_name => 'resolved_on',
570 my $count = $return_claims->count;
571 $return_claims->delete if $confirm;
575 ? sprintf "Done with purging %d resolved return claims.", $count
576 : sprintf "%d resolved return claims would have been purged.", $count;
580 if ($pDeletedCatalog) {
581 print "Purging deleted catalog older than $pDeletedCatalog days.\n"
583 my $old_items = Koha::Old::Items->filter_by_last_update( { days => $pDeletedCatalog } );
584 my $old_biblioitems = Koha::Old::Biblioitems->filter_by_last_update( { days => $pDeletedCatalog } );
585 my $old_biblios = Koha::Old::Biblios->filter_by_last_update( { days => $pDeletedCatalog } );
586 my ( $c_i, $c_bi, $c_b ) =
587 ( $old_items->count, $old_biblioitems->count, $old_biblios->count );
590 $old_biblioitems->delete;
591 $old_biblios->delete;
596 ? "Done with purging deleted catalog (%d items, %d biblioitems, %d biblios)."
597 : "Deleted catalog would have been removed (%d items, %d biblioitems, %d biblios).",
602 if ($pDeletedPatrons) {
603 print "Purging deleted patrons older than $pDeletedPatrons days.\n" if $verbose;
604 my $old_patrons = Koha::Old::Patrons->filter_by_last_update(
605 { timestamp_column_name => 'updated_on', days => $pDeletedPatrons } );
606 my $count = $old_patrons->count;
607 $old_patrons->delete if $confirm;
610 ? sprintf "Done with purging %d deleted patrons.", $count
611 : sprintf "%d deleted patrons would have been purged.", $count;
616 print "Purging old checkouts older than $pOldIssues days.\n" if $verbose;
617 my $old_checkouts = Koha::Old::Checkouts->filter_by_last_update( { days => $pOldIssues } );
618 my $count = $old_checkouts->count;
619 $old_checkouts->delete if $confirm;
622 ? sprintf "Done with purging %d old checkouts.", $count
623 : sprintf "%d old checkouts would have been purged.", $count;
628 print "Purging old reserves older than $pOldReserves days.\n" if $verbose;
629 my $old_reserves = Koha::Old::Holds->filter_by_last_update( { days => $pOldReserves } );
630 my $count = $old_reserves->count;
631 $old_reserves->delete if $confirm;
634 ? sprintf "Done with purging %d old reserves.", $count
635 : sprintf "%d old reserves would have been purged.", $count;
640 print "Purging arrived item transfers older than $pTransfers days.\n" if $verbose;
641 my $transfers = Koha::Item::Transfers->filter_by_last_update(
643 timestamp_column_name => 'datearrived',
647 my $count = $transfers->count;
648 $transfers->delete if $confirm;
651 ? sprintf "Done with purging %d transfers.", $count
652 : sprintf "%d transfers would have been purged.", $count;
656 if (defined $pPseudoTransactions or $pPseudoTransactionsFrom or $pPseudoTransactionsTo ) {
657 print "Purging pseudonymized transactions\n" if $verbose;
658 my $anonymized_transactions = Koha::PseudonymizedTransactions->filter_by_last_update(
660 timestamp_column_name => 'datetime',
661 ( defined $pPseudoTransactions ? ( days => $pPseudoTransactions ) : () ),
662 ( $pPseudoTransactionsFrom ? ( from => $pPseudoTransactionsFrom ) : () ),
663 ( $pPseudoTransactionsTo ? ( to => $pPseudoTransactionsTo ) : () ),
666 my $count = $anonymized_transactions->count;
667 $anonymized_transactions->delete if $confirm;
670 ? sprintf "Done with purging %d pseudonymized transactions.", $count
671 : sprintf "%d pseudonymized transactions would have been purged.", $count;
676 print "Purging item label batches last added to more than $labels days ago.\n" if $verbose;
677 my $count = PurgeCreatorBatches($labels, 'labels', $confirm);
680 ? sprintf "Done with purging %d item label batches last added to more than %d days ago.\n", $count, $labels
681 : sprintf "%d item label batches would have been purged.", $count;
686 print "Purging card creator batches last added to more than $cards days ago.\n" if $verbose;
687 my $count = PurgeCreatorBatches($labels, 'patroncards', $confirm);
690 ? sprintf "Done with purging %d card creator batches last added to more than %d days ago.\n", $count, $labels
691 : sprintf "%d card creator batches would have been purged.", $count;
696 print "Purging background jobs more than $jobs_days days ago.\n"
698 my $jobs = Koha::BackgroundJobs->search(
700 status => 'finished',
701 ( $jobs_types[0] eq 'all' ? () : ( type => \@jobs_types ) )
703 )->filter_by_last_update(
705 timestamp_column_name => 'ended_on',
709 my $count = $jobs->count;
710 $jobs->delete if $confirm;
713 ? sprintf "Done with purging %d background jobs of type(s): %s added more than %d days ago.\n",
714 $count, join( ',', @jobs_types ), $jobs_days
715 : sprintf "%d background jobs of type(s): %s added more than %d days ago would have been purged.",
716 $count, join( ',', @jobs_types ), $jobs_days;
722 PurgeSavedReports($reports);
724 say "Purging reports data saved more than $reports days ago.\n";
728 cronlogaction({ action => 'End', info => "COMPLETED" });
732 sub RemoveOldSessions {
733 my ( $id, $a_session, $limit, $lasttime );
734 $limit = time() - 24 * 3600 * $sess_days;
736 $sth = $dbh->prepare(q{ SELECT id, a_session FROM sessions });
737 $sth->execute or die $dbh->errstr;
738 $sth->bind_columns( \$id, \$a_session );
739 $sth2 = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? });
742 while ( $sth->fetch ) {
744 if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
747 elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
750 if ( $lasttime && $lasttime < $limit ) {
751 $sth2->execute($id) or die $dbh->errstr;
756 print "$count sessions were deleted.\n";
760 sub PurgeImportTables {
762 #First purge import_records
763 #Delete cascades to import_biblios, import_items and import_record_matches
764 $sth = $dbh->prepare(
766 DELETE FROM import_records
767 WHERE upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
770 $sth->execute($pImport) or die $dbh->errstr;
772 # Now purge import_batches
773 # Timestamp cannot be used here without care, because records are added
774 # continuously to batches without updating timestamp (Z39.50 search).
775 # So we only delete older empty batches.
776 # This delete will therefore not have a cascading effect.
777 $sth = $dbh->prepare(
780 FROM import_batches ba
781 LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
782 WHERE re.import_record_id IS NULL AND
783 ba.upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
786 $sth->execute($pImport) or die $dbh->errstr;
790 $sth = $dbh->prepare(
792 DELETE FROM import_batches
793 WHERE batch_type = 'z3950'
796 $sth->execute() or die $dbh->errstr;
799 sub PurgeDebarments {
800 require Koha::Patron::Debarments;
801 my ( $days, $doit ) = @_;
803 $sth = $dbh->prepare(
805 SELECT borrower_debarment_id
806 FROM borrower_debarments
807 WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
810 $sth->execute($days) or die $dbh->errstr;
811 while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
812 Koha::Patron::Debarments::DelDebarment($borrower_debarment_id) if $doit;
818 sub PurgeCreatorBatches {
819 require C4::Labels::Batch;
820 my ( $days, $creator, $doit ) = @_;
822 $sth = $dbh->prepare(
824 SELECT batch_id, branch_code FROM creator_batches
827 FROM (SELECT batch_id
831 HAVING max(timestamp) <= date_sub(curdate(),interval ? day)) a)
834 $sth->execute( $creator, $days ) or die $dbh->errstr;
835 while ( my ( $batch_id, $branch_code ) = $sth->fetchrow_array ) {
836 C4::Labels::Batch::delete(
837 batch_id => $batch_id,
838 branch_code => $branch_code
845 sub DeleteExpiredSelfRegs {
846 my $cnt= C4::Members::DeleteExpiredOpacRegistrations();
847 print "Removed $cnt expired self-registered borrowers\n" if $verbose;
850 sub DeleteUnverifiedSelfRegs {
851 my $cnt= C4::Members::DeleteUnverifiedOpacRegistrations( $_[0] );
852 print "Removed $cnt unverified self-registrations\n" if $verbose;
855 sub DeleteSpecialHolidays {
858 my $sth = $dbh->prepare(q{
859 DELETE FROM special_holidays
860 WHERE DATE( CONCAT( year, '-', month, '-', day ) ) < DATE_SUB( CAST(NOW() AS DATE), INTERVAL ? DAY );
862 my $count = $sth->execute( $days ) + 0;
863 print "Removed $count unique holidays\n" if $verbose;
866 sub PurgeSavedReports {
867 my ( $reports ) = @_;
869 my $sth = $dbh->prepare(q{
870 DELETE FROM saved_reports
871 WHERE date(date_run) < DATE_SUB(CURDATE(),INTERVAL ? DAY );
873 $sth->execute( $reports );