Bug 24153: Make sure $count will not be reused for another purpose
[koha.git] / misc / cronjobs / cleanup_database.pl
blob318a225e9676121dfe5da9f514e78f8af837e1c2
1 #!/usr/bin/perl
3 # Copyright 2009 PTFS, Inc.
5 # This file is part of Koha.
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.
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.
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>.
20 use Modern::Perl;
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;
30 BEGIN {
31 # find Koha's Perl modules
32 # test carefully before changing this
33 use FindBin;
34 eval { require "$FindBin::Bin/../kohalib.pl" };
37 use Koha::Script -cron;
38 use C4::Context;
39 use C4::Search;
40 use C4::Search::History;
41 use Getopt::Long;
42 use C4::Log;
43 use C4::Accounts;
44 use Koha::UploadedFiles;
45 use Koha::Old::Biblios;
46 use Koha::Old::Items;
47 use Koha::Old::Biblioitems;
48 use Koha::Old::Checkouts;
49 use Koha::Old::Holds;
50 use Koha::Old::Patrons;
51 use Koha::Item::Transfers;
52 use Koha::PseudonymizedTransactions;
54 sub usage {
55 print STDERR <<USAGE;
56 Usage: $0 [-h|--help] [--confirm] [--sessions] [--sessdays DAYS] [-v|--verbose] [--zebraqueue DAYS] [-m|--mail] [--merged] [--import DAYS] [--logs DAYS] [--searchhistory DAYS] [--restrictions DAYS] [--all-restrictions] [--fees DAYS] [--temp-uploads] [--temp-uploads-days DAYS] [--uploads-missing 0|1 ] [--statistics DAYS] [--deleted-catalog DAYS] [--deleted-patrons DAYS] [--old-issues DAYS] [--old-reserves DAYS] [--transfers DAYS]
58 -h --help prints this help message, and exits, ignoring all
59 other options
60 --confirm Confirmation flag, the script will be running in dry-run mode is not set.
61 --sessions purge the sessions table. If you use this while users
62 are logged into Koha, they will have to reconnect.
63 --sessdays DAYS purge only sessions older than DAYS days.
64 -v --verbose will cause the script to give you a bit more information
65 about the run.
66 --zebraqueue DAYS purge completed zebraqueue entries older than DAYS days.
67 Defaults to 30 days if no days specified.
68 -m --mail DAYS purge items from the mail queue that are older than DAYS days.
69 Defaults to 30 days if no days specified.
70 --merged purged completed entries from need_merge_authorities.
71 --import DAYS purge records from import tables older than DAYS days.
72 Defaults to 60 days if no days specified.
73 --z3950 purge records from import tables that are the result
74 of Z39.50 searches
75 --fees DAYS purge entries accountlines older than DAYS days, where
76 amountoutstanding is 0 or NULL.
77 In the case of --fees, DAYS must be greater than
78 or equal to 1.
79 --logs DAYS purge entries from action_logs older than DAYS days.
80 Defaults to 180 days if no days specified.
81 --searchhistory DAYS purge entries from search_history older than DAYS days.
82 Defaults to 30 days if no days specified
83 --list-invites DAYS purge (unaccepted) list share invites older than DAYS
84 days. Defaults to 14 days if no days specified.
85 --restrictions DAYS purge patrons restrictions expired since more than DAYS days.
86 Defaults to 30 days if no days specified.
87 --all-restrictions purge all expired patrons restrictions.
88 --del-exp-selfreg Delete expired self registration accounts
89 --del-unv-selfreg DAYS Delete unverified self registrations older than DAYS
90 --unique-holidays DAYS Delete all unique holidays older than DAYS
91 --temp-uploads Delete temporary uploads.
92 --temp-uploads-days DAYS Override the corresponding preference value.
93 --uploads-missing FLAG Delete upload records for missing files when FLAG is true, count them otherwise
94 --oauth-tokens Delete expired OAuth2 tokens
95 --statistics DAYS Purge statistics entries more than DAYS days old.
96 This table is used to build reports, make sure you are aware of the consequences of this before using it!
97 --deleted-catalog DAYS Purge catalog records deleted more then DAYS days ago
98 (from tables deleteditems, deletedbiblioitems, deletedbiblio_metadata and deletedbiblio).
99 --deleted-patrons DAYS Purge patrons deleted more than DAYS days ago.
100 --old-issues DAYS Purge checkouts (old_issues) returned more than DAYS days ago.
101 --old-reserves DAYS Purge reserves (old_reserves) more than DAYS old.
102 --transfers DAYS Purge transfers completed more than DAYS day ago.
103 --pseudo-transactions DAYS Purge the pseudonymized transactions that have been originally created more than DAYS days ago
104 DAYS is optional and can be replaced by:
105 --pseudo-transactions-from YYYY-MM-DD and/or --pseudo-transactions-to YYYY-MM-DD
106 USAGE
107 exit $_[0];
110 my $help;
111 my $confirm;
112 my $sessions;
113 my $sess_days;
114 my $verbose;
115 my $zebraqueue_days;
116 my $mail;
117 my $purge_merged;
118 my $pImport;
119 my $pLogs;
120 my $pSearchhistory;
121 my $pZ3950;
122 my $pListShareInvites;
123 my $pDebarments;
124 my $allDebarments;
125 my $pExpSelfReg;
126 my $pUnvSelfReg;
127 my $fees_days;
128 my $special_holidays_days;
129 my $temp_uploads;
130 my $temp_uploads_days;
131 my $uploads_missing;
132 my $oauth_tokens;
133 my $pStatistics;
134 my $pDeletedCatalog;
135 my $pDeletedPatrons;
136 my $pOldIssues;
137 my $pOldReserves;
138 my $pTransfers;
139 my ( $pPseudoTransactions, $pPseudoTransactionsFrom, $pPseudoTransactionsTo );
141 GetOptions(
142 'h|help' => \$help,
143 'confirm' => \$confirm,
144 'sessions' => \$sessions,
145 'sessdays:i' => \$sess_days,
146 'v|verbose' => \$verbose,
147 'm|mail:i' => \$mail,
148 'zebraqueue:i' => \$zebraqueue_days,
149 'merged' => \$purge_merged,
150 'import:i' => \$pImport,
151 'z3950' => \$pZ3950,
152 'logs:i' => \$pLogs,
153 'fees:i' => \$fees_days,
154 'searchhistory:i' => \$pSearchhistory,
155 'list-invites:i' => \$pListShareInvites,
156 'restrictions:i' => \$pDebarments,
157 'all-restrictions' => \$allDebarments,
158 'del-exp-selfreg' => \$pExpSelfReg,
159 'del-unv-selfreg' => \$pUnvSelfReg,
160 'unique-holidays:i' => \$special_holidays_days,
161 'temp-uploads' => \$temp_uploads,
162 'temp-uploads-days:i' => \$temp_uploads_days,
163 'uploads-missing:i' => \$uploads_missing,
164 'oauth-tokens' => \$oauth_tokens,
165 'statistics:i' => \$pStatistics,
166 'deleted-catalog:i' => \$pDeletedCatalog,
167 'deleted-patrons:i' => \$pDeletedPatrons,
168 'old-issues:i' => \$pOldIssues,
169 'old-reserves:i' => \$pOldReserves,
170 'transfers:i' => \$pTransfers,
171 'pseudo-transactions:i' => \$pPseudoTransactions,
172 'pseudo-transactions-from:s' => \$pPseudoTransactionsFrom,
173 'pseudo-transactions-to:s' => \$pPseudoTransactionsTo,
174 ) || usage(1);
176 # Use default values
177 $sessions = 1 if $sess_days && $sess_days > 0;
178 $pImport = DEFAULT_IMPORT_PURGEDAYS if defined($pImport) && $pImport == 0;
179 $pLogs = DEFAULT_LOGS_PURGEDAYS if defined($pLogs) && $pLogs == 0;
180 $zebraqueue_days = DEFAULT_ZEBRAQ_PURGEDAYS if defined($zebraqueue_days) && $zebraqueue_days == 0;
181 $mail = DEFAULT_MAIL_PURGEDAYS if defined($mail) && $mail == 0;
182 $pSearchhistory = DEFAULT_SEARCHHISTORY_PURGEDAYS if defined($pSearchhistory) && $pSearchhistory == 0;
183 $pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0;
184 $pDebarments = DEFAULT_DEBARMENTS_PURGEDAYS if defined($pDebarments) && $pDebarments == 0;
186 if ($help) {
187 usage(0);
190 unless ( $sessions
191 || $zebraqueue_days
192 || $mail
193 || $purge_merged
194 || $pImport
195 || $pLogs
196 || $fees_days
197 || $pSearchhistory
198 || $pZ3950
199 || $pListShareInvites
200 || $pDebarments
201 || $allDebarments
202 || $pExpSelfReg
203 || $pUnvSelfReg
204 || $special_holidays_days
205 || $temp_uploads
206 || defined $uploads_missing
207 || $oauth_tokens
208 || $pStatistics
209 || $pDeletedCatalog
210 || $pDeletedPatrons
211 || $pOldIssues
212 || $pOldReserves
213 || $pTransfers
214 || defined $pPseudoTransactions
215 || $pPseudoTransactionsFrom
216 || $pPseudoTransactionsTo
218 print "You did not specify any cleanup work for the script to do.\n\n";
219 usage(1);
222 if ($pDebarments && $allDebarments) {
223 print "You can not specify both --restrictions and --all-restrictions.\n\n";
224 usage(1);
227 say "Confirm flag not passed, running in dry-run mode..." unless $confirm;
229 cronlogaction() unless $confirm;
231 my $dbh = C4::Context->dbh();
232 my $sth;
233 my $sth2;
235 if ( $sessions && !$sess_days ) {
236 if ($verbose) {
237 say "Session purge triggered.";
238 $sth = $dbh->prepare(q{ SELECT COUNT(*) FROM sessions });
239 $sth->execute() or die $dbh->errstr;
240 my @count_arr = $sth->fetchrow_array;
241 say $confirm ? "$count_arr[0] entries will be deleted." : "$count_arr[0] entries would be deleted.";
243 if ( $confirm ) {
244 $sth = $dbh->prepare(q{ TRUNCATE sessions });
245 $sth->execute() or die $dbh->errstr;
247 if ($verbose) {
248 print "Done with session purge.\n";
251 elsif ( $sessions && $sess_days > 0 ) {
252 print "Session purge triggered with days>$sess_days.\n" if $verbose;
253 RemoveOldSessions() if $confirm;
254 print "Done with session purge with days>$sess_days.\n" if $verbose;
257 if ($zebraqueue_days) {
258 my $count = 0;
259 print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
260 $sth = $dbh->prepare(
262 SELECT id,biblio_auth_number,server,time
263 FROM zebraqueue
264 WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY)
267 if ( $confirm ) {
268 $sth->execute($zebraqueue_days) or die $dbh->errstr;
270 $sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? });
271 while ( my $record = $sth->fetchrow_hashref ) {
272 if ( $confirm ) {
273 $sth2->execute( $record->{id} ) or die $dbh->errstr;
275 $count++;
277 if ( $verbose ) {
278 say $confirm ? "$count records were deleted." : "$count records would have been deleted.";
279 say "Done with zebraqueue purge.";
283 if ($mail) {
284 my $count = 0;
285 print "Mail queue purge triggered for $mail days.\n" if $verbose;
286 $count = 0;
287 $sth = $dbh->prepare(
289 DELETE FROM message_queue
290 WHERE time_queued < date_sub(curdate(), INTERVAL ? DAY)
293 if ( $confirm ) {
294 $sth->execute($mail) or die $dbh->errstr;
295 $count = $sth->rows;
297 if ( $verbose ) {
298 say $confirm ? "$count messages were deleted from the mail queue." : "Message from message_queue would have been deleted";
299 say "Done with message_queue purge.";
303 if ($purge_merged) {
304 print "Purging completed entries from need_merge_authorities.\n" if $verbose;
305 if ( $confirm ) {
306 $sth = $dbh->prepare(q{ DELETE FROM need_merge_authorities WHERE done=1 });
307 $sth->execute() or die $dbh->errstr;
309 print "Done with purging need_merge_authorities.\n" if $verbose;
312 if ($pImport) {
313 print "Purging records from import tables.\n" if $verbose;
314 PurgeImportTables() if $confirm;
315 print "Done with purging import tables.\n" if $verbose;
318 if ($pZ3950) {
319 print "Purging Z39.50 records from import tables.\n" if $verbose;
320 PurgeZ3950() if $confirm;
321 print "Done with purging Z39.50 records from import tables.\n" if $verbose;
324 if ($pLogs) {
325 print "Purging records from action_logs.\n" if $verbose;
326 $sth = $dbh->prepare(
328 DELETE FROM action_logs
329 WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY)
332 if ( $confirm ) {
333 $sth->execute($pLogs) or die $dbh->errstr;
335 print "Done with purging action_logs.\n" if $verbose;
338 if ($fees_days) {
339 print "Purging records from accountlines.\n" if $verbose;
340 purge_zero_balance_fees( $fees_days ) if $confirm;
341 print "Done purging records from accountlines.\n" if $verbose;
344 if ($pSearchhistory) {
345 print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;
346 C4::Search::History::delete({ interval => $pSearchhistory }) if $confirm;
347 print "Done with purging search_history.\n" if $verbose;
350 if ($pListShareInvites) {
351 print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;
352 $sth = $dbh->prepare(
354 DELETE FROM virtualshelfshares
355 WHERE invitekey IS NOT NULL
356 AND (sharedate + INTERVAL ? DAY) < NOW()
359 if ( $confirm ) {
360 $sth->execute($pListShareInvites);
362 print "Done with purging unaccepted list share invites.\n" if $verbose;
365 if ($pDebarments) {
366 print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
367 my $count = PurgeDebarments($pDebarments, $confirm);
368 if ( $verbose ) {
369 say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
370 say "Done with restrictions purge.";
374 if($allDebarments) {
375 print "All expired patrons restrictions purge triggered.\n" if $verbose;
376 my $count = PurgeDebarments(0, $confirm);
377 if ( $verbose ) {
378 say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
379 say "Done with all restrictions purge.";
383 # Handle unsubscribe requests from GDPR consent form, depends on UnsubscribeReflectionDelay preference
384 my $unsubscribed_patrons = Koha::Patrons->search_unsubscribed;
385 my $count = $unsubscribed_patrons->count;
386 $unsubscribed_patrons->lock( { expire => 1, remove => 1 } ) if $confirm;
387 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("%d patrons would have been locked", $count) if $verbose;
389 # Anonymize patron data, depending on PatronAnonymizeDelay
390 my $anonymize_candidates = Koha::Patrons->search_anonymize_candidates( { locked => 1 } );
391 $count = $anonymize_candidates->count;
392 $anonymize_candidates->anonymize if $confirm;
393 say $confirm ? sprintf("Anonymized %d patrons", $count) : sprintf("%d patrons would have been anonymized", $count) if $verbose;
395 # Remove patron data, depending on PatronRemovalDelay (will raise an exception if problem encountered
396 my $anonymized_patrons = Koha::Patrons->search_anonymized;
397 $count = $anonymized_patrons->count;
398 if ( $confirm ) {
399 $anonymized_patrons->delete( { move => 1 } );
400 if ($@) {
401 warn $@;
404 if ($verbose) {
405 say $confirm ? sprintf("Deleted %d patrons", $count) : sprintf("%d patrons would have been deleted", $count);
408 # FIXME The output for dry-run mode needs to be improved
409 # But non trivial changes to C4::Members need to be done before.
410 if( $pExpSelfReg ) {
411 if ( $confirm ) {
412 DeleteExpiredSelfRegs();
413 } elsif ( $verbose ) {
414 say "self-registered borrowers may be deleted";
417 if( $pUnvSelfReg ) {
418 if ( $confirm ) {
419 DeleteUnverifiedSelfRegs( $pUnvSelfReg );
420 } elsif ( $verbose ) {
421 say "unverified self-registrations may be deleted";
425 if ($special_holidays_days) {
426 if ( $confirm ) {
427 DeleteSpecialHolidays( abs($special_holidays_days) );
428 } elsif ( $verbose ) {
429 say "self-registered borrowers may be deleted";
433 if( $temp_uploads ) {
434 # Delete temporary uploads, governed by a pref (unless you override)
435 print "Purging temporary uploads.\n" if $verbose;
436 if ( $confirm ) {
437 Koha::UploadedFiles->delete_temporary({
438 defined($temp_uploads_days)
439 ? ( override_pref => $temp_uploads_days )
440 : ()
443 print "Done purging temporary uploads.\n" if $verbose;
446 if( defined $uploads_missing ) {
447 print "Looking for missing uploads\n" if $verbose;
448 if ( $confirm ) {
449 my $keep = $uploads_missing == 1 ? 0 : 1;
450 my $count = Koha::UploadedFiles->delete_missing({ keep_record => $keep });
451 if( $keep ) {
452 print "Counted $count missing uploaded files\n";
453 } else {
454 print "Removed $count records for missing uploads\n";
456 } else {
457 # FIXME need to create a filter_by_missing method (then call ->delete) instead of delete_missing
458 say "Dry-run mode cannot guess how many uploads would have been deleted";
462 if ($oauth_tokens) {
463 require Koha::OAuthAccessTokens;
465 my $tokens = Koha::OAuthAccessTokens->search({ expires => { '<=', time } });
466 my $count = $tokens->count;
467 $tokens->delete if $confirm;
468 if ( $verbose ) {
469 say $confirm
470 ? sprintf( "Removed %d expired OAuth2 tokens", $count )
471 : sprintf( "%d expired OAuth tokens would have been removed", $count );
475 if ($pStatistics) {
476 print "Purging statistics older than $pStatistics days.\n" if $verbose;
477 my $statistics = Koha::Statistics->filter_by_last_update(
478 { timestamp_column_name => 'datetime', days => $pStatistics } );
479 my $count = $statistics->count;
480 $statistics->delete if $confirm;
481 if ( $verbose ) {
482 say $confirm
483 ? sprintf( "Done with purging %d statistics", $count )
484 : sprintf( "%d statistics would have been removed", $count );
488 if ($pDeletedCatalog) {
489 print "Purging deleted catalog older than $pDeletedCatalog days.\n"
490 if $verbose;
491 my $old_items = Koha::Old::Items->filter_by_last_update( { days => $pDeletedCatalog } );
492 my $old_biblioitems = Koha::Old::Biblioitems->filter_by_last_update( { days => $pDeletedCatalog } );
493 my $old_biblios = Koha::Old::Biblios->filter_by_last_update( { days => $pDeletedCatalog } );
494 my ( $c_i, $c_bi, $c_b ) =
495 ( $old_items->count, $old_biblioitems->count, $old_biblios->count );
496 if ($confirm) {
497 $old_items->delete;
498 $old_biblioitems->delete;
499 $old_biblios->delete;
501 if ($verbose) {
502 say sprintf(
503 $confirm
504 ? "Done with purging deleted catalog (%d items, %d biblioitems, %d biblios)."
505 : "Deleted catalog would have been removed (%d items, %d biblioitems, %d biblios).",
506 $c_i, $c_bi, $c_b);
510 if ($pDeletedPatrons) {
511 print "Purging deleted patrons older than $pDeletedPatrons days.\n" if $verbose;
512 my $old_patrons = Koha::Old::Patrons->filter_by_last_update(
513 { timestamp_column_name => 'updated_on', days => $pDeletedPatrons } );
514 my $count = $old_patrons->count;
515 $old_patrons->delete if $confirm;
516 if ($verbose) {
517 say $confirm
518 ? sprintf "Done with purging %d deleted patrons.", $count
519 : sprintf "%d deleted patrons would have been purged.", $count;
523 if ($pOldIssues) {
524 print "Purging old checkouts older than $pOldIssues days.\n" if $verbose;
525 my $old_checkouts = Koha::Old::Checkouts->filter_by_last_update( { days => $pOldIssues } );
526 my $count = $old_checkouts->count;
527 $old_checkouts->delete if $confirm;
528 if ($verbose) {
529 say $confirm
530 ? sprintf "Done with purging %d old checkouts.", $count
531 : sprintf "%d old checkouts would have been purged.", $count;
535 if ($pOldReserves) {
536 print "Purging old reserves older than $pOldReserves days.\n" if $verbose;
537 my $old_reserves = Koha::Old::Holds->filter_by_last_update( { days => $pOldReserves } );
538 my $count = $old_reserves->count;
539 $old_reserves->delete if $verbose;
540 if ($verbose) {
541 say $confirm
542 ? sprintf "Done with purging %d old reserves.", $count
543 : sprintf "%d old reserves would have been purged.", $count;
547 if ($pTransfers) {
548 print "Purging arrived item transfers older than $pTransfers days.\n" if $verbose;
549 my $transfers = Koha::Item::Transfers->filter_by_last_update(
551 timestamp_column_name => 'datearrived',
552 days => $pTransfers,
555 my $count = $transfers->count;
556 $transfers->delete if $verbose;
557 if ($verbose) {
558 say $confirm
559 ? sprintf "Done with purging %d transfers.", $count
560 : sprintf "%d transfers would have been purged.", $count;
564 if (defined $pPseudoTransactions or $pPseudoTransactionsFrom or $pPseudoTransactionsTo ) {
565 print "Purging pseudonymized transactions\n" if $verbose;
566 my $anonymized_transactions = Koha::PseudonymizedTransactions->filter_by_last_update(
568 timestamp_column_name => 'datetime',
569 ( defined $pPseudoTransactions ? ( days => $pPseudoTransactions ) : () ),
570 ( $pPseudoTransactionsFrom ? ( from => $pPseudoTransactionsFrom ) : () ),
571 ( $pPseudoTransactionsTo ? ( to => $pPseudoTransactionsTo ) : () ),
574 my $count = $anonymized_transactions->count;
575 $anonymized_transactions->delete if $confirm;
576 if ($verbose) {
577 say $confirm
578 ? sprintf "Done with purging %d pseudonymized transactions.", $count
579 : sprintf "%d pseudonymized transactions would have been purged.", $count;
583 exit(0);
585 sub RemoveOldSessions {
586 my ( $id, $a_session, $limit, $lasttime );
587 $limit = time() - 24 * 3600 * $sess_days;
589 $sth = $dbh->prepare(q{ SELECT id, a_session FROM sessions });
590 $sth->execute or die $dbh->errstr;
591 $sth->bind_columns( \$id, \$a_session );
592 $sth2 = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? });
593 my $count = 0;
595 while ( $sth->fetch ) {
596 $lasttime = 0;
597 if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
598 $lasttime = $1;
600 elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
601 $lasttime = $2;
603 if ( $lasttime && $lasttime < $limit ) {
604 $sth2->execute($id) or die $dbh->errstr;
605 $count++;
608 if ($verbose) {
609 print "$count sessions were deleted.\n";
613 sub PurgeImportTables {
615 #First purge import_records
616 #Delete cascades to import_biblios, import_items and import_record_matches
617 $sth = $dbh->prepare(
619 DELETE FROM import_records
620 WHERE upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
623 $sth->execute($pImport) or die $dbh->errstr;
625 # Now purge import_batches
626 # Timestamp cannot be used here without care, because records are added
627 # continuously to batches without updating timestamp (Z39.50 search).
628 # So we only delete older empty batches.
629 # This delete will therefore not have a cascading effect.
630 $sth = $dbh->prepare(
632 DELETE ba
633 FROM import_batches ba
634 LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
635 WHERE re.import_record_id IS NULL AND
636 ba.upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
639 $sth->execute($pImport) or die $dbh->errstr;
642 sub PurgeZ3950 {
643 $sth = $dbh->prepare(
645 DELETE FROM import_batches
646 WHERE batch_type = 'z3950'
649 $sth->execute() or die $dbh->errstr;
652 sub PurgeDebarments {
653 require Koha::Patron::Debarments;
654 my ( $days, $doit ) = @_;
655 my $count = 0;
656 $sth = $dbh->prepare(
658 SELECT borrower_debarment_id
659 FROM borrower_debarments
660 WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
663 $sth->execute($days) or die $dbh->errstr;
664 while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
665 Koha::Patron::Debarments::DelDebarment($borrower_debarment_id) if $doit;
666 $count++;
668 return $count;
671 sub DeleteExpiredSelfRegs {
672 my $cnt= C4::Members::DeleteExpiredOpacRegistrations();
673 print "Removed $cnt expired self-registered borrowers\n" if $verbose;
676 sub DeleteUnverifiedSelfRegs {
677 my $cnt= C4::Members::DeleteUnverifiedOpacRegistrations( $_[0] );
678 print "Removed $cnt unverified self-registrations\n" if $verbose;
681 sub DeleteSpecialHolidays {
682 my ( $days ) = @_;
684 my $sth = $dbh->prepare(q{
685 DELETE FROM special_holidays
686 WHERE DATE( CONCAT( year, '-', month, '-', day ) ) < DATE_SUB( CAST(NOW() AS DATE), INTERVAL ? DAY );
688 my $count = $sth->execute( $days ) + 0;
689 print "Removed $count unique holidays\n" if $verbose;