Bug 31122: Terminology - Replace occurences of 'Notices & slips' with 'Notices and...
[srvgit] / misc / cronjobs / cleanup_database.pl
index 318a225..74505cf 100755 (executable)
@@ -23,24 +23,18 @@ use constant DEFAULT_ZEBRAQ_PURGEDAYS             => 30;
 use constant DEFAULT_MAIL_PURGEDAYS               => 30;
 use constant DEFAULT_IMPORT_PURGEDAYS             => 60;
 use constant DEFAULT_LOGS_PURGEDAYS               => 180;
+use constant DEFAULT_MESSAGES_PURGEDAYS           => 365;
 use constant DEFAULT_SEARCHHISTORY_PURGEDAYS      => 30;
 use constant DEFAULT_SHARE_INVITATION_EXPIRY_DAYS => 14;
 use constant DEFAULT_DEBARMENTS_PURGEDAYS         => 30;
 
-BEGIN {
-    # find Koha's Perl modules
-    # test carefully before changing this
-    use FindBin;
-    eval { require "$FindBin::Bin/../kohalib.pl" };
-}
-
 use Koha::Script -cron;
 use C4::Context;
 use C4::Search;
 use C4::Search::History;
-use Getopt::Long;
-use C4::Log;
-use C4::Accounts;
+use Getopt::Long qw( GetOptions );
+use C4::Log qw( cronlogaction );
+use C4::Accounts qw( purge_zero_balance_fees );
 use Koha::UploadedFiles;
 use Koha::Old::Biblios;
 use Koha::Old::Items;
@@ -50,10 +44,12 @@ use Koha::Old::Holds;
 use Koha::Old::Patrons;
 use Koha::Item::Transfers;
 use Koha::PseudonymizedTransactions;
+use Koha::Patron::Messages;
+use Koha::Patron::Debarments qw( DelDebarment );
 
 sub usage {
     print STDERR <<USAGE;
-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]
+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]
 
    -h --help          prints this help message, and exits, ignoring all
                       other options
@@ -68,6 +64,8 @@ Usage: $0 [-h|--help] [--confirm] [--sessions] [--sessdays DAYS] [-v|--verbose]
    -m --mail DAYS     purge items from the mail queue that are older than DAYS days.
                       Defaults to 30 days if no days specified.
    --merged           purged completed entries from need_merge_authorities.
+   --messages DAYS    purge entries from messages table older than DAYS days.
+                      Defaults to 365 days if no days specified.
    --import DAYS      purge records from import tables older than DAYS days.
                       Defaults to 60 days if no days specified.
    --z3950            purge records from import tables that are the result
@@ -76,6 +74,8 @@ Usage: $0 [-h|--help] [--confirm] [--sessions] [--sessdays DAYS] [-v|--verbose]
                       amountoutstanding is 0 or NULL.
                       In the case of --fees, DAYS must be greater than
                       or equal to 1.
+   --log-modules      Specify which action log modules to trim. Repeatable.
+   --preserve-logs    Specify which action logs to exclude. Repeatable.
    --logs DAYS        purge entries from action_logs older than DAYS days.
                       Defaults to 180 days if no days specified.
    --searchhistory DAYS  purge entries from search_history older than DAYS days.
@@ -84,7 +84,7 @@ Usage: $0 [-h|--help] [--confirm] [--sessions] [--sessdays DAYS] [-v|--verbose]
                          days.  Defaults to 14 days if no days specified.
    --restrictions DAYS   purge patrons restrictions expired since more than DAYS days.
                          Defaults to 30 days if no days specified.
-    --all-restrictions   purge all expired patrons restrictions.
+   --all-restrictions   purge all expired patrons restrictions.
    --del-exp-selfreg  Delete expired self registration accounts
    --del-unv-selfreg  DAYS  Delete unverified self registrations older than DAYS
    --unique-holidays DAYS  Delete all unique holidays older than DAYS
@@ -103,6 +103,10 @@ Usage: $0 [-h|--help] [--confirm] [--sessions] [--sessdays DAYS] [-v|--verbose]
    --pseudo-transactions DAYS   Purge the pseudonymized transactions that have been originally created more than DAYS days ago
                                 DAYS is optional and can be replaced by:
                                     --pseudo-transactions-from YYYY-MM-DD and/or --pseudo-transactions-to YYYY-MM-DD
+   --labels DAYS           Purge item label batches last added to more than DAYS days ago.
+   --cards DAY             Purge card creator batches last added to more than DAYS days ago.
+   --return-claims         Purge all resolved return claims older than the number of days specified in
+                           the system preference CleanUpDatabaseReturnClaims.
 USAGE
     exit $_[0];
 }
@@ -122,6 +126,7 @@ my $pZ3950;
 my $pListShareInvites;
 my $pDebarments;
 my $allDebarments;
+my $return_claims;
 my $pExpSelfReg;
 my $pUnvSelfReg;
 my $fees_days;
@@ -137,6 +142,12 @@ my $pOldIssues;
 my $pOldReserves;
 my $pTransfers;
 my ( $pPseudoTransactions, $pPseudoTransactionsFrom, $pPseudoTransactionsTo );
