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     || $return_claims
 238 ) {
 239     print "You did not specify any cleanup work for the script to do.\n\n";
 240     usage(1);
 241 }
 242
 243 if ($pDebarments && $allDebarments) {
 244     print "You can not specify both --restrictions and --all-restrictions.\n\n";
 245     usage(1);
 246 }
 247
 248 say "Confirm flag not passed, running in dry-run mode..." unless $confirm;
 249
 250 cronlogaction() unless $confirm;
 251
 252 my $dbh = C4::Context->dbh();
 253 my $sth;
 254 my $sth2;
 255
 256 if ( $sessions && !$sess_days ) {
 257     if ($verbose) {
 258         say "Session purge triggered.";
 259         $sth = $dbh->prepare(q{ SELECT COUNT(*) FROM sessions });
 260         $sth->execute() or die $dbh->errstr;
 261         my @count_arr = $sth->fetchrow_array;
 262         say $confirm ? "$count_arr[0] entries will be deleted." : "$count_arr[0] entries would be deleted.";
 263     }
 264     if ( $confirm ) {
 265         $sth = $dbh->prepare(q{ TRUNCATE sessions });
 266         $sth->execute() or die $dbh->errstr;
 267     }
 268     if ($verbose) {
 269         print "Done with session purge.\n";
 270     }
 271 }
 272 elsif ( $sessions && $sess_days > 0 ) {
 273     print "Session purge triggered with days>$sess_days.\n" if $verbose;
 274     RemoveOldSessions() if $confirm;
 275     print "Done with session purge with days>$sess_days.\n" if $verbose;
 276 }
 277
 278 if ($zebraqueue_days) {
 279     my $count = 0;
 280     print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
 281     $sth = $dbh->prepare(
 282         q{
 283             SELECT id,biblio_auth_number,server,time
 284             FROM zebraqueue
 285             WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY)
 286         }
 287     );
 288     $sth->execute($zebraqueue_days) or die $dbh->errstr;
 289     $sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? });
 290     while ( my $record = $sth->fetchrow_hashref ) {
 291         if ( $confirm ) {
 292             $sth2->execute( $record->{id} ) or die $dbh->errstr;
 293         }
 294         $count++;
 295     }
 296     if ( $verbose ) {
 297         say $confirm ? "$count records were deleted." : "$count records would have been deleted.";
 298         say "Done with zebraqueue purge.";
 299     }
 300 }
 301
 302 if ($mail) {
 303     my $count = 0;
 304     print "Mail queue purge triggered for $mail days.\n" if $verbose;
 305     $sth = $dbh->prepare(
 306         q{
 307             DELETE FROM message_queue
 308             WHERE time_queued < date_sub(curdate(), INTERVAL ? DAY)
 309         }
 310     );
 311     if ( $confirm ) {
 312         $sth->execute($mail) or die $dbh->errstr;
 313         $count = $sth->rows;
 314     }
 315     if ( $verbose ) {
 316         say $confirm ? "$count messages were deleted from the mail queue." : "Message from message_queue would have been deleted";
 317         say "Done with message_queue purge.";
 318     }
 319 }
 320
 321 if ($purge_merged) {
 322     print "Purging completed entries from need_merge_authorities.\n" if $verbose;
 323     if ( $confirm ) {
 324         $sth = $dbh->prepare(q{ DELETE FROM need_merge_authorities WHERE done=1 });
 325         $sth->execute() or die $dbh->errstr;
 326     }
 327     print "Done with purging need_merge_authorities.\n" if $verbose;
 328 }
 329
 330 if ($pImport) {
 331     print "Purging records from import tables.\n" if $verbose;
 332     PurgeImportTables() if $confirm;
 333     print "Done with purging import tables.\n" if $verbose;
 334 }
 335
 336 if ($pZ3950) {
 337     print "Purging Z39.50 records from import tables.\n" if $verbose;
 338     PurgeZ3950() if $confirm;
 339     print "Done with purging Z39.50 records from import tables.\n" if $verbose;
 340 }
 341
 342 if ($pLogs) {
 343     print "Purging records from action_logs.\n" if $verbose;
 344     $sth = $dbh->prepare(
 345         q{
 346             DELETE FROM action_logs
 347             WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY)
 348         }
 349     );
 350     if ( $confirm ) {
 351         $sth->execute($pLogs) or die $dbh->errstr;
 352     }
 353     print "Done with purging action_logs.\n" if $verbose;
 354 }
 355
 356 if ($pMessages) {
 357     print "Purging messages older than $pMessages days.\n" if $verbose;
 358     my $messages = Koha::Patron::Messages->filter_by_last_update(
 359         { timestamp_column_name => 'message_date', days => $pMessages } );
 360     my $count = $messages->count;
 361     $messages->delete if $confirm;
 362     if ( $verbose ) {
 363         say $confirm
 364           ? sprintf( "Done with purging %d messages", $count )
 365           : sprintf( "%d messages would have been removed", $count );
 366     }
 367 }
 368
 369 if ($fees_days) {
 370     print "Purging records from accountlines.\n" if $verbose;
 371     purge_zero_balance_fees( $fees_days ) if $confirm;
 372     print "Done purging records from accountlines.\n" if $verbose;
 373 }
 374
 375 if ($pSearchhistory) {
 376     print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;
 377     C4::Search::History::delete({ interval => $pSearchhistory }) if $confirm;
 378     print "Done with purging search_history.\n" if $verbose;
 379 }
 380
 381 if ($pListShareInvites) {
 382     print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;
 383     $sth = $dbh->prepare(
 384         q{
 385             DELETE FROM virtualshelfshares
 386             WHERE invitekey IS NOT NULL
 387             AND (sharedate + INTERVAL ? DAY) < NOW()
 388         }
 389     );
 390     if ( $confirm ) {
 391         $sth->execute($pListShareInvites);
 392     }
 393     print "Done with purging unaccepted list share invites.\n" if $verbose;
 394 }
 395
 396 if ($pDebarments) {
 397     print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
 398     my $count = PurgeDebarments($pDebarments, $confirm);
 399     if ( $verbose ) {
 400         say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
 401         say "Done with restrictions purge.";
 402     }
 403 }
 404
 405 if($allDebarments) {
 406     print "All expired patrons restrictions purge triggered.\n" if $verbose;
 407     my $count = PurgeDebarments(0, $confirm);
 408     if ( $verbose ) {
 409         say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
 410         say "Done with all restrictions purge.";
 411     }
 412 }
 413
 414 # Lock expired patrons?
 415 if( defined $lock_days && $lock_days ne q{} ) {
 416     say "Start locking expired patrons" if $verbose;
 417     my $expired_patrons = Koha::Patrons->filter_by_expiration_date({ days => $lock_days })->search({ login_attempts => { '!=' => -1 } });
 418     my $count = $expired_patrons->count;
 419     $expired_patrons->lock({ remove => 1 }) if $confirm;
 420     if( $verbose ) {
 421         say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("Found %d patrons", $count);
 422     }
 423 }
 424
 425 # Handle unsubscribe requests from GDPR consent form, depends on UnsubscribeReflectionDelay preference
 426 say "Start lock unsubscribed, anonymize and delete" if $verbose;
 427 my $unsubscribed_patrons = Koha::Patrons->search_unsubscribed;
 428 my $count = $unsubscribed_patrons->count;
 429 $unsubscribed_patrons->lock( { expire => 1, remove => 1 } ) if $confirm;
 430 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("%d patrons would have been locked", $count) if $verbose;
 431
 432 # Anonymize patron data, depending on PatronAnonymizeDelay
 433 my $anonymize_candidates = Koha::Patrons->search_anonymize_candidates( { locked => 1 } );
 434 $count = $anonymize_candidates->count;
 435 $anonymize_candidates->anonymize if $confirm;
 436 say $confirm ? sprintf("Anonymized %d patrons", $count) : sprintf("%d patrons would have been anonymized", $count) if $verbose;
 437
 438 # Remove patron data, depending on PatronRemovalDelay (will raise an exception if problem encountered
 439 my $anonymized_patrons = Koha::Patrons->search_anonymized;
 440 $count = $anonymized_patrons->count;
 441 if ( $confirm ) {
 442     $anonymized_patrons->delete( { move => 1 } );
 443     if ($@) {
 444         warn $@;
 445     }
 446 }
 447 if ($verbose) {
 448     say $confirm ? sprintf("Deleted %d patrons", $count) : sprintf("%d patrons would have been deleted", $count);
 449 }
 450
 451 # FIXME The output for dry-run mode needs to be improved
 452 # But non trivial changes to C4::Members need to be done before.
 453 if( $pExpSelfReg ) {
 454     if ( $confirm ) {
 455         DeleteExpiredSelfRegs();
 456     } elsif ( $verbose ) {
 457         say "self-registered borrowers may be deleted";
 458     }
 459 }
 460 if( $pUnvSelfReg ) {
 461     if ( $confirm ) {
 462         DeleteUnverifiedSelfRegs( $pUnvSelfReg );
 463     } elsif ( $verbose ) {
 464         say "unverified self-registrations may be deleted";
 465     }
 466 }
 467
 468 if ($special_holidays_days) {
 469     if ( $confirm ) {
 470         DeleteSpecialHolidays( abs($special_holidays_days) );
 471     } elsif ( $verbose ) {
 472         say "self-registered borrowers may be deleted";
 473     }
 474 }
 475
 476 if( $temp_uploads ) {
 477     # Delete temporary uploads, governed by a pref (unless you override)
 478     print "Purging temporary uploads.\n" if $verbose;
 479     if ( $confirm ) {
 480         Koha::UploadedFiles->delete_temporary({
 481             defined($temp_uploads_days)
 482                 ? ( override_pref => $temp_uploads_days )
 483                 : ()
 484         });
 485     }
 486     print "Done purging temporary uploads.\n" if $verbose;
 487 }
 488
 489 if( defined $uploads_missing ) {
 490     print "Looking for missing uploads\n" if $verbose;
 491     if ( $confirm ) {
 492         my $keep = $uploads_missing == 1 ? 0 : 1;
 493         my $count = Koha::UploadedFiles->delete_missing({ keep_record => $keep });
 494         if( $keep ) {
 495             print "Counted $count missing uploaded files\n";
 496         } else {
 497             print "Removed $count records for missing uploads\n";
 498         }
 499     } else {
 500         # FIXME need to create a filter_by_missing method (then call ->delete) instead of delete_missing
 501         say "Dry-run mode cannot guess how many uploads would have been deleted";
 502     }
 503 }
 504
 505 if ($oauth_tokens) {
 506     require Koha::OAuthAccessTokens;
 507
 508     my $tokens = Koha::OAuthAccessTokens->search({ expires => { '<=', time } });
 509     my $count = $tokens->count;
 510     $tokens->delete if $confirm;
 511     if ( $verbose ) {
 512         say $confirm
 513           ? sprintf( "Removed %d expired OAuth2 tokens", $count )
 514           : sprintf( "%d expired OAuth tokens would have been removed", $count );
 515     }
 516 }
 517
 518 if ($pStatistics) {
 519     print "Purging statistics older than $pStatistics days.\n" if $verbose;
 520     my $statistics = Koha::Statistics->filter_by_last_update(
 521         { timestamp_column_name => 'datetime', days => $pStatistics } );
 522     my $count = $statistics->count;
 523     $statistics->delete if $confirm;
 524     if ( $verbose ) {
 525         say $confirm
 526           ? sprintf( "Done with purging %d statistics", $count )
 527           : sprintf( "%d statistics would have been removed", $count );
 528     }
 529 }
 530
 531 if ($return_claims) {
 532     print "Purging return claims older than $return_claims days.\n" if $verbose;
 533
 534     $return_claims = Koha::Checkouts::ReturnClaims->filter_by_last_update(
 535         {
 536             timestamp_column_name => 'resolved_on',
 537             days => $return_claims
 538         }
 539     );
 540
 541     my $count = $return_claims->count;
 542     $return_claims->delete if $confirm;
 543
 544     if ($verbose) {
 545         say $confirm
 546             ? sprintf "Done with purging %d resolved return claims.", $count
 547             : sprintf "%d resolved return claims would have been purged.", $count;
 548     }
 549 }
 550
 551 if ($pDeletedCatalog) {
 552     print "Purging deleted catalog older than $pDeletedCatalog days.\n"
 553       if $verbose;
 554     my $old_items = Koha::Old::Items->filter_by_last_update( { days => $pDeletedCatalog } );
 555     my $old_biblioitems = Koha::Old::Biblioitems->filter_by_last_update( { days => $pDeletedCatalog } );
 556     my $old_biblios = Koha::Old::Biblios->filter_by_last_update( { days => $pDeletedCatalog } );
 557     my ( $c_i, $c_bi, $c_b ) =
 558       ( $old_items->count, $old_biblioitems->count, $old_biblios->count );
 559     if ($confirm) {
 560         $old_items->delete;
 561         $old_biblioitems->delete;
 562         $old_biblios->delete;
 563     }
 564     if ($verbose) {
 565         say sprintf(
 566             $confirm
 567             ? "Done with purging deleted catalog (%d items, %d biblioitems, %d biblios)."
 568             : "Deleted catalog would have been removed (%d items, %d biblioitems, %d biblios).",
 569         $c_i, $c_bi, $c_b);
 570     }
 571 }
 572
 573 if ($pDeletedPatrons) {
 574     print "Purging deleted patrons older than $pDeletedPatrons days.\n" if $verbose;
 575     my $old_patrons = Koha::Old::Patrons->filter_by_last_update(
 576         { timestamp_column_name => 'updated_on', days => $pDeletedPatrons } );
 577     my $count = $old_patrons->count;
 578     $old_patrons->delete if $confirm;
 579     if ($verbose) {
 580         say $confirm
 581           ? sprintf "Done with purging %d deleted patrons.", $count
 582           : sprintf "%d deleted patrons would have been purged.", $count;
 583     }
 584 }
 585
 586 if ($pOldIssues) {
 587     print "Purging old checkouts older than $pOldIssues days.\n" if $verbose;
 588     my $old_checkouts = Koha::Old::Checkouts->filter_by_last_update( { days => $pOldIssues } );
 589     my $count = $old_checkouts->count;
 590     $old_checkouts->delete if $confirm;
 591     if ($verbose) {
 592         say $confirm
 593           ? sprintf "Done with purging %d old checkouts.", $count
 594           : sprintf "%d old checkouts would have been purged.", $count;
 595     }
 596 }
 597
 598 if ($pOldReserves) {
 599     print "Purging old reserves older than $pOldReserves days.\n" if $verbose;
 600     my $old_reserves = Koha::Old::Holds->filter_by_last_update( { days => $pOldReserves } );
 601     my $count = $old_reserves->count;
 602     $old_reserves->delete if $verbose;
 603     if ($verbose) {
 604         say $confirm
 605           ? sprintf "Done with purging %d old reserves.", $count
 606           : sprintf "%d old reserves would have been purged.", $count;
 607     }
 608 }
 609
 610 if ($pTransfers) {
 611     print "Purging arrived item transfers older than $pTransfers days.\n" if $verbose;
 612     my $transfers = Koha::Item::Transfers->filter_by_last_update(
 613         {
 614             timestamp_column_name => 'datearrived',
 615             days => $pTransfers,
 616         }
 617     );
 618     my $count = $transfers->count;
 619     $transfers->delete if $verbose;
 620     if ($verbose) {
 621         say $confirm
 622           ? sprintf "Done with purging %d transfers.", $count
 623           : sprintf "%d transfers would have been purged.", $count;
 624     }
 625 }
 626
 627 if (defined $pPseudoTransactions or $pPseudoTransactionsFrom or $pPseudoTransactionsTo ) {
 628     print "Purging pseudonymized transactions\n" if $verbose;
 629     my $anonymized_transactions = Koha::PseudonymizedTransactions->filter_by_last_update(
 630         {
 631             timestamp_column_name => 'datetime',
 632             ( defined $pPseudoTransactions  ? ( days => $pPseudoTransactions     ) : () ),
 633             ( $pPseudoTransactionsFrom      ? ( from => $pPseudoTransactionsFrom ) : () ),
 634             ( $pPseudoTransactionsTo        ? ( to   => $pPseudoTransactionsTo   ) : () ),
 635         }
 636     );
 637     my $count = $anonymized_transactions->count;
 638     $anonymized_transactions->delete if $confirm;
 639     if ($verbose) {
 640         say $confirm
 641           ? sprintf "Done with purging %d pseudonymized transactions.", $count
 642           : sprintf "%d pseudonymized transactions would have been purged.", $count;
 643     }
 644 }
 645
 646 if ($labels) {
 647     print "Purging item label batches last added to more than $labels days ago.\n" if $verbose;
 648     my $count = PurgeCreatorBatches($labels, 'labels', $confirm);
 649     if ($verbose) {
 650         say $confirm
 651           ? sprintf "Done with purging %d item label batches last added to more than %d days ago.\n", $count, $labels
 652           : sprintf "%d item label batches would have been purged.", $count;
 653     }
 654 }
 655
 656 if ($cards) {
 657     print "Purging card creator batches last added to more than $cards days ago.\n" if $verbose;
 658     my $count = PurgeCreatorBatches($labels, 'patroncards', $confirm);
 659     if ($verbose) {
 660         say $confirm
 661           ? sprintf "Done with purging %d card creator batches last added to more than %d days ago.\n", $count, $labels
 662           : sprintf "%d card creator batches would have been purged.", $count;
 663     }
 664 }
 665
 666 exit(0);
 667
 668 sub RemoveOldSessions {
 669     my ( $id, $a_session, $limit, $lasttime );
 670     $limit = time() - 24 * 3600 * $sess_days;
 671
 672     $sth = $dbh->prepare(q{ SELECT id, a_session FROM sessions });
 673     $sth->execute or die $dbh->errstr;
 674     $sth->bind_columns( \$id, \$a_session );
 675     $sth2  = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? });
 676     my $count = 0;
 677
 678     while ( $sth->fetch ) {
 679         $lasttime = 0;
 680         if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
 681             $lasttime = $1;
 682         }
 683         elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
 684             $lasttime = $2;
 685         }
 686         if ( $lasttime && $lasttime < $limit ) {
 687             $sth2->execute($id) or die $dbh->errstr;
 688             $count++;
 689         }
 690     }
 691     if ($verbose) {
 692         print "$count sessions were deleted.\n";
 693     }
 694 }
 695
 696 sub PurgeImportTables {
 697
 698     #First purge import_records
 699     #Delete cascades to import_biblios, import_items and import_record_matches
 700     $sth = $dbh->prepare(
 701         q{
 702             DELETE FROM import_records
 703             WHERE upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
 704         }
 705     );
 706     $sth->execute($pImport) or die $dbh->errstr;
 707
 708     # Now purge import_batches
 709     # Timestamp cannot be used here without care, because records are added
 710     # continuously to batches without updating timestamp (Z39.50 search).
 711     # So we only delete older empty batches.
 712     # This delete will therefore not have a cascading effect.
 713     $sth = $dbh->prepare(
 714         q{
 715             DELETE ba
 716             FROM import_batches ba
 717             LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
 718             WHERE re.import_record_id IS NULL AND
 719             ba.upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
 720         }
 721     );
 722     $sth->execute($pImport) or die $dbh->errstr;
 723 }
 724
 725 sub PurgeZ3950 {
 726     $sth = $dbh->prepare(
 727         q{
 728             DELETE FROM import_batches
 729             WHERE batch_type = 'z3950'
 730         }
 731     );
 732     $sth->execute() or die $dbh->errstr;
 733 }
 734
 735 sub PurgeDebarments {
 736     require Koha::Patron::Debarments;
 737     my ( $days, $doit ) = @_;
 738     my $count = 0;
 739     $sth   = $dbh->prepare(
 740         q{
 741             SELECT borrower_debarment_id
 742             FROM borrower_debarments
 743             WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
 744         }
 745     );
 746     $sth->execute($days) or die $dbh->errstr;
 747     while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
 748         Koha::Patron::Debarments::DelDebarment($borrower_debarment_id) if $doit;
 749         $count++;
 750     }
 751     return $count;
 752 }
 753
 754 sub PurgeCreatorBatches {
 755     require C4::Labels::Batch;
 756     my ( $days, $creator, $doit ) = @_;
 757     my $count = 0;
 758     $sth = $dbh->prepare(
 759         q{
 760             SELECT batch_id, branch_code FROM creator_batches
 761             WHERE batch_id in
 762                 (SELECT batch_id
 763                 FROM (SELECT batch_id
 764                         FROM creator_batches
 765                         WHERE creator=?
 766                         GROUP BY batch_id
 767                         HAVING max(timestamp) <= date_sub(curdate(),interval ? day)) a)
 768         }
 769     );
 770     $sth->execute( $creator, $days ) or die $dbh->errstr;
 771     while ( my ( $batch_id, $branch_code ) = $sth->fetchrow_array ) {
 772         C4::Labels::Batch::delete(
 773             batch_id    => $batch_id,
 774             branch_code => $branch_code
 775         ) if $doit;
 776         $count++;
 777     }
 778     return $count;
 779 }
 780
 781 sub DeleteExpiredSelfRegs {
 782     my $cnt= C4::Members::DeleteExpiredOpacRegistrations();
 783     print "Removed $cnt expired self-registered borrowers\n" if $verbose;
 784 }
 785
 786 sub DeleteUnverifiedSelfRegs {
 787     my $cnt= C4::Members::DeleteUnverifiedOpacRegistrations( $_[0] );
 788     print "Removed $cnt unverified self-registrations\n" if $verbose;
 789 }
 790
 791 sub DeleteSpecialHolidays {
 792     my ( $days ) = @_;
 793
 794     my $sth = $dbh->prepare(q{
 795         DELETE FROM special_holidays
 796         WHERE DATE( CONCAT( year, '-', month, '-', day ) ) < DATE_SUB( CAST(NOW() AS DATE), INTERVAL ? DAY );
 797     });
 798     my $count = $sth->execute( $days ) + 0;
 799     print "Removed $count unique holidays\n" if $verbose;
 800 }