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_SEARCHHISTORY_PURGEDAYS
=> 30;
27 use constant DEFAULT_SHARE_INVITATION_EXPIRY_DAYS
=> 14;
28 use constant DEFAULT_DEBARMENTS_PURGEDAYS
=> 30;
31 # find Koha's Perl modules
32 # test carefully before changing this
34 eval { require "$FindBin::Bin/../kohalib.pl" };
37 use Koha
::Script
-cron
;
40 use C4
::Search
::History
;
44 use Koha
::UploadedFiles
;
45 use Koha
::Old
::Biblios
;
47 use Koha
::Old
::Biblioitems
;
48 use Koha
::Old
::Checkouts
;
50 use Koha
::Old
::Patrons
;
51 use Koha
::Item
::Transfers
;
52 use Koha
::PseudonymizedTransactions
;
56 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]
58 -h --help prints this help message, and exits, ignoring all
60 --confirm Confirmation flag, the script will be running in dry-run mode is not set.
61 --sessions purge the sessions table. If you use this while users
62 are logged into Koha, they will have to reconnect.
63 --sessdays DAYS purge only sessions older than DAYS days.
64 -v --verbose will cause the script to give you a bit more information
66 --zebraqueue DAYS purge completed zebraqueue entries older than DAYS days.
67 Defaults to 30 days if no days specified.
68 -m --mail DAYS purge items from the mail queue that are older than DAYS days.
69 Defaults to 30 days if no days specified.
70 --merged purged completed entries from need_merge_authorities.
71 --import DAYS purge records from import tables older than DAYS days.
72 Defaults to 60 days if no days specified.
73 --z3950 purge records from import tables that are the result
75 --fees DAYS purge entries accountlines older than DAYS days, where
76 amountoutstanding is 0 or NULL.
77 In the case of --fees, DAYS must be greater than
79 --logs DAYS purge entries from action_logs older than DAYS days.
80 Defaults to 180 days if no days specified.
81 --searchhistory DAYS purge entries from search_history older than DAYS days.
82 Defaults to 30 days if no days specified
83 --list-invites DAYS purge (unaccepted) list share invites older than DAYS
84 days. Defaults to 14 days if no days specified.
85 --restrictions DAYS purge patrons restrictions expired since more than DAYS days.
86 Defaults to 30 days if no days specified.
87 --all-restrictions purge all expired patrons restrictions.
88 --del-exp-selfreg Delete expired self registration accounts
89 --del-unv-selfreg DAYS Delete unverified self registrations older than DAYS
90 --unique-holidays DAYS Delete all unique holidays older than DAYS
91 --temp-uploads Delete temporary uploads.
92 --temp-uploads-days DAYS Override the corresponding preference value.
93 --uploads-missing FLAG Delete upload records for missing files when FLAG is true, count them otherwise
94 --oauth-tokens Delete expired OAuth2 tokens
95 --statistics DAYS Purge statistics entries more than DAYS days old.
96 This table is used to build reports, make sure you are aware of the consequences of this before using it!
97 --deleted-catalog DAYS Purge catalog records deleted more then DAYS days ago
98 (from tables deleteditems, deletedbiblioitems, deletedbiblio_metadata and deletedbiblio).
99 --deleted-patrons DAYS Purge patrons deleted more than DAYS days ago.
100 --old-issues DAYS Purge checkouts (old_issues) returned more than DAYS days ago.
101 --old-reserves DAYS Purge reserves (old_reserves) more than DAYS old.
102 --transfers DAYS Purge transfers completed more than DAYS day ago.
103 --pseudo-transactions DAYS Purge the pseudonymized transactions that have been originally created more than DAYS days ago
104 DAYS is optional and can be replaced by:
105 --pseudo-transactions-from YYYY-MM-DD and/or --pseudo-transactions-to YYYY-MM-DD
122 my $pListShareInvites;
128 my $special_holidays_days;
130 my $temp_uploads_days;
139 my ( $pPseudoTransactions, $pPseudoTransactionsFrom, $pPseudoTransactionsTo );
143 'confirm' => \
$confirm,
144 'sessions' => \
$sessions,
145 'sessdays:i' => \
$sess_days,
146 'v|verbose' => \
$verbose,
147 'm|mail:i' => \
$mail,
148 'zebraqueue:i' => \
$zebraqueue_days,
149 'merged' => \
$purge_merged,
150 'import:i' => \
$pImport,
153 'fees:i' => \
$fees_days,
154 'searchhistory:i' => \
$pSearchhistory,
155 'list-invites:i' => \
$pListShareInvites,
156 'restrictions:i' => \
$pDebarments,
157 'all-restrictions' => \
$allDebarments,
158 'del-exp-selfreg' => \
$pExpSelfReg,
159 'del-unv-selfreg' => \
$pUnvSelfReg,
160 'unique-holidays:i' => \
$special_holidays_days,
161 'temp-uploads' => \
$temp_uploads,
162 'temp-uploads-days:i' => \
$temp_uploads_days,
163 'uploads-missing:i' => \
$uploads_missing,
164 'oauth-tokens' => \
$oauth_tokens,
165 'statistics:i' => \
$pStatistics,
166 'deleted-catalog:i' => \
$pDeletedCatalog,
167 'deleted-patrons:i' => \
$pDeletedPatrons,
168 'old-issues:i' => \
$pOldIssues,
169 'old-reserves:i' => \
$pOldReserves,
170 'transfers:i' => \
$pTransfers,
171 'pseudo-transactions:i' => \
$pPseudoTransactions,
172 'pseudo-transactions-from:s' => \
$pPseudoTransactionsFrom,
173 'pseudo-transactions-to:s' => \
$pPseudoTransactionsTo,
177 $sessions = 1 if $sess_days && $sess_days > 0;
178 $pImport = DEFAULT_IMPORT_PURGEDAYS
if defined($pImport) && $pImport == 0;
179 $pLogs = DEFAULT_LOGS_PURGEDAYS
if defined($pLogs) && $pLogs == 0;
180 $zebraqueue_days = DEFAULT_ZEBRAQ_PURGEDAYS
if defined($zebraqueue_days) && $zebraqueue_days == 0;
181 $mail = DEFAULT_MAIL_PURGEDAYS
if defined($mail) && $mail == 0;
182 $pSearchhistory = DEFAULT_SEARCHHISTORY_PURGEDAYS
if defined($pSearchhistory) && $pSearchhistory == 0;
183 $pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS
if defined($pListShareInvites) && $pListShareInvites == 0;
184 $pDebarments = DEFAULT_DEBARMENTS_PURGEDAYS
if defined($pDebarments) && $pDebarments == 0;
199 || $pListShareInvites
204 || $special_holidays_days
206 || defined $uploads_missing
214 || defined $pPseudoTransactions
215 || $pPseudoTransactionsFrom
216 || $pPseudoTransactionsTo
218 print "You did not specify any cleanup work for the script to do.\n\n";
222 if ($pDebarments && $allDebarments) {
223 print "You can not specify both --restrictions and --all-restrictions.\n\n";
227 say "Confirm flag not passed, running in dry-run mode..." unless $confirm;
229 cronlogaction
() unless $confirm;
231 my $dbh = C4
::Context
->dbh();
235 if ( $sessions && !$sess_days ) {
237 say "Session purge triggered.";
238 $sth = $dbh->prepare(q{ SELECT COUNT(*) FROM sessions });
239 $sth->execute() or die $dbh->errstr;
240 my @count_arr = $sth->fetchrow_array;
241 say $confirm ?
"$count_arr[0] entries will be deleted." : "$count_arr[0] entries would be deleted.";
244 $sth = $dbh->prepare(q{ TRUNCATE sessions });
245 $sth->execute() or die $dbh->errstr;
248 print "Done with session purge.\n";
251 elsif ( $sessions && $sess_days > 0 ) {
252 print "Session purge triggered with days>$sess_days.\n" if $verbose;
253 RemoveOldSessions
() if $confirm;
254 print "Done with session purge with days>$sess_days.\n" if $verbose;
257 if ($zebraqueue_days) {
259 print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
260 $sth = $dbh->prepare(
262 SELECT id,biblio_auth_number,server,time
264 WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY)
268 $sth->execute($zebraqueue_days) or die $dbh->errstr;
270 $sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? });
271 while ( my $record = $sth->fetchrow_hashref ) {
273 $sth2->execute( $record->{id
} ) or die $dbh->errstr;
278 say $confirm ?
"$count records were deleted." : "$count records would have been deleted.";
279 say "Done with zebraqueue purge.";
285 print "Mail queue purge triggered for $mail days.\n" if $verbose;
286 $sth = $dbh->prepare(
288 DELETE FROM message_queue
289 WHERE time_queued < date_sub(curdate(), INTERVAL ? DAY)
293 $sth->execute($mail) or die $dbh->errstr;
297 say $confirm ?
"$count messages were deleted from the mail queue." : "Message from message_queue would have been deleted";
298 say "Done with message_queue purge.";
303 print "Purging completed entries from need_merge_authorities.\n" if $verbose;
305 $sth = $dbh->prepare(q{ DELETE FROM need_merge_authorities WHERE done=1 });
306 $sth->execute() or die $dbh->errstr;
308 print "Done with purging need_merge_authorities.\n" if $verbose;
312 print "Purging records from import tables.\n" if $verbose;
313 PurgeImportTables
() if $confirm;
314 print "Done with purging import tables.\n" if $verbose;
318 print "Purging Z39.50 records from import tables.\n" if $verbose;
319 PurgeZ3950
() if $confirm;
320 print "Done with purging Z39.50 records from import tables.\n" if $verbose;
324 print "Purging records from action_logs.\n" if $verbose;
325 $sth = $dbh->prepare(
327 DELETE FROM action_logs
328 WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY)
332 $sth->execute($pLogs) or die $dbh->errstr;
334 print "Done with purging action_logs.\n" if $verbose;
338 print "Purging records from accountlines.\n" if $verbose;
339 purge_zero_balance_fees
( $fees_days ) if $confirm;
340 print "Done purging records from accountlines.\n" if $verbose;
343 if ($pSearchhistory) {
344 print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;
345 C4
::Search
::History
::delete({ interval
=> $pSearchhistory }) if $confirm;
346 print "Done with purging search_history.\n" if $verbose;
349 if ($pListShareInvites) {
350 print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;
351 $sth = $dbh->prepare(
353 DELETE FROM virtualshelfshares
354 WHERE invitekey IS NOT NULL
355 AND (sharedate + INTERVAL ? DAY) < NOW()
359 $sth->execute($pListShareInvites);
361 print "Done with purging unaccepted list share invites.\n" if $verbose;
365 print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
366 my $count = PurgeDebarments
($pDebarments, $confirm);
368 say $confirm ?
"$count restrictions were deleted." : "$count restrictions would have been deleted";
369 say "Done with restrictions purge.";
374 print "All expired patrons restrictions purge triggered.\n" if $verbose;
375 my $count = PurgeDebarments
(0, $confirm);
377 say $confirm ?
"$count restrictions were deleted." : "$count restrictions would have been deleted";
378 say "Done with all restrictions purge.";
382 # Handle unsubscribe requests from GDPR consent form, depends on UnsubscribeReflectionDelay preference
383 my $unsubscribed_patrons = Koha
::Patrons
->search_unsubscribed;
384 my $count = $unsubscribed_patrons->count;
385 $unsubscribed_patrons->lock( { expire
=> 1, remove
=> 1 } ) if $confirm;
386 say $confirm ?
sprintf("Locked %d patrons", $count) : sprintf("%d patrons would have been locked", $count) if $verbose;
388 # Anonymize patron data, depending on PatronAnonymizeDelay
389 my $anonymize_candidates = Koha
::Patrons
->search_anonymize_candidates( { locked
=> 1 } );
390 $count = $anonymize_candidates->count;
391 $anonymize_candidates->anonymize if $confirm;
392 say $confirm ?
sprintf("Anonymized %d patrons", $count) : sprintf("%d patrons would have been anonymized", $count) if $verbose;
394 # Remove patron data, depending on PatronRemovalDelay (will raise an exception if problem encountered
395 my $anonymized_patrons = Koha
::Patrons
->search_anonymized;
396 $count = $anonymized_patrons->count;
398 $anonymized_patrons->delete( { move
=> 1 } );
404 say $confirm ?
sprintf("Deleted %d patrons", $count) : sprintf("%d patrons would have been deleted", $count);
407 # FIXME The output for dry-run mode needs to be improved
408 # But non trivial changes to C4::Members need to be done before.
411 DeleteExpiredSelfRegs
();
412 } elsif ( $verbose ) {
413 say "self-registered borrowers may be deleted";
418 DeleteUnverifiedSelfRegs
( $pUnvSelfReg );
419 } elsif ( $verbose ) {
420 say "unverified self-registrations may be deleted";
424 if ($special_holidays_days) {
426 DeleteSpecialHolidays
( abs($special_holidays_days) );
427 } elsif ( $verbose ) {
428 say "self-registered borrowers may be deleted";
432 if( $temp_uploads ) {
433 # Delete temporary uploads, governed by a pref (unless you override)
434 print "Purging temporary uploads.\n" if $verbose;
436 Koha
::UploadedFiles
->delete_temporary({
437 defined($temp_uploads_days)
438 ?
( override_pref
=> $temp_uploads_days )
442 print "Done purging temporary uploads.\n" if $verbose;
445 if( defined $uploads_missing ) {
446 print "Looking for missing uploads\n" if $verbose;
448 my $keep = $uploads_missing == 1 ?
0 : 1;
449 my $count = Koha
::UploadedFiles
->delete_missing({ keep_record
=> $keep });
451 print "Counted $count missing uploaded files\n";
453 print "Removed $count records for missing uploads\n";
456 # FIXME need to create a filter_by_missing method (then call ->delete) instead of delete_missing
457 say "Dry-run mode cannot guess how many uploads would have been deleted";
462 require Koha
::OAuthAccessTokens
;
464 my $tokens = Koha
::OAuthAccessTokens
->search({ expires
=> { '<=', time } });
465 my $count = $tokens->count;
466 $tokens->delete if $confirm;
469 ?
sprintf( "Removed %d expired OAuth2 tokens", $count )
470 : sprintf( "%d expired OAuth tokens would have been removed", $count );
475 print "Purging statistics older than $pStatistics days.\n" if $verbose;
476 my $statistics = Koha
::Statistics
->filter_by_last_update(
477 { timestamp_column_name
=> 'datetime', days
=> $pStatistics } );
478 my $count = $statistics->count;
479 $statistics->delete if $confirm;
482 ?
sprintf( "Done with purging %d statistics", $count )
483 : sprintf( "%d statistics would have been removed", $count );
487 if ($pDeletedCatalog) {
488 print "Purging deleted catalog older than $pDeletedCatalog days.\n"
490 my $old_items = Koha
::Old
::Items
->filter_by_last_update( { days
=> $pDeletedCatalog } );
491 my $old_biblioitems = Koha
::Old
::Biblioitems
->filter_by_last_update( { days
=> $pDeletedCatalog } );
492 my $old_biblios = Koha
::Old
::Biblios
->filter_by_last_update( { days
=> $pDeletedCatalog } );
493 my ( $c_i, $c_bi, $c_b ) =
494 ( $old_items->count, $old_biblioitems->count, $old_biblios->count );
497 $old_biblioitems->delete;
498 $old_biblios->delete;
503 ?
"Done with purging deleted catalog (%d items, %d biblioitems, %d biblios)."
504 : "Deleted catalog would have been removed (%d items, %d biblioitems, %d biblios).",
509 if ($pDeletedPatrons) {
510 print "Purging deleted patrons older than $pDeletedPatrons days.\n" if $verbose;
511 my $old_patrons = Koha
::Old
::Patrons
->filter_by_last_update(
512 { timestamp_column_name
=> 'updated_on', days
=> $pDeletedPatrons } );
513 my $count = $old_patrons->count;
514 $old_patrons->delete if $confirm;
517 ?
sprintf "Done with purging %d deleted patrons.", $count
518 : sprintf "%d deleted patrons would have been purged.", $count;
523 print "Purging old checkouts older than $pOldIssues days.\n" if $verbose;
524 my $old_checkouts = Koha
::Old
::Checkouts
->filter_by_last_update( { days
=> $pOldIssues } );
525 my $count = $old_checkouts->count;
526 $old_checkouts->delete if $confirm;
529 ?
sprintf "Done with purging %d old checkouts.", $count
530 : sprintf "%d old checkouts would have been purged.", $count;
535 print "Purging old reserves older than $pOldReserves days.\n" if $verbose;
536 my $old_reserves = Koha
::Old
::Holds
->filter_by_last_update( { days
=> $pOldReserves } );
537 my $count = $old_reserves->count;
538 $old_reserves->delete if $verbose;
541 ?
sprintf "Done with purging %d old reserves.", $count
542 : sprintf "%d old reserves would have been purged.", $count;
547 print "Purging arrived item transfers older than $pTransfers days.\n" if $verbose;
548 my $transfers = Koha
::Item
::Transfers
->filter_by_last_update(
550 timestamp_column_name
=> 'datearrived',
554 my $count = $transfers->count;
555 $transfers->delete if $verbose;
558 ?
sprintf "Done with purging %d transfers.", $count
559 : sprintf "%d transfers would have been purged.", $count;
563 if (defined $pPseudoTransactions or $pPseudoTransactionsFrom or $pPseudoTransactionsTo ) {
564 print "Purging pseudonymized transactions\n" if $verbose;
565 my $anonymized_transactions = Koha
::PseudonymizedTransactions
->filter_by_last_update(
567 timestamp_column_name
=> 'datetime',
568 ( defined $pPseudoTransactions ?
( days
=> $pPseudoTransactions ) : () ),
569 ( $pPseudoTransactionsFrom ?
( from
=> $pPseudoTransactionsFrom ) : () ),
570 ( $pPseudoTransactionsTo ?
( to
=> $pPseudoTransactionsTo ) : () ),
573 my $count = $anonymized_transactions->count;
574 $anonymized_transactions->delete if $confirm;
577 ?
sprintf "Done with purging %d pseudonymized transactions.", $count
578 : sprintf "%d pseudonymized transactions would have been purged.", $count;
584 sub RemoveOldSessions
{
585 my ( $id, $a_session, $limit, $lasttime );
586 $limit = time() - 24 * 3600 * $sess_days;
588 $sth = $dbh->prepare(q{ SELECT id, a_session FROM sessions });
589 $sth->execute or die $dbh->errstr;
590 $sth->bind_columns( \
$id, \
$a_session );
591 $sth2 = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? });
594 while ( $sth->fetch ) {
596 if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
599 elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
602 if ( $lasttime && $lasttime < $limit ) {
603 $sth2->execute($id) or die $dbh->errstr;
608 print "$count sessions were deleted.\n";
612 sub PurgeImportTables
{
614 #First purge import_records
615 #Delete cascades to import_biblios, import_items and import_record_matches
616 $sth = $dbh->prepare(
618 DELETE FROM import_records
619 WHERE upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
622 $sth->execute($pImport) or die $dbh->errstr;
624 # Now purge import_batches
625 # Timestamp cannot be used here without care, because records are added
626 # continuously to batches without updating timestamp (Z39.50 search).
627 # So we only delete older empty batches.
628 # This delete will therefore not have a cascading effect.
629 $sth = $dbh->prepare(
632 FROM import_batches ba
633 LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
634 WHERE re.import_record_id IS NULL AND
635 ba.upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
638 $sth->execute($pImport) or die $dbh->errstr;
642 $sth = $dbh->prepare(
644 DELETE FROM import_batches
645 WHERE batch_type = 'z3950'
648 $sth->execute() or die $dbh->errstr;
651 sub PurgeDebarments
{
652 require Koha
::Patron
::Debarments
;
653 my ( $days, $doit ) = @_;
655 $sth = $dbh->prepare(
657 SELECT borrower_debarment_id
658 FROM borrower_debarments
659 WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
662 $sth->execute($days) or die $dbh->errstr;
663 while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
664 Koha
::Patron
::Debarments
::DelDebarment
($borrower_debarment_id) if $doit;
670 sub DeleteExpiredSelfRegs
{
671 my $cnt= C4
::Members
::DeleteExpiredOpacRegistrations
();
672 print "Removed $cnt expired self-registered borrowers\n" if $verbose;
675 sub DeleteUnverifiedSelfRegs
{
676 my $cnt= C4
::Members
::DeleteUnverifiedOpacRegistrations
( $_[0] );
677 print "Removed $cnt unverified self-registrations\n" if $verbose;
680 sub DeleteSpecialHolidays
{
683 my $sth = $dbh->prepare(q{
684 DELETE FROM special_holidays
685 WHERE DATE( CONCAT( year, '-', month, '-', day ) ) < DATE_SUB( CAST(NOW() AS DATE), INTERVAL ? DAY );
687 my $count = $sth->execute( $days ) + 0;
688 print "Removed $count unique holidays\n" if $verbose;