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 BEGIN {
  24
  25     # find Koha's Perl modules
  26     # test carefully before changing this
  27     use FindBin;
  28     eval { require "$FindBin::Bin/../kohalib.pl" };
  29 }
  30
  31 use C4::Context;
  32 use C4::Dates;
  33
  34 #use C4::Debug;
  35 #use C4::Letters;
  36 #use File::Spec;
  37 use Getopt::Long;
  38
  39 sub usage {
  40     print STDERR <<USAGE;
  41 Usage: $0 [-h|--help] [--sessions] [--sessdays DAYS] [-v|--verbose] [--zebraqueue DAYS] [-m|--mail] [--merged]
  42
  43    -h --help          prints this help message, and exits, ignoring all
  44                       other options
  45    --sessions         purge the sessions table.  If you use this while users
  46                       are logged into Koha, they will have to reconnect.
  47    --sessdays DAYS    purge only sessions older than DAYS days.
  48    -v --verbose       will cause the script to give you a bit more information
  49                       about the run.
  50    --zebraqueue DAYS  purge completed entries from the zebraqueue from
  51                       more than DAYS days ago.
  52    -m --mail          purge the mail queue.
  53    --merged           purged completed entries from need_merge_authorities.
  54 USAGE
  55     exit $_[0];
  56 }
  57
  58 my ( $help, $sessions, $sess_days, $verbose, $zebraqueue_days, $mail, $purge_merged);
  59
  60 GetOptions(
  61     'h|help'       => \$help,
  62     'sessions'     => \$sessions,
  63     'sessdays:i'   => \$sess_days,
  64     'v|verbose'    => \$verbose,
  65     'm|mail'       => \$mail,
  66     'zebraqueue:i' => \$zebraqueue_days,
  67     'merged'       => \$purge_merged,
  68 ) || usage(1);
  69 $sessions=1 if $sess_days && $sess_days>0;
  70
  71 if ($help) {
  72     usage(0);
  73 }
  74
  75 if ( !( $sessions || $zebraqueue_days || $mail || $purge_merged) ) {
  76     print "You did not specify any cleanup work for the script to do.\n\n";
  77     usage(1);
  78 }
  79
  80 my $dbh = C4::Context->dbh();
  81 my $query;
  82 my $sth;
  83 my $sth2;
  84 my $count;
  85
  86 if ( $sessions && !$sess_days ) {
  87     if ($verbose) {
  88         print "Session purge triggered.\n";
  89         $sth = $dbh->prepare("SELECT COUNT(*) FROM sessions");
  90         $sth->execute() or die $dbh->errstr;
  91         my @count_arr = $sth->fetchrow_array;
  92         print "$count_arr[0] entries will be deleted.\n";
  93     }
  94     $sth = $dbh->prepare("TRUNCATE sessions");
  95     $sth->execute() or die $dbh->errstr;
  96     if ($verbose) {
  97         print "Done with session purge.\n";
  98     }
  99 } elsif ( $sessions && $sess_days > 0 ) {
 100     if ($verbose) {
 101         print "Session purge triggered with days>$sess_days.\n";
 102     }
 103     RemoveOldSessions();
 104     if ($verbose) {
 105         print "Done with session purge with days>$sess_days.\n";
 106     }
 107 }
 108
 109 if ($zebraqueue_days) {
 110     $count = 0;
 111     if ($verbose) {
 112         print "Zebraqueue purge triggered for $zebraqueue_days days.\n";
 113     }
 114     $sth = $dbh->prepare(
 115         "SELECT id,biblio_auth_number,server,time FROM zebraqueue
 116                           WHERE done=1 and time < date_sub(curdate(), interval ? day)"
 117     );
 118     $sth->execute($zebraqueue_days) or die $dbh->errstr;
 119     $sth2 = $dbh->prepare("DELETE FROM zebraqueue WHERE id=?");
 120     while ( my $record = $sth->fetchrow_hashref ) {
 121         $sth2->execute( $record->{id} ) or die $dbh->errstr;
 122         $count++;
 123     }
 124     if ($verbose) {
 125         print "$count records were deleted.\nDone with zebraqueue purge.\n";
 126     }
 127 }
 128
 129 if ($mail) {
 130     if ($verbose) {
 131         $sth = $dbh->prepare("SELECT COUNT(*) FROM message_queue");
 132         $sth->execute() or die $dbh->errstr;
 133         my @count_arr = $sth->fetchrow_array;
 134         print "Deleting $count_arr[0] entries from the mail queue.\n";
 135     }
 136     $sth = $dbh->prepare("TRUNCATE message_queue");
 137     $sth->execute() or $dbh->errstr;
 138     print "Done with purging the mail queue.\n" if ($verbose);
 139 }
 140
 141 if($purge_merged) {
 142     print "Purging completed entries from need_merge_authorities.\n" if $verbose;
 143     $sth = $dbh->prepare("DELETE FROM need_merge_authorities WHERE done=1");
 144     $sth->execute() or die $dbh->errstr;
 145     print "Done with purging need_merge_authorities.\n" if $verbose;
 146 }
 147
 148 exit(0);
 149
 150 sub RemoveOldSessions {
 151     my ( $id, $a_session, $limit, $lasttime );
 152     $limit = time() - 24 * 3600 * $sess_days;
 153
 154     $sth = $dbh->prepare("SELECT id, a_session FROM sessions");
 155     $sth->execute or die $dbh->errstr;
 156     $sth->bind_columns( \$id, \$a_session );
 157     $sth2  = $dbh->prepare("DELETE FROM sessions WHERE id=?");
 158     $count = 0;
 159
 160     while ( $sth->fetch ) {
 161         $lasttime = 0;
 162         if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
 163             $lasttime = $1;
 164         } elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
 165             $lasttime = $2;
 166         }
 167         if ( $lasttime && $lasttime < $limit ) {
 168             $sth2->execute($id) or die $dbh->errstr;
 169             $count++;
 170         }
 171     }
 172     if ($verbose) {
 173         print "$count sessions were deleted.\n";
 174     }
 175 }