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 under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 use strict;
  21 use warnings;
  22
  23 use constant DEFAULT_ZEBRAQ_PURGEDAYS => 30;
  24 use constant DEFAULT_MAIL_PURGEDAYS => 30;
  25 use constant DEFAULT_IMPORT_PURGEDAYS => 60;
  26 use constant DEFAULT_LOGS_PURGEDAYS => 180;
  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 C4::Context;
  39 use C4::Dates;
  40
  41 use C4::Search;
  42
  43 use Getopt::Long;
  44
  45 sub usage {
  46     print STDERR <<USAGE;
  47 Usage: $0 [-h|--help] [--sessions] [--sessdays DAYS] [-v|--verbose] [--zebraqueue DAYS] [-m|--mail] [--merged] [--import DAYS] [--logs DAYS] [--searchhistory DAYS] [--restrictions DAYS]
  48
  49    -h --help          prints this help message, and exits, ignoring all
  50                       other options
  51    --sessions         purge the sessions table.  If you use this while users
  52                       are logged into Koha, they will have to reconnect.
  53    --sessdays DAYS    purge only sessions older than DAYS days.
  54    -v --verbose       will cause the script to give you a bit more information
  55                       about the run.
  56    --zebraqueue DAYS  purge completed zebraqueue entries older than DAYS days.
  57                       Defaults to 30 days if no days specified.
  58    -m --mail DAYS     purge items from the mail queue that are older than DAYS days.
  59                       Defaults to 30 days if no days specified.
  60    --merged           purged completed entries from need_merge_authorities.
  61    --import DAYS      purge records from import tables older than DAYS days.
  62                       Defaults to 60 days if no days specified.
  63    --z3950            purge records from import tables that are the result
  64                       of Z39.50 searches
  65    --logs DAYS        purge entries from action_logs older than DAYS days.
  66                       Defaults to 180 days if no days specified.
  67    --searchhistory DAYS  purge entries from search_history older than DAYS days.
  68                          Defaults to 30 days if no days specified
  69    --list-invites  DAYS  purge (unaccepted) list share invites older than DAYS
  70                          days.  Defaults to 14 days if no days specified.
  71    --restrictions DAYS   purge patrons restrictions expired since more than DAYS days.
  72                          Defaults to 30 days if no days specified.
  73 USAGE
  74     exit $_[0];
  75 }
  76
  77 my (
  78     $help,            $sessions,       $sess_days,    $verbose,
  79     $zebraqueue_days, $mail,           $purge_merged, $pImport,
  80     $pLogs,           $pSearchhistory, $pZ3950,
  81     $pListShareInvites, $pDebarments,
  82 );
  83
  84 GetOptions(
  85     'h|help'       => \$help,
  86     'sessions'     => \$sessions,
  87     'sessdays:i'   => \$sess_days,
  88     'v|verbose'    => \$verbose,
  89     'm|mail:i'       => \$mail,
  90     'zebraqueue:i' => \$zebraqueue_days,
  91     'merged'       => \$purge_merged,
  92     'import:i'     => \$pImport,
  93     'z3950'        => \$pZ3950,
  94     'logs:i'       => \$pLogs,
  95     'searchhistory:i' => \$pSearchhistory,
  96     'list-invites:i'  => \$pListShareInvites,
  97     'restrictions:i'    => \$pDebarments,
  98 ) || usage(1);
  99
 100 $sessions=1 if $sess_days && $sess_days>0;
 101 # if --import, --logs, --zebraqueue or --searchhistory were passed without number of days,
 102 # use defaults
 103 $pImport= DEFAULT_IMPORT_PURGEDAYS if defined($pImport) && $pImport==0;
 104 $pLogs= DEFAULT_LOGS_PURGEDAYS if defined($pLogs) && $pLogs==0;
 105 $zebraqueue_days= DEFAULT_ZEBRAQ_PURGEDAYS if defined($zebraqueue_days) && $zebraqueue_days==0;
 106 $mail= DEFAULT_MAIL_PURGEDAYS if defined($mail) && $mail==0;
 107 $pSearchhistory= DEFAULT_SEARCHHISTORY_PURGEDAYS if defined($pSearchhistory) && $pSearchhistory==0;
 108 $pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0;
 109 $pDebarments = DEFAULT_DEBARMENTS_PURGEDAYS if defined($pDebarments) && $pDebarments == 0;
 110
 111 if ($help) {
 112     usage(0);
 113 }
 114
 115 unless ( $sessions
 116     || $zebraqueue_days
 117     || $mail
 118     || $purge_merged
 119     || $pImport
 120     || $pLogs
 121     || $pSearchhistory
 122     || $pZ3950
 123     || $pListShareInvites
 124     || $pDebarments )
 125 {
 126     print "You did not specify any cleanup work for the script to do.\n\n";
 127     usage(1);
 128 }
 129
 130 my $dbh = C4::Context->dbh();
 131 my $query;
 132 my $sth;
 133 my $sth2;
 134 my $count;
 135
 136 if ( $sessions && !$sess_days ) {
 137     if ($verbose) {
 138         print "Session purge triggered.\n";
 139         $sth = $dbh->prepare("SELECT COUNT(*) FROM sessions");
 140         $sth->execute() or die $dbh->errstr;
 141         my @count_arr = $sth->fetchrow_array;
 142         print "$count_arr[0] entries will be deleted.\n";
 143     }
 144     $sth = $dbh->prepare("TRUNCATE sessions");
 145     $sth->execute() or die $dbh->errstr;
 146     if ($verbose) {
 147         print "Done with session purge.\n";
 148     }
 149 } elsif ( $sessions && $sess_days > 0 ) {
 150     if ($verbose) {
 151         print "Session purge triggered with days>$sess_days.\n";
 152     }
 153     RemoveOldSessions();
 154     if ($verbose) {
 155         print "Done with session purge with days>$sess_days.\n";
 156     }
 157 }
 158
 159 if ($zebraqueue_days) {
 160     $count = 0;
 161     if ($verbose) {
 162         print "Zebraqueue purge triggered for $zebraqueue_days days.\n";
 163     }
 164     $sth = $dbh->prepare(
 165         "SELECT id,biblio_auth_number,server,time FROM zebraqueue
 166                           WHERE done=1 and time < date_sub(curdate(), interval ? day)"
 167     );
 168     $sth->execute($zebraqueue_days) or die $dbh->errstr;
 169     $sth2 = $dbh->prepare("DELETE FROM zebraqueue WHERE id=?");
 170     while ( my $record = $sth->fetchrow_hashref ) {
 171         $sth2->execute( $record->{id} ) or die $dbh->errstr;
 172         $count++;
 173     }
 174     if ($verbose) {
 175         print "$count records were deleted.\nDone with zebraqueue purge.\n";
 176     }
 177 }
 178
 179 if ($mail) {
 180     print "Mail queue purge triggered for $mail days.\n" if ($verbose);
 181
 182     $sth = $dbh->prepare("DELETE FROM message_queue WHERE time_queued < date_sub(curdate(), interval ? day)");
 183     $sth->execute($mail) or die $dbh->errstr;
 184     my $count = $sth->rows;
 185     $sth->finish;
 186
 187     print "$count messages were deleted from the mail queue.\nDone with message_queue purge.\n" if ($verbose);
 188 }
 189
 190 if($purge_merged) {
 191     print "Purging completed entries from need_merge_authorities.\n" if $verbose;
 192     $sth = $dbh->prepare("DELETE FROM need_merge_authorities WHERE done=1");
 193     $sth->execute() or die $dbh->errstr;
 194     print "Done with purging need_merge_authorities.\n" if $verbose;
 195 }
 196
 197 if($pImport) {
 198     print "Purging records from import tables.\n" if $verbose;
 199     PurgeImportTables();
 200     print "Done with purging import tables.\n" if $verbose;
 201 }
 202
 203 if($pZ3950) {
 204     print "Purging Z39.50 records from import tables.\n" if $verbose;
 205     PurgeZ3950();
 206     print "Done with purging Z39.50 records from import tables.\n" if $verbose;
 207 }
 208
 209 if($pLogs) {
 210     print "Purging records from action_logs.\n" if $verbose;
 211     $sth = $dbh->prepare("DELETE FROM action_logs WHERE timestamp < date_sub(curdate(), interval ? DAY)");
 212     $sth->execute($pLogs) or die $dbh->errstr;
 213     print "Done with purging action_logs.\n" if $verbose;
 214 }
 215
 216 if($pSearchhistory) {
 217     print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;
 218     PurgeSearchHistory($pSearchhistory);
 219     print "Done with purging search_history.\n" if $verbose;
 220 }
 221
 222 if ($pListShareInvites) {
 223     print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;
 224     $sth = $dbh->prepare("
 225         DELETE FROM virtualshelfshares
 226         WHERE invitekey IS NOT NULL
 227         AND (sharedate + INTERVAL ? DAY) < NOW()
 228     ");
 229     $sth->execute($pListShareInvites);
 230     print "Done with purging unaccepted list share invites.\n" if $verbose;
 231 }
 232
 233 if($pDebarments) {
 234     print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
 235     $count = PurgeDebarments();
 236     print "$count restrictions were deleted.\nDone with restrictions purge.\n" if $verbose;
 237 }
 238
 239 exit(0);
 240
 241 sub RemoveOldSessions {
 242     my ( $id, $a_session, $limit, $lasttime );
 243     $limit = time() - 24 * 3600 * $sess_days;
 244
 245     $sth = $dbh->prepare("SELECT id, a_session FROM sessions");
 246     $sth->execute or die $dbh->errstr;
 247     $sth->bind_columns( \$id, \$a_session );
 248     $sth2  = $dbh->prepare("DELETE FROM sessions WHERE id=?");
 249     $count = 0;
 250
 251     while ( $sth->fetch ) {
 252         $lasttime = 0;
 253         if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
 254             $lasttime = $1;
 255         } elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
 256             $lasttime = $2;
 257         }
 258         if ( $lasttime && $lasttime < $limit ) {
 259             $sth2->execute($id) or die $dbh->errstr;
 260             $count++;
 261         }
 262     }
 263     if ($verbose) {
 264         print "$count sessions were deleted.\n";
 265     }
 266 }
 267
 268 sub PurgeImportTables {
 269     #First purge import_records
 270     #Delete cascades to import_biblios, import_items and import_record_matches
 271     $sth = $dbh->prepare("DELETE FROM import_records WHERE upload_timestamp < date_sub(curdate(), interval ? DAY)");
 272     $sth->execute($pImport) or die $dbh->errstr;
 273
 274     # Now purge import_batches
 275     # Timestamp cannot be used here without care, because records are added
 276     # continuously to batches without updating timestamp (Z39.50 search).
 277     # So we only delete older empty batches.
 278     # This delete will therefore not have a cascading effect.
 279     $sth = $dbh->prepare("DELETE ba
 280  FROM import_batches ba
 281  LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
 282  WHERE re.import_record_id IS NULL AND
 283  ba.upload_timestamp < date_sub(curdate(), interval ? DAY)");
 284     $sth->execute($pImport) or die $dbh->errstr;
 285 }
 286
 287
 288 sub PurgeZ3950 {
 289     $sth = $dbh->prepare(q{
 290         DELETE FROM import_batches WHERE batch_type = 'z3950'
 291     });
 292     $sth->execute() or die $dbh->errstr;
 293 }
 294
 295 sub PurgeDebarments {
 296     require Koha::Borrower::Debarments;
 297     $count = 0;
 298     $sth = $dbh->prepare(q{
 299         SELECT borrower_debarment_id FROM borrower_debarments WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
 300     });
 301     $sth->execute($pDebarments) or die $dbh->errstr;
 302     while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
 303         Koha::Borrower::Debarments::DelDebarment($borrower_debarment_id);
 304         $count++;
 305     }
 306     return $count;
 307 }