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 C4::Context;
  38 use C4::Dates;
  39 use C4::Search;
  40 use Getopt::Long;
  41 use C4::Log;
  42
  43 sub usage {
  44     print STDERR <<USAGE;
  45 Usage: $0 [-h|--help] [--sessions] [--sessdays DAYS] [-v|--verbose] [--zebraqueue DAYS] [-m|--mail] [--merged] [--import DAYS] [--logs DAYS] [--searchhistory DAYS] [--restrictions DAYS] [--all-restrictions]
  46
  47    -h --help          prints this help message, and exits, ignoring all
  48                       other options
  49    --sessions         purge the sessions table.  If you use this while users
  50                       are logged into Koha, they will have to reconnect.
  51    --sessdays DAYS    purge only sessions older than DAYS days.
  52    -v --verbose       will cause the script to give you a bit more information
  53                       about the run.
  54    --zebraqueue DAYS  purge completed zebraqueue entries older than DAYS days.
  55                       Defaults to 30 days if no days specified.
  56    -m --mail DAYS     purge items from the mail queue that are older than DAYS days.
  57                       Defaults to 30 days if no days specified.
  58    --merged           purged completed entries from need_merge_authorities.
  59    --import DAYS      purge records from import tables older than DAYS days.
  60                       Defaults to 60 days if no days specified.
  61    --z3950            purge records from import tables that are the result
  62                       of Z39.50 searches
  63    --logs DAYS        purge entries from action_logs older than DAYS days.
  64                       Defaults to 180 days if no days specified.
  65    --searchhistory DAYS  purge entries from search_history older than DAYS days.
  66                          Defaults to 30 days if no days specified
  67    --list-invites  DAYS  purge (unaccepted) list share invites older than DAYS
  68                          days.  Defaults to 14 days if no days specified.
  69    --restrictions DAYS   purge patrons restrictions expired since more than DAYS days.
  70                          Defaults to 30 days if no days specified.
  71     --all-restrictions   purge all expired patrons restrictions.
  72    --del-exp-selfreg  Delete expired self registration accounts
  73    --del-unv-selfreg DAYS  Delete unverified self registrations older than DAYS
  74 USAGE
  75     exit $_[0];
  76 }
  77
  78 my (
  79     $help,
  80     $sessions,
  81     $sess_days,
  82     $verbose,
  83     $zebraqueue_days,
  84     $mail,
  85     $purge_merged,
  86     $pImport,
  87     $pLogs,
  88     $pSearchhistory,
  89     $pZ3950,
  90     $pListShareInvites,
  91     $pDebarments,
  92     $allDebarments,
  93     $pExpSelfReg,
  94     $pUnvSelfReg,
  95 );
  96
  97 GetOptions(
  98     'h|help'          => \$help,
  99     'sessions'        => \$sessions,
 100     'sessdays:i'      => \$sess_days,
 101     'v|verbose'       => \$verbose,
 102     'm|mail:i'        => \$mail,
 103     'zebraqueue:i'    => \$zebraqueue_days,
 104     'merged'          => \$purge_merged,
 105     'import:i'        => \$pImport,
 106     'z3950'           => \$pZ3950,
 107     'logs:i'          => \$pLogs,
 108     'searchhistory:i' => \$pSearchhistory,
 109     'list-invites:i'  => \$pListShareInvites,
 110     'restrictions:i'  => \$pDebarments,
 111     'all-restrictions' => \$allDebarments,
 112     'del-exp-selfreg' => \$pExpSelfReg,
 113     'del-unv-selfreg' => \$pUnvSelfReg,
 114 ) || usage(1);
 115
 116 # Use default values
 117 $sessions          = 1                                    if $sess_days                  && $sess_days > 0;
 118 $pImport           = DEFAULT_IMPORT_PURGEDAYS             if defined($pImport)           && $pImport == 0;
 119 $pLogs             = DEFAULT_LOGS_PURGEDAYS               if defined($pLogs)             && $pLogs == 0;
 120 $zebraqueue_days   = DEFAULT_ZEBRAQ_PURGEDAYS             if defined($zebraqueue_days)   && $zebraqueue_days == 0;
 121 $mail              = DEFAULT_MAIL_PURGEDAYS               if defined($mail)              && $mail == 0;
 122 $pSearchhistory    = DEFAULT_SEARCHHISTORY_PURGEDAYS      if defined($pSearchhistory)    && $pSearchhistory == 0;
 123 $pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0;
 124 $pDebarments       = DEFAULT_DEBARMENTS_PURGEDAYS         if defined($pDebarments)       && $pDebarments == 0;
 125
 126 if ($help) {
 127     usage(0);
 128 }
 129
 130 unless ( $sessions
 131     || $zebraqueue_days
 132     || $mail
 133     || $purge_merged
 134     || $pImport
 135     || $pLogs
 136     || $pSearchhistory
 137     || $pZ3950
 138     || $pListShareInvites
 139     || $pDebarments
 140     || $allDebarments
 141     || $pExpSelfReg
 142     || $pUnvSelfReg
 143 ) {
 144     print "You did not specify any cleanup work for the script to do.\n\n";
 145     usage(1);
 146 }
 147
 148 if ($pDebarments && $allDebarments) {
 149     print "You can not specify both --restrictions and --all-restrictions.\n\n";
 150     usage(1);
 151 }
 152
 153 cronlogaction();
 154
 155 my $dbh = C4::Context->dbh();
 156 my $sth;
 157 my $sth2;
 158 my $count;
 159
 160 if ( $sessions && !$sess_days ) {
 161     if ($verbose) {
 162         print "Session purge triggered.\n";
 163         $sth = $dbh->prepare(q{ SELECT COUNT(*) FROM sessions });
 164         $sth->execute() or die $dbh->errstr;
 165         my @count_arr = $sth->fetchrow_array;
 166         print "$count_arr[0] entries will be deleted.\n";
 167     }
 168     $sth = $dbh->prepare(q{ TRUNCATE sessions });
 169     $sth->execute() or die $dbh->errstr;
 170     if ($verbose) {
 171         print "Done with session purge.\n";
 172     }
 173 }
 174 elsif ( $sessions && $sess_days > 0 ) {
 175     print "Session purge triggered with days>$sess_days.\n" if $verbose;
 176     RemoveOldSessions();
 177     print "Done with session purge with days>$sess_days.\n" if $verbose;
 178 }
 179
 180 if ($zebraqueue_days) {
 181     $count = 0;
 182     print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
 183     $sth = $dbh->prepare(
 184         q{
 185             SELECT id,biblio_auth_number,server,time
 186             FROM zebraqueue
 187             WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY)
 188         }
 189     );
 190     $sth->execute($zebraqueue_days) or die $dbh->errstr;
 191     $sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? });
 192     while ( my $record = $sth->fetchrow_hashref ) {
 193         $sth2->execute( $record->{id} ) or die $dbh->errstr;
 194         $count++;
 195     }
 196     print "$count records were deleted.\nDone with zebraqueue purge.\n" if $verbose;
 197 }
 198
 199 if ($mail) {
 200     print "Mail queue purge triggered for $mail days.\n" if $verbose;
 201     $sth = $dbh->prepare(
 202         q{
 203             DELETE FROM message_queue
 204             WHERE time_queued < date_sub(curdate(), INTERVAL ? DAY)
 205         }
 206     );
 207     $sth->execute($mail) or die $dbh->errstr;
 208     $count = $sth->rows;
 209     $sth->finish;
 210     print "$count messages were deleted from the mail queue.\nDone with message_queue purge.\n" if $verbose;
 211 }
 212
 213 if ($purge_merged) {
 214     print "Purging completed entries from need_merge_authorities.\n" if $verbose;
 215     $sth = $dbh->prepare(q{ DELETE FROM need_merge_authorities WHERE done=1 });
 216     $sth->execute() or die $dbh->errstr;
 217     print "Done with purging need_merge_authorities.\n" if $verbose;
 218 }
 219
 220 if ($pImport) {
 221     print "Purging records from import tables.\n" if $verbose;
 222     PurgeImportTables();
 223     print "Done with purging import tables.\n" if $verbose;
 224 }
 225
 226 if ($pZ3950) {
 227     print "Purging Z39.50 records from import tables.\n" if $verbose;
 228     PurgeZ3950();
 229     print "Done with purging Z39.50 records from import tables.\n" if $verbose;
 230 }
 231
 232 if ($pLogs) {
 233     print "Purging records from action_logs.\n" if $verbose;
 234     $sth = $dbh->prepare(
 235         q{
 236             DELETE FROM action_logs
 237             WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY)
 238         }
 239     );
 240     $sth->execute($pLogs) or die $dbh->errstr;
 241     print "Done with purging action_logs.\n" if $verbose;
 242 }
 243
 244 if ($pSearchhistory) {
 245     print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;
 246     C4::Search::History::delete({ interval => $pSearchhistory });
 247     print "Done with purging search_history.\n" if $verbose;
 248 }
 249
 250 if ($pListShareInvites) {
 251     print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;
 252     $sth = $dbh->prepare(
 253         q{
 254             DELETE FROM virtualshelfshares
 255             WHERE invitekey IS NOT NULL
 256             AND (sharedate + INTERVAL ? DAY) < NOW()
 257         }
 258     );
 259     $sth->execute($pListShareInvites);
 260     print "Done with purging unaccepted list share invites.\n" if $verbose;
 261 }
 262
 263 if ($pDebarments) {
 264     print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
 265     $count = PurgeDebarments($pDebarments);
 266     print "$count restrictions were deleted.\nDone with restrictions purge.\n" if $verbose;
 267 }
 268
 269 if($allDebarments) {
 270     print "All expired patrons restrictions purge triggered.\n" if $verbose;
 271     $count = PurgeDebarments(0);
 272     print "$count restrictions were deleted.\nDone with all restrictions purge.\n" if $verbose;
 273 }
 274
 275 if( $pExpSelfReg ) {
 276     DeleteExpiredSelfRegs();
 277 }
 278 if( $pUnvSelfReg ) {
 279     DeleteUnverifiedSelfRegs( $pUnvSelfReg );
 280 }
 281
 282 exit(0);
 283
 284 sub RemoveOldSessions {
 285     my ( $id, $a_session, $limit, $lasttime );
 286     $limit = time() - 24 * 3600 * $sess_days;
 287
 288     $sth = $dbh->prepare(q{ SELECT id, a_session FROM sessions });
 289     $sth->execute or die $dbh->errstr;
 290     $sth->bind_columns( \$id, \$a_session );
 291     $sth2  = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? });
 292     $count = 0;
 293
 294     while ( $sth->fetch ) {
 295         $lasttime = 0;
 296         if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
 297             $lasttime = $1;
 298         }
 299         elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
 300             $lasttime = $2;
 301         }
 302         if ( $lasttime && $lasttime < $limit ) {
 303             $sth2->execute($id) or die $dbh->errstr;
 304             $count++;
 305         }
 306     }
 307     if ($verbose) {
 308         print "$count sessions were deleted.\n";
 309     }
 310 }
 311
 312 sub PurgeImportTables {
 313
 314     #First purge import_records
 315     #Delete cascades to import_biblios, import_items and import_record_matches
 316     $sth = $dbh->prepare(
 317         q{
 318             DELETE FROM import_records
 319             WHERE upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
 320         }
 321     );
 322     $sth->execute($pImport) or die $dbh->errstr;
 323
 324     # Now purge import_batches
 325     # Timestamp cannot be used here without care, because records are added
 326     # continuously to batches without updating timestamp (Z39.50 search).
 327     # So we only delete older empty batches.
 328     # This delete will therefore not have a cascading effect.
 329     $sth = $dbh->prepare(
 330         q{
 331             DELETE ba
 332             FROM import_batches ba
 333             LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
 334             WHERE re.import_record_id IS NULL AND
 335             ba.upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
 336         }
 337     );
 338     $sth->execute($pImport) or die $dbh->errstr;
 339 }
 340
 341 sub PurgeZ3950 {
 342     $sth = $dbh->prepare(
 343         q{
 344             DELETE FROM import_batches
 345             WHERE batch_type = 'z3950'
 346         }
 347     );
 348     $sth->execute() or die $dbh->errstr;
 349 }
 350
 351 sub PurgeDebarments {
 352     require Koha::Borrower::Debarments;
 353     my $days = shift;
 354     $count = 0;
 355     $sth   = $dbh->prepare(
 356         q{
 357             SELECT borrower_debarment_id
 358             FROM borrower_debarments
 359             WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
 360         }
 361     );
 362     $sth->execute($days) or die $dbh->errstr;
 363     while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
 364         Koha::Borrower::Debarments::DelDebarment($borrower_debarment_id);
 365         $count++;
 366     }
 367     return $count;
 368 }
 369
 370 sub DeleteExpiredSelfRegs {
 371     my $cnt= C4::Members::DeleteExpiredOpacRegistrations();
 372     print "Removed $cnt expired self-registered borrowers\n" if $verbose;
 373 }
 374
 375 sub DeleteUnverifiedSelfRegs {
 376     my $cnt= C4::Members::DeleteUnverifiedOpacRegistrations( $_[0] );
 377     print "Removed $cnt unverified self-registrations\n" if $verbose;
 378 }