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
  28 BEGIN {
  29     # find Koha's Perl modules
  30     # test carefully before changing this
  31     use FindBin;
  32     eval { require "$FindBin::Bin/../kohalib.pl" };
  33 }
  34
  35 use C4::Context;
  36 use C4::Dates;
  37
  38 use Getopt::Long;
  39
  40 sub usage {
  41     print STDERR <<USAGE;
  42 Usage: $0 [-h|--help] [--sessions] [--sessdays DAYS] [-v|--verbose] [--zebraqueue DAYS] [-m|--mail] [--merged] [--import DAYS] [--logs DAYS]
  43
  44    -h --help          prints this help message, and exits, ignoring all
  45                       other options
  46    --sessions         purge the sessions table.  If you use this while users
  47                       are logged into Koha, they will have to reconnect.
  48    --sessdays DAYS    purge only sessions older than DAYS days.
  49    -v --verbose       will cause the script to give you a bit more information
  50                       about the run.
  51    --zebraqueue DAYS  purge completed zebraqueue entries older than DAYS days.
  52                       Defaults to 30 days if no days specified.
  53    -m --mail DAYS     purge items from the mail queue that are older than DAYS days.
  54                       Defaults to 30 days if no days specified.
  55    --merged           purged completed entries from need_merge_authorities.
  56    --import DAYS      purge records from import tables older than DAYS days.
  57                       Defaults to 60 days if no days specified.
  58    --logs DAYS        purge entries from action_logs older than DAYS days.
  59                       Defaults to 180 days if no days specified.
  60 USAGE
  61     exit $_[0];
  62 }
  63
  64 my ( $help, $sessions, $sess_days, $verbose, $zebraqueue_days, $mail, $purge_merged, $pImport, $pLogs);
  65
  66 GetOptions(
  67     'h|help'       => \$help,
  68     'sessions'     => \$sessions,
  69     'sessdays:i'   => \$sess_days,
  70     'v|verbose'    => \$verbose,
  71     'm|mail:i'       => \$mail,
  72     'zebraqueue:i' => \$zebraqueue_days,
  73     'merged'       => \$purge_merged,
  74     'import:i'     => \$pImport,
  75     'logs:i'       => \$pLogs,
  76 ) || usage(1);
  77
  78 $sessions=1 if $sess_days && $sess_days>0;
  79 # if --import, --logs or --zebraqueue were passed without number of days,
  80 # use defaults
  81 $pImport= DEFAULT_IMPORT_PURGEDAYS if defined($pImport) && $pImport==0;
  82 $pLogs= DEFAULT_LOGS_PURGEDAYS if defined($pLogs) && $pLogs==0;
  83 $zebraqueue_days= DEFAULT_ZEBRAQ_PURGEDAYS if defined($zebraqueue_days) && $zebraqueue_days==0;
  84 $mail= DEFAULT_MAIL_PURGEDAYS if defined($mail) && $mail==0;
  85
  86 if ($help) {
  87     usage(0);
  88 }
  89
  90 if ( !( $sessions || $zebraqueue_days || $mail || $purge_merged || $pImport || $pLogs) ) {
  91     print "You did not specify any cleanup work for the script to do.\n\n";
  92     usage(1);
  93 }
  94
  95 my $dbh = C4::Context->dbh();
  96 my $query;
  97 my $sth;
  98 my $sth2;
  99 my $count;
 100
 101 if ( $sessions && !$sess_days ) {
 102     if ($verbose) {
 103         print "Session purge triggered.\n";
 104         $sth = $dbh->prepare("SELECT COUNT(*) FROM sessions");
 105         $sth->execute() or die $dbh->errstr;
 106         my @count_arr = $sth->fetchrow_array;
 107         print "$count_arr[0] entries will be deleted.\n";
 108     }
 109     $sth = $dbh->prepare("TRUNCATE sessions");
 110     $sth->execute() or die $dbh->errstr;
 111     if ($verbose) {
 112         print "Done with session purge.\n";
 113     }
 114 } elsif ( $sessions && $sess_days > 0 ) {
 115     if ($verbose) {
 116         print "Session purge triggered with days>$sess_days.\n";
 117     }
 118     RemoveOldSessions();
 119     if ($verbose) {
 120         print "Done with session purge with days>$sess_days.\n";
 121     }
 122 }
 123
 124 if ($zebraqueue_days) {
 125     $count = 0;
 126     if ($verbose) {
 127         print "Zebraqueue purge triggered for $zebraqueue_days days.\n";
 128     }
 129     $sth = $dbh->prepare(
 130         "SELECT id,biblio_auth_number,server,time FROM zebraqueue
 131                           WHERE done=1 and time < date_sub(curdate(), interval ? day)"
 132     );
 133     $sth->execute($zebraqueue_days) or die $dbh->errstr;
 134     $sth2 = $dbh->prepare("DELETE FROM zebraqueue WHERE id=?");
 135     while ( my $record = $sth->fetchrow_hashref ) {
 136         $sth2->execute( $record->{id} ) or die $dbh->errstr;
 137         $count++;
 138     }
 139     if ($verbose) {
 140         print "$count records were deleted.\nDone with zebraqueue purge.\n";
 141     }
 142 }
 143
 144 if ($mail) {
 145     print "Mail queue purge triggered for $mail days.\n" if ($verbose);
 146
 147     $sth = $dbh->prepare("DELETE FROM message_queue WHERE time_queued < date_sub(curdate(), interval ? day)");
 148     $sth->execute($mail) or die $dbh->errstr;
 149     my $count = $sth->rows;
 150     $sth->finish;
 151
 152     print "$count messages were deleted from the mail queue.\nDone with message_queue purge.\n" if ($verbose);
 153 }
 154
 155 if($purge_merged) {
 156     print "Purging completed entries from need_merge_authorities.\n" if $verbose;
 157     $sth = $dbh->prepare("DELETE FROM need_merge_authorities WHERE done=1");
 158     $sth->execute() or die $dbh->errstr;
 159     print "Done with purging need_merge_authorities.\n" if $verbose;
 160 }
 161
 162 if($pImport) {
 163     print "Purging records from import tables.\n" if $verbose;
 164     PurgeImportTables();
 165     print "Done with purging import tables.\n" if $verbose;
 166 }
 167
 168 if($pLogs) {
 169     print "Purging records from action_logs.\n" if $verbose;
 170     $sth = $dbh->prepare("DELETE FROM action_logs WHERE timestamp < date_sub(curdate(), interval ? DAY)");
 171     $sth->execute($pLogs) or die $dbh->errstr;
 172     print "Done with purging action_logs.\n" if $verbose;
 173 }
 174
 175 exit(0);
 176
 177 sub RemoveOldSessions {
 178     my ( $id, $a_session, $limit, $lasttime );
 179     $limit = time() - 24 * 3600 * $sess_days;
 180
 181     $sth = $dbh->prepare("SELECT id, a_session FROM sessions");
 182     $sth->execute or die $dbh->errstr;
 183     $sth->bind_columns( \$id, \$a_session );
 184     $sth2  = $dbh->prepare("DELETE FROM sessions WHERE id=?");
 185     $count = 0;
 186
 187     while ( $sth->fetch ) {
 188         $lasttime = 0;
 189         if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
 190             $lasttime = $1;
 191         } elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
 192             $lasttime = $2;
 193         }
 194         if ( $lasttime && $lasttime < $limit ) {
 195             $sth2->execute($id) or die $dbh->errstr;
 196             $count++;
 197         }
 198     }
 199     if ($verbose) {
 200         print "$count sessions were deleted.\n";
 201     }
 202 }
 203
 204 sub PurgeImportTables {
 205     #First purge import_records
 206     #Delete cascades to import_biblios, import_items and import_record_matches
 207     $sth = $dbh->prepare("DELETE FROM import_records WHERE upload_timestamp < date_sub(curdate(), interval ? DAY)");
 208     $sth->execute($pImport) or die $dbh->errstr;
 209
 210     # Now purge import_batches
 211     # Timestamp cannot be used here without care, because records are added
 212     # continuously to batches without updating timestamp (z3950 search).
 213     # So we only delete older empty batches.
 214     # This delete will therefore not have a cascading effect.
 215     $sth = $dbh->prepare("DELETE ba
 216  FROM import_batches ba
 217  LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
 218  WHERE re.import_record_id IS NULL AND
 219  ba.upload_timestamp < date_sub(curdate(), interval ? DAY)");
 220     $sth->execute($pImport) or die $dbh->errstr;
 221 }