Bug 17350: Add note about how the saved reports data is created in first place
[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
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_MESSAGES_PURGEDAYS           => 365;
27 use constant DEFAULT_SEARCHHISTORY_PURGEDAYS      => 30;
28 use constant DEFAULT_SHARE_INVITATION_EXPIRY_DAYS => 14;
29 use constant DEFAULT_DEBARMENTS_PURGEDAYS         => 30;
30 use constant DEFAULT_JOBS_PURGEDAYS               => 1;
31 use constant DEFAULT_JOBS_PURGETYPES              => qw{ update_elastic_index };
32
33 use Koha::Script -cron;
34 use C4::Context;
35 use C4::Search;
36 use C4::Search::History;
37 use Getopt::Long qw( GetOptions );
38 use C4::Log qw( cronlogaction );
39 use C4::Accounts qw( purge_zero_balance_fees );
40 use Koha::UploadedFiles;
41 use Koha::BackgroundJobs;
42 use Koha::Old::Biblios;
43 use Koha::Old::Items;
44 use Koha::Old::Biblioitems;
45 use Koha::Old::Checkouts;
46 use Koha::Old::Holds;
47 use Koha::Old::Patrons;
48 use Koha::Item::Transfers;
49 use Koha::PseudonymizedTransactions;
50 use Koha::Patron::Messages;
51 use Koha::Patron::Debarments qw( DelDebarment );
52
53 sub usage {
54     print STDERR <<USAGE;
55 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] [--labels DAYS] [--cards DAYS] [--bg-days DAYS [--bg-type TYPE] ]
56
57    -h --help          prints this help message, and exits, ignoring all
58                       other options
59    --confirm          Confirmation flag, the script will be running in dry-run mode is not set.
60    --sessions         purge the sessions table.  If you use this while users 
61                       are logged into Koha, they will have to reconnect.
62    --sessdays DAYS    purge only sessions older than DAYS days.
63    -v --verbose       will cause the script to give you a bit more information
64                       about the run.
65    --zebraqueue DAYS  purge completed zebraqueue entries older than DAYS days.
66                       Defaults to 30 days if no days specified.
67    -m --mail DAYS     purge items from the mail queue that are older than DAYS days.
68                       Defaults to 30 days if no days specified.
69    --merged           purged completed entries from need_merge_authorities.
70    --messages DAYS    purge entries from messages table older than DAYS days.
71                       Defaults to 365 days if no days specified.
72    --import DAYS      purge records from import tables older than DAYS days.
73                       Defaults to 60 days if no days specified.
74    --z3950            purge records from import tables that are the result
75                       of Z39.50 searches
76    --fees DAYS        purge entries accountlines older than DAYS days, where
77                       amountoutstanding is 0 or NULL.
78                       In the case of --fees, DAYS must be greater than
79                       or equal to 1.
80    --log-modules      Specify which action log modules to trim. Repeatable.
81    --preserve-log     Specify which action logs to exclude. Repeatable.
82    --logs DAYS        purge entries from action_logs older than DAYS days.
83                       Defaults to 180 days if no days specified.
84    --searchhistory DAYS  purge entries from search_history older than DAYS days.
85                          Defaults to 30 days if no days specified
86    --list-invites  DAYS  purge (unaccepted) list share invites older than DAYS
87                          days.  Defaults to 14 days if no days specified.
88    --restrictions DAYS   purge patrons restrictions expired since more than DAYS days.
89                          Defaults to 30 days if no days specified.
90    --all-restrictions   purge all expired patrons restrictions.
91    --del-exp-selfreg  Delete expired self registration accounts
92    --del-unv-selfreg  DAYS  Delete unverified self registrations older than DAYS
93    --unique-holidays DAYS  Delete all unique holidays older than DAYS
94    --temp-uploads     Delete temporary uploads.
95    --temp-uploads-days DAYS Override the corresponding preference value.
96    --uploads-missing FLAG Delete upload records for missing files when FLAG is true, count them otherwise
97    --oauth-tokens     Delete expired OAuth2 tokens
98    --statistics DAYS       Purge statistics entries more than DAYS days old.
99                            This table is used to build reports, make sure you are aware of the consequences of this before using it!
100    --deleted-catalog  DAYS Purge catalog records deleted more then DAYS days ago
101                            (from tables deleteditems, deletedbiblioitems, deletedbiblio_metadata and deletedbiblio).
102    --deleted-patrons DAYS  Purge patrons deleted more than DAYS days ago.
103    --old-issues DAYS       Purge checkouts (old_issues) returned more than DAYS days ago.
104    --old-reserves DAYS     Purge reserves (old_reserves) more than DAYS old.
105    --transfers DAYS        Purge transfers completed more than DAYS day ago.
106    --pseudo-transactions DAYS   Purge the pseudonymized transactions that have been originally created more than DAYS days ago
107                                 DAYS is optional and can be replaced by:
108                                     --pseudo-transactions-from YYYY-MM-DD and/or --pseudo-transactions-to YYYY-MM-DD
109    --labels DAYS           Purge item label batches last added to more than DAYS days ago.
110    --cards DAY             Purge card creator batches last added to more than DAYS days ago.
111    --return-claims         Purge all resolved return claims older than the number of days specified in
112                            the system preference CleanUpDatabaseReturnClaims.
113    --jobs-days DAYS        Purge all finished background jobs this many days old. Defaults to 1 if no DAYS provided.
114    --jobs-type TYPES       What type of background job to purge. Defaults to "update_elastic_index" if omitted
115                            Specifying "all" will purge all types. Repeatable.
116    --reports DAYS          Purge reports data saved more than DAYS days ago. The data is created by running runreport.pl with the --store-results option.
117 USAGE
118     exit $_[0];
119 }
120
121 my $help;
122 my $confirm;
123 my $sessions;
124 my $sess_days;
125 my $verbose;
126 my $zebraqueue_days;
127 my $mail;
128 my $purge_merged;
129 my $pImport;
130 my $pLogs;
131 my $pSearchhistory;
132 my $pZ3950;
133 my $pListShareInvites;
134 my $pDebarments;
135 my $allDebarments;
136 my $return_claims;
137 my $pExpSelfReg;
138 my $pUnvSelfReg;
139 my $fees_days;
140 my $special_holidays_days;
141 my $temp_uploads;
142 my $temp_uploads_days;
143 my $uploads_missing;
144 my $oauth_tokens;
145 my $pStatistics;
146 my $pDeletedCatalog;
147 my $pDeletedPatrons;
148 my $pOldIssues;
149 my $pOldReserves;
150 my $pTransfers;
151 my ( $pPseudoTransactions, $pPseudoTransactionsFrom, $pPseudoTransactionsTo );
152 my $pMessages;
153 my $lock_days = C4::Context->preference('LockExpiredDelay');
154 my $labels;
155 my $cards;
156 my @log_modules;
157 my @preserve_logs;
158 my $jobs_days;
159 my @jobs_types;
160 my $reports;
161
162 my $command_line_options = join(" ",@ARGV);
163
164 GetOptions(
165     'h|help'            => \$help,
166     'confirm'           => \$confirm,
167     'sessions'          => \$sessions,
168     'sessdays:i'        => \$sess_days,
169     'v|verbose'         => \$verbose,
170     'm|mail:i'          => \$mail,
171     'zebraqueue:i'      => \$zebraqueue_days,
172     'merged'            => \$purge_merged,
173     'import:i'          => \$pImport,
174     'z3950'             => \$pZ3950,
175     'logs:i'            => \$pLogs,
176     'log-module:s'      => \@log_modules,
177     'preserve-log:s'    => \@preserve_logs,
178     'messages:i'        => \$pMessages,
179     'fees:i'            => \$fees_days,
180     'searchhistory:i'   => \$pSearchhistory,
181     'list-invites:i'    => \$pListShareInvites,
182     'restrictions:i'    => \$pDebarments,
183     'all-restrictions'  => \$allDebarments,
184     'del-exp-selfreg'   => \$pExpSelfReg,
185     'del-unv-selfreg:i' => \$pUnvSelfReg,
186     'unique-holidays:i' => \$special_holidays_days,
187     'temp-uploads'      => \$temp_uploads,
188     'temp-uploads-days:i' => \$temp_uploads_days,
189     'uploads-missing:i' => \$uploads_missing,
190     'oauth-tokens'      => \$oauth_tokens,
191     'statistics:i'      => \$pStatistics,
192     'deleted-catalog:i' => \$pDeletedCatalog,
193     'deleted-patrons:i' => \$pDeletedPatrons,
194     'old-issues:i'      => \$pOldIssues,
195     'old-reserves:i'    => \$pOldReserves,
196     'transfers:i'       => \$pTransfers,
197     'pseudo-transactions:i'      => \$pPseudoTransactions,
198     'pseudo-transactions-from:s' => \$pPseudoTransactionsFrom,
199     'pseudo-transactions-to:s'   => \$pPseudoTransactionsTo,
200     'labels'            => \$labels,
201     'cards'             => \$cards,
202     'return-claims'     => \$return_claims,
203     'jobs-type:s'       => \@jobs_types,
204     'jobs-days:i'       => \$jobs_days,
205     'reports:i'           => \$reports,
206 ) || usage(1);
207
208 # Use default values
209 $sessions          = 1                                    if $sess_days                  && $sess_days > 0;
210 $pImport           = DEFAULT_IMPORT_PURGEDAYS             if defined($pImport)           && $pImport == 0;
211 $pLogs             = DEFAULT_LOGS_PURGEDAYS               if defined($pLogs)             && $pLogs == 0;
212 $zebraqueue_days   = DEFAULT_ZEBRAQ_PURGEDAYS             if defined($zebraqueue_days)   && $zebraqueue_days == 0;
213 $mail              = DEFAULT_MAIL_PURGEDAYS               if defined($mail)              && $mail == 0;
214 $pSearchhistory    = DEFAULT_SEARCHHISTORY_PURGEDAYS      if defined($pSearchhistory)    && $pSearchhistory == 0;
215 $pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0;
216 $pDebarments       = DEFAULT_DEBARMENTS_PURGEDAYS         if defined($pDebarments)       && $pDebarments == 0;
217 $pMessages         = DEFAULT_MESSAGES_PURGEDAYS           if defined($pMessages)         && $pMessages == 0;
218 $jobs_days         = DEFAULT_JOBS_PURGEDAYS               if defined($jobs_days)         && $jobs_days == 0;
219 @jobs_types        = (DEFAULT_JOBS_PURGETYPES)            if $jobs_days                  && @jobs_types == 0;
220
221 if ($help) {
222     usage(0);
223 }
224
225 unless ( $sessions
226     || $zebraqueue_days
227     || $mail
228     || $purge_merged
229     || $pImport
230     || $pLogs
231     || $fees_days
232     || $pSearchhistory
233     || $pZ3950
234     || $pListShareInvites
235     || $pDebarments
236     || $allDebarments
237     || $pExpSelfReg
238     || $pUnvSelfReg
239     || $special_holidays_days
240     || $temp_uploads
241     || defined $uploads_missing
242     || $oauth_tokens
243     || $pStatistics
244     || $pDeletedCatalog
245     || $pDeletedPatrons
246     || $pOldIssues
247     || $pOldReserves
248     || $pTransfers
249     || defined $pPseudoTransactions
250     || $pPseudoTransactionsFrom
251     || $pPseudoTransactionsTo
252     || $pMessages
253     || defined $lock_days && $lock_days ne q{}
254     || $labels
255     || $cards
256     || $return_claims
257     || $jobs_days
258     || $reports
259 ) {
260     print "You did not specify any cleanup work for the script to do.\n\n";
261     usage(1);
262 }
263
264 if ($pDebarments && $allDebarments) {
265     print "You can not specify both --restrictions and --all-restrictions.\n\n";
266     usage(1);
267 }
268
269 say "Confirm flag not passed, running in dry-run mode..." unless $confirm;
270
271 cronlogaction({ info => $command_line_options });
272
273 my $dbh = C4::Context->dbh();
274 my $sth;
275 my $sth2;
276
277 if ( $sessions && !$sess_days ) {
278     if ($verbose) {
279         say "Session purge triggered.";
280         $sth = $dbh->prepare(q{ SELECT COUNT(*) FROM sessions });
281         $sth->execute() or die $dbh->errstr;
282         my @count_arr = $sth->fetchrow_array;
283         say $confirm ? "$count_arr[0] entries will be deleted." : "$count_arr[0] entries would be deleted.";
284     }
285     if ( $confirm ) {
286         $sth = $dbh->prepare(q{ TRUNCATE sessions });
287         $sth->execute() or die $dbh->errstr;
288     }
289     if ($verbose) {
290         print "Done with session purge.\n";
291     }
292 }
293 elsif ( $sessions && $sess_days > 0 ) {
294     print "Session purge triggered with days>$sess_days.\n" if $verbose;
295     RemoveOldSessions() if $confirm;
296     print "Done with session purge with days>$sess_days.\n" if $verbose;
297 }
298
299 if ($zebraqueue_days) {
300     my $count = 0;
301     print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
302     $sth = $dbh->prepare(
303         q{
304             SELECT id,biblio_auth_number,server,time
305             FROM zebraqueue
306             WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY)
307         }
308     );
309     $sth->execute($zebraqueue_days) or die $dbh->errstr;
310     $sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? });
311     while ( my $record = $sth->fetchrow_hashref ) {
312         if ( $confirm ) {
313             $sth2->execute( $record->{id} ) or die $dbh->errstr;
314         }
315         $count++;
316     }
317     if ( $verbose ) {
318         say $confirm ? "$count records were deleted." : "$count records would have been deleted.";
319         say "Done with zebraqueue purge.";
320     }
321 }
322
323 if ($mail) {
324     my $count = 0;
325     print "Mail queue purge triggered for $mail days.\n" if $verbose;
326     $sth = $dbh->prepare(
327         q{
328             DELETE FROM message_queue
329             WHERE time_queued < date_sub(curdate(), INTERVAL ? DAY)
330         }
331     );
332     if ( $confirm ) {
333         $sth->execute($mail) or die $dbh->errstr;
334         $count = $sth->rows;
335     }
336     if ( $verbose ) {
337         say $confirm ? "$count messages were deleted from the mail queue." : "Message from message_queue would have been deleted";
338         say "Done with message_queue purge.";
339     }
340 }
341
342 if ($purge_merged) {
343     print "Purging completed entries from need_merge_authorities.\n" if $verbose;
344     if ( $confirm ) {
345         $sth = $dbh->prepare(q{ DELETE FROM need_merge_authorities WHERE done=1 });
346         $sth->execute() or die $dbh->errstr;
347     }
348     print "Done with purging need_merge_authorities.\n" if $verbose;
349 }
350
351 if ($pImport) {
352     print "Purging records from import tables.\n" if $verbose;
353     PurgeImportTables() if $confirm;
354     print "Done with purging import tables.\n" if $verbose;
355 }
356
357 if ($pZ3950) {
358     print "Purging Z39.50 records from import tables.\n" if $verbose;
359     PurgeZ3950() if $confirm;
360     print "Done with purging Z39.50 records from import tables.\n" if $verbose;
361 }
362
363 if ($pLogs) {
364     print "Purging records from action_logs.\n" if $verbose;
365     my $log_query = q{
366             DELETE FROM action_logs
367             WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY)
368     };
369     my @query_params = ();
370     if( @preserve_logs ){
371         $log_query .= " AND module NOT IN (" . join(',',('?') x @preserve_logs ) . ")";
372         push @query_params, @preserve_logs;
373     }
374     if( @log_modules ){
375         $log_query .= " AND module IN (" . join(',',('?') x @log_modules ) . ")";
376         push @query_params, @log_modules;
377     }
378     $sth = $dbh->prepare( $log_query );
379     if ( $confirm ) {
380         $sth->execute($pLogs, @query_params) or die $dbh->errstr;
381     }
382     print "Done with purging action_logs.\n" if $verbose;
383 }
384
385 if ($pMessages) {
386     print "Purging messages older than $pMessages days.\n" if $verbose;
387     my $messages = Koha::Patron::Messages->filter_by_last_update(
388         { timestamp_column_name => 'message_date', days => $pMessages } );
389     my $count = $messages->count;
390     $messages->delete if $confirm;
391     if ( $verbose ) {
392         say $confirm
393           ? sprintf( "Done with purging %d messages", $count )
394           : sprintf( "%d messages would have been removed", $count );
395     }
396 }
397
398 if ($fees_days) {
399     print "Purging records from accountlines.\n" if $verbose;
400     purge_zero_balance_fees( $fees_days ) if $confirm;
401     print "Done purging records from accountlines.\n" if $verbose;
402 }
403
404 if ($pSearchhistory) {
405     print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;
406     C4::Search::History::delete({ interval => $pSearchhistory }) if $confirm;
407     print "Done with purging search_history.\n" if $verbose;
408 }
409
410 if ($pListShareInvites) {
411     print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;
412     $sth = $dbh->prepare(
413         q{
414             DELETE FROM virtualshelfshares
415             WHERE invitekey IS NOT NULL
416             AND (sharedate + INTERVAL ? DAY) < NOW()
417         }
418     );
419     if ( $confirm ) {
420         $sth->execute($pListShareInvites);
421     }
422     print "Done with purging unaccepted list share invites.\n" if $verbose;
423 }
424
425 if ($pDebarments) {
426     print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
427     my $count = PurgeDebarments($pDebarments, $confirm);
428     if ( $verbose ) {
429         say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
430         say "Done with restrictions purge.";
431     }
432 }
433
434 if($allDebarments) {
435     print "All expired patrons restrictions purge triggered.\n" if $verbose;
436     my $count = PurgeDebarments(0, $confirm);
437     if ( $verbose ) {
438         say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
439         say "Done with all restrictions purge.";
440     }
441 }
442
443 # Lock expired patrons?
444 if( defined $lock_days && $lock_days ne q{} ) {
445     say "Start locking expired patrons" if $verbose;
446     my $expired_patrons = Koha::Patrons->filter_by_expiration_date({ days => $lock_days })->search({ login_attempts => { '!=' => -1 } });
447     my $count = $expired_patrons->count;
448     $expired_patrons->lock({ remove => 1 }) if $confirm;
449     if( $verbose ) {
450         say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("Found %d patrons", $count);
451     }
452 }
453
454 # Handle unsubscribe requests from GDPR consent form, depends on UnsubscribeReflectionDelay preference
455 say "Start lock unsubscribed, anonymize and delete" if $verbose;
456 my $unsubscribed_patrons = Koha::Patrons->search_unsubscribed;
457 my $count = $unsubscribed_patrons->count;
458 $unsubscribed_patrons->lock( { expire => 1, remove => 1 } ) if $confirm;
459 say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("%d patrons would have been locked", $count) if $verbose;
460
461 # Anonymize patron data, depending on PatronAnonymizeDelay
462 my $anonymize_candidates = Koha::Patrons->search_anonymize_candidates( { locked => 1 } );
463 $count = $anonymize_candidates->count;
464 $anonymize_candidates->anonymize if $confirm;
465 say $confirm ? sprintf("Anonymized %d patrons", $count) : sprintf("%d patrons would have been anonymized", $count) if $verbose;
466
467 # Remove patron data, depending on PatronRemovalDelay (will raise an exception if problem encountered
468 my $anonymized_patrons = Koha::Patrons->search_anonymized;
469 $count = $anonymized_patrons->count;
470 if ( $confirm ) {
471     $anonymized_patrons->delete( { move => 1 } );
472     if ($@) {
473         warn $@;
474     }
475 }
476 if ($verbose) {
477     say $confirm ? sprintf("Deleted %d patrons", $count) : sprintf("%d patrons would have been deleted", $count);
478 }
479
480 # FIXME The output for dry-run mode needs to be improved
481 # But non trivial changes to C4::Members need to be done before.
482 if( $pExpSelfReg ) {
483     if ( $confirm ) {
484         DeleteExpiredSelfRegs();
485     } elsif ( $verbose ) {
486         say "self-registered borrowers may be deleted";
487     }
488 }
489 if( $pUnvSelfReg ) {
490     if ( $confirm ) {
491         DeleteUnverifiedSelfRegs( $pUnvSelfReg );
492     } elsif ( $verbose ) {
493         say "unverified self-registrations may be deleted";
494     }
495 }
496
497 if ($special_holidays_days) {
498     if ( $confirm ) {
499         DeleteSpecialHolidays( abs($special_holidays_days) );
500     } elsif ( $verbose ) {
501         say "self-registered borrowers may be deleted";
502     }
503 }
504
505 if( $temp_uploads ) {
506     # Delete temporary uploads, governed by a pref (unless you override)
507     print "Purging temporary uploads.\n" if $verbose;
508     if ( $confirm ) {
509         Koha::UploadedFiles->delete_temporary({
510             defined($temp_uploads_days)
511                 ? ( override_pref => $temp_uploads_days )
512                 : ()
513         });
514     }
515     print "Done purging temporary uploads.\n" if $verbose;
516 }
517
518 if( defined $uploads_missing ) {
519     print "Looking for missing uploads\n" if $verbose;
520     if ( $confirm ) {
521         my $keep = $uploads_missing == 1 ? 0 : 1;
522         my $count = Koha::UploadedFiles->delete_missing({ keep_record => $keep });
523         if( $keep ) {
524             print "Counted $count missing uploaded files\n";
525         } else {
526             print "Removed $count records for missing uploads\n";
527         }
528     } else {
529         # FIXME need to create a filter_by_missing method (then call ->delete) instead of delete_missing
530         say "Dry-run mode cannot guess how many uploads would have been deleted";
531     }
532 }
533
534 if ($oauth_tokens) {
535     require Koha::OAuthAccessTokens;
536
537     my $tokens = Koha::OAuthAccessTokens->search({ expires => { '<=', time } });
538     my $count = $tokens->count;
539     $tokens->delete if $confirm;
540     if ( $verbose ) {
541         say $confirm
542           ? sprintf( "Removed %d expired OAuth2 tokens", $count )
543           : sprintf( "%d expired OAuth tokens would have been removed", $count );
544     }
545 }
546
547 if ($pStatistics) {
548     print "Purging statistics older than $pStatistics days.\n" if $verbose;
549     my $statistics = Koha::Statistics->filter_by_last_update(
550         { timestamp_column_name => 'datetime', days => $pStatistics } );
551     my $count = $statistics->count;
552     $statistics->delete if $confirm;
553     if ( $verbose ) {
554         say $confirm
555           ? sprintf( "Done with purging %d statistics", $count )
556           : sprintf( "%d statistics would have been removed", $count );
557     }
558 }
559
560 if( $return_claims && ( my $days = C4::Context->preference('CleanUpDatabaseReturnClaims') )) {
561     print "Purging return claims older than $days days.\n" if $verbose;
562
563     $return_claims = Koha::Checkouts::ReturnClaims->filter_by_last_update(
564         {
565             timestamp_column_name => 'resolved_on',
566             days => $days,
567         }
568     );
569
570     my $count = $return_claims->count;
571     $return_claims->delete if $confirm;
572
573     if ($verbose) {
574         say $confirm
575             ? sprintf "Done with purging %d resolved return claims.", $count
576             : sprintf "%d resolved return claims would have been purged.", $count;
577     }
578 }
579
580 if ($pDeletedCatalog) {
581     print "Purging deleted catalog older than $pDeletedCatalog days.\n"
582       if $verbose;
583     my $old_items = Koha::Old::Items->filter_by_last_update( { days => $pDeletedCatalog } );
584     my $old_biblioitems = Koha::Old::Biblioitems->filter_by_last_update( { days => $pDeletedCatalog } );
585     my $old_biblios = Koha::Old::Biblios->filter_by_last_update( { days => $pDeletedCatalog } );
586     my ( $c_i, $c_bi, $c_b ) =
587       ( $old_items->count, $old_biblioitems->count, $old_biblios->count );
588     if ($confirm) {
589         $old_items->delete;
590         $old_biblioitems->delete;
591         $old_biblios->delete;
592     }
593     if ($verbose) {
594         say sprintf(
595             $confirm
596             ? "Done with purging deleted catalog (%d items, %d biblioitems, %d biblios)."
597             : "Deleted catalog would have been removed (%d items, %d biblioitems, %d biblios).",
598         $c_i, $c_bi, $c_b);
599     }
600 }
601
602 if ($pDeletedPatrons) {
603     print "Purging deleted patrons older than $pDeletedPatrons days.\n" if $verbose;
604     my $old_patrons = Koha::Old::Patrons->filter_by_last_update(
605         { timestamp_column_name => 'updated_on', days => $pDeletedPatrons } );
606     my $count = $old_patrons->count;
607     $old_patrons->delete if $confirm;
608     if ($verbose) {
609         say $confirm
610           ? sprintf "Done with purging %d deleted patrons.", $count
611           : sprintf "%d deleted patrons would have been purged.", $count;
612     }
613 }
614
615 if ($pOldIssues) {
616     print "Purging old checkouts older than $pOldIssues days.\n" if $verbose;
617     my $old_checkouts = Koha::Old::Checkouts->filter_by_last_update( { days => $pOldIssues } );
618     my $count = $old_checkouts->count;
619     $old_checkouts->delete if $confirm;
620     if ($verbose) {
621         say $confirm
622           ? sprintf "Done with purging %d old checkouts.", $count
623           : sprintf "%d old checkouts would have been purged.", $count;
624     }
625 }
626
627 if ($pOldReserves) {
628     print "Purging old reserves older than $pOldReserves days.\n" if $verbose;
629     my $old_reserves = Koha::Old::Holds->filter_by_last_update( { days => $pOldReserves } );
630     my $count = $old_reserves->count;
631     $old_reserves->delete if $confirm;
632     if ($verbose) {
633         say $confirm
634           ? sprintf "Done with purging %d old reserves.", $count
635           : sprintf "%d old reserves would have been purged.", $count;
636     }
637 }
638
639 if ($pTransfers) {
640     print "Purging arrived item transfers older than $pTransfers days.\n" if $verbose;
641     my $transfers = Koha::Item::Transfers->filter_by_last_update(
642         {
643             timestamp_column_name => 'datearrived',
644             days => $pTransfers,
645         }
646     );
647     my $count = $transfers->count;
648     $transfers->delete if $confirm;
649     if ($verbose) {
650         say $confirm
651           ? sprintf "Done with purging %d transfers.", $count
652           : sprintf "%d transfers would have been purged.", $count;
653     }
654 }
655
656 if (defined $pPseudoTransactions or $pPseudoTransactionsFrom or $pPseudoTransactionsTo ) {
657     print "Purging pseudonymized transactions\n" if $verbose;
658     my $anonymized_transactions = Koha::PseudonymizedTransactions->filter_by_last_update(
659         {
660             timestamp_column_name => 'datetime',
661             ( defined $pPseudoTransactions  ? ( days => $pPseudoTransactions     ) : () ),
662             ( $pPseudoTransactionsFrom      ? ( from => $pPseudoTransactionsFrom ) : () ),
663             ( $pPseudoTransactionsTo        ? ( to   => $pPseudoTransactionsTo   ) : () ),
664         }
665     );
666     my $count = $anonymized_transactions->count;
667     $anonymized_transactions->delete if $confirm;
668     if ($verbose) {
669         say $confirm
670           ? sprintf "Done with purging %d pseudonymized transactions.", $count
671           : sprintf "%d pseudonymized transactions would have been purged.", $count;
672     }
673 }
674
675 if ($labels) {
676     print "Purging item label batches last added to more than $labels days ago.\n" if $verbose;
677     my $count = PurgeCreatorBatches($labels, 'labels', $confirm);
678     if ($verbose) {
679         say $confirm
680           ? sprintf "Done with purging %d item label batches last added to more than %d days ago.\n", $count, $labels
681           : sprintf "%d item label batches would have been purged.", $count;
682     }
683 }
684
685 if ($cards) {
686     print "Purging card creator batches last added to more than $cards days ago.\n" if $verbose;
687     my $count = PurgeCreatorBatches($labels, 'patroncards', $confirm);
688     if ($verbose) {
689         say $confirm
690           ? sprintf "Done with purging %d card creator batches last added to more than %d days ago.\n", $count, $labels
691           : sprintf "%d card creator batches would have been purged.", $count;
692     }
693 }
694
695 if ($jobs_days) {
696     print "Purging background jobs more than $jobs_days days ago.\n"
697       if $verbose;
698     my $jobs = Koha::BackgroundJobs->search(
699         {
700             status => 'finished',
701             ( $jobs_types[0] eq 'all' ? () : ( type => \@jobs_types ) )
702         }
703     )->filter_by_last_update(
704         {
705             timestamp_column_name => 'ended_on',
706             days => $jobs_days,
707         }
708     );
709     my $count = $jobs->count;
710     $jobs->delete if $confirm;
711     if ($verbose) {
712         say $confirm
713           ? sprintf "Done with purging %d background jobs of type(s): %s added more than %d days ago.\n",
714           $count, join( ',', @jobs_types ), $jobs_days
715           : sprintf "%d background jobs of type(s): %s added more than %d days ago would have been purged.",
716           $count, join( ',', @jobs_types ), $jobs_days;
717     }
718 }
719
720 if ($reports) {
721     if ( $confirm ) {
722         PurgeSavedReports($reports);
723     } if ( $verbose ) {
724         say "Purging reports data saved more than $reports days ago.\n";
725     }
726 }
727
728 cronlogaction({ action => 'End', info => "COMPLETED" });
729
730 exit(0);
731
732 sub RemoveOldSessions {
733     my ( $id, $a_session, $limit, $lasttime );
734     $limit = time() - 24 * 3600 * $sess_days;
735
736     $sth = $dbh->prepare(q{ SELECT id, a_session FROM sessions });
737     $sth->execute or die $dbh->errstr;
738     $sth->bind_columns( \$id, \$a_session );
739     $sth2  = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? });
740     my $count = 0;
741
742     while ( $sth->fetch ) {
743         $lasttime = 0;
744         if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
745             $lasttime = $1;
746         }
747         elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
748             $lasttime = $2;
749         }
750         if ( $lasttime && $lasttime < $limit ) {
751             $sth2->execute($id) or die $dbh->errstr;
752             $count++;
753         }
754     }
755     if ($verbose) {
756         print "$count sessions were deleted.\n";
757     }
758 }
759
760 sub PurgeImportTables {
761
762     #First purge import_records
763     #Delete cascades to import_biblios, import_items and import_record_matches
764     $sth = $dbh->prepare(
765         q{
766             DELETE FROM import_records
767             WHERE upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
768         }
769     );
770     $sth->execute($pImport) or die $dbh->errstr;
771
772     # Now purge import_batches
773     # Timestamp cannot be used here without care, because records are added
774     # continuously to batches without updating timestamp (Z39.50 search).
775     # So we only delete older empty batches.
776     # This delete will therefore not have a cascading effect.
777     $sth = $dbh->prepare(
778         q{
779             DELETE ba
780             FROM import_batches ba
781             LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
782             WHERE re.import_record_id IS NULL AND
783             ba.upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
784         }
785     );
786     $sth->execute($pImport) or die $dbh->errstr;
787 }
788
789 sub PurgeZ3950 {
790     $sth = $dbh->prepare(
791         q{
792             DELETE FROM import_batches
793             WHERE batch_type = 'z3950'
794         }
795     );
796     $sth->execute() or die $dbh->errstr;
797 }
798
799 sub PurgeDebarments {
800     require Koha::Patron::Debarments;
801     my ( $days, $doit ) = @_;
802     my $count = 0;
803     $sth   = $dbh->prepare(
804         q{
805             SELECT borrower_debarment_id
806             FROM borrower_debarments
807             WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
808         }
809     );
810     $sth->execute($days) or die $dbh->errstr;
811     while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
812         Koha::Patron::Debarments::DelDebarment($borrower_debarment_id) if $doit;
813         $count++;
814     }
815     return $count;
816 }
817
818 sub PurgeCreatorBatches {
819     require C4::Labels::Batch;
820     my ( $days, $creator, $doit ) = @_;
821     my $count = 0;
822     $sth = $dbh->prepare(
823         q{
824             SELECT batch_id, branch_code FROM creator_batches
825             WHERE batch_id in
826                 (SELECT batch_id
827                 FROM (SELECT batch_id
828                         FROM creator_batches
829                         WHERE creator=?
830                         GROUP BY batch_id
831                         HAVING max(timestamp) <= date_sub(curdate(),interval ? day)) a)
832         }
833     );
834     $sth->execute( $creator, $days ) or die $dbh->errstr;
835     while ( my ( $batch_id, $branch_code ) = $sth->fetchrow_array ) {
836         C4::Labels::Batch::delete(
837             batch_id    => $batch_id,
838             branch_code => $branch_code
839         ) if $doit;
840         $count++;
841     }
842     return $count;
843 }
844
845 sub DeleteExpiredSelfRegs {
846     my $cnt= C4::Members::DeleteExpiredOpacRegistrations();
847     print "Removed $cnt expired self-registered borrowers\n" if $verbose;
848 }
849
850 sub DeleteUnverifiedSelfRegs {
851     my $cnt= C4::Members::DeleteUnverifiedOpacRegistrations( $_[0] );
852     print "Removed $cnt unverified self-registrations\n" if $verbose;
853 }
854
855 sub DeleteSpecialHolidays {
856     my ( $days ) = @_;
857
858     my $sth = $dbh->prepare(q{
859         DELETE FROM special_holidays
860         WHERE DATE( CONCAT( year, '-', month, '-', day ) ) < DATE_SUB( CAST(NOW() AS DATE), INTERVAL ? DAY );
861     });
862     my $count = $sth->execute( $days ) + 0;
863     print "Removed $count unique holidays\n" if $verbose;
864 }
865
866 sub PurgeSavedReports {
867     my ( $reports ) = @_;
868
869     my $sth = $dbh->prepare(q{
870             DELETE FROM saved_reports
871             WHERE date(date_run) < DATE_SUB(CURDATE(),INTERVAL ? DAY );
872         });
873     $sth->execute( $reports );
874 }