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