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 --logs DAYS purge entries from action_logs older than DAYS days.
88 Defaults to 180 days if no days specified.
89 --searchhistory DAYS purge entries from search_history older than DAYS days.
90 Defaults to 30 days if no days specified
91 --list-invites DAYS purge (unaccepted) list share invites older than DAYS
92 days. Defaults to 14 days if no days specified.
93 --restrictions DAYS purge patrons restrictions expired since more than DAYS days.
94 Defaults to 30 days if no days specified.
95 --all-restrictions purge all expired patrons restrictions.
96 --del-exp-selfreg Delete expired self registration accounts
97 --del-unv-selfreg DAYS Delete unverified self registrations older than DAYS
98 --unique-holidays DAYS Delete all unique holidays older than DAYS
99 --temp-uploads Delete temporary uploads.
100 --temp-uploads-days DAYS Override the corresponding preference value.
101 --uploads-missing FLAG Delete upload records for missing files when FLAG is true, count them otherwise
102 --oauth-tokens Delete expired OAuth2 tokens
103 --statistics DAYS Purge statistics entries more than DAYS days old.
104 This table is used to build reports, make sure you are aware of the consequences of this before using it!
105 --deleted-catalog DAYS Purge catalog records deleted more then DAYS days ago
106 (from tables deleteditems, deletedbiblioitems, deletedbiblio_metadata and deletedbiblio).
107 --deleted-patrons DAYS Purge patrons deleted more than DAYS days ago.
108 --old-issues DAYS Purge checkouts (old_issues) returned more than DAYS days ago.
109 --old-reserves DAYS Purge reserves (old_reserves) more than DAYS old.
110 --transfers DAYS Purge transfers completed more than DAYS day ago.
111 --pseudo-transactions DAYS Purge the pseudonymized transactions that have been originally created more than DAYS days ago
112 DAYS is optional and can be replaced by:
113 --pseudo-transactions-from YYYY-MM-DD and/or --pseudo-transactions-to YYYY-MM-DD
114 --labels DAYS Purge item label batches last added to more than DAYS days ago.
115 --cards DAY Purge card creator batches last added to more than DAYS days ago.
116 --return-claims Purge all resolved return claims older than the number of days specified in
117 the system preference CleanUpDatabaseReturnClaims.
118 --jobs-days DAYS Purge all finished background jobs this many days old. Defaults to 1 if no DAYS provided.
119 --jobs-type TYPES What type of background job to purge. Defaults to "update_elastic_index" if omitted
120 Specifying "all" will purge all types. Repeatable.
121 --reports DAYS Purge reports data saved more than DAYS days ago. The data is created by running runreport.pl with the --store-results option.
122 --edifact-messages DAYS Purge process and failed EDIFACT messages handled more than DAYS days.
123 Defaults to 365 days if no days specified.
140 my $pListShareInvites;
147 my $special_holidays_days;
149 my $temp_uploads_days;
158 my ( $pPseudoTransactions, $pPseudoTransactionsFrom, $pPseudoTransactionsTo );
160 my $lock_days = C4::Context->preference('LockExpiredDelay');
168 my $edifact_msg_days;
170 my $command_line_options = join(" ",@ARGV);
174 'confirm' => \$confirm,
175 'sessions' => \$sessions,
176 'sessdays:i' => \$sess_days,
177 'v|verbose' => \$verbose,
178 'm|mail:i' => \$mail,
179 'zebraqueue:i' => \$zebraqueue_days,
180 'merged' => \$purge_merged,
181 'import:i' => \$pImport,
184 'log-module:s' => \@log_modules,
185 'preserve-log:s' => \@preserve_logs,
186 'messages:i' => \$pMessages,
187 'fees:i' => \$fees_days,
188 'searchhistory:i' => \$pSearchhistory,
189 'list-invites:i' => \$pListShareInvites,
190 'restrictions:i' => \$pDebarments,
191 'all-restrictions' => \$allDebarments,
192 'del-exp-selfreg' => \$pExpSelfReg,
193 'del-unv-selfreg:i' => \$pUnvSelfReg,
194 'unique-holidays:i' => \$special_holidays_days,
195 'temp-uploads' => \$temp_uploads,
196 'temp-uploads-days:i' => \$temp_uploads_days,
197 'uploads-missing:i' => \$uploads_missing,
198 'oauth-tokens' => \$oauth_tokens,
199 'statistics:i' => \$pStatistics,
200 'deleted-catalog:i' => \$pDeletedCatalog,
201 'deleted-patrons:i' => \$pDeletedPatrons,
202 'old-issues:i' => \$pOldIssues,
203 'old-reserves:i' => \$pOldReserves,
204 'transfers:i' => \$pTransfers,
205 'pseudo-transactions:i' => \$pPseudoTransactions,
206 'pseudo-transactions-from:s' => \$pPseudoTransactionsFrom,
207 'pseudo-transactions-to:s' => \$pPseudoTransactionsTo,
208 'labels' => \$labels,
210 'return-claims' => \$return_claims,
211 'jobs-type:s' => \@jobs_types,
212 'jobs-days:i' => \$jobs_days,
213 'reports:i' => \$reports,
214 'edifact-messages:i' => \$edifact_msg_days,
218 $sessions = 1 if $sess_days && $sess_days > 0;
219 $pImport = DEFAULT_IMPORT_PURGEDAYS if defined($pImport) && $pImport == 0;
220 $pLogs = DEFAULT_LOGS_PURGEDAYS if defined($pLogs) && $pLogs == 0;
221 $zebraqueue_days = DEFAULT_ZEBRAQ_PURGEDAYS if defined($zebraqueue_days) && $zebraqueue_days == 0;
222 $mail = DEFAULT_MAIL_PURGEDAYS if defined($mail) && $mail == 0;
223 $pSearchhistory = DEFAULT_SEARCHHISTORY_PURGEDAYS if defined($pSearchhistory) && $pSearchhistory == 0;
224 $pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0;
225 $pDebarments = DEFAULT_DEBARMENTS_PURGEDAYS if defined($pDebarments) && $pDebarments == 0;
226 $pMessages = DEFAULT_MESSAGES_PURGEDAYS if defined($pMessages) && $pMessages == 0;
227 $jobs_days = DEFAULT_JOBS_PURGEDAYS if defined($jobs_days) && $jobs_days == 0;
228 @jobs_types = (DEFAULT_JOBS_PURGETYPES) if $jobs_days && @jobs_types == 0;
229 $edifact_msg_days = DEFAULT_EDIFACT_MSG_PURGEDAYS if defined($edifact_msg_days) && $edifact_msg_days == 0;
244 || $pListShareInvites
249 || $special_holidays_days
251 || defined $uploads_missing
259 || defined $pPseudoTransactions
260 || $pPseudoTransactionsFrom
261 || $pPseudoTransactionsTo
263 || defined $lock_days && $lock_days ne q{}
271 print "You did not specify any cleanup work for the script to do.\n\n";
275 if ($pDebarments && $allDebarments) {
276 print "You can not specify both --restrictions and --all-restrictions.\n\n";
280 say "Confirm flag not passed, running in dry-run mode..." unless $confirm;
282 cronlogaction({ info => $command_line_options });
284 my $dbh = C4::Context->dbh();
288 if ( $sessions && !$sess_days ) {
290 say "Session purge triggered.";
291 $sth = $dbh->prepare(q{ SELECT COUNT(*) FROM sessions });
292 $sth->execute() or die $dbh->errstr;
293 my @count_arr = $sth->fetchrow_array;
294 say $confirm ? "$count_arr[0] entries will be deleted." : "$count_arr[0] entries would be deleted.";
297 $sth = $dbh->prepare(q{ TRUNCATE sessions });
298 $sth->execute() or die $dbh->errstr;
301 print "Done with session purge.\n";
304 elsif ( $sessions && $sess_days > 0 ) {
305 print "Session purge triggered with days>$sess_days.\n" if $verbose;
306 RemoveOldSessions() if $confirm;
307 print "Done with session purge with days>$sess_days.\n" if $verbose;
310 if ($zebraqueue_days) {
312 print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
313 $sth = $dbh->prepare(
315 SELECT id,biblio_auth_number,server,time
317 WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY)
320 $sth->execute($zebraqueue_days) or die $dbh->errstr;
321 $sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? });
322 while ( my $record = $sth->fetchrow_hashref ) {
324 $sth2->execute( $record->{id} ) or die $dbh->errstr;
329 say $confirm ? "$count records were deleted." : "$count records would have been deleted.";
330 say "Done with zebraqueue purge.";
336 print "Mail queue purge triggered for $mail days.\n" if $verbose;
337 $sth = $dbh->prepare(
339 DELETE FROM message_queue
340 WHERE time_queued < date_sub(curdate(), INTERVAL ? DAY)
344 $sth->execute($mail) or die $dbh->errstr;
348 say $confirm ? "$count messages were deleted from the mail queue." : "Message from message_queue would have been deleted";
349 say "Done with message_queue purge.";
354 print "Purging completed entries from need_merge_authorities.\n" if $verbose;
356 $sth = $dbh->prepare(q{ DELETE FROM need_merge_authorities WHERE done=1 });
357 $sth->execute() or die $dbh->errstr;
359 print "Done with purging need_merge_authorities.\n" if $verbose;
363 print "Purging records from import tables.\n" if $verbose;
364 PurgeImportTables() if $confirm;
365 print "Done with purging import tables.\n" if $verbose;
369 print "Purging Z39.50 records from import tables.\n" if $verbose;
370 PurgeZ3950() if $confirm;
371 print "Done with purging Z39.50 records from import tables.\n" if $verbose;
375 print "Purging records from action_logs.\n" if $verbose;
377 DELETE FROM action_logs
378 WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY)
380 my @query_params = ();
381 if( @preserve_logs ){
382 $log_query .= " AND module NOT IN (" . join(',',('?') x @preserve_logs ) . ")";
383 push @query_params, @preserve_logs;
386 $log_query .= " AND module IN (" . join(',',('?') x @log_modules ) . ")";
387 push @query_params, @log_modules;
389 $sth = $dbh->prepare( $log_query );
391 $sth->execute($pLogs, @query_params) or die $dbh->errstr;
393 print "Done with purging action_logs.\n" if $verbose;
397 print "Purging messages older than $pMessages days.\n" if $verbose;
398 my $messages = Koha::Patron::Messages->filter_by_last_update(
399 { timestamp_column_name => 'message_date', days => $pMessages } );
400 my $count = $messages->count;
401 $messages->delete if $confirm;
404 ? sprintf( "Done with purging %d messages", $count )
405 : sprintf( "%d messages would have been removed", $count );
410 print "Purging records from accountlines.\n" if $verbose;
411 purge_zero_balance_fees( $fees_days ) if $confirm;
412 print "Done purging records from accountlines.\n" if $verbose;
415 if ($pSearchhistory) {
416 print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;
417 C4::Search::History::delete({ interval => $pSearchhistory }) if $confirm;
418 print "Done with purging search_history.\n" if $verbose;
421 if ($pListShareInvites) {
422 print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;
423 $sth = $dbh->prepare(
425 DELETE FROM virtualshelfshares
426 WHERE invitekey IS NOT NULL
427 AND (sharedate + INTERVAL ? DAY) < NOW()
431 $sth->execute($pListShareInvites);
433 print "Done with purging unaccepted list share invites.\n" if $verbose;
437 print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
438 my $count = PurgeDebarments($pDebarments, $confirm);
440 say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
441 say "Done with restrictions purge.";
446 print "All expired patrons restrictions purge triggered.\n" if $verbose;
447 my $count = PurgeDebarments(0, $confirm);
449 say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
450 say "Done with all restrictions purge.";
454 # Lock expired patrons?
455 if( defined $lock_days && $lock_days ne q{} ) {
456 say "Start locking expired patrons" if $verbose;
457 my $expired_patrons = Koha::Patrons->filter_by_expiration_date({ days => $lock_days })->search({ login_attempts => { '!=' => -1 } });
458 my $count = $expired_patrons->count;
459 $expired_patrons->lock({ remove => 1 }) if $confirm;
461 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("Found %d patrons", $count);
465 # Handle unsubscribe requests from GDPR consent form, depends on UnsubscribeReflectionDelay preference
466 say "Start lock unsubscribed, anonymize and delete" if $verbose;
467 my $unsubscribed_patrons = Koha::Patrons->search_unsubscribed;
468 my $count = $unsubscribed_patrons->count;
469 $unsubscribed_patrons->lock( { expire => 1, remove => 1 } ) if $confirm;
470 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("%d patrons would have been locked", $count) if $verbose;
472 # Anonymize patron data, depending on PatronAnonymizeDelay
473 my $anonymize_candidates = Koha::Patrons->search_anonymize_candidates( { locked => 1 } );
474 $count = $anonymize_candidates->count;
475 $anonymize_candidates->anonymize if $confirm;
476 say $confirm ? sprintf("Anonymized %d patrons", $count) : sprintf("%d patrons would have been anonymized", $count) if $verbose;
478 # Remove patron data, depending on PatronRemovalDelay (will raise an exception if problem encountered
479 my $anonymized_patrons = Koha::Patrons->search_anonymized;
480 $count = $anonymized_patrons->count;
482 $anonymized_patrons->delete( { move => 1 } );
488 say $confirm ? sprintf("Deleted %d patrons", $count) : sprintf("%d patrons would have been deleted", $count);
491 # FIXME The output for dry-run mode needs to be improved
492 # But non trivial changes to C4::Members need to be done before.
495 DeleteExpiredSelfRegs();
496 } elsif ( $verbose ) {
497 say "self-registered borrowers may be deleted";
502 DeleteUnverifiedSelfRegs( $pUnvSelfReg );
503 } elsif ( $verbose ) {
504 say "unverified self-registrations may be deleted";
508 if ($special_holidays_days) {
510 DeleteSpecialHolidays( abs($special_holidays_days) );
511 } elsif ( $verbose ) {
512 say "self-registered borrowers may be deleted";
516 if( $temp_uploads ) {
517 # Delete temporary uploads, governed by a pref (unless you override)
518 print "Purging temporary uploads.\n" if $verbose;
520 Koha::UploadedFiles->delete_temporary({
521 defined($temp_uploads_days)
522 ? ( override_pref => $temp_uploads_days )
526 print "Done purging temporary uploads.\n" if $verbose;
529 if( defined $uploads_missing ) {
530 print "Looking for missing uploads\n" if $verbose;
532 my $keep = $uploads_missing == 1 ? 0 : 1;
533 my $count = Koha::UploadedFiles->delete_missing({ keep_record => $keep });
535 print "Counted $count missing uploaded files\n";
537 print "Removed $count records for missing uploads\n";
540 # FIXME need to create a filter_by_missing method (then call ->delete) instead of delete_missing
541 say "Dry-run mode cannot guess how many uploads would have been deleted";
546 require Koha::OAuthAccessTokens;
548 my $tokens = Koha::OAuthAccessTokens->search({ expires => { '<=', time } });
549 my $count = $tokens->count;
550 $tokens->delete if $confirm;
553 ? sprintf( "Removed %d expired OAuth2 tokens", $count )
554 : sprintf( "%d expired OAuth tokens would have been removed", $count );
559 print "Purging statistics older than $pStatistics days.\n" if $verbose;
560 my $statistics = Koha::Statistics->filter_by_last_update(
561 { timestamp_column_name => 'datetime', days => $pStatistics } );
562 my $count = $statistics->count;
563 $statistics->delete if $confirm;
566 ? sprintf( "Done with purging %d statistics", $count )
567 : sprintf( "%d statistics would have been removed", $count );
571 if( $return_claims && ( my $days = C4::Context->preference('CleanUpDatabaseReturnClaims') )) {
572 print "Purging return claims older than $days days.\n" if $verbose;
574 $return_claims = Koha::Checkouts::ReturnClaims->filter_by_last_update(
576 timestamp_column_name => 'resolved_on',
581 my $count = $return_claims->count;
582 $return_claims->delete if $confirm;
586 ? sprintf "Done with purging %d resolved return claims.", $count
587 : sprintf "%d resolved return claims would have been purged.", $count;
591 if ($pDeletedCatalog) {
592 print "Purging deleted catalog older than $pDeletedCatalog days.\n"
594 my $old_items = Koha::Old::Items->filter_by_last_update( { days => $pDeletedCatalog } );
595 my $old_biblioitems = Koha::Old::Biblioitems->filter_by_last_update( { days => $pDeletedCatalog } );
596 my $old_biblios = Koha::Old::Biblios->filter_by_last_update( { days => $pDeletedCatalog } );
597 my ( $c_i, $c_bi, $c_b ) =
598 ( $old_items->count, $old_biblioitems->count, $old_biblios->count );
601 $old_biblioitems->delete;
602 $old_biblios->delete;
607 ? "Done with purging deleted catalog (%d items, %d biblioitems, %d biblios)."
608 : "Deleted catalog would have been removed (%d items, %d biblioitems, %d biblios).",
613 if ($pDeletedPatrons) {
614 print "Purging deleted patrons older than $pDeletedPatrons days.\n" if $verbose;
615 my $old_patrons = Koha::Old::Patrons->filter_by_last_update(
616 { timestamp_column_name => 'updated_on', days => $pDeletedPatrons } );
617 my $count = $old_patrons->count;
618 $old_patrons->delete if $confirm;
621 ? sprintf "Done with purging %d deleted patrons.", $count
622 : sprintf "%d deleted patrons would have been purged.", $count;
627 print "Purging old checkouts older than $pOldIssues days.\n" if $verbose;
628 my $old_checkouts = Koha::Old::Checkouts->filter_by_last_update( { days => $pOldIssues } );
629 my $count = $old_checkouts->count;
630 $old_checkouts->delete if $confirm;
633 ? sprintf "Done with purging %d old checkouts.", $count
634 : sprintf "%d old checkouts would have been purged.", $count;
639 print "Purging old reserves older than $pOldReserves days.\n" if $verbose;
640 my $old_reserves = Koha::Old::Holds->filter_by_last_update( { days => $pOldReserves } );
641 my $count = $old_reserves->count;
642 $old_reserves->delete if $confirm;
645 ? sprintf "Done with purging %d old reserves.", $count
646 : sprintf "%d old reserves would have been purged.", $count;
651 print "Purging arrived item transfers older than $pTransfers days.\n" if $verbose;
652 my $transfers = Koha::Item::Transfers->filter_by_last_update(
654 timestamp_column_name => 'datearrived',
658 my $count = $transfers->count;
659 $transfers->delete if $confirm;
662 ? sprintf "Done with purging %d transfers.", $count
663 : sprintf "%d transfers would have been purged.", $count;
667 if (defined $pPseudoTransactions or $pPseudoTransactionsFrom or $pPseudoTransactionsTo ) {
668 print "Purging pseudonymized transactions\n" if $verbose;
669 my $anonymized_transactions = Koha::PseudonymizedTransactions->filter_by_last_update(
671 timestamp_column_name => 'datetime',
672 ( defined $pPseudoTransactions ? ( days => $pPseudoTransactions ) : () ),
673 ( $pPseudoTransactionsFrom ? ( from => $pPseudoTransactionsFrom ) : () ),
674 ( $pPseudoTransactionsTo ? ( to => $pPseudoTransactionsTo ) : () ),
677 my $count = $anonymized_transactions->count;
678 $anonymized_transactions->delete if $confirm;
681 ? sprintf "Done with purging %d pseudonymized transactions.", $count
682 : sprintf "%d pseudonymized transactions would have been purged.", $count;
687 print "Purging item label batches last added to more than $labels days ago.\n" if $verbose;
688 my $count = PurgeCreatorBatches($labels, 'labels', $confirm);
691 ? sprintf "Done with purging %d item label batches last added to more than %d days ago.\n", $count, $labels
692 : sprintf "%d item label batches would have been purged.", $count;
697 print "Purging card creator batches last added to more than $cards days ago.\n" if $verbose;
698 my $count = PurgeCreatorBatches($labels, 'patroncards', $confirm);
701 ? sprintf "Done with purging %d card creator batches last added to more than %d days ago.\n", $count, $labels
702 : sprintf "%d card creator batches would have been purged.", $count;
707 print "Purging background jobs more than $jobs_days days ago.\n"
709 my $jobs = Koha::BackgroundJobs->search(
711 status => 'finished',
712 ( $jobs_types[0] eq 'all' ? () : ( type => \@jobs_types ) )
714 )->filter_by_last_update(
716 timestamp_column_name => 'ended_on',
720 my $count = $jobs->count;
721 $jobs->delete if $confirm;
724 ? sprintf "Done with purging %d background jobs of type(s): %s added more than %d days ago.\n",
725 $count, join( ',', @jobs_types ), $jobs_days
726 : sprintf "%d background jobs of type(s): %s added more than %d days ago would have been purged.",
727 $count, join( ',', @jobs_types ), $jobs_days;
733 PurgeSavedReports($reports);
735 say "Purging reports data saved more than $reports days ago.\n";
739 if($edifact_msg_days) {
740 print "Purging EDIFACT messages older than $edifact_msg_days days.\n" if $verbose;
741 my $count = PurgeEdifactMessages($edifact_msg_days, $confirm);
744 ? sprintf( "Done with purging %d EDIFACT messages", $count )
745 : sprintf( "%d EDIFACT messages would have been removed", $count );
749 cronlogaction({ action => 'End', info => "COMPLETED" });
753 sub RemoveOldSessions {
754 my ( $id, $a_session, $limit, $lasttime );
755 $limit = time() - 24 * 3600 * $sess_days;
757 $sth = $dbh->prepare(q{ SELECT id, a_session FROM sessions });
758 $sth->execute or die $dbh->errstr;
759 $sth->bind_columns( \$id, \$a_session );
760 $sth2 = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? });
763 while ( $sth->fetch ) {
765 if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
768 elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
771 if ( $lasttime && $lasttime < $limit ) {
772 $sth2->execute($id) or die $dbh->errstr;
777 print "$count sessions were deleted.\n";
781 sub PurgeImportTables {
783 #First purge import_records
784 #Delete cascades to import_biblios, import_items and import_record_matches
785 $sth = $dbh->prepare(
787 DELETE FROM import_records
788 WHERE upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
791 $sth->execute($pImport) or die $dbh->errstr;
793 # Now purge import_batches
794 # Timestamp cannot be used here without care, because records are added
795 # continuously to batches without updating timestamp (Z39.50 search).
796 # So we only delete older empty batches.
797 # This delete will therefore not have a cascading effect.
798 $sth = $dbh->prepare(
801 FROM import_batches ba
802 LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
803 WHERE re.import_record_id IS NULL AND
804 ba.upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
807 $sth->execute($pImport) or die $dbh->errstr;
811 $sth = $dbh->prepare(
813 DELETE FROM import_batches
814 WHERE batch_type = 'z3950'
817 $sth->execute() or die $dbh->errstr;
820 sub PurgeDebarments {
821 require Koha::Patron::Debarments;
822 my ( $days, $doit ) = @_;
824 $sth = $dbh->prepare(
826 SELECT borrower_debarment_id
827 FROM borrower_debarments
828 WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
831 $sth->execute($days) or die $dbh->errstr;
832 while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
833 Koha::Patron::Debarments::DelDebarment($borrower_debarment_id) if $doit;
839 sub PurgeCreatorBatches {
840 require C4::Labels::Batch;
841 my ( $days, $creator, $doit ) = @_;
843 $sth = $dbh->prepare(
845 SELECT batch_id, branch_code FROM creator_batches
848 FROM (SELECT batch_id
852 HAVING max(timestamp) <= date_sub(curdate(),interval ? day)) a)
855 $sth->execute( $creator, $days ) or die $dbh->errstr;
856 while ( my ( $batch_id, $branch_code ) = $sth->fetchrow_array ) {
857 C4::Labels::Batch::delete(
858 batch_id => $batch_id,
859 branch_code => $branch_code
866 sub DeleteExpiredSelfRegs {
867 my $cnt= C4::Members::DeleteExpiredOpacRegistrations();
868 print "Removed $cnt expired self-registered borrowers\n" if $verbose;
871 sub DeleteUnverifiedSelfRegs {
872 my $cnt= C4::Members::DeleteUnverifiedOpacRegistrations( $_[0] );
873 print "Removed $cnt unverified self-registrations\n" if $verbose;
876 sub DeleteSpecialHolidays {
879 my $sth = $dbh->prepare(q{
880 DELETE FROM special_holidays
881 WHERE DATE( CONCAT( year, '-', month, '-', day ) ) < DATE_SUB( CAST(NOW() AS DATE), INTERVAL ? DAY );
883 my $count = $sth->execute( $days ) + 0;
884 print "Removed $count unique holidays\n" if $verbose;
887 sub PurgeSavedReports {
888 my ( $reports ) = @_;
890 my $sth = $dbh->prepare(q{
891 DELETE FROM saved_reports
892 WHERE date(date_run) < DATE_SUB(CURDATE(),INTERVAL ? DAY );
894 $sth->execute( $reports );
897 sub PurgeEdifactMessages {
898 my ( $days, $doit ) = @_;
900 my $schema = Koha::Database->new()->schema();
901 my $dtf = $schema->storage->datetime_parser;
902 my $resultset = $schema->resultset('EdifactMessage')->search(
905 '<' => $dtf->format_datetime(dt_from_string->subtract( days => $days ))
907 status => { '!=' => 'new' },
910 my $count = $resultset->count;
912 $resultset->delete if $doit;