misc/cronjobs/cleanup_database.pl

   1 #!/usr/bin/perl
   2
   3 # Copyright 2009 PTFS, Inc.
   4 #
   5 # This file is part of Koha.
   6 #
   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.
  11 #
  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.
  16 #
  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>.
  19
  20 use Modern::Perl;
  21
  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
  31 BEGIN {
  32     # find Koha's Perl modules
  33     # test carefully before changing this
  34     use FindBin ();
  35     eval { require "$FindBin::Bin/../kohalib.pl" };
  36 }
  37
  38 use Koha::Script -cron;
  39 use C4::Context;
  40 use C4::Search;
  41 use C4::Search::History;
  42 use Getopt::Long qw( GetOptions );
  43 use C4::Log qw( cronlogaction );
  44 use C4::Accounts qw( purge_zero_balance_fees );
  45 use Koha::UploadedFiles;
  46 use Koha::Old::Biblios;
  47 use Koha::Old::Items;
  48 use Koha::Old::Biblioitems;
  49 use Koha::Old::Checkouts;
  50 use Koha::Old::Holds;
  51 use Koha::Old::Patrons;
  52 use Koha::Item::Transfers;
  53 use Koha::PseudonymizedTransactions;
  54 use Koha::Patron::Messages;
  55
  56 sub usage {
  57     print STDERR <<USAGE;
  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] [--labels DAYS] [--cards DAYS]
  59
  60    -h --help          prints this help message, and exits, ignoring all
  61                       other options
  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
  67                       about the run.
  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
  78                       of Z39.50 searches
  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
  82                       or equal to 1.
  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
 110    --labels DAYS           Purge item label batches last added to more than DAYS days ago.
 111    --cards DAY             Purge card creator batches last added to more than DAYS days ago.
 112
 113 USAGE
 114     exit $_[0];
 115 }
 116
 117 my $help;
 118 my $confirm;
 119 my $sessions;
 120 my $sess_days;
 121 my $verbose;
 122 my $zebraqueue_days;
 123 my $mail;
 124 my $purge_merged;
 125 my $pImport;
 126 my $pLogs;
 127 my $pSearchhistory;
 128 my $pZ3950;
 129 my $pListShareInvites;
 130 my $pDebarments;
 131 my $allDebarments;
 132 my $return_claims = C4::Context->preference('CleanUpDatabaseReturnClaims');
 133 my $pExpSelfReg;
 134 my $pUnvSelfReg;
 135 my $fees_days;
 136 my $special_holidays_days;
 137 my $temp_uploads;
 138 my $temp_uploads_days;
 139 my $uploads_missing;
 140 my $oauth_tokens;
 141 my $pStatistics;
 142 my $pDeletedCatalog;
 143 my $pDeletedPatrons;
 144 my $pOldIssues;
 145 my $pOldReserves;
 146 my $pTransfers;
 147 my ( $pPseudoTransactions, $pPseudoTransactionsFrom, $pPseudoTransactionsTo );
 148 my $pMessages;
 149 my $lock_days = C4::Context->preference('LockExpiredDelay');
 150 my $labels;
 151 my $cards;
 152
 153 GetOptions(
 154     'h|help'            => \$help,
 155     'confirm'           => \$confirm,
 156     'sessions'          => \$sessions,
 157     'sessdays:i'        => \$sess_days,
 158     'v|verbose'         => \$verbose,
 159     'm|mail:i'          => \$mail,
 160     'zebraqueue:i'      => \$zebraqueue_days,
 161     'merged'            => \$purge_merged,
 162     'import:i'          => \$pImport,
 163     'z3950'             => \$pZ3950,
 164     'logs:i'            => \$pLogs,
 165     'messages:i'        => \$pMessages,
 166     'fees:i'            => \$fees_days,
 167     'searchhistory:i'   => \$pSearchhistory,
 168     'list-invites:i'    => \$pListShareInvites,
 169     'restrictions:i'    => \$pDebarments,
 170     'all-restrictions'  => \$allDebarments,
 171     'del-exp-selfreg'   => \$pExpSelfReg,
 172     'del-unv-selfreg'   => \$pUnvSelfReg,
 173     'unique-holidays:i' => \$special_holidays_days,
 174     'temp-uploads'      => \$temp_uploads,
 175     'temp-uploads-days:i' => \$temp_uploads_days,
 176     'uploads-missing:i' => \$uploads_missing,
 177     'oauth-tokens'      => \$oauth_tokens,
 178     'statistics:i'      => \$pStatistics,
 179     'deleted-catalog:i' => \$pDeletedCatalog,
 180     'deleted-patrons:i' => \$pDeletedPatrons,
 181     'old-issues:i'      => \$pOldIssues,
 182     'old-reserves:i'    => \$pOldReserves,
 183     'transfers:i'       => \$pTransfers,
 184     'pseudo-transactions:i'      => \$pPseudoTransactions,
 185     'pseudo-transactions-from:s' => \$pPseudoTransactionsFrom,
 186     'pseudo-transactions-to:s'   => \$pPseudoTransactionsTo,
 187     'labels'            => \$labels,
 188     'cards'             => \$cards,
 189 ) || usage(1);
 190
 191 # Use default values
 192 $sessions          = 1                                    if $sess_days                  && $sess_days > 0;
 193 $pImport           = DEFAULT_IMPORT_PURGEDAYS             if defined($pImport)           && $pImport == 0;
 194 $pLogs             = DEFAULT_LOGS_PURGEDAYS               if defined($pLogs)             && $pLogs == 0;
 195 $zebraqueue_days   = DEFAULT_ZEBRAQ_PURGEDAYS             if defined($zebraqueue_days)   && $zebraqueue_days == 0;
 196 $mail              = DEFAULT_MAIL_PURGEDAYS               if defined($mail)              && $mail == 0;
 197 $pSearchhistory    = DEFAULT_SEARCHHISTORY_PURGEDAYS      if defined($pSearchhistory)    && $pSearchhistory == 0;
 198 $pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0;
 199 $pDebarments       = DEFAULT_DEBARMENTS_PURGEDAYS         if defined($pDebarments)       && $pDebarments == 0;
 200 $pMessages         = DEFAULT_MESSAGES_PURGEDAYS           if defined($pMessages)         && $pMessages == 0;
 201
 202 if ($help) {
 203     usage(0);
 204 }
 205
 206 unless ( $sessions
 207     || $zebraqueue_days
 208     || $mail
 209     || $purge_merged
 210     || $pImport
 211     || $pLogs
 212     || $fees_days
 213     || $pSearchhistory
 214     || $pZ3950
 215     || $pListShareInvites
 216     || $pDebarments
 217     || $allDebarments
 218     || $pExpSelfReg
 219     || $pUnvSelfReg
 220     || $special_holidays_days
 221     || $temp_uploads
 222     || defined $uploads_missing
 223     || $oauth_tokens
 224     || $pStatistics
 225     || $pDeletedCatalog
 226     || $pDeletedPatrons
 227     || $pOldIssues
 228     || $pOldReserves
 229     || $pTransfers
 230     || defined $pPseudoTransactions
 231     || $pPseudoTransactionsFrom
 232     || $pPseudoTransactionsTo
 233     || $pMessages
 234     || defined $lock_days && $lock_days ne q{}
 235     || $labels
 236     || $cards
 237 ) {
 238     print "You did not specify any cleanup work for the script to do.\n\n";
 239     usage(1);
 240 }
 241
 242 if ($pDebarments && $allDebarments) {
 243     print "You can not specify both --restrictions and --all-restrictions.\n\n";
 244     usage(1);
 245 }
 246
 247 say "Confirm flag not passed, running in dry-run mode..." unless $confirm;
 248
 249 cronlogaction() unless $confirm;
 250
 251 my $dbh = C4::Context->dbh();
 252 my $sth;
 253 my $sth2;
 254
 255 if ( $sessions && !$sess_days ) {
 256     if ($verbose) {
 257         say "Session purge triggered.";
 258         $sth = $dbh->prepare(q{ SELECT COUNT(*) FROM sessions });
 259         $sth->execute() or die $dbh->errstr;
 260         my @count_arr = $sth->fetchrow_array;
 261         say $confirm ? "$count_arr[0] entries will be deleted." : "$count_arr[0] entries would be deleted.";
 262     }
 263     if ( $confirm ) {
 264         $sth = $dbh->prepare(q{ TRUNCATE sessions });
 265         $sth->execute() or die $dbh->errstr;
 266     }
 267     if ($verbose) {
 268         print "Done with session purge.\n";
 269     }
 270 }
 271 elsif ( $sessions && $sess_days > 0 ) {
 272     print "Session purge triggered with days>$sess_days.\n" if $verbose;
 273     RemoveOldSessions() if $confirm;
 274     print "Done with session purge with days>$sess_days.\n" if $verbose;
 275 }
 276
 277 if ($zebraqueue_days) {
 278     my $count = 0;
 279     print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
 280     $sth = $dbh->prepare(
 281         q{
 282             SELECT id,biblio_auth_number,server,time
 283             FROM zebraqueue
 284             WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY)
 285         }
 286     );
 287     $sth->execute($zebraqueue_days) or die $dbh->errstr;
 288     $sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? });
 289     while ( my $record = $sth->fetchrow_hashref ) {
 290         if ( $confirm ) {
 291             $sth2->execute( $record->{id} ) or die $dbh->errstr;
 292         }
 293         $count++;
 294     }
 295     if ( $verbose ) {
 296         say $confirm ? "$count records were deleted." : "$count records would have been deleted.";
 297         say "Done with zebraqueue purge.";
 298     }
 299 }
 300
 301 if ($mail) {
 302     my $count = 0;
 303     print "Mail queue purge triggered for $mail days.\n" if $verbose;
 304     $sth = $dbh->prepare(
 305         q{
 306             DELETE FROM message_queue
 307             WHERE time_queued < date_sub(curdate(), INTERVAL ? DAY)
 308         }
 309     );
 310     if ( $confirm ) {
 311         $sth->execute($mail) or die $dbh->errstr;
 312         $count = $sth->rows;
 313     }
 314     if ( $verbose ) {
 315         say $confirm ? "$count messages were deleted from the mail queue." : "Message from message_queue would have been deleted";
 316         say "Done with message_queue purge.";
 317     }
 318 }
 319
 320 if ($purge_merged) {
 321     print "Purging completed entries from need_merge_authorities.\n" if $verbose;
 322     if ( $confirm ) {
 323         $sth = $dbh->prepare(q{ DELETE FROM need_merge_authorities WHERE done=1 });
 324         $sth->execute() or die $dbh->errstr;
 325     }
 326     print "Done with purging need_merge_authorities.\n" if $verbose;
 327 }
 328
 329 if ($pImport) {
 330     print "Purging records from import tables.\n" if $verbose;
 331     PurgeImportTables() if $confirm;
 332     print "Done with purging import tables.\n" if $verbose;
 333 }
 334
 335 if ($pZ3950) {
 336     print "Purging Z39.50 records from import tables.\n" if $verbose;
 337     PurgeZ3950() if $confirm;
 338     print "Done with purging Z39.50 records from import tables.\n" if $verbose;
 339 }
 340
 341 if ($pLogs) {
 342     print "Purging records from action_logs.\n" if $verbose;
 343     $sth = $dbh->prepare(
 344         q{
 345             DELETE FROM action_logs
 346             WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY)
 347         }
 348     );
 349     if ( $confirm ) {
 350         $sth->execute($pLogs) or die $dbh->errstr;
 351     }
 352     print "Done with purging action_logs.\n" if $verbose;
 353 }
 354
 355 if ($pMessages) {
 356     print "Purging messages older than $pMessages days.\n" if $verbose;
 357     my $messages = Koha::Patron::Messages->filter_by_last_update(
 358         { timestamp_column_name => 'message_date', days => $pMessages } );
 359     my $count = $messages->count;
 360     $messages->delete if $confirm;
 361     if ( $verbose ) {
 362         say $confirm
 363           ? sprintf( "Done with purging %d messages", $count )
 364           : sprintf( "%d messages would have been removed", $count );
 365     }
 366 }
 367
 368 if ($fees_days) {
 369     print "Purging records from accountlines.\n" if $verbose;
 370     purge_zero_balance_fees( $fees_days ) if $confirm;
 371     print "Done purging records from accountlines.\n" if $verbose;
 372 }
 373
 374 if ($pSearchhistory) {
 375     print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;
 376     C4::Search::History::delete({ interval => $pSearchhistory }) if $confirm;
 377     print "Done with purging search_history.\n" if $verbose;
 378 }
 379
 380 if ($pListShareInvites) {
 381     print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;
 382     $sth = $dbh->prepare(
 383         q{
 384             DELETE FROM virtualshelfshares
 385             WHERE invitekey IS NOT NULL
 386             AND (sharedate + INTERVAL ? DAY) < NOW()
 387         }
 388     );
 389     if ( $confirm ) {
 390         $sth->execute($pListShareInvites);
 391     }
 392     print "Done with purging unaccepted list share invites.\n" if $verbose;
 393 }
 394
 395 if ($pDebarments) {
 396     print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
 397     my $count = PurgeDebarments($pDebarments, $confirm);
 398     if ( $verbose ) {
 399         say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
 400         say "Done with restrictions purge.";
 401     }
 402 }
 403
 404 if($allDebarments) {
 405     print "All expired patrons restrictions purge triggered.\n" if $verbose;
 406     my $count = PurgeDebarments(0, $confirm);
 407     if ( $verbose ) {
 408         say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
 409         say "Done with all restrictions purge.";
 410     }
 411 }
 412
 413 # Lock expired patrons?
 414 if( defined $lock_days && $lock_days ne q{} ) {
 415     say "Start locking expired patrons" if $verbose;
 416     my $expired_patrons = Koha::Patrons->filter_by_expiration_date({ days => $lock_days })->search({ login_attempts => { '!=' => -1 } });
 417     my $count = $expired_patrons->count;
 418     $expired_patrons->lock({ remove => 1 }) if $confirm;
 419     if( $verbose ) {
 420         say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("Found %d patrons", $count);
 421     }
 422 }
 423
 424 # Handle unsubscribe requests from GDPR consent form, depends on UnsubscribeReflectionDelay preference
 425 say "Start lock unsubscribed, anonymize and delete" if $verbose;
 426 my $unsubscribed_patrons = Koha::Patrons->search_unsubscribed;
 427 my $count = $unsubscribed_patrons->count;
 428 $unsubscribed_patrons->lock( { expire => 1, remove => 1 } ) if $confirm;
 429 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("%d patrons would have been locked", $count) if $verbose;
 430
 431 # Anonymize patron data, depending on PatronAnonymizeDelay
 432 my $anonymize_candidates = Koha::Patrons->search_anonymize_candidates( { locked => 1 } );
 433 $count = $anonymize_candidates->count;
 434 $anonymize_candidates->anonymize if $confirm;
 435 say $confirm ? sprintf("Anonymized %d patrons", $count) : sprintf("%d patrons would have been anonymized", $count) if $verbose;
 436
 437 # Remove patron data, depending on PatronRemovalDelay (will raise an exception if problem encountered
 438 my $anonymized_patrons = Koha::Patrons->search_anonymized;
 439 $count = $anonymized_patrons->count;
 440 if ( $confirm ) {
 441     $anonymized_patrons->delete( { move => 1 } );
 442     if ($@) {
 443         warn $@;
 444     }
 445 }
 446 if ($verbose) {
 447     say $confirm ? sprintf("Deleted %d patrons", $count) : sprintf("%d patrons would have been deleted", $count);
 448 }
 449
 450 # FIXME The output for dry-run mode needs to be improved
 451 # But non trivial changes to C4::Members need to be done before.
 452 if( $pExpSelfReg ) {
 453     if ( $confirm ) {
 454         DeleteExpiredSelfRegs();
 455     } elsif ( $verbose ) {
 456         say "self-registered borrowers may be deleted";
 457     }
 458 }
 459 if( $pUnvSelfReg ) {
 460     if ( $confirm ) {
 461         DeleteUnverifiedSelfRegs( $pUnvSelfReg );
 462     } elsif ( $verbose ) {
 463         say "unverified self-registrations may be deleted";
 464     }
 465 }
 466
 467 if ($special_holidays_days) {
 468     if ( $confirm ) {
 469         DeleteSpecialHolidays( abs($special_holidays_days) );
 470     } elsif ( $verbose ) {
 471         say "self-registered borrowers may be deleted";
 472     }
 473 }
 474
 475 if( $temp_uploads ) {
 476     # Delete temporary uploads, governed by a pref (unless you override)
 477     print "Purging temporary uploads.\n" if $verbose;
 478     if ( $confirm ) {
 479         Koha::UploadedFiles->delete_temporary({
 480             defined($temp_uploads_days)
 481                 ? ( override_pref => $temp_uploads_days )
 482                 : ()
 483         });
 484     }
 485     print "Done purging temporary uploads.\n" if $verbose;
 486 }
 487
 488 if( defined $uploads_missing ) {
 489     print "Looking for missing uploads\n" if $verbose;
 490     if ( $confirm ) {
 491         my $keep = $uploads_missing == 1 ? 0 : 1;
 492         my $count = Koha::UploadedFiles->delete_missing({ keep_record => $keep });
 493         if( $keep ) {
 494             print "Counted $count missing uploaded files\n";
 495         } else {
 496             print "Removed $count records for missing uploads\n";
 497         }
 498     } else {
 499         # FIXME need to create a filter_by_missing method (then call ->delete) instead of delete_missing
 500         say "Dry-run mode cannot guess how many uploads would have been deleted";
 501     }
 502 }
 503
 504 if ($oauth_tokens) {
 505     require Koha::OAuthAccessTokens;
 506
 507     my $tokens = Koha::OAuthAccessTokens->search({ expires => { '<=', time } });
 508     my $count = $tokens->count;
 509     $tokens->delete if $confirm;
 510     if ( $verbose ) {
 511         say $confirm
 512           ? sprintf( "Removed %d expired OAuth2 tokens", $count )
 513           : sprintf( "%d expired OAuth tokens would have been removed", $count );
 514     }
 515 }
 516
 517 if ($pStatistics) {
 518     print "Purging statistics older than $pStatistics days.\n" if $verbose;
 519     my $statistics = Koha::Statistics->filter_by_last_update(
 520         { timestamp_column_name => 'datetime', days => $pStatistics } );
 521     my $count = $statistics->count;
 522     $statistics->delete if $confirm;
 523     if ( $verbose ) {
 524         say $confirm
 525           ? sprintf( "Done with purging %d statistics", $count )
 526           : sprintf( "%d statistics would have been removed", $count );
 527     }
 528 }
 529
 530 if ($return_claims) {
 531     print "Purging return claims older than $return_claims days.\n" if $verbose;
 532     $sth = $dbh->prepare(
 533         q{
 534             DELETE FROM return_claims
 535             WHERE resolved_on < DATE_SUB(CURDATE(), INTERVAL ? DAY)
 536         }
 537     );
 538     $sth->execute($return_claims);
 539     print "Done with purging return claims.\n" if $verbose;
 540 }
 541
 542 if ($pDeletedCatalog) {
 543     print "Purging deleted catalog older than $pDeletedCatalog days.\n"
 544       if $verbose;
 545     my $old_items = Koha::Old::Items->filter_by_last_update( { days => $pDeletedCatalog } );
 546     my $old_biblioitems = Koha::Old::Biblioitems->filter_by_last_update( { days => $pDeletedCatalog } );
 547     my $old_biblios = Koha::Old::Biblios->filter_by_last_update( { days => $pDeletedCatalog } );
 548     my ( $c_i, $c_bi, $c_b ) =
 549       ( $old_items->count, $old_biblioitems->count, $old_biblios->count );
 550     if ($confirm) {
 551         $old_items->delete;
 552         $old_biblioitems->delete;
 553         $old_biblios->delete;
 554     }
 555     if ($verbose) {
 556         say sprintf(
 557             $confirm
 558             ? "Done with purging deleted catalog (%d items, %d biblioitems, %d biblios)."
 559             : "Deleted catalog would have been removed (%d items, %d biblioitems, %d biblios).",
 560         $c_i, $c_bi, $c_b);
 561     }
 562 }
 563
 564 if ($pDeletedPatrons) {
 565     print "Purging deleted patrons older than $pDeletedPatrons days.\n" if $verbose;
 566     my $old_patrons = Koha::Old::Patrons->filter_by_last_update(
 567         { timestamp_column_name => 'updated_on', days => $pDeletedPatrons } );
 568     my $count = $old_patrons->count;
 569     $old_patrons->delete if $confirm;
 570     if ($verbose) {
 571         say $confirm
 572           ? sprintf "Done with purging %d deleted patrons.", $count
 573           : sprintf "%d deleted patrons would have been purged.", $count;
 574     }
 575 }
 576
 577 if ($pOldIssues) {
 578     print "Purging old checkouts older than $pOldIssues days.\n" if $verbose;
 579     my $old_checkouts = Koha::Old::Checkouts->filter_by_last_update( { days => $pOldIssues } );
 580     my $count = $old_checkouts->count;
 581     $old_checkouts->delete if $confirm;
 582     if ($verbose) {
 583         say $confirm
 584           ? sprintf "Done with purging %d old checkouts.", $count
 585           : sprintf "%d old checkouts would have been purged.", $count;
 586     }
 587 }
 588
 589 if ($pOldReserves) {
 590     print "Purging old reserves older than $pOldReserves days.\n" if $verbose;
 591     my $old_reserves = Koha::Old::Holds->filter_by_last_update( { days => $pOldReserves } );
 592     my $count = $old_reserves->count;
 593     $old_reserves->delete if $verbose;
 594     if ($verbose) {
 595         say $confirm
 596           ? sprintf "Done with purging %d old reserves.", $count
 597           : sprintf "%d old reserves would have been purged.", $count;
 598     }
 599 }
 600
 601 if ($pTransfers) {
 602     print "Purging arrived item transfers older than $pTransfers days.\n" if $verbose;
 603     my $transfers = Koha::Item::Transfers->filter_by_last_update(
 604         {
 605             timestamp_column_name => 'datearrived',
 606             days => $pTransfers,
 607         }
 608     );
 609     my $count = $transfers->count;
 610     $transfers->delete if $verbose;
 611     if ($verbose) {
 612         say $confirm
 613           ? sprintf "Done with purging %d transfers.", $count
 614           : sprintf "%d transfers would have been purged.", $count;
 615     }
 616 }
 617
 618 if (defined $pPseudoTransactions or $pPseudoTransactionsFrom or $pPseudoTransactionsTo ) {
 619     print "Purging pseudonymized transactions\n" if $verbose;
 620     my $anonymized_transactions = Koha::PseudonymizedTransactions->filter_by_last_update(
 621         {
 622             timestamp_column_name => 'datetime',
 623             ( defined $pPseudoTransactions  ? ( days => $pPseudoTransactions     ) : () ),
 624             ( $pPseudoTransactionsFrom      ? ( from => $pPseudoTransactionsFrom ) : () ),
 625             ( $pPseudoTransactionsTo        ? ( to   => $pPseudoTransactionsTo   ) : () ),
 626         }
 627     );
 628     my $count = $anonymized_transactions->count;
 629     $anonymized_transactions->delete if $confirm;
 630     if ($verbose) {
 631         say $confirm
 632           ? sprintf "Done with purging %d pseudonymized transactions.", $count
 633           : sprintf "%d pseudonymized transactions would have been purged.", $count;
 634     }
 635 }
 636
 637 if ($labels) {
 638     print "Purging item label batches last added to more than $labels days ago.\n" if $verbose;
 639     my $count = PurgeCreatorBatches($labels, 'labels', $confirm);
 640     if ($verbose) {
 641         say $confirm
 642           ? sprintf "Done with purging %d item label batches last added to more than %d days ago.\n", $count, $labels
 643           : sprintf "%d item label batches would have been purged.", $count;
 644     }
 645 }
 646
 647 if ($cards) {
 648     print "Purging card creator batches last added to more than $cards days ago.\n" if $verbose;
 649     my $count = PurgeCreatorBatches($labels, 'patroncards', $confirm);
 650     if ($verbose) {
 651         say $confirm
 652           ? sprintf "Done with purging %d card creator batches last added to more than %d days ago.\n", $count, $labels
 653           : sprintf "%d card creator batches would have been purged.", $count;
 654     }
 655 }
 656
 657 exit(0);
 658
 659 sub RemoveOldSessions {
 660     my ( $id, $a_session, $limit, $lasttime );
 661     $limit = time() - 24 * 3600 * $sess_days;
 662
 663     $sth = $dbh->prepare(q{ SELECT id, a_session FROM sessions });
 664     $sth->execute or die $dbh->errstr;
 665     $sth->bind_columns( \$id, \$a_session );
 666     $sth2  = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? });
 667     my $count = 0;
 668
 669     while ( $sth->fetch ) {
 670         $lasttime = 0;
 671         if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
 672             $lasttime = $1;
 673         }
 674         elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
 675             $lasttime = $2;
 676         }
 677         if ( $lasttime && $lasttime < $limit ) {
 678             $sth2->execute($id) or die $dbh->errstr;
 679             $count++;
 680         }
 681     }
 682     if ($verbose) {
 683         print "$count sessions were deleted.\n";
 684     }
 685 }
 686
 687 sub PurgeImportTables {
 688
 689     #First purge import_records
 690     #Delete cascades to import_biblios, import_items and import_record_matches
 691     $sth = $dbh->prepare(
 692         q{
 693             DELETE FROM import_records
 694             WHERE upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
 695         }
 696     );
 697     $sth->execute($pImport) or die $dbh->errstr;
 698
 699     # Now purge import_batches
 700     # Timestamp cannot be used here without care, because records are added
 701     # continuously to batches without updating timestamp (Z39.50 search).
 702     # So we only delete older empty batches.
 703     # This delete will therefore not have a cascading effect.
 704     $sth = $dbh->prepare(
 705         q{
 706             DELETE ba
 707             FROM import_batches ba
 708             LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
 709             WHERE re.import_record_id IS NULL AND
 710             ba.upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
 711         }
 712     );
 713     $sth->execute($pImport) or die $dbh->errstr;
 714 }
 715
 716 sub PurgeZ3950 {
 717     $sth = $dbh->prepare(
 718         q{
 719             DELETE FROM import_batches
 720             WHERE batch_type = 'z3950'
 721         }
 722     );
 723     $sth->execute() or die $dbh->errstr;
 724 }
 725
 726 sub PurgeDebarments {
 727     require Koha::Patron::Debarments;
 728     my ( $days, $doit ) = @_;
 729     my $count = 0;
 730     $sth   = $dbh->prepare(
 731         q{
 732             SELECT borrower_debarment_id
 733             FROM borrower_debarments
 734             WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
 735         }
 736     );
 737     $sth->execute($days) or die $dbh->errstr;
 738     while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
 739         Koha::Patron::Debarments::DelDebarment($borrower_debarment_id) if $doit;
 740         $count++;
 741     }
 742     return $count;
 743 }
 744
 745 sub PurgeCreatorBatches {
 746     require C4::Labels::Batch;
 747     my ( $days, $creator, $doit ) = @_;
 748     my $count = 0;
 749     $sth = $dbh->prepare(
 750         q{
 751             SELECT batch_id, branch_code FROM creator_batches
 752             WHERE batch_id in
 753                 (SELECT batch_id
 754                 FROM (SELECT batch_id
 755                         FROM creator_batches
 756                         WHERE creator=?
 757                         GROUP BY batch_id
 758                         HAVING max(timestamp) <= date_sub(curdate(),interval ? day)) a)
 759         }
 760     );
 761     $sth->execute( $creator, $days ) or die $dbh->errstr;
 762     while ( my ( $batch_id, $branch_code ) = $sth->fetchrow_array ) {
 763         C4::Labels::Batch::delete(
 764             batch_id    => $batch_id,
 765             branch_code => $branch_code
 766         ) if $doit;
 767         $count++;
 768     }
 769     return $count;
 770 }
 771
 772 sub DeleteExpiredSelfRegs {
 773     my $cnt= C4::Members::DeleteExpiredOpacRegistrations();
 774     print "Removed $cnt expired self-registered borrowers\n" if $verbose;
 775 }
 776
 777 sub DeleteUnverifiedSelfRegs {
 778     my $cnt= C4::Members::DeleteUnverifiedOpacRegistrations( $_[0] );
 779     print "Removed $cnt unverified self-registrations\n" if $verbose;
 780 }
 781
 782 sub DeleteSpecialHolidays {
 783     my ( $days ) = @_;
 784
 785     my $sth = $dbh->prepare(q{
 786         DELETE FROM special_holidays
 787         WHERE DATE( CONCAT( year, '-', month, '-', day ) ) < DATE_SUB( CAST(NOW() AS DATE), INTERVAL ? DAY );
 788     });
 789     my $count = $sth->execute( $days ) + 0;
 790     print "Removed $count unique holidays\n" if $verbose;
 791 }