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