6094 Follow up for cleanup_database
[koha.git] / 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 (use together with sessions parameter).
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
70 if ($help) {
71     usage(0);
72 }
73
74 if ( !( $sessions || $zebraqueue_days || $mail || $purge_merged) ) {
75     print "You did not specify any cleanup work for the script to do.\n\n";
76     usage(1);
77 }
78
79 my $dbh = C4::Context->dbh();
80 my $query;
81 my $sth;
82 my $sth2;
83 my $count;
84
85 if ( $sessions && !$sess_days ) {
86     if ($verbose) {
87         print "Session purge triggered.\n";
88         $sth = $dbh->prepare("SELECT COUNT(*) FROM sessions");
89         $sth->execute() or die $dbh->errstr;
90         my @count_arr = $sth->fetchrow_array;
91         print "$count_arr[0] entries will be deleted.\n";
92     }
93     $sth = $dbh->prepare("TRUNCATE sessions");
94     $sth->execute() or die $dbh->errstr;
95     if ($verbose) {
96         print "Done with session purge.\n";
97     }
98 } elsif ( $sessions && $sess_days > 0 ) {
99     if ($verbose) {
100         print "Session purge triggered with days>$sess_days.\n";
101     }
102     RemoveOldSessions();
103     if ($verbose) {
104         print "Done with session purge with days>$sess_days.\n";
105     }
106 }
107
108 if ($zebraqueue_days) {
109     $count = 0;
110     if ($verbose) {
111         print "Zebraqueue purge triggered for $zebraqueue_days days.\n";
112     }
113     $sth = $dbh->prepare(
114         "SELECT id,biblio_auth_number,server,time FROM zebraqueue
115                           WHERE done=1 and time < date_sub(curdate(), interval ? day)"
116     );
117     $sth->execute($zebraqueue_days) or die $dbh->errstr;
118     $sth2 = $dbh->prepare("DELETE FROM zebraqueue WHERE id=?");
119     while ( my $record = $sth->fetchrow_hashref ) {
120         $sth2->execute( $record->{id} ) or die $dbh->errstr;
121         $count++;
122     }
123     if ($verbose) {
124         print "$count records were deleted.\nDone with zebraqueue purge.\n";
125     }
126 }
127
128 if ($mail) {
129     if ($verbose) {
130         $sth = $dbh->prepare("SELECT COUNT(*) FROM message_queue");
131         $sth->execute() or die $dbh->errstr;
132         my @count_arr = $sth->fetchrow_array;
133         print "Deleting $count_arr[0] entries from the mail queue.\n";
134     }
135     $sth = $dbh->prepare("TRUNCATE message_queue");
136     $sth->execute() or $dbh->errstr;
137     print "Done with purging the mail queue.\n" if ($verbose);
138 }
139
140 if($purge_merged) {
141     print "Purging completed entries from need_merge_authorities.\n" if $verbose;
142     $sth = $dbh->prepare("DELETE FROM need_merge_authorities WHERE done=1");
143     $sth->execute() or die $dbh->errstr;
144     print "Done with purging need_merge_authorities.\n" if $verbose;
145 }
146
147 exit(0);
148
149 sub RemoveOldSessions {
150     my ( $id, $a_session, $limit, $lasttime );
151     $limit = time() - 24 * 3600 * $sess_days;
152
153     $sth = $dbh->prepare("SELECT id, a_session FROM sessions");
154     $sth->execute or die $dbh->errstr;
155     $sth->bind_columns( \$id, \$a_session );
156     $sth2  = $dbh->prepare("DELETE FROM sessions WHERE id=?");
157     $count = 0;
158
159     while ( $sth->fetch ) {
160         $lasttime = 0;
161         if ( $a_session =~ /lasttime:\s+(\d+)/ ) {
162             $lasttime = $1;
163         } elsif ( $a_session =~ /(ATIME|CTIME):\s+(\d+)/ ) {
164             $lasttime = $2;
165         }
166         if ( $lasttime && $lasttime < $limit ) {
167             $sth2->execute($id) or die $dbh->errstr;
168             $count++;
169         }
170     }
171     if ($verbose) {
172         print "$count sessions were deleted.\n";
173     }
174 }