|
Lines 17-32
Link Here
|
| 17 |
# with Koha; if not, write to the Free Software Foundation, Inc., |
17 |
# with Koha; if not, write to the Free Software Foundation, Inc., |
| 18 |
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
18 |
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
| 19 |
|
19 |
|
| 20 |
use strict; |
20 |
use Modern::Perl; |
| 21 |
use warnings; |
21 |
|
| 22 |
|
22 |
use constant DEFAULT_ZEBRAQ_PURGEDAYS => 30; |
| 23 |
use constant DEFAULT_ZEBRAQ_PURGEDAYS => 30; |
23 |
use constant DEFAULT_MAIL_PURGEDAYS => 30; |
| 24 |
use constant DEFAULT_MAIL_PURGEDAYS => 30; |
24 |
use constant DEFAULT_IMPORT_PURGEDAYS => 60; |
| 25 |
use constant DEFAULT_IMPORT_PURGEDAYS => 60; |
25 |
use constant DEFAULT_LOGS_PURGEDAYS => 180; |
| 26 |
use constant DEFAULT_LOGS_PURGEDAYS => 180; |
26 |
use constant DEFAULT_SEARCHHISTORY_PURGEDAYS => 30; |
| 27 |
use constant DEFAULT_SEARCHHISTORY_PURGEDAYS => 30; |
|
|
| 28 |
use constant DEFAULT_SHARE_INVITATION_EXPIRY_DAYS => 14; |
27 |
use constant DEFAULT_SHARE_INVITATION_EXPIRY_DAYS => 14; |
| 29 |
use constant DEFAULT_DEBARMENTS_PURGEDAYS => 30; |
28 |
use constant DEFAULT_DEBARMENTS_PURGEDAYS => 30; |
| 30 |
|
29 |
|
| 31 |
BEGIN { |
30 |
BEGIN { |
| 32 |
# find Koha's Perl modules |
31 |
# find Koha's Perl modules |
|
Lines 75-112
USAGE
Link Here
|
| 75 |
} |
74 |
} |
| 76 |
|
75 |
|
| 77 |
my ( |
76 |
my ( |
| 78 |
$help, $sessions, $sess_days, $verbose, |
77 |
$help, $sessions, $sess_days, $verbose, $zebraqueue_days, |
| 79 |
$zebraqueue_days, $mail, $purge_merged, $pImport, |
78 |
$mail, $purge_merged, $pImport, $pLogs, $pSearchhistory, |
| 80 |
$pLogs, $pSearchhistory, $pZ3950, |
79 |
$pZ3950, $pListShareInvites, $pDebarments, |
| 81 |
$pListShareInvites, $pDebarments, |
|
|
| 82 |
); |
80 |
); |
| 83 |
|
81 |
|
| 84 |
GetOptions( |
82 |
GetOptions( |
| 85 |
'h|help' => \$help, |
83 |
'h|help' => \$help, |
| 86 |
'sessions' => \$sessions, |
84 |
'sessions' => \$sessions, |
| 87 |
'sessdays:i' => \$sess_days, |
85 |
'sessdays:i' => \$sess_days, |
| 88 |
'v|verbose' => \$verbose, |
86 |
'v|verbose' => \$verbose, |
| 89 |
'm|mail:i' => \$mail, |
87 |
'm|mail:i' => \$mail, |
| 90 |
'zebraqueue:i' => \$zebraqueue_days, |
88 |
'zebraqueue:i' => \$zebraqueue_days, |
| 91 |
'merged' => \$purge_merged, |
89 |
'merged' => \$purge_merged, |
| 92 |
'import:i' => \$pImport, |
90 |
'import:i' => \$pImport, |
| 93 |
'z3950' => \$pZ3950, |
91 |
'z3950' => \$pZ3950, |
| 94 |
'logs:i' => \$pLogs, |
92 |
'logs:i' => \$pLogs, |
| 95 |
'searchhistory:i' => \$pSearchhistory, |
93 |
'searchhistory:i' => \$pSearchhistory, |
| 96 |
'list-invites:i' => \$pListShareInvites, |
94 |
'list-invites:i' => \$pListShareInvites, |
| 97 |
'restrictions:i' => \$pDebarments, |
95 |
'restrictions:i' => \$pDebarments, |
| 98 |
) || usage(1); |
96 |
) || usage(1); |
| 99 |
|
97 |
|
| 100 |
$sessions=1 if $sess_days && $sess_days>0; |
98 |
# Use default values |
| 101 |
# if --import, --logs, --zebraqueue or --searchhistory were passed without number of days, |
99 |
$sessions = 1 if $sess_days && $sess_days > 0; |
| 102 |
# use defaults |
100 |
$pImport = DEFAULT_IMPORT_PURGEDAYS if defined($pImport) && $pImport == 0; |
| 103 |
$pImport= DEFAULT_IMPORT_PURGEDAYS if defined($pImport) && $pImport==0; |
101 |
$pLogs = DEFAULT_LOGS_PURGEDAYS if defined($pLogs) && $pLogs == 0; |
| 104 |
$pLogs= DEFAULT_LOGS_PURGEDAYS if defined($pLogs) && $pLogs==0; |
102 |
$zebraqueue_days = DEFAULT_ZEBRAQ_PURGEDAYS if defined($zebraqueue_days) && $zebraqueue_days == 0; |
| 105 |
$zebraqueue_days= DEFAULT_ZEBRAQ_PURGEDAYS if defined($zebraqueue_days) && $zebraqueue_days==0; |
103 |
$mail = DEFAULT_MAIL_PURGEDAYS if defined($mail) && $mail == 0; |
| 106 |
$mail= DEFAULT_MAIL_PURGEDAYS if defined($mail) && $mail==0; |
104 |
$pSearchhistory = DEFAULT_SEARCHHISTORY_PURGEDAYS if defined($pSearchhistory) && $pSearchhistory == 0; |
| 107 |
$pSearchhistory= DEFAULT_SEARCHHISTORY_PURGEDAYS if defined($pSearchhistory) && $pSearchhistory==0; |
|
|
| 108 |
$pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0; |
105 |
$pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0; |
| 109 |
$pDebarments = DEFAULT_DEBARMENTS_PURGEDAYS if defined($pDebarments) && $pDebarments == 0; |
106 |
$pDebarments = DEFAULT_DEBARMENTS_PURGEDAYS if defined($pDebarments) && $pDebarments == 0; |
| 110 |
|
107 |
|
| 111 |
if ($help) { |
108 |
if ($help) { |
| 112 |
usage(0); |
109 |
usage(0); |
|
Lines 135-218
my $count;
Link Here
|
| 135 |
if ( $sessions && !$sess_days ) { |
132 |
if ( $sessions && !$sess_days ) { |
| 136 |
if ($verbose) { |
133 |
if ($verbose) { |
| 137 |
print "Session purge triggered.\n"; |
134 |
print "Session purge triggered.\n"; |
| 138 |
$sth = $dbh->prepare("SELECT COUNT(*) FROM sessions"); |
135 |
$sth = $dbh->prepare(q{ SELECT COUNT(*) FROM sessions }); |
| 139 |
$sth->execute() or die $dbh->errstr; |
136 |
$sth->execute() or die $dbh->errstr; |
| 140 |
my @count_arr = $sth->fetchrow_array; |
137 |
my @count_arr = $sth->fetchrow_array; |
| 141 |
print "$count_arr[0] entries will be deleted.\n"; |
138 |
print "$count_arr[0] entries will be deleted.\n"; |
| 142 |
} |
139 |
} |
| 143 |
$sth = $dbh->prepare("TRUNCATE sessions"); |
140 |
$sth = $dbh->prepare(q{ TRUNCATE sessions }); |
| 144 |
$sth->execute() or die $dbh->errstr; |
141 |
$sth->execute() or die $dbh->errstr; |
| 145 |
if ($verbose) { |
142 |
if ($verbose) { |
| 146 |
print "Done with session purge.\n"; |
143 |
print "Done with session purge.\n"; |
| 147 |
} |
144 |
} |
| 148 |
} elsif ( $sessions && $sess_days > 0 ) { |
145 |
} |
| 149 |
if ($verbose) { |
146 |
elsif ( $sessions && $sess_days > 0 ) { |
| 150 |
print "Session purge triggered with days>$sess_days.\n"; |
147 |
print "Session purge triggered with days>$sess_days.\n" if $verbose; |
| 151 |
} |
|
|
| 152 |
RemoveOldSessions(); |
148 |
RemoveOldSessions(); |
| 153 |
if ($verbose) { |
149 |
print "Done with session purge with days>$sess_days.\n" if $verbose; |
| 154 |
print "Done with session purge with days>$sess_days.\n"; |
|
|
| 155 |
} |
| 156 |
} |
150 |
} |
| 157 |
|
151 |
|
| 158 |
if ($zebraqueue_days) { |
152 |
if ($zebraqueue_days) { |
| 159 |
$count = 0; |
153 |
$count = 0; |
| 160 |
if ($verbose) { |
154 |
print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose; |
| 161 |
print "Zebraqueue purge triggered for $zebraqueue_days days.\n"; |
|
|
| 162 |
} |
| 163 |
$sth = $dbh->prepare( |
155 |
$sth = $dbh->prepare( |
| 164 |
"SELECT id,biblio_auth_number,server,time FROM zebraqueue |
156 |
q{ |
| 165 |
WHERE done=1 and time < date_sub(curdate(), interval ? day)" |
157 |
SELECT id,biblio_auth_number,server,time |
|
|
158 |
FROM zebraqueue |
| 159 |
WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY) |
| 160 |
} |
| 166 |
); |
161 |
); |
| 167 |
$sth->execute($zebraqueue_days) or die $dbh->errstr; |
162 |
$sth->execute($zebraqueue_days) or die $dbh->errstr; |
| 168 |
$sth2 = $dbh->prepare("DELETE FROM zebraqueue WHERE id=?"); |
163 |
$sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? }); |
| 169 |
while ( my $record = $sth->fetchrow_hashref ) { |
164 |
while ( my $record = $sth->fetchrow_hashref ) { |
| 170 |
$sth2->execute( $record->{id} ) or die $dbh->errstr; |
165 |
$sth2->execute( $record->{id} ) or die $dbh->errstr; |
| 171 |
$count++; |
166 |
$count++; |
| 172 |
} |
167 |
} |
| 173 |
if ($verbose) { |
168 |
print "$count records were deleted.\nDone with zebraqueue purge.\n" if $verbose; |
| 174 |
print "$count records were deleted.\nDone with zebraqueue purge.\n"; |
|
|
| 175 |
} |
| 176 |
} |
169 |
} |
| 177 |
|
170 |
|
| 178 |
if ($mail) { |
171 |
if ($mail) { |
| 179 |
print "Mail queue purge triggered for $mail days.\n" if ($verbose); |
172 |
print "Mail queue purge triggered for $mail days.\n" if $verbose; |
| 180 |
|
173 |
$sth = $dbh->prepare( |
| 181 |
$sth = $dbh->prepare("DELETE FROM message_queue WHERE time_queued < date_sub(curdate(), interval ? day)"); |
174 |
q{ |
|
|
175 |
DELETE FROM message_queue |
| 176 |
WHERE time_queued < date_sub(curdate(), INTERVAL ? DAY) |
| 177 |
} |
| 178 |
); |
| 182 |
$sth->execute($mail) or die $dbh->errstr; |
179 |
$sth->execute($mail) or die $dbh->errstr; |
| 183 |
$count = $sth->rows; |
180 |
$count = $sth->rows; |
| 184 |
$sth->finish; |
181 |
$sth->finish; |
| 185 |
|
182 |
print "$count messages were deleted from the mail queue.\nDone with message_queue purge.\n" if $verbose; |
| 186 |
print "$count messages were deleted from the mail queue.\nDone with message_queue purge.\n" if ($verbose); |
|
|
| 187 |
} |
183 |
} |
| 188 |
|
184 |
|
| 189 |
if($purge_merged) { |
185 |
if ($purge_merged) { |
| 190 |
print "Purging completed entries from need_merge_authorities.\n" if $verbose; |
186 |
print "Purging completed entries from need_merge_authorities.\n" if $verbose; |
| 191 |
$sth = $dbh->prepare("DELETE FROM need_merge_authorities WHERE done=1"); |
187 |
$sth = $dbh->prepare(q{ DELETE FROM need_merge_authorities WHERE done=1 }); |
| 192 |
$sth->execute() or die $dbh->errstr; |
188 |
$sth->execute() or die $dbh->errstr; |
| 193 |
print "Done with purging need_merge_authorities.\n" if $verbose; |
189 |
print "Done with purging need_merge_authorities.\n" if $verbose; |
| 194 |
} |
190 |
} |
| 195 |
|
191 |
|
| 196 |
if($pImport) { |
192 |
if ($pImport) { |
| 197 |
print "Purging records from import tables.\n" if $verbose; |
193 |
print "Purging records from import tables.\n" if $verbose; |
| 198 |
PurgeImportTables(); |
194 |
PurgeImportTables(); |
| 199 |
print "Done with purging import tables.\n" if $verbose; |
195 |
print "Done with purging import tables.\n" if $verbose; |
| 200 |
} |
196 |
} |
| 201 |
|
197 |
|
| 202 |
if($pZ3950) { |
198 |
if ($pZ3950) { |
| 203 |
print "Purging Z39.50 records from import tables.\n" if $verbose; |
199 |
print "Purging Z39.50 records from import tables.\n" if $verbose; |
| 204 |
PurgeZ3950(); |
200 |
PurgeZ3950(); |
| 205 |
print "Done with purging Z39.50 records from import tables.\n" if $verbose; |
201 |
print "Done with purging Z39.50 records from import tables.\n" if $verbose; |
| 206 |
} |
202 |
} |
| 207 |
|
203 |
|
| 208 |
if($pLogs) { |
204 |
if ($pLogs) { |
| 209 |
print "Purging records from action_logs.\n" if $verbose; |
205 |
print "Purging records from action_logs.\n" if $verbose; |
| 210 |
$sth = $dbh->prepare("DELETE FROM action_logs WHERE timestamp < date_sub(curdate(), interval ? DAY)"); |
206 |
$sth = $dbh->prepare( |
|
|
207 |
q{ |
| 208 |
DELETE FROM action_logs |
| 209 |
WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY) |
| 210 |
} |
| 211 |
); |
| 211 |
$sth->execute($pLogs) or die $dbh->errstr; |
212 |
$sth->execute($pLogs) or die $dbh->errstr; |
| 212 |
print "Done with purging action_logs.\n" if $verbose; |
213 |
print "Done with purging action_logs.\n" if $verbose; |
| 213 |
} |
214 |
} |
| 214 |
|
215 |
|
| 215 |
if($pSearchhistory) { |
216 |
if ($pSearchhistory) { |
| 216 |
print "Purging records older than $pSearchhistory from search_history.\n" if $verbose; |
217 |
print "Purging records older than $pSearchhistory from search_history.\n" if $verbose; |
| 217 |
PurgeSearchHistory($pSearchhistory); |
218 |
PurgeSearchHistory($pSearchhistory); |
| 218 |
print "Done with purging search_history.\n" if $verbose; |
219 |
print "Done with purging search_history.\n" if $verbose; |
|
Lines 220-235
if($pSearchhistory) {
Link Here
|
| 220 |
|
221 |
|
| 221 |
if ($pListShareInvites) { |
222 |
if ($pListShareInvites) { |
| 222 |
print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose; |
223 |
print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose; |
| 223 |
$sth = $dbh->prepare(" |
224 |
$sth = $dbh->prepare( |
| 224 |
DELETE FROM virtualshelfshares |
225 |
q{ |
| 225 |
WHERE invitekey IS NOT NULL |
226 |
DELETE FROM virtualshelfshares |
| 226 |
AND (sharedate + INTERVAL ? DAY) < NOW() |
227 |
WHERE invitekey IS NOT NULL |
| 227 |
"); |
228 |
AND (sharedate + INTERVAL ? DAY) < NOW() |
|
|
229 |
} |
| 230 |
); |
| 228 |
$sth->execute($pListShareInvites); |
231 |
$sth->execute($pListShareInvites); |
| 229 |
print "Done with purging unaccepted list share invites.\n" if $verbose; |
232 |
print "Done with purging unaccepted list share invites.\n" if $verbose; |
| 230 |
} |
233 |
} |
| 231 |
|
234 |
|
| 232 |
if($pDebarments) { |
235 |
if ($pDebarments) { |
| 233 |
print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose; |
236 |
print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose; |
| 234 |
$count = PurgeDebarments(); |
237 |
$count = PurgeDebarments(); |
| 235 |
print "$count restrictions were deleted.\nDone with restrictions purge.\n" if $verbose; |
238 |
print "$count restrictions were deleted.\nDone with restrictions purge.\n" if $verbose; |
|
Lines 241-257
sub RemoveOldSessions {
Link Here
|
| 241 |
my ( $id, $a_session, $limit, $lasttime ); |
244 |
my ( $id, $a_session, $limit, $lasttime ); |
| 242 |
$limit = time() - 24 * 3600 * $sess_days; |
245 |
$limit = time() - 24 * 3600 * $sess_days; |
| 243 |
|
246 |
|
| 244 |
$sth = $dbh->prepare("SELECT id, a_session FROM sessions"); |
247 |
$sth = $dbh->prepare(q{ SELECT id, a_session FROM sessions }); |
| 245 |
$sth->execute or die $dbh->errstr; |
248 |
$sth->execute or die $dbh->errstr; |
| 246 |
$sth->bind_columns( \$id, \$a_session ); |
249 |
$sth->bind_columns( \$id, \$a_session ); |
| 247 |
$sth2 = $dbh->prepare("DELETE FROM sessions WHERE id=?"); |
250 |
$sth2 = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? }); |
| 248 |
$count = 0; |
251 |
$count = 0; |
| 249 |
|
252 |
|
| 250 |
while ( $sth->fetch ) { |
253 |
while ( $sth->fetch ) { |
| 251 |
$lasttime = 0; |
254 |
$lasttime = 0; |
| 252 |
if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) { |
255 |
if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) { |
| 253 |
$lasttime = $1; |
256 |
$lasttime = $1; |
| 254 |
} elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) { |
257 |
} |
|
|
258 |
elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) { |
| 255 |
$lasttime = $2; |
259 |
$lasttime = $2; |
| 256 |
} |
260 |
} |
| 257 |
if ( $lasttime && $lasttime < $limit ) { |
261 |
if ( $lasttime && $lasttime < $limit ) { |
|
Lines 265-273
sub RemoveOldSessions {
Link Here
|
| 265 |
} |
269 |
} |
| 266 |
|
270 |
|
| 267 |
sub PurgeImportTables { |
271 |
sub PurgeImportTables { |
|
|
272 |
|
| 268 |
#First purge import_records |
273 |
#First purge import_records |
| 269 |
#Delete cascades to import_biblios, import_items and import_record_matches |
274 |
#Delete cascades to import_biblios, import_items and import_record_matches |
| 270 |
$sth = $dbh->prepare("DELETE FROM import_records WHERE upload_timestamp < date_sub(curdate(), interval ? DAY)"); |
275 |
$sth = $dbh->prepare( |
|
|
276 |
q{ |
| 277 |
DELETE FROM import_records |
| 278 |
WHERE upload_timestamp < date_sub(curdate(), INTERVAL ? DAY) |
| 279 |
} |
| 280 |
); |
| 271 |
$sth->execute($pImport) or die $dbh->errstr; |
281 |
$sth->execute($pImport) or die $dbh->errstr; |
| 272 |
|
282 |
|
| 273 |
# Now purge import_batches |
283 |
# Now purge import_batches |
|
Lines 275-302
sub PurgeImportTables {
Link Here
|
| 275 |
# continuously to batches without updating timestamp (Z39.50 search). |
285 |
# continuously to batches without updating timestamp (Z39.50 search). |
| 276 |
# So we only delete older empty batches. |
286 |
# So we only delete older empty batches. |
| 277 |
# This delete will therefore not have a cascading effect. |
287 |
# This delete will therefore not have a cascading effect. |
| 278 |
$sth = $dbh->prepare("DELETE ba |
288 |
$sth = $dbh->prepare( |
| 279 |
FROM import_batches ba |
289 |
q{ |
| 280 |
LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id |
290 |
DELETE ba |
| 281 |
WHERE re.import_record_id IS NULL AND |
291 |
FROM import_batches ba |
| 282 |
ba.upload_timestamp < date_sub(curdate(), interval ? DAY)"); |
292 |
LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id |
|
|
293 |
WHERE re.import_record_id IS NULL AND |
| 294 |
ba.upload_timestamp < date_sub(curdate(), INTERVAL ? DAY) |
| 295 |
} |
| 296 |
); |
| 283 |
$sth->execute($pImport) or die $dbh->errstr; |
297 |
$sth->execute($pImport) or die $dbh->errstr; |
| 284 |
} |
298 |
} |
| 285 |
|
299 |
|
| 286 |
|
|
|
| 287 |
sub PurgeZ3950 { |
300 |
sub PurgeZ3950 { |
| 288 |
$sth = $dbh->prepare(q{ |
301 |
$sth = $dbh->prepare( |
| 289 |
DELETE FROM import_batches WHERE batch_type = 'z3950' |
302 |
q{ |
| 290 |
}); |
303 |
DELETE FROM import_batches |
|
|
304 |
WHERE batch_type = 'z3950' |
| 305 |
} |
| 306 |
); |
| 291 |
$sth->execute() or die $dbh->errstr; |
307 |
$sth->execute() or die $dbh->errstr; |
| 292 |
} |
308 |
} |
| 293 |
|
309 |
|
| 294 |
sub PurgeDebarments { |
310 |
sub PurgeDebarments { |
| 295 |
require Koha::Borrower::Debarments; |
311 |
require Koha::Borrower::Debarments; |
| 296 |
$count = 0; |
312 |
$count = 0; |
| 297 |
$sth = $dbh->prepare(q{ |
313 |
$sth = $dbh->prepare( |
| 298 |
SELECT borrower_debarment_id FROM borrower_debarments WHERE expiration < date_sub(curdate(), INTERVAL ? DAY) |
314 |
q{ |
| 299 |
}); |
315 |
SELECT borrower_debarment_id |
|
|
316 |
FROM borrower_debarments |
| 317 |
WHERE expiration < date_sub(curdate(), INTERVAL ? DAY) |
| 318 |
} |
| 319 |
); |
| 300 |
$sth->execute($pDebarments) or die $dbh->errstr; |
320 |
$sth->execute($pDebarments) or die $dbh->errstr; |
| 301 |
while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) { |
321 |
while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) { |
| 302 |
Koha::Borrower::Debarments::DelDebarment($borrower_debarment_id); |
322 |
Koha::Borrower::Debarments::DelDebarment($borrower_debarment_id); |
| 303 |
- |
|
|