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 };
32 use constant DEFAULT_EDIFACT_MSG_PURGEDAYS => 365;
34 use Getopt::Long qw( GetOptions );
36 use Koha::Script -cron;
38 use C4::Accounts qw( purge_zero_balance_fees );
40 use C4::Log qw( cronlogaction );
41 use C4::Search::History;
43 use Koha::BackgroundJobs;
45 use Koha::DateUtils qw( dt_from_string );
46 use Koha::Item::Transfers;
47 use Koha::Old::Biblioitems;
48 use Koha::Old::Biblios;
49 use Koha::Old::Checkouts;
52 use Koha::Old::Patrons;
53 use Koha::Patron::Debarments qw( DelDebarment );
54 use Koha::Patron::Messages;
55 use Koha::PseudonymizedTransactions;
56 use Koha::UploadedFiles;
60 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] ] [--edifact-messages DAYS]
62 -h --help prints this help message, and exits, ignoring all
64 --confirm Confirmation flag, the script will be running in dry-run mode is not set.
65 --sessions purge the sessions table. If you use this while users
66 are logged into Koha, they will have to reconnect.
67 --sessdays DAYS purge only sessions older than DAYS days.
68 -v --verbose will cause the script to give you a bit more information
70 --zebraqueue DAYS purge completed zebraqueue entries older than DAYS days.
71 Defaults to 30 days if no days specified.
72 -m --mail DAYS purge items from the mail queue that are older than DAYS days.
73 Defaults to 30 days if no days specified.
74 --merged purged completed entries from need_merge_authorities.
75 --messages DAYS purge entries from messages table older than DAYS days.
76 Defaults to 365 days if no days specified.
77 --import DAYS purge records from import tables older than DAYS days.
78 Defaults to 60 days if no days specified.
79 --z3950 purge records from import tables that are the result
81 --fees DAYS purge entries accountlines older than DAYS days, where
82 amountoutstanding is 0 or NULL.
83 In the case of --fees, DAYS must be greater than
85 --log-modules Specify which action log modules to trim. Repeatable.
86 --preserve-log Specify which action logs to exclude. Repeatable.
87 --log-action Specify which action log action entries to trim. Repeatable.
88 --logs DAYS purge entries from action_logs older than DAYS days.
89 Defaults to 180 days if no days specified.
90 --searchhistory DAYS purge entries from search_history older than DAYS days.
91 Defaults to 30 days if no days specified
92 --list-invites DAYS purge (unaccepted) list share invites older than DAYS
93 days. Defaults to 14 days if no days specified.
94 --restrictions DAYS purge patrons restrictions expired since more than DAYS days.
95 Defaults to 30 days if no days specified.
96 --all-restrictions purge all expired patrons restrictions.
97 --del-exp-selfreg Delete expired self registration accounts
98 --del-unv-selfreg DAYS Delete unverified self registrations older than DAYS
99 --unique-holidays DAYS Delete all unique holidays older than DAYS
100 --temp-uploads Delete temporary uploads.
101 --temp-uploads-days DAYS Override the corresponding preference value.
102 --uploads-missing FLAG Delete upload records for missing files when FLAG is true, count them otherwise
103 --oauth-tokens Delete expired OAuth2 tokens
104 --statistics DAYS Purge statistics entries more than DAYS days old.
105 This table is used to build reports, make sure you are aware of the consequences of this before using it!
106 --deleted-catalog DAYS Purge catalog records deleted more then DAYS days ago
107 (from tables deleteditems, deletedbiblioitems, deletedbiblio_metadata and deletedbiblio).
108 --deleted-patrons DAYS Purge patrons deleted more than DAYS days ago.
109 --old-issues DAYS Purge checkouts (old_issues) returned more than DAYS days ago.
110 --old-reserves DAYS Purge reserves (old_reserves) more than DAYS old.
111 --transfers DAYS Purge transfers completed more than DAYS day ago.
112 --pseudo-transactions DAYS Purge the pseudonymized transactions that have been originally created more than DAYS days ago
113 DAYS is optional and can be replaced by:
114 --pseudo-transactions-from YYYY-MM-DD and/or --pseudo-transactions-to YYYY-MM-DD
115 --labels DAYS Purge item label batches last added to more than DAYS days ago.
116 --cards DAY Purge card creator batches last added to more than DAYS days ago.
117 --return-claims Purge all resolved return claims older than the number of days specified in
118 the system preference CleanUpDatabaseReturnClaims.
119 --jobs-days DAYS Purge all finished background jobs this many days old. Defaults to 1 if no DAYS provided.
120 --jobs-type TYPES What type of background job to purge. Defaults to "update_elastic_index" if omitted
121 Specifying "all" will purge all types. Repeatable.
122 --reports DAYS Purge reports data saved more than DAYS days ago. The data is created by running runreport.pl with the --store-results option.
123 --edifact-messages DAYS Purge process and failed EDIFACT messages handled more than DAYS days.
124 Defaults to 365 days if no days specified.
141 my $pListShareInvites;
148 my $special_holidays_days;
150 my $temp_uploads_days;
159 my ( $pPseudoTransactions, $pPseudoTransactionsFrom, $pPseudoTransactionsTo );
161 my $lock_days = C4::Context->preference('LockExpiredDelay');
170 my $edifact_msg_days;
172 my $command_line_options = join(" ",@ARGV);
176 'confirm' => \$confirm,
177 'sessions' => \$sessions,
178 'sessdays:i' => \$sess_days,
179 'v|verbose' => \$verbose,
180 'm|mail:i' => \$mail,
181 'zebraqueue:i' => \$zebraqueue_days,
182 'merged' => \$purge_merged,
183 'import:i' => \$pImport,
186 'log-module:s' => \@log_modules,
187 'preserve-log:s' => \@preserve_logs,
188 'log-action:s' => \@log_actions,
189 'messages:i' => \$pMessages,
190 'fees:i' => \$fees_days,
191 'searchhistory:i' => \$pSearchhistory,
192 'list-invites:i' => \$pListShareInvites,
193 'restrictions:i' => \$pDebarments,
194 'all-restrictions' => \$allDebarments,
195 'del-exp-selfreg' => \$pExpSelfReg,
196 'del-unv-selfreg:i' => \$pUnvSelfReg,
197 'unique-holidays:i' => \$special_holidays_days,
198 'temp-uploads' => \$temp_uploads,
199 'temp-uploads-days:i' => \$temp_uploads_days,
200 'uploads-missing:i' => \$uploads_missing,
201 'oauth-tokens' => \$oauth_tokens,
202 'statistics:i' => \$pStatistics,
203 'deleted-catalog:i' => \$pDeletedCatalog,
204 'deleted-patrons:i' => \$pDeletedPatrons,
205 'old-issues:i' => \$pOldIssues,
206 'old-reserves:i' => \$pOldReserves,
207 'transfers:i' => \$pTransfers,
208 'pseudo-transactions:i' => \$pPseudoTransactions,
209 'pseudo-transactions-from:s' => \$pPseudoTransactionsFrom,
210 'pseudo-transactions-to:s' => \$pPseudoTransactionsTo,
211 'labels' => \$labels,
213 'return-claims' => \$return_claims,
214 'jobs-type:s' => \@jobs_types,
215 'jobs-days:i' => \$jobs_days,
216 'reports:i' => \$reports,
217 'edifact-messages:i' => \$edifact_msg_days,
221 $sessions = 1 if $sess_days && $sess_days > 0;
222 $pImport = DEFAULT_IMPORT_PURGEDAYS if defined($pImport) && $pImport == 0;
223 $pLogs = DEFAULT_LOGS_PURGEDAYS if defined($pLogs) && $pLogs == 0;
224 $zebraqueue_days = DEFAULT_ZEBRAQ_PURGEDAYS if defined($zebraqueue_days) && $zebraqueue_days == 0;
225 $mail = DEFAULT_MAIL_PURGEDAYS if defined($mail) && $mail == 0;
226 $pSearchhistory = DEFAULT_SEARCHHISTORY_PURGEDAYS if defined($pSearchhistory) && $pSearchhistory == 0;
227 $pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0;
228 $pDebarments = DEFAULT_DEBARMENTS_PURGEDAYS if defined($pDebarments) && $pDebarments == 0;
229 $pMessages = DEFAULT_MESSAGES_PURGEDAYS if defined($pMessages) && $pMessages == 0;
230 $jobs_days = DEFAULT_JOBS_PURGEDAYS if defined($jobs_days) && $jobs_days == 0;
231 @jobs_types = (DEFAULT_JOBS_PURGETYPES) if $jobs_days && @jobs_types == 0;
232 $edifact_msg_days = DEFAULT_EDIFACT_MSG_PURGEDAYS if defined($edifact_msg_days) && $edifact_msg_days == 0;
247 || $pListShareInvites
252 || $special_holidays_days
254 || defined $uploads_missing
262 || defined $pPseudoTransactions
263 || $pPseudoTransactionsFrom
264 || $pPseudoTransactionsTo
266 || defined $lock_days && $lock_days ne q{}
274 print "You did not specify any cleanup work for the script to do.\n\n";
278 if ($pDebarments && $allDebarments) {
279 print "You can not specify both --restrictions and --all-restrictions.\n\n";
283 say "Confirm flag not passed, running in dry-run mode..." unless $confirm;
285 cronlogaction({ info => $command_line_options });
287 my $dbh = C4::Context->dbh();
291 if ( $sessions && !$sess_days ) {
293 say "Session purge triggered.";
294 $sth = $dbh->prepare(q{ SELECT COUNT(*) FROM sessions });
295 $sth->execute() or die $dbh->errstr;
296 my @count_arr = $sth->fetchrow_array;
297 say $confirm ? "$count_arr[0] entries will be deleted." : "$count_arr[0] entries would be deleted.";
300 $sth = $dbh->prepare(q{ TRUNCATE sessions });
301 $sth->execute() or die $dbh->errstr;
304 print "Done with session purge.\n";
307 elsif ( $sessions && $sess_days > 0 ) {
308 print "Session purge triggered with days>$sess_days.\n" if $verbose;
309 RemoveOldSessions() if $confirm;
310 print "Done with session purge with days>$sess_days.\n" if $verbose;
313 if ($zebraqueue_days) {
315 print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
316 $sth = $dbh->prepare(
318 SELECT id,biblio_auth_number,server,time
320 WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY)
323 $sth->execute($zebraqueue_days) or die $dbh->errstr;
324 $sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? });
325 while ( my $record = $sth->fetchrow_hashref ) {
327 $sth2->execute( $record->{id} ) or die $dbh->errstr;
332 say $confirm ? "$count records were deleted." : "$count records would have been deleted.";
333 say "Done with zebraqueue purge.";
339 print "Mail queue purge triggered for $mail days.\n" if $verbose;
340 $sth = $dbh->prepare(
342 DELETE FROM message_queue
343 WHERE time_queued < date_sub(curdate(), INTERVAL ? DAY)
347 $sth->execute($mail) or die $dbh->errstr;
351 say $confirm ? "$count messages were deleted from the mail queue." : "Message from message_queue would have been deleted";
352 say "Done with message_queue purge.";
357 print "Purging completed entries from need_merge_authorities.\n" if $verbose;
359 $sth = $dbh->prepare(q{ DELETE FROM need_merge_authorities WHERE done=1 });
360 $sth->execute() or die $dbh->errstr;
362 print "Done with purging need_merge_authorities.\n" if $verbose;
366 print "Purging records from import tables.\n" if $verbose;
367 PurgeImportTables() if $confirm;
368 print "Done with purging import tables.\n" if $verbose;
372 print "Purging Z39.50 records from import tables.\n" if $verbose;
373 PurgeZ3950() if $confirm;
374 print "Done with purging Z39.50 records from import tables.\n" if $verbose;
378 print "Purging records from action_logs.\n" if $verbose;
380 DELETE FROM action_logs
381 WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY)
383 my @query_params = ();
384 if( @preserve_logs ){
385 $log_query .= " AND module NOT IN (" . join(',',('?') x @preserve_logs ) . ")";
386 push @query_params, @preserve_logs;
389 $log_query .= " AND module IN (" . join(',',('?') x @log_modules ) . ")";
390 push @query_params, @log_modules;
393 $log_query .= " AND action IN (" . join(',',('?') x @log_actions ) . ")";
394 push @query_params, @log_actions;
396 $sth = $dbh->prepare( $log_query );
398 $sth->execute($pLogs, @query_params) or die $dbh->errstr;
400 print "Done with purging action_logs.\n" if $verbose;
404 print "Purging messages older than $pMessages days.\n" if $verbose;
405 my $messages = Koha::Patron::Messages->filter_by_last_update(
406 { timestamp_column_name => 'message_date', days => $pMessages } );
407 my $count = $messages->count;
408 $messages->delete if $confirm;
411 ? sprintf( "Done with purging %d messages", $count )
412 : sprintf( "%d messages would have been removed", $count );
417 print "Purging records from accountlines.\n" if $verbose;
418 purge_zero_balance_fees( $fees_days ) if $confirm;
419 print "Done purging records from accountlines.\n" if $verbose;
422 if ($pSearchhistory) {
423 print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;
424 C4::Search::History::delete({ interval => $pSearchhistory }) if $confirm;
425 print "Done with purging search_history.\n" if $verbose;
428 if ($pListShareInvites) {
429 print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;
430 $sth = $dbh->prepare(
432 DELETE FROM virtualshelfshares
433 WHERE invitekey IS NOT NULL
434 AND (sharedate + INTERVAL ? DAY) < NOW()
438 $sth->execute($pListShareInvites);
440 print "Done with purging unaccepted list share invites.\n" if $verbose;
444 print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
445 my $count = PurgeDebarments($pDebarments, $confirm);
447 say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
448 say "Done with restrictions purge.";
453 print "All expired patrons restrictions purge triggered.\n" if $verbose;
454 my $count = PurgeDebarments(0, $confirm);
456 say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
457 say "Done with all restrictions purge.";
461 # Lock expired patrons?
462 if( defined $lock_days && $lock_days ne q{} ) {
463 say "Start locking expired patrons" if $verbose;
464 my $expired_patrons = Koha::Patrons->filter_by_expiration_date({ days => $lock_days })->search({ login_attempts => { '!=' => -1 } });
465 my $count = $expired_patrons->count;
466 $expired_patrons->lock({ remove => 1 }) if $confirm;
468 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("Found %d patrons", $count);
472 # Handle unsubscribe requests from GDPR consent form, depends on UnsubscribeReflectionDelay preference
473 say "Start lock unsubscribed, anonymize and delete" if $verbose;
474 my $unsubscribed_patrons = Koha::Patrons->search_unsubscribed;
475 my $count = $unsubscribed_patrons->count;
476 $unsubscribed_patrons->lock( { expire => 1, remove => 1 } ) if $confirm;
477 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("%d patrons would have been locked", $count) if $verbose;
479 # Anonymize patron data, depending on PatronAnonymizeDelay
480 my $anonymize_candidates = Koha::Patrons->search_anonymize_candidates( { locked => 1 } );
481 $count = $anonymize_candidates->count;
482 $anonymize_candidates->anonymize if $confirm;
483 say $confirm ? sprintf("Anonymized %d patrons", $count) : sprintf("%d patrons would have been anonymized", $count) if $verbose;
485 # Remove patron data, depending on PatronRemovalDelay (will raise an exception if problem encountered
486 my $anonymized_patrons = Koha::Patrons->search_anonymized;
487 $count = $anonymized_patrons->count;
489 $anonymized_patrons->delete( { move => 1 } );
495 say $confirm ? sprintf("Deleted %d patrons", $count) : sprintf("%d patrons would have been deleted", $count);
498 # FIXME The output for dry-run mode needs to be improved
499 # But non trivial changes to C4::Members need to be done before.
502 DeleteExpiredSelfRegs();
503 } elsif ( $verbose ) {
504 say "self-registered borrowers may be deleted";
509 DeleteUnverifiedSelfRegs( $pUnvSelfReg );
510 } elsif ( $verbose ) {
511 say "unverified self-registrations may be deleted";
515 if ($special_holidays_days) {
517 DeleteSpecialHolidays( abs($special_holidays_days) );
518 } elsif ( $verbose ) {
519 say "self-registered borrowers may be deleted";
523 if( $temp_uploads ) {
524 # Delete temporary uploads, governed by a pref (unless you override)
525 print "Purging temporary uploads.\n" if $verbose;
527 Koha::UploadedFiles->delete_temporary({
528 defined($temp_uploads_days)
529 ? ( override_pref => $temp_uploads_days )
533 print "Done purging temporary uploads.\n" if $verbose;
536 if( defined $uploads_missing ) {
537 print "Looking for missing uploads\n" if $verbose;
539 my $keep = $uploads_missing == 1 ? 0 : 1;
540 my $count = Koha::UploadedFiles->delete_missing({ keep_record => $keep });
542 print "Counted $count missing uploaded files\n";
544 print "Removed $count records for missing uploads\n";
547 # FIXME need to create a filter_by_missing method (then call ->delete) instead of delete_missing
548 say "Dry-run mode cannot guess how many uploads would have been deleted";
553 require Koha::OAuthAccessTokens;
555 my $tokens = Koha::OAuthAccessTokens->search({ expires => { '<=', time } });
556 my $count = $tokens->count;
557 $tokens->delete if $confirm;
560 ? sprintf( "Removed %d expired OAuth2 tokens", $count )
561 : sprintf( "%d expired OAuth tokens would have been removed", $count );
566 print "Purging statistics older than $pStatistics days.\n" if $verbose;
567 my $statistics = Koha::Statistics->filter_by_last_update(
568 { timestamp_column_name => 'datetime', days => $pStatistics } );
569 my $count = $statistics->count;
570 $statistics->delete if $confirm;
573 ? sprintf( "Done with purging %d statistics", $count )
574 : sprintf( "%d statistics would have been removed", $count );
578 if( $return_claims && ( my $days = C4::Context->preference('CleanUpDatabaseReturnClaims') )) {
579 print "Purging return claims older than $days days.\n" if $verbose;
581 $return_claims = Koha::Checkouts::ReturnClaims->filter_by_last_update(
583 timestamp_column_name => 'resolved_on',
588 my $count = $return_claims->count;
589 $return_claims->delete if $confirm;
593 ? sprintf "Done with purging %d resolved return claims.", $count
594 : sprintf "%d resolved return claims would have been purged.", $count;
598 if ($pDeletedCatalog) {
599 print "Purging deleted catalog older than $pDeletedCatalog days.\n"
601 my $old_items = Koha::Old::Items->filter_by_last_update( { days => $pDeletedCatalog } );
602 my $old_biblioitems = Koha::Old::Biblioitems->filter_by_last_update( { days => $pDeletedCatalog } );
603 my $old_biblios = Koha::Old::Biblios->filter_by_last_update( { days => $pDeletedCatalog } );
604 my ( $c_i, $c_bi, $c_b ) =
605 ( $old_items->count, $old_biblioitems->count, $old_biblios->count );
608 $old_biblioitems->delete;
609 $old_biblios->delete;
614 ? "Done with purging deleted catalog (%d items, %d biblioitems, %d biblios)."
615 : "Deleted catalog would have been removed (%d items, %d biblioitems, %d biblios).",
620 if ($pDeletedPatrons) {
621 print "Purging deleted patrons older than $pDeletedPatrons days.\n" if $verbose;
622 my $old_patrons = Koha::Old::Patrons->filter_by_last_update(
623 { timestamp_column_name => 'updated_on', days => $pDeletedPatrons } );
624 my $count = $old_patrons->count;
625 $old_patrons->delete if $confirm;
628 ? sprintf "Done with purging %d deleted patrons.", $count
629 : sprintf "%d deleted patrons would have been purged.", $count;
634 print "Purging old checkouts older than $pOldIssues days.\n" if $verbose;
635 my $old_checkouts = Koha::Old::Checkouts->filter_by_last_update( { days => $pOldIssues } );
636 my $count = $old_checkouts->count;
637 $old_checkouts->delete if $confirm;
640 ? sprintf "Done with purging %d old checkouts.", $count
641 : sprintf "%d old checkouts would have been purged.", $count;
646 print "Purging old reserves older than $pOldReserves days.\n" if $verbose;
647 my $old_reserves = Koha::Old::Holds->filter_by_last_update( { days => $pOldReserves } );
648 my $count = $old_reserves->count;
649 $old_reserves->delete if $confirm;
652 ? sprintf "Done with purging %d old reserves.", $count
653 : sprintf "%d old reserves would have been purged.", $count;
658 print "Purging arrived item transfers older than $pTransfers days.\n" if $verbose;
659 my $transfers = Koha::Item::Transfers->filter_by_last_update(
661 timestamp_column_name => 'datearrived',
665 my $count = $transfers->count;
666 $transfers->delete if $confirm;
669 ? sprintf "Done with purging %d transfers.", $count
670 : sprintf "%d transfers would have been purged.", $count;
674 if (defined $pPseudoTransactions or $pPseudoTransactionsFrom or $pPseudoTransactionsTo ) {
675 print "Purging pseudonymized transactions\n" if $verbose;
676 my $anonymized_transactions = Koha::PseudonymizedTransactions->filter_by_last_update(
678 timestamp_column_name => 'datetime',
679 ( defined $pPseudoTransactions ? ( days => $pPseudoTransactions ) : () ),
680 ( $pPseudoTransactionsFrom ? ( from => $pPseudoTransactionsFrom ) : () ),
681 ( $pPseudoTransactionsTo ? ( to => $pPseudoTransactionsTo ) : () ),
684 my $count = $anonymized_transactions->count;
685 $anonymized_transactions->delete if $confirm;
688 ? sprintf "Done with purging %d pseudonymized transactions.", $count
689 : sprintf "%d pseudonymized transactions would have been purged.", $count;
694 print "Purging item label batches last added to more than $labels days ago.\n" if $verbose;
695 my $count = PurgeCreatorBatches($labels, 'labels', $confirm);
698 ? sprintf "Done with purging %d item label batches last added to more than %d days ago.\n", $count, $labels
699 : sprintf "%d item label batches would have been purged.", $count;
704 print "Purging card creator batches last added to more than $cards days ago.\n" if $verbose;
705 my $count = PurgeCreatorBatches($labels, 'patroncards', $confirm);
708 ? sprintf "Done with purging %d card creator batches last added to more than %d days ago.\n", $count, $labels
709 : sprintf "%d card creator batches would have been purged.", $count;
714 print "Purging background jobs more than $jobs_days days ago.\n"
716 my $jobs = Koha::BackgroundJobs->search(
718 status => 'finished',
719 ( $jobs_types[0] eq 'all' ? () : ( type => \@jobs_types ) )
721 )->filter_by_last_update(
723 timestamp_column_name => 'ended_on',
727 my $count = $jobs->count;
728 $jobs->delete if $confirm;
731 ? sprintf "Done with purging %d background jobs of type(s): %s added more than %d days ago.\n",
732 $count, join( ',', @jobs_types ), $jobs_days
733 : sprintf "%d background jobs of type(s): %s added more than %d days ago would have been purged.",
734 $count, join( ',', @jobs_types ), $jobs_days;
740 PurgeSavedReports($reports);
742 say "Purging reports data saved more than $reports days ago.\n";
746 if($edifact_msg_days) {
747 print "Purging EDIFACT messages older than $edifact_msg_days days.\n" if $verbose;
748 my $count = PurgeEdifactMessages($edifact_msg_days, $confirm);
751 ? sprintf( "Done with purging %d EDIFACT messages", $count )
752 : sprintf( "%d EDIFACT messages would have been removed", $count );
756 cronlogaction({ action => 'End', info => "COMPLETED" });
760 sub RemoveOldSessions {
761 my ( $id, $a_session, $limit, $lasttime );
762 $limit = time() - 24 * 3600 * $sess_days;
764 $sth = $dbh->prepare(q{ SELECT id, a_session FROM sessions });
765 $sth->execute or die $dbh->errstr;
766 $sth->bind_columns( \$id, \$a_session );
767 $sth2 = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? });
770 while ( $sth->fetch ) {
772 if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
775 elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
778 if ( $lasttime && $lasttime < $limit ) {
779 $sth2->execute($id) or die $dbh->errstr;
784 print "$count sessions were deleted.\n";
788 sub PurgeImportTables {
790 #First purge import_records
791 #Delete cascades to import_biblios, import_items and import_record_matches
792 $sth = $dbh->prepare(
794 DELETE FROM import_records
795 WHERE upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
798 $sth->execute($pImport) or die $dbh->errstr;
800 # Now purge import_batches
801 # Timestamp cannot be used here without care, because records are added
802 # continuously to batches without updating timestamp (Z39.50 search).
803 # So we only delete older empty batches.
804 # This delete will therefore not have a cascading effect.
805 $sth = $dbh->prepare(
808 FROM import_batches ba
809 LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
810 WHERE re.import_record_id IS NULL AND
811 ba.upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
814 $sth->execute($pImport) or die $dbh->errstr;
818 $sth = $dbh->prepare(
820 DELETE FROM import_batches
821 WHERE batch_type = 'z3950'
824 $sth->execute() or die $dbh->errstr;
827 sub PurgeDebarments {
828 require Koha::Patron::Debarments;
829 my ( $days, $doit ) = @_;
831 $sth = $dbh->prepare(
833 SELECT borrower_debarment_id
834 FROM borrower_debarments
835 WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
838 $sth->execute($days) or die $dbh->errstr;
839 while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
840 Koha::Patron::Debarments::DelDebarment($borrower_debarment_id) if $doit;
846 sub PurgeCreatorBatches {
847 require C4::Labels::Batch;
848 my ( $days, $creator, $doit ) = @_;
850 $sth = $dbh->prepare(
852 SELECT batch_id, branch_code FROM creator_batches
855 FROM (SELECT batch_id
859 HAVING max(timestamp) <= date_sub(curdate(),interval ? day)) a)
862 $sth->execute( $creator, $days ) or die $dbh->errstr;
863 while ( my ( $batch_id, $branch_code ) = $sth->fetchrow_array ) {
864 C4::Labels::Batch::delete(
865 batch_id => $batch_id,
866 branch_code => $branch_code
873 sub DeleteExpiredSelfRegs {
874 my $cnt= C4::Members::DeleteExpiredOpacRegistrations();
875 print "Removed $cnt expired self-registered borrowers\n" if $verbose;
878 sub DeleteUnverifiedSelfRegs {
879 my $cnt= C4::Members::DeleteUnverifiedOpacRegistrations( $_[0] );
880 print "Removed $cnt unverified self-registrations\n" if $verbose;
883 sub DeleteSpecialHolidays {
886 my $sth = $dbh->prepare(q{
887 DELETE FROM special_holidays
888 WHERE DATE( CONCAT( year, '-', month, '-', day ) ) < DATE_SUB( CAST(NOW() AS DATE), INTERVAL ? DAY );
890 my $count = $sth->execute( $days ) + 0;
891 print "Removed $count unique holidays\n" if $verbose;
894 sub PurgeSavedReports {
895 my ( $reports ) = @_;
897 my $sth = $dbh->prepare(q{
898 DELETE FROM saved_reports
899 WHERE date(date_run) < DATE_SUB(CURDATE(),INTERVAL ? DAY );
901 $sth->execute( $reports );
904 sub PurgeEdifactMessages {
905 my ( $days, $doit ) = @_;
907 my $schema = Koha::Database->new()->schema();
908 my $dtf = $schema->storage->datetime_parser;
909 my $resultset = $schema->resultset('EdifactMessage')->search(
912 '<' => $dtf->format_datetime(dt_from_string->subtract( days => $days ))
914 status => { '!=' => 'new' },
917 my $count = $resultset->count;
919 $resultset->delete if $doit;