+my $pMessages;
+my $lock_days = C4::Context->preference('LockExpiredDelay');
+my $labels;
+my $cards;
+my @log_modules;
+my @preserve_logs;
 
 GetOptions(
     'h|help'            => \$help,
@@ -150,13 +161,16 @@ GetOptions(
     'import:i'          => \$pImport,
     'z3950'             => \$pZ3950,
     'logs:i'            => \$pLogs,
+    'log-module:s'      => \@log_modules,
+    'preserve-log:s'    => \@preserve_logs,
+    'messages:i'        => \$pMessages,
     'fees:i'            => \$fees_days,
     'searchhistory:i'   => \$pSearchhistory,
     'list-invites:i'    => \$pListShareInvites,
     'restrictions:i'    => \$pDebarments,
     'all-restrictions'  => \$allDebarments,
     'del-exp-selfreg'   => \$pExpSelfReg,
-    'del-unv-selfreg'   => \$pUnvSelfReg,
+    'del-unv-selfreg:i' => \$pUnvSelfReg,
     'unique-holidays:i' => \$special_holidays_days,
     'temp-uploads'      => \$temp_uploads,
     'temp-uploads-days:i' => \$temp_uploads_days,
@@ -171,6 +185,9 @@ GetOptions(
     'pseudo-transactions:i'      => \$pPseudoTransactions,
     'pseudo-transactions-from:s' => \$pPseudoTransactionsFrom,
     'pseudo-transactions-to:s'   => \$pPseudoTransactionsTo,
+    'labels'            => \$labels,
+    'cards'             => \$cards,
+    'return-claims'     => \$return_claims,
 ) || usage(1);
 
 # Use default values
@@ -182,6 +199,7 @@ $mail              = DEFAULT_MAIL_PURGEDAYS               if defined($mail)
 $pSearchhistory    = DEFAULT_SEARCHHISTORY_PURGEDAYS      if defined($pSearchhistory)    && $pSearchhistory == 0;
 $pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0;
 $pDebarments       = DEFAULT_DEBARMENTS_PURGEDAYS         if defined($pDebarments)       && $pDebarments == 0;
+$pMessages         = DEFAULT_MESSAGES_PURGEDAYS           if defined($pMessages)         && $pMessages == 0;
 
 if ($help) {
     usage(0);
@@ -214,6 +232,11 @@ unless ( $sessions
     || defined $pPseudoTransactions
     || $pPseudoTransactionsFrom
     || $pPseudoTransactionsTo
+    || $pMessages
+    || defined $lock_days && $lock_days ne q{}
+    || $labels
+    || $cards
+    || $return_claims
 ) {
     print "You did not specify any cleanup work for the script to do.\n\n";
     usage(1);
@@ -264,9 +287,7 @@ if ($zebraqueue_days) {
             WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY)
         }
     );
-    if ( $confirm ) {
-        $sth->execute($zebraqueue_days) or die $dbh->errstr;
-    }
+    $sth->execute($zebraqueue_days) or die $dbh->errstr;
     $sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? });
     while ( my $record = $sth->fetchrow_hashref ) {
         if ( $confirm ) {
@@ -283,7 +304,6 @@ if ($zebraqueue_days) {
 if ($mail) {
     my $count = 0;
     print "Mail queue purge triggered for $mail days.\n" if $verbose;
-    $count = 0;
     $sth = $dbh->prepare(
         q{
             DELETE FROM message_queue
@@ -323,18 +343,39 @@ if ($pZ3950) {
 
 if ($pLogs) {
     print "Purging records from action_logs.\n" if $verbose;
-    $sth = $dbh->prepare(
-        q{
+    my $log_query = q{
             DELETE FROM action_logs
             WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY)
-        }
-    );
+    };
+    my @query_params = ();
+    if( @preserve_logs ){
+        $log_query .= " AND module NOT IN (" . join(',',('?') x @preserve_logs ) . ")";
+        push @query_params, @preserve_logs;
+    }
+    if( @log_modules ){
+        $log_query .= " AND module IN (" . join(',',('?') x @log_modules ) . ")";
+        push @query_params, @log_modules;
+    }
+    $sth = $dbh->prepare( $log_query );
     if ( $confirm ) {
-        $sth->execute($pLogs) or die $dbh->errstr;
+        $sth->execute($pLogs, @query_params) or die $dbh->errstr;
     }
     print "Done with purging action_logs.\n" if $verbose;
 }
 
+if ($pMessages) {
+    print "Purging messages older than $pMessages days.\n" if $verbose;
+    my $messages = Koha::Patron::Messages->filter_by_last_update(
+        { timestamp_column_name => 'message_date', days => $pMessages } );
+    my $count = $messages->count;
+    $messages->delete if $confirm;
+    if ( $verbose ) {
+        say $confirm
+          ? sprintf( "Done with purging %d messages", $count )
+          : sprintf( "%d messages would have been removed", $count );
+    }
+}
+
 if ($fees_days) {
     print "Purging records from accountlines.\n" if $verbose;
     purge_zero_balance_fees( $fees_days ) if $confirm;
@@ -380,7 +421,19 @@ if($allDebarments) {
     }
 }
 
+# Lock expired patrons?
+if( defined $lock_days && $lock_days ne q{} ) {
+    say "Start locking expired patrons" if $verbose;
+    my $expired_patrons = Koha::Patrons->filter_by_expiration_date({ days => $lock_days })->search({ login_attempts => { '!=' => -1 } });
+    my $count = $expired_patrons->count;
+    $expired_patrons->lock({ remove => 1 }) if $confirm;
+    if( $verbose ) {
+        say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("Found %d patrons", $count);
+    }
+}
+
 # Handle unsubscribe requests from GDPR consent form, depends on UnsubscribeReflectionDelay preference
+say "Start lock unsubscribed, anonymize and delete" if $verbose;
 my $unsubscribed_patrons = Koha::Patrons->search_unsubscribed;
 my $count = $unsubscribed_patrons->count;
 $unsubscribed_patrons->lock( { expire => 1, remove => 1 } ) if $confirm;
@@ -485,6 +538,26 @@ if ($pStatistics) {
     }
 }
 
+if( $return_claims && ( my $days = C4::Context->preference('CleanUpDatabaseReturnClaims') )) {
+    print "Purging return claims older than $days days.\n" if $verbose;
+
+    $return_claims = Koha::Checkouts::ReturnClaims->filter_by_last_update(
+        {
+            timestamp_column_name => 'resolved_on',
+            days => $days,
+        }
+    );
+
+    my $count = $return_claims->count;
+    $return_claims->delete if $confirm;
+
+    if ($verbose) {
+        say $confirm
+            ? sprintf "Done with purging %d resolved return claims.", $count
+            : sprintf "%d resolved return claims would have been purged.", $count;
+    }
+}
+
 if ($pDeletedCatalog) {
     print "Purging deleted catalog older than $pDeletedCatalog days.\n"
       if $verbose;
@@ -536,7 +609,7 @@ if ($pOldReserves) {
     print "Purging old reserves older than $pOldReserves days.\n" if $verbose;
     my $old_reserves = Koha::Old::Holds->filter_by_last_update( { days => $pOldReserves } );
     my $count = $old_reserves->count;
-    $old_reserves->delete if $verbose;
+    $old_reserves->delete if $confirm;
     if ($verbose) {
         say $confirm
           ? sprintf "Done with purging %d old reserves.", $count
@@ -553,7 +626,7 @@ if ($pTransfers) {
         }
     );
     my $count = $transfers->count;
-    $transfers->delete if $verbose;
+    $transfers->delete if $confirm;
     if ($verbose) {
         say $confirm
           ? sprintf "Done with purging %d transfers.", $count
@@ -580,6 +653,26 @@ if (defined $pPseudoTransactions or $pPseudoTransactionsFrom or $pPseudoTransact
     }
 }
 
+if ($labels) {
+    print "Purging item label batches last added to more than $labels days ago.\n" if $verbose;
+    my $count = PurgeCreatorBatches($labels, 'labels', $confirm);
+    if ($verbose) {
+        say $confirm
+          ? sprintf "Done with purging %d item label batches last added to more than %d days ago.\n", $count, $labels
+          : sprintf "%d item label batches would have been purged.", $count;
+    }
+}
+
+if ($cards) {
+    print "Purging card creator batches last added to more than $cards days ago.\n" if $verbose;
+    my $count = PurgeCreatorBatches($labels, 'patroncards', $confirm);
+    if ($verbose) {
+        say $confirm
+          ? sprintf "Done with purging %d card creator batches last added to more than %d days ago.\n", $count, $labels
+          : sprintf "%d card creator batches would have been purged.", $count;
+    }
+}
+
 exit(0);
 
 sub RemoveOldSessions {
@@ -668,6 +761,33 @@ sub PurgeDebarments {
     return $count;
 }
 
+sub PurgeCreatorBatches {
+    require C4::Labels::Batch;
+    my ( $days, $creator, $doit ) = @_;
+    my $count = 0;
+    $sth = $dbh->prepare(
+        q{
+            SELECT batch_id, branch_code FROM creator_batches
+            WHERE batch_id in
+                (SELECT batch_id
+                FROM (SELECT batch_id
+                        FROM creator_batches
+                        WHERE creator=?
+                        GROUP BY batch_id
+                        HAVING max(timestamp) <= date_sub(curdate(),interval ? day)) a)
+        }
+    );
+    $sth->execute( $creator, $days ) or die $dbh->errstr;
+    while ( my ( $batch_id, $branch_code ) = $sth->fetchrow_array ) {
+        C4::Labels::Batch::delete(
+            batch_id    => $batch_id,
+            branch_code => $branch_code
+        ) if $doit;
+        $count++;
+    }
+    return $count;
+}
+
 sub DeleteExpiredSelfRegs {
     my $cnt= C4::Members::DeleteExpiredOpacRegistrations();
     print "Removed $cnt expired self-registered borrowers\n" if $verbose;