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_BGJOBS_PURGEDAYS => 1;
31 use constant DEFAULT_BGJOBS_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 --bg-days DAYS Purge all finished background jobs this many days old. Defaults to 1 if no DAYS provided.
114 --bg-type TYPES What type of background job to purge. Defaults to "update_elastic_index" if omitted
115 Specifying "all" will purge all types. Repeatable.
132 my $pListShareInvites;
139 my $special_holidays_days;
141 my $temp_uploads_days;
150 my ( $pPseudoTransactions, $pPseudoTransactionsFrom, $pPseudoTransactionsTo );
152 my $lock_days = C4::Context->preference('LockExpiredDelay');
158 my @background_types;
160 my $command_line_options = join(" ",@ARGV);
164 'confirm' => \$confirm,
165 'sessions' => \$sessions,
166 'sessdays:i' => \$sess_days,
167 'v|verbose' => \$verbose,
168 'm|mail:i' => \$mail,
169 'zebraqueue:i' => \$zebraqueue_days,
170 'merged' => \$purge_merged,
171 'import:i' => \$pImport,
174 'log-module:s' => \@log_modules,
175 'preserve-log:s' => \@preserve_logs,
176 'messages:i' => \$pMessages,
177 'fees:i' => \$fees_days,
178 'searchhistory:i' => \$pSearchhistory,
179 'list-invites:i' => \$pListShareInvites,
180 'restrictions:i' => \$pDebarments,
181 'all-restrictions' => \$allDebarments,
182 'del-exp-selfreg' => \$pExpSelfReg,
183 'del-unv-selfreg:i' => \$pUnvSelfReg,
184 'unique-holidays:i' => \$special_holidays_days,
185 'temp-uploads' => \$temp_uploads,
186 'temp-uploads-days:i' => \$temp_uploads_days,
187 'uploads-missing:i' => \$uploads_missing,
188 'oauth-tokens' => \$oauth_tokens,
189 'statistics:i' => \$pStatistics,
190 'deleted-catalog:i' => \$pDeletedCatalog,
191 'deleted-patrons:i' => \$pDeletedPatrons,
192 'old-issues:i' => \$pOldIssues,
193 'old-reserves:i' => \$pOldReserves,
194 'transfers:i' => \$pTransfers,
195 'pseudo-transactions:i' => \$pPseudoTransactions,
196 'pseudo-transactions-from:s' => \$pPseudoTransactionsFrom,
197 'pseudo-transactions-to:s' => \$pPseudoTransactionsTo,
198 'labels' => \$labels,
200 'return-claims' => \$return_claims,
201 'bg-type:s' => \@background_types,
202 'bg-days:i' => \$background_days,
206 $sessions = 1 if $sess_days && $sess_days > 0;
207 $pImport = DEFAULT_IMPORT_PURGEDAYS if defined($pImport) && $pImport == 0;
208 $pLogs = DEFAULT_LOGS_PURGEDAYS if defined($pLogs) && $pLogs == 0;
209 $zebraqueue_days = DEFAULT_ZEBRAQ_PURGEDAYS if defined($zebraqueue_days) && $zebraqueue_days == 0;
210 $mail = DEFAULT_MAIL_PURGEDAYS if defined($mail) && $mail == 0;
211 $pSearchhistory = DEFAULT_SEARCHHISTORY_PURGEDAYS if defined($pSearchhistory) && $pSearchhistory == 0;
212 $pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0;
213 $pDebarments = DEFAULT_DEBARMENTS_PURGEDAYS if defined($pDebarments) && $pDebarments == 0;
214 $pMessages = DEFAULT_MESSAGES_PURGEDAYS if defined($pMessages) && $pMessages == 0;
215 $background_days = DEFAULT_BGJOBS_PURGEDAYS if defined($background_days) && $background_days == 0;
216 @background_types = (DEFAULT_BGJOBS_PURGETYPES) if $background_days && @background_types == 0;
231 || $pListShareInvites
236 || $special_holidays_days
238 || defined $uploads_missing
246 || defined $pPseudoTransactions
247 || $pPseudoTransactionsFrom
248 || $pPseudoTransactionsTo
250 || defined $lock_days && $lock_days ne q{}
256 print "You did not specify any cleanup work for the script to do.\n\n";
260 if ($pDebarments && $allDebarments) {
261 print "You can not specify both --restrictions and --all-restrictions.\n\n";
265 say "Confirm flag not passed, running in dry-run mode..." unless $confirm;
267 cronlogaction({ info => $command_line_options });
269 my $dbh = C4::Context->dbh();
273 if ( $sessions && !$sess_days ) {
275 say "Session purge triggered.";
276 $sth = $dbh->prepare(q{ SELECT COUNT(*) FROM sessions });
277 $sth->execute() or die $dbh->errstr;
278 my @count_arr = $sth->fetchrow_array;
279 say $confirm ? "$count_arr[0] entries will be deleted." : "$count_arr[0] entries would be deleted.";
282 $sth = $dbh->prepare(q{ TRUNCATE sessions });
283 $sth->execute() or die $dbh->errstr;
286 print "Done with session purge.\n";
289 elsif ( $sessions && $sess_days > 0 ) {
290 print "Session purge triggered with days>$sess_days.\n" if $verbose;
291 RemoveOldSessions() if $confirm;
292 print "Done with session purge with days>$sess_days.\n" if $verbose;
295 if ($zebraqueue_days) {
297 print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
298 $sth = $dbh->prepare(
300 SELECT id,biblio_auth_number,server,time
302 WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY)
305 $sth->execute($zebraqueue_days) or die $dbh->errstr;
306 $sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? });
307 while ( my $record = $sth->fetchrow_hashref ) {
309 $sth2->execute( $record->{id} ) or die $dbh->errstr;
314 say $confirm ? "$count records were deleted." : "$count records would have been deleted.";
315 say "Done with zebraqueue purge.";
321 print "Mail queue purge triggered for $mail days.\n" if $verbose;
322 $sth = $dbh->prepare(
324 DELETE FROM message_queue
325 WHERE time_queued < date_sub(curdate(), INTERVAL ? DAY)
329 $sth->execute($mail) or die $dbh->errstr;
333 say $confirm ? "$count messages were deleted from the mail queue." : "Message from message_queue would have been deleted";
334 say "Done with message_queue purge.";
339 print "Purging completed entries from need_merge_authorities.\n" if $verbose;
341 $sth = $dbh->prepare(q{ DELETE FROM need_merge_authorities WHERE done=1 });
342 $sth->execute() or die $dbh->errstr;
344 print "Done with purging need_merge_authorities.\n" if $verbose;
348 print "Purging records from import tables.\n" if $verbose;
349 PurgeImportTables() if $confirm;
350 print "Done with purging import tables.\n" if $verbose;
354 print "Purging Z39.50 records from import tables.\n" if $verbose;
355 PurgeZ3950() if $confirm;
356 print "Done with purging Z39.50 records from import tables.\n" if $verbose;
360 print "Purging records from action_logs.\n" if $verbose;
362 DELETE FROM action_logs
363 WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY)
365 my @query_params = ();
366 if( @preserve_logs ){
367 $log_query .= " AND module NOT IN (" . join(',',('?') x @preserve_logs ) . ")";
368 push @query_params, @preserve_logs;
371 $log_query .= " AND module IN (" . join(',',('?') x @log_modules ) . ")";
372 push @query_params, @log_modules;
374 $sth = $dbh->prepare( $log_query );
376 $sth->execute($pLogs, @query_params) or die $dbh->errstr;
378 print "Done with purging action_logs.\n" if $verbose;
382 print "Purging messages older than $pMessages days.\n" if $verbose;
383 my $messages = Koha::Patron::Messages->filter_by_last_update(
384 { timestamp_column_name => 'message_date', days => $pMessages } );
385 my $count = $messages->count;
386 $messages->delete if $confirm;
389 ? sprintf( "Done with purging %d messages", $count )
390 : sprintf( "%d messages would have been removed", $count );
395 print "Purging records from accountlines.\n" if $verbose;
396 purge_zero_balance_fees( $fees_days ) if $confirm;
397 print "Done purging records from accountlines.\n" if $verbose;
400 if ($pSearchhistory) {
401 print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;
402 C4::Search::History::delete({ interval => $pSearchhistory }) if $confirm;
403 print "Done with purging search_history.\n" if $verbose;
406 if ($pListShareInvites) {
407 print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;
408 $sth = $dbh->prepare(
410 DELETE FROM virtualshelfshares
411 WHERE invitekey IS NOT NULL
412 AND (sharedate + INTERVAL ? DAY) < NOW()
416 $sth->execute($pListShareInvites);
418 print "Done with purging unaccepted list share invites.\n" if $verbose;
422 print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
423 my $count = PurgeDebarments($pDebarments, $confirm);
425 say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
426 say "Done with restrictions purge.";
431 print "All expired patrons restrictions purge triggered.\n" if $verbose;
432 my $count = PurgeDebarments(0, $confirm);
434 say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
435 say "Done with all restrictions purge.";
439 # Lock expired patrons?
440 if( defined $lock_days && $lock_days ne q{} ) {
441 say "Start locking expired patrons" if $verbose;
442 my $expired_patrons = Koha::Patrons->filter_by_expiration_date({ days => $lock_days })->search({ login_attempts => { '!=' => -1 } });
443 my $count = $expired_patrons->count;
444 $expired_patrons->lock({ remove => 1 }) if $confirm;
446 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("Found %d patrons", $count);
450 # Handle unsubscribe requests from GDPR consent form, depends on UnsubscribeReflectionDelay preference
451 say "Start lock unsubscribed, anonymize and delete" if $verbose;
452 my $unsubscribed_patrons = Koha::Patrons->search_unsubscribed;
453 my $count = $unsubscribed_patrons->count;
454 $unsubscribed_patrons->lock( { expire => 1, remove => 1 } ) if $confirm;
455 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("%d patrons would have been locked", $count) if $verbose;
457 # Anonymize patron data, depending on PatronAnonymizeDelay
458 my $anonymize_candidates = Koha::Patrons->search_anonymize_candidates( { locked => 1 } );
459 $count = $anonymize_candidates->count;
460 $anonymize_candidates->anonymize if $confirm;
461 say $confirm ? sprintf("Anonymized %d patrons", $count) : sprintf("%d patrons would have been anonymized", $count) if $verbose;
463 # Remove patron data, depending on PatronRemovalDelay (will raise an exception if problem encountered
464 my $anonymized_patrons = Koha::Patrons->search_anonymized;
465 $count = $anonymized_patrons->count;
467 $anonymized_patrons->delete( { move => 1 } );
473 say $confirm ? sprintf("Deleted %d patrons", $count) : sprintf("%d patrons would have been deleted", $count);
476 # FIXME The output for dry-run mode needs to be improved
477 # But non trivial changes to C4::Members need to be done before.
480 DeleteExpiredSelfRegs();
481 } elsif ( $verbose ) {
482 say "self-registered borrowers may be deleted";
487 DeleteUnverifiedSelfRegs( $pUnvSelfReg );
488 } elsif ( $verbose ) {
489 say "unverified self-registrations may be deleted";
493 if ($special_holidays_days) {
495 DeleteSpecialHolidays( abs($special_holidays_days) );
496 } elsif ( $verbose ) {
497 say "self-registered borrowers may be deleted";
501 if( $temp_uploads ) {
502 # Delete temporary uploads, governed by a pref (unless you override)
503 print "Purging temporary uploads.\n" if $verbose;
505 Koha::UploadedFiles->delete_temporary({
506 defined($temp_uploads_days)
507 ? ( override_pref => $temp_uploads_days )
511 print "Done purging temporary uploads.\n" if $verbose;
514 if( defined $uploads_missing ) {
515 print "Looking for missing uploads\n" if $verbose;
517 my $keep = $uploads_missing == 1 ? 0 : 1;
518 my $count = Koha::UploadedFiles->delete_missing({ keep_record => $keep });
520 print "Counted $count missing uploaded files\n";
522 print "Removed $count records for missing uploads\n";
525 # FIXME need to create a filter_by_missing method (then call ->delete) instead of delete_missing
526 say "Dry-run mode cannot guess how many uploads would have been deleted";
531 require Koha::OAuthAccessTokens;
533 my $tokens = Koha::OAuthAccessTokens->search({ expires => { '<=', time } });
534 my $count = $tokens->count;
535 $tokens->delete if $confirm;
538 ? sprintf( "Removed %d expired OAuth2 tokens", $count )
539 : sprintf( "%d expired OAuth tokens would have been removed", $count );
544 print "Purging statistics older than $pStatistics days.\n" if $verbose;
545 my $statistics = Koha::Statistics->filter_by_last_update(
546 { timestamp_column_name => 'datetime', days => $pStatistics } );
547 my $count = $statistics->count;
548 $statistics->delete if $confirm;
551 ? sprintf( "Done with purging %d statistics", $count )
552 : sprintf( "%d statistics would have been removed", $count );
556 if( $return_claims && ( my $days = C4::Context->preference('CleanUpDatabaseReturnClaims') )) {
557 print "Purging return claims older than $days days.\n" if $verbose;
559 $return_claims = Koha::Checkouts::ReturnClaims->filter_by_last_update(
561 timestamp_column_name => 'resolved_on',
566 my $count = $return_claims->count;
567 $return_claims->delete if $confirm;
571 ? sprintf "Done with purging %d resolved return claims.", $count
572 : sprintf "%d resolved return claims would have been purged.", $count;
576 if ($pDeletedCatalog) {
577 print "Purging deleted catalog older than $pDeletedCatalog days.\n"
579 my $old_items = Koha::Old::Items->filter_by_last_update( { days => $pDeletedCatalog } );
580 my $old_biblioitems = Koha::Old::Biblioitems->filter_by_last_update( { days => $pDeletedCatalog } );
581 my $old_biblios = Koha::Old::Biblios->filter_by_last_update( { days => $pDeletedCatalog } );
582 my ( $c_i, $c_bi, $c_b ) =
583 ( $old_items->count, $old_biblioitems->count, $old_biblios->count );
586 $old_biblioitems->delete;
587 $old_biblios->delete;
592 ? "Done with purging deleted catalog (%d items, %d biblioitems, %d biblios)."
593 : "Deleted catalog would have been removed (%d items, %d biblioitems, %d biblios).",
598 if ($pDeletedPatrons) {
599 print "Purging deleted patrons older than $pDeletedPatrons days.\n" if $verbose;
600 my $old_patrons = Koha::Old::Patrons->filter_by_last_update(
601 { timestamp_column_name => 'updated_on', days => $pDeletedPatrons } );
602 my $count = $old_patrons->count;
603 $old_patrons->delete if $confirm;
606 ? sprintf "Done with purging %d deleted patrons.", $count
607 : sprintf "%d deleted patrons would have been purged.", $count;
612 print "Purging old checkouts older than $pOldIssues days.\n" if $verbose;
613 my $old_checkouts = Koha::Old::Checkouts->filter_by_last_update( { days => $pOldIssues } );
614 my $count = $old_checkouts->count;
615 $old_checkouts->delete if $confirm;
618 ? sprintf "Done with purging %d old checkouts.", $count
619 : sprintf "%d old checkouts would have been purged.", $count;
624 print "Purging old reserves older than $pOldReserves days.\n" if $verbose;
625 my $old_reserves = Koha::Old::Holds->filter_by_last_update( { days => $pOldReserves } );
626 my $count = $old_reserves->count;
627 $old_reserves->delete if $confirm;
630 ? sprintf "Done with purging %d old reserves.", $count
631 : sprintf "%d old reserves would have been purged.", $count;
636 print "Purging arrived item transfers older than $pTransfers days.\n" if $verbose;
637 my $transfers = Koha::Item::Transfers->filter_by_last_update(
639 timestamp_column_name => 'datearrived',
643 my $count = $transfers->count;
644 $transfers->delete if $confirm;
647 ? sprintf "Done with purging %d transfers.", $count
648 : sprintf "%d transfers would have been purged.", $count;
652 if (defined $pPseudoTransactions or $pPseudoTransactionsFrom or $pPseudoTransactionsTo ) {
653 print "Purging pseudonymized transactions\n" if $verbose;
654 my $anonymized_transactions = Koha::PseudonymizedTransactions->filter_by_last_update(
656 timestamp_column_name => 'datetime',
657 ( defined $pPseudoTransactions ? ( days => $pPseudoTransactions ) : () ),
658 ( $pPseudoTransactionsFrom ? ( from => $pPseudoTransactionsFrom ) : () ),
659 ( $pPseudoTransactionsTo ? ( to => $pPseudoTransactionsTo ) : () ),
662 my $count = $anonymized_transactions->count;
663 $anonymized_transactions->delete if $confirm;
666 ? sprintf "Done with purging %d pseudonymized transactions.", $count
667 : sprintf "%d pseudonymized transactions would have been purged.", $count;
672 print "Purging item label batches last added to more than $labels days ago.\n" if $verbose;
673 my $count = PurgeCreatorBatches($labels, 'labels', $confirm);
676 ? sprintf "Done with purging %d item label batches last added to more than %d days ago.\n", $count, $labels
677 : sprintf "%d item label batches would have been purged.", $count;
682 print "Purging card creator batches last added to more than $cards days ago.\n" if $verbose;
683 my $count = PurgeCreatorBatches($labels, 'patroncards', $confirm);
686 ? sprintf "Done with purging %d card creator batches last added to more than %d days ago.\n", $count, $labels
687 : sprintf "%d card creator batches would have been purged.", $count;
691 if ($background_days) {
692 print "Purging background jobs more than $background_days days ago.\n" if $verbose;
693 my $params = { job_types => \@background_types ,
694 days => $background_days,
697 my $count = Koha::BackgroundJobs->purge( $params );
700 ? sprintf "Done with purging %d background jobs of type(s): %s added more than %d days ago.\n", $count, join(',', @background_types), $background_days
701 : sprintf "%d background jobs of type(s): %s added more than %d days ago would have been purged.", $count, join(',', @background_types), $background_days;
705 cronlogaction({ action => 'End', info => "COMPLETED" });
709 sub RemoveOldSessions {
710 my ( $id, $a_session, $limit, $lasttime );
711 $limit = time() - 24 * 3600 * $sess_days;
713 $sth = $dbh->prepare(q{ SELECT id, a_session FROM sessions });
714 $sth->execute or die $dbh->errstr;
715 $sth->bind_columns( \$id, \$a_session );
716 $sth2 = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? });
719 while ( $sth->fetch ) {
721 if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
724 elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
727 if ( $lasttime && $lasttime < $limit ) {
728 $sth2->execute($id) or die $dbh->errstr;
733 print "$count sessions were deleted.\n";
737 sub PurgeImportTables {
739 #First purge import_records
740 #Delete cascades to import_biblios, import_items and import_record_matches
741 $sth = $dbh->prepare(
743 DELETE FROM import_records
744 WHERE upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
747 $sth->execute($pImport) or die $dbh->errstr;
749 # Now purge import_batches
750 # Timestamp cannot be used here without care, because records are added
751 # continuously to batches without updating timestamp (Z39.50 search).
752 # So we only delete older empty batches.
753 # This delete will therefore not have a cascading effect.
754 $sth = $dbh->prepare(
757 FROM import_batches ba
758 LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
759 WHERE re.import_record_id IS NULL AND
760 ba.upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
763 $sth->execute($pImport) or die $dbh->errstr;
767 $sth = $dbh->prepare(
769 DELETE FROM import_batches
770 WHERE batch_type = 'z3950'
773 $sth->execute() or die $dbh->errstr;
776 sub PurgeDebarments {
777 require Koha::Patron::Debarments;
778 my ( $days, $doit ) = @_;
780 $sth = $dbh->prepare(
782 SELECT borrower_debarment_id
783 FROM borrower_debarments
784 WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
787 $sth->execute($days) or die $dbh->errstr;
788 while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
789 Koha::Patron::Debarments::DelDebarment($borrower_debarment_id) if $doit;
795 sub PurgeCreatorBatches {
796 require C4::Labels::Batch;
797 my ( $days, $creator, $doit ) = @_;
799 $sth = $dbh->prepare(
801 SELECT batch_id, branch_code FROM creator_batches
804 FROM (SELECT batch_id
808 HAVING max(timestamp) <= date_sub(curdate(),interval ? day)) a)
811 $sth->execute( $creator, $days ) or die $dbh->errstr;
812 while ( my ( $batch_id, $branch_code ) = $sth->fetchrow_array ) {
813 C4::Labels::Batch::delete(
814 batch_id => $batch_id,
815 branch_code => $branch_code
822 sub DeleteExpiredSelfRegs {
823 my $cnt= C4::Members::DeleteExpiredOpacRegistrations();
824 print "Removed $cnt expired self-registered borrowers\n" if $verbose;
827 sub DeleteUnverifiedSelfRegs {
828 my $cnt= C4::Members::DeleteUnverifiedOpacRegistrations( $_[0] );
829 print "Removed $cnt unverified self-registrations\n" if $verbose;
832 sub DeleteSpecialHolidays {
835 my $sth = $dbh->prepare(q{
836 DELETE FROM special_holidays
837 WHERE DATE( CONCAT( year, '-', month, '-', day ) ) < DATE_SUB( CAST(NOW() AS DATE), INTERVAL ? DAY );
839 my $count = $sth->execute( $days ) + 0;
840 print "Removed $count unique holidays\n" if $verbose;