3 # Copyright 2009 PTFS, Inc.
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 use constant DEFAULT_ZEBRAQ_PURGEDAYS => 30;
23 use constant DEFAULT_MAIL_PURGEDAYS => 30;
24 use constant DEFAULT_IMPORT_PURGEDAYS => 60;
25 use constant DEFAULT_LOGS_PURGEDAYS => 180;
26 use constant DEFAULT_MESSAGES_PURGEDAYS => 365;
27 use constant DEFAULT_SEARCHHISTORY_PURGEDAYS => 30;
28 use constant DEFAULT_SHARE_INVITATION_EXPIRY_DAYS => 14;
29 use constant DEFAULT_DEBARMENTS_PURGEDAYS => 30;
32 # find Koha's Perl modules
33 # test carefully before changing this
35 eval { require "$FindBin::Bin/../kohalib.pl" };
38 use Koha::Script -cron;
41 use C4::Search::History;
45 use Koha::UploadedFiles;
46 use Koha::Old::Biblios;
48 use Koha::Old::Biblioitems;
49 use Koha::Old::Checkouts;
51 use Koha::Old::Patrons;
52 use Koha::Item::Transfers;
53 use Koha::PseudonymizedTransactions;
54 use Koha::Patron::Messages;
58 Usage: $0 [-h|--help] [--confirm] [--sessions] [--sessdays DAYS] [-v|--verbose] [--zebraqueue DAYS] [-m|--mail] [--merged] [--import DAYS] [--logs DAYS] [--searchhistory DAYS] [--restrictions DAYS] [--all-restrictions] [--fees DAYS] [--temp-uploads] [--temp-uploads-days DAYS] [--uploads-missing 0|1 ] [--statistics DAYS] [--deleted-catalog DAYS] [--deleted-patrons DAYS] [--old-issues DAYS] [--old-reserves DAYS] [--transfers DAYS]
60 -h --help prints this help message, and exits, ignoring all
62 --confirm Confirmation flag, the script will be running in dry-run mode is not set.
63 --sessions purge the sessions table. If you use this while users
64 are logged into Koha, they will have to reconnect.
65 --sessdays DAYS purge only sessions older than DAYS days.
66 -v --verbose will cause the script to give you a bit more information
68 --zebraqueue DAYS purge completed zebraqueue entries older than DAYS days.
69 Defaults to 30 days if no days specified.
70 -m --mail DAYS purge items from the mail queue that are older than DAYS days.
71 Defaults to 30 days if no days specified.
72 --merged purged completed entries from need_merge_authorities.
73 --messages DAYS purge entries from messages table older than DAYS days.
74 Defaults to 365 days if no days specified.
75 --import DAYS purge records from import tables older than DAYS days.
76 Defaults to 60 days if no days specified.
77 --z3950 purge records from import tables that are the result
79 --fees DAYS purge entries accountlines older than DAYS days, where
80 amountoutstanding is 0 or NULL.
81 In the case of --fees, DAYS must be greater than
83 --logs DAYS purge entries from action_logs older than DAYS days.
84 Defaults to 180 days if no days specified.
85 --searchhistory DAYS purge entries from search_history older than DAYS days.
86 Defaults to 30 days if no days specified
87 --list-invites DAYS purge (unaccepted) list share invites older than DAYS
88 days. Defaults to 14 days if no days specified.
89 --restrictions DAYS purge patrons restrictions expired since more than DAYS days.
90 Defaults to 30 days if no days specified.
91 --all-restrictions purge all expired patrons restrictions.
92 --del-exp-selfreg Delete expired self registration accounts
93 --del-unv-selfreg DAYS Delete unverified self registrations older than DAYS
94 --unique-holidays DAYS Delete all unique holidays older than DAYS
95 --temp-uploads Delete temporary uploads.
96 --temp-uploads-days DAYS Override the corresponding preference value.
97 --uploads-missing FLAG Delete upload records for missing files when FLAG is true, count them otherwise
98 --oauth-tokens Delete expired OAuth2 tokens
99 --statistics DAYS Purge statistics entries more than DAYS days old.
100 This table is used to build reports, make sure you are aware of the consequences of this before using it!
101 --deleted-catalog DAYS Purge catalog records deleted more then DAYS days ago
102 (from tables deleteditems, deletedbiblioitems, deletedbiblio_metadata and deletedbiblio).
103 --deleted-patrons DAYS Purge patrons deleted more than DAYS days ago.
104 --old-issues DAYS Purge checkouts (old_issues) returned more than DAYS days ago.
105 --old-reserves DAYS Purge reserves (old_reserves) more than DAYS old.
106 --transfers DAYS Purge transfers completed more than DAYS day ago.
107 --pseudo-transactions DAYS Purge the pseudonymized transactions that have been originally created more than DAYS days ago
108 DAYS is optional and can be replaced by:
109 --pseudo-transactions-from YYYY-MM-DD and/or --pseudo-transactions-to YYYY-MM-DD
126 my $pListShareInvites;
132 my $special_holidays_days;
134 my $temp_uploads_days;
143 my ( $pPseudoTransactions, $pPseudoTransactionsFrom, $pPseudoTransactionsTo );
145 my $lock_days = C4::Context->preference('LockExpiredDelay');
149 'confirm' => \$confirm,
150 'sessions' => \$sessions,
151 'sessdays:i' => \$sess_days,
152 'v|verbose' => \$verbose,
153 'm|mail:i' => \$mail,
154 'zebraqueue:i' => \$zebraqueue_days,
155 'merged' => \$purge_merged,
156 'import:i' => \$pImport,
159 'messages:i' => \$pMessages,
160 'fees:i' => \$fees_days,
161 'searchhistory:i' => \$pSearchhistory,
162 'list-invites:i' => \$pListShareInvites,
163 'restrictions:i' => \$pDebarments,
164 'all-restrictions' => \$allDebarments,
165 'del-exp-selfreg' => \$pExpSelfReg,
166 'del-unv-selfreg' => \$pUnvSelfReg,
167 'unique-holidays:i' => \$special_holidays_days,
168 'temp-uploads' => \$temp_uploads,
169 'temp-uploads-days:i' => \$temp_uploads_days,
170 'uploads-missing:i' => \$uploads_missing,
171 'oauth-tokens' => \$oauth_tokens,
172 'statistics:i' => \$pStatistics,
173 'deleted-catalog:i' => \$pDeletedCatalog,
174 'deleted-patrons:i' => \$pDeletedPatrons,
175 'old-issues:i' => \$pOldIssues,
176 'old-reserves:i' => \$pOldReserves,
177 'transfers:i' => \$pTransfers,
178 'pseudo-transactions:i' => \$pPseudoTransactions,
179 'pseudo-transactions-from:s' => \$pPseudoTransactionsFrom,
180 'pseudo-transactions-to:s' => \$pPseudoTransactionsTo,
184 $sessions = 1 if $sess_days && $sess_days > 0;
185 $pImport = DEFAULT_IMPORT_PURGEDAYS if defined($pImport) && $pImport == 0;
186 $pLogs = DEFAULT_LOGS_PURGEDAYS if defined($pLogs) && $pLogs == 0;
187 $zebraqueue_days = DEFAULT_ZEBRAQ_PURGEDAYS if defined($zebraqueue_days) && $zebraqueue_days == 0;
188 $mail = DEFAULT_MAIL_PURGEDAYS if defined($mail) && $mail == 0;
189 $pSearchhistory = DEFAULT_SEARCHHISTORY_PURGEDAYS if defined($pSearchhistory) && $pSearchhistory == 0;
190 $pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0;
191 $pDebarments = DEFAULT_DEBARMENTS_PURGEDAYS if defined($pDebarments) && $pDebarments == 0;
192 $pMessages = DEFAULT_MESSAGES_PURGEDAYS if defined($pMessages) && $pMessages == 0;
207 || $pListShareInvites
212 || $special_holidays_days
214 || defined $uploads_missing
222 || defined $pPseudoTransactions
223 || $pPseudoTransactionsFrom
224 || $pPseudoTransactionsTo
226 || defined $lock_days && $lock_days ne q{}
228 print "You did not specify any cleanup work for the script to do.\n\n";
232 if ($pDebarments && $allDebarments) {
233 print "You can not specify both --restrictions and --all-restrictions.\n\n";
237 say "Confirm flag not passed, running in dry-run mode..." unless $confirm;
239 cronlogaction() unless $confirm;
241 my $dbh = C4::Context->dbh();
245 if ( $sessions && !$sess_days ) {
247 say "Session purge triggered.";
248 $sth = $dbh->prepare(q{ SELECT COUNT(*) FROM sessions });
249 $sth->execute() or die $dbh->errstr;
250 my @count_arr = $sth->fetchrow_array;
251 say $confirm ? "$count_arr[0] entries will be deleted." : "$count_arr[0] entries would be deleted.";
254 $sth = $dbh->prepare(q{ TRUNCATE sessions });
255 $sth->execute() or die $dbh->errstr;
258 print "Done with session purge.\n";
261 elsif ( $sessions && $sess_days > 0 ) {
262 print "Session purge triggered with days>$sess_days.\n" if $verbose;
263 RemoveOldSessions() if $confirm;
264 print "Done with session purge with days>$sess_days.\n" if $verbose;
267 if ($zebraqueue_days) {
269 print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
270 $sth = $dbh->prepare(
272 SELECT id,biblio_auth_number,server,time
274 WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY)
278 $sth->execute($zebraqueue_days) or die $dbh->errstr;
280 $sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? });
281 while ( my $record = $sth->fetchrow_hashref ) {
283 $sth2->execute( $record->{id} ) or die $dbh->errstr;
288 say $confirm ? "$count records were deleted." : "$count records would have been deleted.";
289 say "Done with zebraqueue purge.";
295 print "Mail queue purge triggered for $mail days.\n" if $verbose;
296 $sth = $dbh->prepare(
298 DELETE FROM message_queue
299 WHERE time_queued < date_sub(curdate(), INTERVAL ? DAY)
303 $sth->execute($mail) or die $dbh->errstr;
307 say $confirm ? "$count messages were deleted from the mail queue." : "Message from message_queue would have been deleted";
308 say "Done with message_queue purge.";
313 print "Purging completed entries from need_merge_authorities.\n" if $verbose;
315 $sth = $dbh->prepare(q{ DELETE FROM need_merge_authorities WHERE done=1 });
316 $sth->execute() or die $dbh->errstr;
318 print "Done with purging need_merge_authorities.\n" if $verbose;
322 print "Purging records from import tables.\n" if $verbose;
323 PurgeImportTables() if $confirm;
324 print "Done with purging import tables.\n" if $verbose;
328 print "Purging Z39.50 records from import tables.\n" if $verbose;
329 PurgeZ3950() if $confirm;
330 print "Done with purging Z39.50 records from import tables.\n" if $verbose;
334 print "Purging records from action_logs.\n" if $verbose;
335 $sth = $dbh->prepare(
337 DELETE FROM action_logs
338 WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY)
342 $sth->execute($pLogs) or die $dbh->errstr;
344 print "Done with purging action_logs.\n" if $verbose;
348 print "Purging messages older than $pMessages days.\n" if $verbose;
349 my $messages = Koha::Patron::Messages->filter_by_last_update(
350 { timestamp_column_name => 'message_date', days => $pMessages } );
351 my $count = $messages->count;
352 $messages->delete if $confirm;
355 ? sprintf( "Done with purging %d messages", $count )
356 : sprintf( "%d messages would have been removed", $count );
361 print "Purging records from accountlines.\n" if $verbose;
362 purge_zero_balance_fees( $fees_days ) if $confirm;
363 print "Done purging records from accountlines.\n" if $verbose;
366 if ($pSearchhistory) {
367 print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;
368 C4::Search::History::delete({ interval => $pSearchhistory }) if $confirm;
369 print "Done with purging search_history.\n" if $verbose;
372 if ($pListShareInvites) {
373 print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;
374 $sth = $dbh->prepare(
376 DELETE FROM virtualshelfshares
377 WHERE invitekey IS NOT NULL
378 AND (sharedate + INTERVAL ? DAY) < NOW()
382 $sth->execute($pListShareInvites);
384 print "Done with purging unaccepted list share invites.\n" if $verbose;
388 print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
389 my $count = PurgeDebarments($pDebarments, $confirm);
391 say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
392 say "Done with restrictions purge.";
397 print "All expired patrons restrictions purge triggered.\n" if $verbose;
398 my $count = PurgeDebarments(0, $confirm);
400 say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
401 say "Done with all restrictions purge.";
405 # Lock expired patrons?
406 if( defined $lock_days && $lock_days ne q{} ) {
407 say "Start locking expired patrons" if $verbose;
408 my $expired_patrons = Koha::Patrons->filter_by_dateexpiry({ days => $lock_days })->search({ login_attempts => { '!=' => -1 } });
409 my $count = $expired_patrons->count;
410 $expired_patrons->lock({ remove => 1 }) if $confirm;
412 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("Found %d patrons", $count);
416 # Handle unsubscribe requests from GDPR consent form, depends on UnsubscribeReflectionDelay preference
417 say "Start lock unsubscribed, anonymize and delete" if $verbose;
418 my $unsubscribed_patrons = Koha::Patrons->search_unsubscribed;
419 my $count = $unsubscribed_patrons->count;
420 $unsubscribed_patrons->lock( { expire => 1, remove => 1 } ) if $confirm;
421 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("%d patrons would have been locked", $count) if $verbose;
423 # Anonymize patron data, depending on PatronAnonymizeDelay
424 my $anonymize_candidates = Koha::Patrons->search_anonymize_candidates( { locked => 1 } );
425 $count = $anonymize_candidates->count;
426 $anonymize_candidates->anonymize if $confirm;
427 say $confirm ? sprintf("Anonymized %d patrons", $count) : sprintf("%d patrons would have been anonymized", $count) if $verbose;
429 # Remove patron data, depending on PatronRemovalDelay (will raise an exception if problem encountered
430 my $anonymized_patrons = Koha::Patrons->search_anonymized;
431 $count = $anonymized_patrons->count;
433 $anonymized_patrons->delete( { move => 1 } );
439 say $confirm ? sprintf("Deleted %d patrons", $count) : sprintf("%d patrons would have been deleted", $count);
442 # FIXME The output for dry-run mode needs to be improved
443 # But non trivial changes to C4::Members need to be done before.
446 DeleteExpiredSelfRegs();
447 } elsif ( $verbose ) {
448 say "self-registered borrowers may be deleted";
453 DeleteUnverifiedSelfRegs( $pUnvSelfReg );
454 } elsif ( $verbose ) {
455 say "unverified self-registrations may be deleted";
459 if ($special_holidays_days) {
461 DeleteSpecialHolidays( abs($special_holidays_days) );
462 } elsif ( $verbose ) {
463 say "self-registered borrowers may be deleted";
467 if( $temp_uploads ) {
468 # Delete temporary uploads, governed by a pref (unless you override)
469 print "Purging temporary uploads.\n" if $verbose;
471 Koha::UploadedFiles->delete_temporary({
472 defined($temp_uploads_days)
473 ? ( override_pref => $temp_uploads_days )
477 print "Done purging temporary uploads.\n" if $verbose;
480 if( defined $uploads_missing ) {
481 print "Looking for missing uploads\n" if $verbose;
483 my $keep = $uploads_missing == 1 ? 0 : 1;
484 my $count = Koha::UploadedFiles->delete_missing({ keep_record => $keep });
486 print "Counted $count missing uploaded files\n";
488 print "Removed $count records for missing uploads\n";
491 # FIXME need to create a filter_by_missing method (then call ->delete) instead of delete_missing
492 say "Dry-run mode cannot guess how many uploads would have been deleted";
497 require Koha::OAuthAccessTokens;
499 my $tokens = Koha::OAuthAccessTokens->search({ expires => { '<=', time } });
500 my $count = $tokens->count;
501 $tokens->delete if $confirm;
504 ? sprintf( "Removed %d expired OAuth2 tokens", $count )
505 : sprintf( "%d expired OAuth tokens would have been removed", $count );
510 print "Purging statistics older than $pStatistics days.\n" if $verbose;
511 my $statistics = Koha::Statistics->filter_by_last_update(
512 { timestamp_column_name => 'datetime', days => $pStatistics } );
513 my $count = $statistics->count;
514 $statistics->delete if $confirm;
517 ? sprintf( "Done with purging %d statistics", $count )
518 : sprintf( "%d statistics would have been removed", $count );
522 if ($pDeletedCatalog) {
523 print "Purging deleted catalog older than $pDeletedCatalog days.\n"
525 my $old_items = Koha::Old::Items->filter_by_last_update( { days => $pDeletedCatalog } );
526 my $old_biblioitems = Koha::Old::Biblioitems->filter_by_last_update( { days => $pDeletedCatalog } );
527 my $old_biblios = Koha::Old::Biblios->filter_by_last_update( { days => $pDeletedCatalog } );
528 my ( $c_i, $c_bi, $c_b ) =
529 ( $old_items->count, $old_biblioitems->count, $old_biblios->count );
532 $old_biblioitems->delete;
533 $old_biblios->delete;
538 ? "Done with purging deleted catalog (%d items, %d biblioitems, %d biblios)."
539 : "Deleted catalog would have been removed (%d items, %d biblioitems, %d biblios).",
544 if ($pDeletedPatrons) {
545 print "Purging deleted patrons older than $pDeletedPatrons days.\n" if $verbose;
546 my $old_patrons = Koha::Old::Patrons->filter_by_last_update(
547 { timestamp_column_name => 'updated_on', days => $pDeletedPatrons } );
548 my $count = $old_patrons->count;
549 $old_patrons->delete if $confirm;
552 ? sprintf "Done with purging %d deleted patrons.", $count
553 : sprintf "%d deleted patrons would have been purged.", $count;
558 print "Purging old checkouts older than $pOldIssues days.\n" if $verbose;
559 my $old_checkouts = Koha::Old::Checkouts->filter_by_last_update( { days => $pOldIssues } );
560 my $count = $old_checkouts->count;
561 $old_checkouts->delete if $confirm;
564 ? sprintf "Done with purging %d old checkouts.", $count
565 : sprintf "%d old checkouts would have been purged.", $count;
570 print "Purging old reserves older than $pOldReserves days.\n" if $verbose;
571 my $old_reserves = Koha::Old::Holds->filter_by_last_update( { days => $pOldReserves } );
572 my $count = $old_reserves->count;
573 $old_reserves->delete if $verbose;
576 ? sprintf "Done with purging %d old reserves.", $count
577 : sprintf "%d old reserves would have been purged.", $count;
582 print "Purging arrived item transfers older than $pTransfers days.\n" if $verbose;
583 my $transfers = Koha::Item::Transfers->filter_by_last_update(
585 timestamp_column_name => 'datearrived',
589 my $count = $transfers->count;
590 $transfers->delete if $verbose;
593 ? sprintf "Done with purging %d transfers.", $count
594 : sprintf "%d transfers would have been purged.", $count;
598 if (defined $pPseudoTransactions or $pPseudoTransactionsFrom or $pPseudoTransactionsTo ) {
599 print "Purging pseudonymized transactions\n" if $verbose;
600 my $anonymized_transactions = Koha::PseudonymizedTransactions->filter_by_last_update(
602 timestamp_column_name => 'datetime',
603 ( defined $pPseudoTransactions ? ( days => $pPseudoTransactions ) : () ),
604 ( $pPseudoTransactionsFrom ? ( from => $pPseudoTransactionsFrom ) : () ),
605 ( $pPseudoTransactionsTo ? ( to => $pPseudoTransactionsTo ) : () ),
608 my $count = $anonymized_transactions->count;
609 $anonymized_transactions->delete if $confirm;
612 ? sprintf "Done with purging %d pseudonymized transactions.", $count
613 : sprintf "%d pseudonymized transactions would have been purged.", $count;
619 sub RemoveOldSessions {
620 my ( $id, $a_session, $limit, $lasttime );
621 $limit = time() - 24 * 3600 * $sess_days;
623 $sth = $dbh->prepare(q{ SELECT id, a_session FROM sessions });
624 $sth->execute or die $dbh->errstr;
625 $sth->bind_columns( \$id, \$a_session );
626 $sth2 = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? });
629 while ( $sth->fetch ) {
631 if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
634 elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
637 if ( $lasttime && $lasttime < $limit ) {
638 $sth2->execute($id) or die $dbh->errstr;
643 print "$count sessions were deleted.\n";
647 sub PurgeImportTables {
649 #First purge import_records
650 #Delete cascades to import_biblios, import_items and import_record_matches
651 $sth = $dbh->prepare(
653 DELETE FROM import_records
654 WHERE upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
657 $sth->execute($pImport) or die $dbh->errstr;
659 # Now purge import_batches
660 # Timestamp cannot be used here without care, because records are added
661 # continuously to batches without updating timestamp (Z39.50 search).
662 # So we only delete older empty batches.
663 # This delete will therefore not have a cascading effect.
664 $sth = $dbh->prepare(
667 FROM import_batches ba
668 LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
669 WHERE re.import_record_id IS NULL AND
670 ba.upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
673 $sth->execute($pImport) or die $dbh->errstr;
677 $sth = $dbh->prepare(
679 DELETE FROM import_batches
680 WHERE batch_type = 'z3950'
683 $sth->execute() or die $dbh->errstr;
686 sub PurgeDebarments {
687 require Koha::Patron::Debarments;
688 my ( $days, $doit ) = @_;
690 $sth = $dbh->prepare(
692 SELECT borrower_debarment_id
693 FROM borrower_debarments
694 WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
697 $sth->execute($days) or die $dbh->errstr;
698 while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
699 Koha::Patron::Debarments::DelDebarment($borrower_debarment_id) if $doit;
705 sub DeleteExpiredSelfRegs {
706 my $cnt= C4::Members::DeleteExpiredOpacRegistrations();
707 print "Removed $cnt expired self-registered borrowers\n" if $verbose;
710 sub DeleteUnverifiedSelfRegs {
711 my $cnt= C4::Members::DeleteUnverifiedOpacRegistrations( $_[0] );
712 print "Removed $cnt unverified self-registrations\n" if $verbose;
715 sub DeleteSpecialHolidays {
718 my $sth = $dbh->prepare(q{
719 DELETE FROM special_holidays
720 WHERE DATE( CONCAT( year, '-', month, '-', day ) ) < DATE_SUB( CAST(NOW() AS DATE), INTERVAL ? DAY );
722 my $count = $sth->execute( $days ) + 0;
723 print "Removed $count unique holidays\n" if $verbose;