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 USAGE
  73     exit $_[0];
  74 }
  75
  76 my (
  77     $help,   $sessions,          $sess_days, $verbose, $zebraqueue_days,
  78     $mail,   $purge_merged,      $pImport,   $pLogs,   $pSearchhistory,
  79     $pZ3950, $pListShareInvites, $pDebarments, $allDebarments,
  80 );
  81
  82 GetOptions(
  83     'h|help'          => \$help,
  84     'sessions'        => \$sessions,
  85     'sessdays:i'      => \$sess_days,
  86     'v|verbose'       => \$verbose,
  87     'm|mail:i'        => \$mail,
  88     'zebraqueue:i'    => \$zebraqueue_days,
  89     'merged'          => \$purge_merged,
  90     'import:i'        => \$pImport,
  91     'z3950'           => \$pZ3950,
  92     'logs:i'          => \$pLogs,
  93     'searchhistory:i' => \$pSearchhistory,
  94     'list-invites:i'  => \$pListShareInvites,
  95     'restrictions:i'  => \$pDebarments,
  96     'all-restrictions' => \$allDebarments,
  97 ) || usage(1);
  98
  99 # Use default values
 100 $sessions          = 1                                    if $sess_days                  && $sess_days > 0;
 101 $pImport           = DEFAULT_IMPORT_PURGEDAYS             if defined($pImport)           && $pImport == 0;
 102 $pLogs             = DEFAULT_LOGS_PURGEDAYS               if defined($pLogs)             && $pLogs == 0;
 103 $zebraqueue_days   = DEFAULT_ZEBRAQ_PURGEDAYS             if defined($zebraqueue_days)   && $zebraqueue_days == 0;
 104 $mail              = DEFAULT_MAIL_PURGEDAYS               if defined($mail)              && $mail == 0;
 105 $pSearchhistory    = DEFAULT_SEARCHHISTORY_PURGEDAYS      if defined($pSearchhistory)    && $pSearchhistory == 0;
 106 $pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0;
 107 $pDebarments       = DEFAULT_DEBARMENTS_PURGEDAYS         if defined($pDebarments)       && $pDebarments == 0;
 108
 109 if ($help) {
 110     usage(0);
 111 }
 112
 113 unless ( $sessions
 114     || $zebraqueue_days
 115     || $mail
 116     || $purge_merged
 117     || $pImport
 118     || $pLogs
 119     || $pSearchhistory
 120     || $pZ3950
 121     || $pListShareInvites
 122     || $pDebarments
 123     || $allDebarments )
 124 {
 125     print "You did not specify any cleanup work for the script to do.\n\n";
 126     usage(1);
 127 }
 128
 129 if ($pDebarments && $allDebarments) {
 130     print "You can not specify both --restrictions and --all-restrictions.\n\n";
 131     usage(1);
 132 }
 133
 134 cronlogaction();
 135
 136 my $dbh = C4::Context->dbh();
 137 my $sth;
 138 my $sth2;
 139 my $count;
 140
 141 if ( $sessions && !$sess_days ) {
 142     if ($verbose) {
 143         print "Session purge triggered.\n";
 144         $sth = $dbh->prepare(q{ SELECT COUNT(*) FROM sessions });
 145         $sth->execute() or die $dbh->errstr;
 146         my @count_arr = $sth->fetchrow_array;
 147         print "$count_arr[0] entries will be deleted.\n";
 148     }
 149     $sth = $dbh->prepare(q{ TRUNCATE sessions });
 150     $sth->execute() or die $dbh->errstr;
 151     if ($verbose) {
 152         print "Done with session purge.\n";
 153     }
 154 }
 155 elsif ( $sessions && $sess_days > 0 ) {
 156     print "Session purge triggered with days>$sess_days.\n" if $verbose;
 157     RemoveOldSessions();
 158     print "Done with session purge with days>$sess_days.\n" if $verbose;
 159 }
 160
 161 if ($zebraqueue_days) {
 162     $count = 0;
 163     print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
 164     $sth = $dbh->prepare(
 165         q{
 166             SELECT id,biblio_auth_number,server,time
 167             FROM zebraqueue
 168             WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY)
 169         }
 170     );
 171     $sth->execute($zebraqueue_days) or die $dbh->errstr;
 172     $sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? });
 173     while ( my $record = $sth->fetchrow_hashref ) {
 174         $sth2->execute( $record->{id} ) or die $dbh->errstr;
 175         $count++;
 176     }
 177     print "$count records were deleted.\nDone with zebraqueue purge.\n" if $verbose;
 178 }
 179
 180 if ($mail) {
 181     print "Mail queue purge triggered for $mail days.\n" if $verbose;
 182     $sth = $dbh->prepare(
 183         q{
 184             DELETE FROM message_queue
 185             WHERE time_queued < date_sub(curdate(), INTERVAL ? DAY)
 186         }
 187     );
 188     $sth->execute($mail) or die $dbh->errstr;
 189     $count = $sth->rows;
 190     $sth->finish;
 191     print "$count messages were deleted from the mail queue.\nDone with message_queue purge.\n" if $verbose;
 192 }
 193
 194 if ($purge_merged) {
 195     print "Purging completed entries from need_merge_authorities.\n" if $verbose;
 196     $sth = $dbh->prepare(q{ DELETE FROM need_merge_authorities WHERE done=1 });
 197     $sth->execute() or die $dbh->errstr;
 198     print "Done with purging need_merge_authorities.\n" if $verbose;
 199 }
 200
 201 if ($pImport) {
 202     print "Purging records from import tables.\n" if $verbose;
 203     PurgeImportTables();
 204     print "Done with purging import tables.\n" if $verbose;
 205 }
 206
 207 if ($pZ3950) {
 208     print "Purging Z39.50 records from import tables.\n" if $verbose;
 209     PurgeZ3950();
 210     print "Done with purging Z39.50 records from import tables.\n" if $verbose;
 211 }
 212
 213 if ($pLogs) {
 214     print "Purging records from action_logs.\n" if $verbose;
 215     $sth = $dbh->prepare(
 216         q{
 217             DELETE FROM action_logs
 218             WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY)
 219         }
 220     );
 221     $sth->execute($pLogs) or die $dbh->errstr;
 222     print "Done with purging action_logs.\n" if $verbose;
 223 }
 224
 225 if ($pSearchhistory) {
 226     print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;
 227     PurgeSearchHistory($pSearchhistory);
 228     print "Done with purging search_history.\n" if $verbose;
 229 }
 230
 231 if ($pListShareInvites) {
 232     print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;
 233     $sth = $dbh->prepare(
 234         q{
 235             DELETE FROM virtualshelfshares
 236             WHERE invitekey IS NOT NULL
 237             AND (sharedate + INTERVAL ? DAY) < NOW()
 238         }
 239     );
 240     $sth->execute($pListShareInvites);
 241     print "Done with purging unaccepted list share invites.\n" if $verbose;
 242 }
 243
 244 if ($pDebarments) {
 245     print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
 246     $count = PurgeDebarments($pDebarments);
 247     print "$count restrictions were deleted.\nDone with restrictions purge.\n" if $verbose;
 248 }
 249
 250 if($allDebarments) {
 251     print "All expired patrons restrictions purge triggered.\n" if $verbose;
 252     $count = PurgeDebarments(0);
 253     print "$count restrictions were deleted.\nDone with all restrictions purge.\n" if $verbose;
 254 }
 255
 256 exit(0);
 257
 258 sub RemoveOldSessions {
 259     my ( $id, $a_session, $limit, $lasttime );
 260     $limit = time() - 24 * 3600 * $sess_days;
 261
 262     $sth = $dbh->prepare(q{ SELECT id, a_session FROM sessions });
 263     $sth->execute or die $dbh->errstr;
 264     $sth->bind_columns( \$id, \$a_session );
 265     $sth2  = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? });
 266     $count = 0;
 267
 268     while ( $sth->fetch ) {
 269         $lasttime = 0;
 270         if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
 271             $lasttime = $1;
 272         }
 273         elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
 274             $lasttime = $2;
 275         }
 276         if ( $lasttime && $lasttime < $limit ) {
 277             $sth2->execute($id) or die $dbh->errstr;
 278             $count++;
 279         }
 280     }
 281     if ($verbose) {
 282         print "$count sessions were deleted.\n";
 283     }
 284 }
 285
 286 sub PurgeImportTables {
 287
 288     #First purge import_records
 289     #Delete cascades to import_biblios, import_items and import_record_matches
 290     $sth = $dbh->prepare(
 291         q{
 292             DELETE FROM import_records
 293             WHERE upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
 294         }
 295     );
 296     $sth->execute($pImport) or die $dbh->errstr;
 297
 298     # Now purge import_batches
 299     # Timestamp cannot be used here without care, because records are added
 300     # continuously to batches without updating timestamp (Z39.50 search).
 301     # So we only delete older empty batches.
 302     # This delete will therefore not have a cascading effect.
 303     $sth = $dbh->prepare(
 304         q{
 305             DELETE ba
 306             FROM import_batches ba
 307             LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
 308             WHERE re.import_record_id IS NULL AND
 309             ba.upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
 310         }
 311     );
 312     $sth->execute($pImport) or die $dbh->errstr;
 313 }
 314
 315 sub PurgeZ3950 {
 316     $sth = $dbh->prepare(
 317         q{
 318             DELETE FROM import_batches
 319             WHERE batch_type = 'z3950'
 320         }
 321     );
 322     $sth->execute() or die $dbh->errstr;
 323 }
 324
 325 sub PurgeDebarments {
 326     require Koha::Borrower::Debarments;
 327     my $days = shift;
 328     $count = 0;
 329     $sth   = $dbh->prepare(
 330         q{
 331             SELECT borrower_debarment_id
 332             FROM borrower_debarments
 333             WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
 334         }
 335     );
 336     $sth->execute($days) or die $dbh->errstr;
 337     while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
 338         Koha::Borrower::Debarments::DelDebarment($borrower_debarment_id);
 339         $count++;
 340     }
 341     return $count;
 342 }