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
  53
  54 sub usage {
  55     print STDERR <<USAGE;
  56 Usage: $0 [-h|--help] [--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    --sessions         purge the sessions table.  If you use this while users
  61                       are logged into Koha, they will have to reconnect.
  62    --sessdays DAYS    purge only sessions older than DAYS days.
  63    -v --verbose       will cause the script to give you a bit more information
  64                       about the run.
  65    --zebraqueue DAYS  purge completed zebraqueue entries older than DAYS days.
  66                       Defaults to 30 days if no days specified.
  67    -m --mail DAYS     purge items from the mail queue that are older than DAYS days.
  68                       Defaults to 30 days if no days specified.
  69    --merged           purged completed entries from need_merge_authorities.
  70    --import DAYS      purge records from import tables older than DAYS days.
  71                       Defaults to 60 days if no days specified.
  72    --z3950            purge records from import tables that are the result
  73                       of Z39.50 searches
  74    --fees DAYS        purge entries accountlines older than DAYS days, where
  75                       amountoutstanding is 0 or NULL.
  76                       In the case of --fees, DAYS must be greater than
  77                       or equal to 1.
  78    --logs DAYS        purge entries from action_logs older than DAYS days.
  79                       Defaults to 180 days if no days specified.
  80    --searchhistory DAYS  purge entries from search_history older than DAYS days.
  81                          Defaults to 30 days if no days specified
  82    --list-invites  DAYS  purge (unaccepted) list share invites older than DAYS
  83                          days.  Defaults to 14 days if no days specified.
  84    --restrictions DAYS   purge patrons restrictions expired since more than DAYS days.
  85                          Defaults to 30 days if no days specified.
  86     --all-restrictions   purge all expired patrons restrictions.
  87    --del-exp-selfreg  Delete expired self registration accounts
  88    --del-unv-selfreg  DAYS  Delete unverified self registrations older than DAYS
  89    --unique-holidays DAYS  Delete all unique holidays older than DAYS
  90    --temp-uploads     Delete temporary uploads.
  91    --temp-uploads-days DAYS Override the corresponding preference value.
  92    --uploads-missing FLAG Delete upload records for missing files when FLAG is true, count them otherwise
  93    --oauth-tokens     Delete expired OAuth2 tokens
  94    --statistics DAYS       Purge statistics entries more than DAYS days old.
  95                            This table is used to build reports, make sure you are aware of the consequences of this before using it!
  96    --deleted-catalog  DAYS Purge catalog records deleted more then DAYS days ago
  97                            (from tables deleteditems, deletedbiblioitems, deletedbiblio_metadata and deletedbiblio).
  98    --deleted-patrons DAYS  Purge patrons deleted more than DAYS days ago.
  99    --old-issues DAYS       Purge checkouts (old_issues) returned more than DAYS days ago.
 100    --old-reserves DAYS     Purge reserves (old_reserves) more than DAYS old.
 101    --transfers DAYS        Purge transfers completed more than DAYS day ago.
 102 USAGE
 103     exit $_[0];
 104 }
 105
 106 my $help;
 107 my $sessions;
 108 my $sess_days;
 109 my $verbose;
 110 my $zebraqueue_days;
 111 my $mail;
 112 my $purge_merged;
 113 my $pImport;
 114 my $pLogs;
 115 my $pSearchhistory;
 116 my $pZ3950;
 117 my $pListShareInvites;
 118 my $pDebarments;
 119 my $allDebarments;
 120 my $pExpSelfReg;
 121 my $pUnvSelfReg;
 122 my $fees_days;
 123 my $special_holidays_days;
 124 my $temp_uploads;
 125 my $temp_uploads_days;
 126 my $uploads_missing;
 127 my $oauth_tokens;
 128 my $pStatistics;
 129 my $pDeletedCatalog;
 130 my $pDeletedPatrons;
 131 my $pOldIssues;
 132 my $pOldReserves;
 133 my $pTransfers;
 134
 135 GetOptions(
 136     'h|help'            => \$help,
 137     'sessions'          => \$sessions,
 138     'sessdays:i'        => \$sess_days,
 139     'v|verbose'         => \$verbose,
 140     'm|mail:i'          => \$mail,
 141     'zebraqueue:i'      => \$zebraqueue_days,
 142     'merged'            => \$purge_merged,
 143     'import:i'          => \$pImport,
 144     'z3950'             => \$pZ3950,
 145     'logs:i'            => \$pLogs,
 146     'fees:i'            => \$fees_days,
 147     'searchhistory:i'   => \$pSearchhistory,
 148     'list-invites:i'    => \$pListShareInvites,
 149     'restrictions:i'    => \$pDebarments,
 150     'all-restrictions'  => \$allDebarments,
 151     'del-exp-selfreg'   => \$pExpSelfReg,
 152     'del-unv-selfreg'   => \$pUnvSelfReg,
 153     'unique-holidays:i' => \$special_holidays_days,
 154     'temp-uploads'      => \$temp_uploads,
 155     'temp-uploads-days:i' => \$temp_uploads_days,
 156     'uploads-missing:i' => \$uploads_missing,
 157     'oauth-tokens'      => \$oauth_tokens,
 158     'statistics:i'      => \$pStatistics,
 159     'deleted-catalog:i' => \$pDeletedCatalog,
 160     'deleted-patrons:i' => \$pDeletedPatrons,
 161     'old-issues:i'      => \$pOldIssues,
 162     'old-reserves:i'    => \$pOldReserves,
 163     'transfers:i'    => \$pTransfers,
 164 ) || usage(1);
 165
 166 # Use default values
 167 $sessions          = 1                                    if $sess_days                  && $sess_days > 0;
 168 $pImport           = DEFAULT_IMPORT_PURGEDAYS             if defined($pImport)           && $pImport == 0;
 169 $pLogs             = DEFAULT_LOGS_PURGEDAYS               if defined($pLogs)             && $pLogs == 0;
 170 $zebraqueue_days   = DEFAULT_ZEBRAQ_PURGEDAYS             if defined($zebraqueue_days)   && $zebraqueue_days == 0;
 171 $mail              = DEFAULT_MAIL_PURGEDAYS               if defined($mail)              && $mail == 0;
 172 $pSearchhistory    = DEFAULT_SEARCHHISTORY_PURGEDAYS      if defined($pSearchhistory)    && $pSearchhistory == 0;
 173 $pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0;
 174 $pDebarments       = DEFAULT_DEBARMENTS_PURGEDAYS         if defined($pDebarments)       && $pDebarments == 0;
 175
 176 if ($help) {
 177     usage(0);
 178 }
 179
 180 unless ( $sessions
 181     || $zebraqueue_days
 182     || $mail
 183     || $purge_merged
 184     || $pImport
 185     || $pLogs
 186     || $fees_days
 187     || $pSearchhistory
 188     || $pZ3950
 189     || $pListShareInvites
 190     || $pDebarments
 191     || $allDebarments
 192     || $pExpSelfReg
 193     || $pUnvSelfReg
 194     || $special_holidays_days
 195     || $temp_uploads
 196     || defined $uploads_missing
 197     || $oauth_tokens
 198     || $pStatistics
 199     || $pDeletedCatalog
 200     || $pDeletedPatrons
 201     || $pOldIssues
 202     || $pOldReserves
 203     || $pTransfers
 204 ) {
 205     print "You did not specify any cleanup work for the script to do.\n\n";
 206     usage(1);
 207 }
 208
 209 if ($pDebarments && $allDebarments) {
 210     print "You can not specify both --restrictions and --all-restrictions.\n\n";
 211     usage(1);
 212 }
 213
 214 cronlogaction();
 215
 216 my $dbh = C4::Context->dbh();
 217 my $sth;
 218 my $sth2;
 219 my $count;
 220
 221 if ( $sessions && !$sess_days ) {
 222     if ($verbose) {
 223         print "Session purge triggered.\n";
 224         $sth = $dbh->prepare(q{ SELECT COUNT(*) FROM sessions });
 225         $sth->execute() or die $dbh->errstr;
 226         my @count_arr = $sth->fetchrow_array;
 227         print "$count_arr[0] entries will be deleted.\n";
 228     }
 229     $sth = $dbh->prepare(q{ TRUNCATE sessions });
 230     $sth->execute() or die $dbh->errstr;
 231     if ($verbose) {
 232         print "Done with session purge.\n";
 233     }
 234 }
 235 elsif ( $sessions && $sess_days > 0 ) {
 236     print "Session purge triggered with days>$sess_days.\n" if $verbose;
 237     RemoveOldSessions();
 238     print "Done with session purge with days>$sess_days.\n" if $verbose;
 239 }
 240
 241 if ($zebraqueue_days) {
 242     $count = 0;
 243     print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
 244     $sth = $dbh->prepare(
 245         q{
 246             SELECT id,biblio_auth_number,server,time
 247             FROM zebraqueue
 248             WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY)
 249         }
 250     );
 251     $sth->execute($zebraqueue_days) or die $dbh->errstr;
 252     $sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? });
 253     while ( my $record = $sth->fetchrow_hashref ) {
 254         $sth2->execute( $record->{id} ) or die $dbh->errstr;
 255         $count++;
 256     }
 257     print "$count records were deleted.\nDone with zebraqueue purge.\n" if $verbose;
 258 }
 259
 260 if ($mail) {
 261     print "Mail queue purge triggered for $mail days.\n" if $verbose;
 262     $sth = $dbh->prepare(
 263         q{
 264             DELETE FROM message_queue
 265             WHERE time_queued < date_sub(curdate(), INTERVAL ? DAY)
 266         }
 267     );
 268     $sth->execute($mail) or die $dbh->errstr;
 269     $count = $sth->rows;
 270     $sth->finish;
 271     print "$count messages were deleted from the mail queue.\nDone with message_queue purge.\n" if $verbose;
 272 }
 273
 274 if ($purge_merged) {
 275     print "Purging completed entries from need_merge_authorities.\n" if $verbose;
 276     $sth = $dbh->prepare(q{ DELETE FROM need_merge_authorities WHERE done=1 });
 277     $sth->execute() or die $dbh->errstr;
 278     print "Done with purging need_merge_authorities.\n" if $verbose;
 279 }
 280
 281 if ($pImport) {
 282     print "Purging records from import tables.\n" if $verbose;
 283     PurgeImportTables();
 284     print "Done with purging import tables.\n" if $verbose;
 285 }
 286
 287 if ($pZ3950) {
 288     print "Purging Z39.50 records from import tables.\n" if $verbose;
 289     PurgeZ3950();
 290     print "Done with purging Z39.50 records from import tables.\n" if $verbose;
 291 }
 292
 293 if ($pLogs) {
 294     print "Purging records from action_logs.\n" if $verbose;
 295     $sth = $dbh->prepare(
 296         q{
 297             DELETE FROM action_logs
 298             WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY)
 299         }
 300     );
 301     $sth->execute($pLogs) or die $dbh->errstr;
 302     print "Done with purging action_logs.\n" if $verbose;
 303 }
 304
 305 if ($fees_days) {
 306     print "Purging records from accountlines.\n" if $verbose;
 307     purge_zero_balance_fees( $fees_days );
 308     print "Done purging records from accountlines.\n" if $verbose;
 309 }
 310
 311 if ($pSearchhistory) {
 312     print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;
 313     C4::Search::History::delete({ interval => $pSearchhistory });
 314     print "Done with purging search_history.\n" if $verbose;
 315 }
 316
 317 if ($pListShareInvites) {
 318     print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;
 319     $sth = $dbh->prepare(
 320         q{
 321             DELETE FROM virtualshelfshares
 322             WHERE invitekey IS NOT NULL
 323             AND (sharedate + INTERVAL ? DAY) < NOW()
 324         }
 325     );
 326     $sth->execute($pListShareInvites);
 327     print "Done with purging unaccepted list share invites.\n" if $verbose;
 328 }
 329
 330 if ($pDebarments) {
 331     print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
 332     $count = PurgeDebarments($pDebarments);
 333     print "$count restrictions were deleted.\nDone with restrictions purge.\n" if $verbose;
 334 }
 335
 336 if($allDebarments) {
 337     print "All expired patrons restrictions purge triggered.\n" if $verbose;
 338     $count = PurgeDebarments(0);
 339     print "$count restrictions were deleted.\nDone with all restrictions purge.\n" if $verbose;
 340 }
 341
 342 # Handle unsubscribe requests from GDPR consent form, depends on UnsubscribeReflectionDelay preference
 343 my $unsubscribed_patrons = Koha::Patrons->search_unsubscribed;
 344 $count = $unsubscribed_patrons->count;
 345 $unsubscribed_patrons->lock( { expire => 1, remove => 1 } );
 346 say sprintf "Locked %d patrons", $count if $verbose;
 347
 348 # Anonymize patron data, depending on PatronAnonymizeDelay
 349 my $anonymize_candidates = Koha::Patrons->search_anonymize_candidates( { locked => 1 } );
 350 $count = $anonymize_candidates->count;
 351 $anonymize_candidates->anonymize;
 352 say sprintf "Anonymized %s patrons", $count if $verbose;
 353
 354 # Remove patron data, depending on PatronRemovalDelay (will raise an exception if problem encountered
 355 my $anonymized_patrons = Koha::Patrons->search_anonymized;
 356 $count = $anonymized_patrons->count;
 357 $anonymized_patrons->delete( { move => 1 } );
 358 if ($@) {
 359     warn $@;
 360 }
 361 elsif ($verbose) {
 362     say sprintf "Deleted %d patrons", $count;
 363 }
 364
 365 if( $pExpSelfReg ) {
 366     DeleteExpiredSelfRegs();
 367 }
 368 if( $pUnvSelfReg ) {
 369     DeleteUnverifiedSelfRegs( $pUnvSelfReg );
 370 }
 371
 372 if ($special_holidays_days) {
 373     DeleteSpecialHolidays( abs($special_holidays_days) );
 374 }
 375
 376 if( $temp_uploads ) {
 377     # Delete temporary uploads, governed by a pref (unless you override)
 378     print "Purging temporary uploads.\n" if $verbose;
 379     Koha::UploadedFiles->delete_temporary({
 380         defined($temp_uploads_days)
 381             ? ( override_pref => $temp_uploads_days )
 382             : ()
 383     });
 384     print "Done purging temporary uploads.\n" if $verbose;
 385 }
 386
 387 if( defined $uploads_missing ) {
 388     print "Looking for missing uploads\n" if $verbose;
 389     my $keep = $uploads_missing == 1 ? 0 : 1;
 390     my $count = Koha::UploadedFiles->delete_missing({ keep_record => $keep });
 391     if( $keep ) {
 392         print "Counted $count missing uploaded files\n";
 393     } else {
 394         print "Removed $count records for missing uploads\n";
 395     }
 396 }
 397
 398 if ($oauth_tokens) {
 399     require Koha::OAuthAccessTokens;
 400
 401     my $count = int Koha::OAuthAccessTokens->search({ expires => { '<=', time } })->delete;
 402     say "Removed $count expired OAuth2 tokens" if $verbose;
 403 }
 404
 405 if ($pStatistics) {
 406     print "Purging statistics older than $pStatistics days.\n" if $verbose;
 407     Koha::Statistics->filter_by_last_update(
 408         { timestamp_column_name => 'datetime', days => $pStatistics } )->delete;
 409     print "Done with purging statistics.\n" if $verbose;
 410 }
 411
 412 if ($pDeletedCatalog) {
 413     print "Purging deleted catalog older than $pDeletedCatalog days.\n" if $verbose;
 414     Koha::Old::Items      ->filter_by_last_update( { days => $pDeletedCatalog } )->delete;
 415     Koha::Old::Biblioitems->filter_by_last_update( { days => $pDeletedCatalog } )->delete;
 416     Koha::Old::Biblios    ->filter_by_last_update( { days => $pDeletedCatalog } )->delete;
 417     print "Done with purging deleted catalog.\n" if $verbose;
 418 }
 419
 420 if ($pDeletedPatrons) {
 421     print "Purging deleted patrons older than $pDeletedPatrons days.\n" if $verbose;
 422     Koha::Old::Patrons->filter_by_last_update(
 423         { timestamp_column_name => 'updated_on', days => $pDeletedPatrons } )
 424       ->delete;
 425     print "Done with purging deleted patrons.\n" if $verbose;
 426 }
 427
 428 if ($pOldIssues) {
 429     print "Purging old checkouts older than $pOldIssues days.\n" if $verbose;
 430     Koha::Old::Checkouts->filter_by_last_update( { days => $pOldIssues } )->delete;
 431     print "Done with purging old issues.\n" if $verbose;
 432 }
 433
 434 if ($pOldReserves) {
 435     print "Purging old reserves older than $pOldReserves days.\n" if $verbose;
 436     Koha::Old::Holds->filter_by_last_update( { days => $pOldReserves } )->delete;
 437     print "Done with purging old reserves.\n" if $verbose;
 438 }
 439
 440 if ($pTransfers) {
 441     print "Purging arrived item transfers older than $pTransfers days.\n" if $verbose;
 442     Koha::Item::Transfers->filter_by_last_update(
 443         {
 444             timestamp_column_name => 'datearrived',
 445             days => $pTransfers,
 446         }
 447     )->delete;
 448     print "Done with purging transfers.\n" if $verbose;
 449 }
 450
 451 exit(0);
 452
 453 sub RemoveOldSessions {
 454     my ( $id, $a_session, $limit, $lasttime );
 455     $limit = time() - 24 * 3600 * $sess_days;
 456
 457     $sth = $dbh->prepare(q{ SELECT id, a_session FROM sessions });
 458     $sth->execute or die $dbh->errstr;
 459     $sth->bind_columns( \$id, \$a_session );
 460     $sth2  = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? });
 461     $count = 0;
 462
 463     while ( $sth->fetch ) {
 464         $lasttime = 0;
 465         if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
 466             $lasttime = $1;
 467         }
 468         elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
 469             $lasttime = $2;
 470         }
 471         if ( $lasttime && $lasttime < $limit ) {
 472             $sth2->execute($id) or die $dbh->errstr;
 473             $count++;
 474         }
 475     }
 476     if ($verbose) {
 477         print "$count sessions were deleted.\n";
 478     }
 479 }
 480
 481 sub PurgeImportTables {
 482
 483     #First purge import_records
 484     #Delete cascades to import_biblios, import_items and import_record_matches
 485     $sth = $dbh->prepare(
 486         q{
 487             DELETE FROM import_records
 488             WHERE upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
 489         }
 490     );
 491     $sth->execute($pImport) or die $dbh->errstr;
 492
 493     # Now purge import_batches
 494     # Timestamp cannot be used here without care, because records are added
 495     # continuously to batches without updating timestamp (Z39.50 search).
 496     # So we only delete older empty batches.
 497     # This delete will therefore not have a cascading effect.
 498     $sth = $dbh->prepare(
 499         q{
 500             DELETE ba
 501             FROM import_batches ba
 502             LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
 503             WHERE re.import_record_id IS NULL AND
 504             ba.upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
 505         }
 506     );
 507     $sth->execute($pImport) or die $dbh->errstr;
 508 }
 509
 510 sub PurgeZ3950 {
 511     $sth = $dbh->prepare(
 512         q{
 513             DELETE FROM import_batches
 514             WHERE batch_type = 'z3950'
 515         }
 516     );
 517     $sth->execute() or die $dbh->errstr;
 518 }
 519
 520 sub PurgeDebarments {
 521     require Koha::Patron::Debarments;
 522     my $days = shift;
 523     $count = 0;
 524     $sth   = $dbh->prepare(
 525         q{
 526             SELECT borrower_debarment_id
 527             FROM borrower_debarments
 528             WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
 529         }
 530     );
 531     $sth->execute($days) or die $dbh->errstr;
 532     while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
 533         Koha::Patron::Debarments::DelDebarment($borrower_debarment_id);
 534         $count++;
 535     }
 536     return $count;
 537 }
 538
 539 sub DeleteExpiredSelfRegs {
 540     my $cnt= C4::Members::DeleteExpiredOpacRegistrations();
 541     print "Removed $cnt expired self-registered borrowers\n" if $verbose;
 542 }
 543
 544 sub DeleteUnverifiedSelfRegs {
 545     my $cnt= C4::Members::DeleteUnverifiedOpacRegistrations( $_[0] );
 546     print "Removed $cnt unverified self-registrations\n" if $verbose;
 547 }
 548
 549 sub DeleteSpecialHolidays {
 550     my ( $days ) = @_;
 551
 552     my $sth = $dbh->prepare(q{
 553         DELETE FROM special_holidays
 554         WHERE DATE( CONCAT( year, '-', month, '-', day ) ) < DATE_SUB( CAST(NOW() AS DATE), INTERVAL ? DAY );
 555     });
 556     my $count = $sth->execute( $days ) + 0;
 557     print "Removed $count unique holidays\n" if $verbose;
 558 }