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