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;
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
-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
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-log 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.
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
--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];
}
my $pListShareInvites;
my $pDebarments;
my $allDebarments;
+my $return_claims;
my $pExpSelfReg;
my $pUnvSelfReg;
my $fees_days;
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;
+
+my $command_line_options = join(" ",@ARGV);
GetOptions(
'h|help' => \$help,
'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,
'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
$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);
|| 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);
say "Confirm flag not passed, running in dry-run mode..." unless $confirm;
-cronlogaction() unless $confirm;
+cronlogaction({ info => $command_line_options });
my $dbh = C4::Context->dbh();
my $sth;
my $sth2;
-my $count;
if ( $sessions && !$sess_days ) {
if ($verbose) {
- print "Session purge triggered.\n";
+ say "Session purge triggered.";
$sth = $dbh->prepare(q{ SELECT COUNT(*) FROM sessions });
$sth->execute() or die $dbh->errstr;
my @count_arr = $sth->fetchrow_array;
- print "$count_arr[0] entries will be deleted.\n";
+ say $confirm ? "$count_arr[0] entries will be deleted." : "$count_arr[0] entries would be deleted.";
}
if ( $confirm ) {
$sth = $dbh->prepare(q{ TRUNCATE sessions });
}
if ($zebraqueue_days) {
- $count = 0;
+ my $count = 0;
print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
$sth = $dbh->prepare(
q{
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 ) {
}
$count++;
}
- print "$count records were deleted.\nDone with zebraqueue purge.\n" if $verbose;
+ if ( $verbose ) {
+ say $confirm ? "$count records were deleted." : "$count records would have been deleted.";
+ say "Done with zebraqueue purge.";
+ }
}
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
if ( $confirm ) {
$sth->execute($mail) or die $dbh->errstr;
$count = $sth->rows;
- print "$count messages were deleted from the mail queue.\nDone with message_queue purge.\n" if $verbose;
- } else {
- print "Messages were deleted from the mail queue.\nDone with message_queue purge.\n" if $verbose;
+ }
+ if ( $verbose ) {
+ say $confirm ? "$count messages were deleted from the mail queue." : "Message from message_queue would have been deleted";
+ say "Done with message_queue purge.";
}
}
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;
if ($pDebarments) {
print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
- $count = PurgeDebarments($pDebarments, $confirm);
- print "$count restrictions were deleted.\nDone with restrictions purge.\n" if $verbose;
+ my $count = PurgeDebarments($pDebarments, $confirm);
+ if ( $verbose ) {
+ say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
+ say "Done with restrictions purge.";
+ }
}
if($allDebarments) {
print "All expired patrons restrictions purge triggered.\n" if $verbose;
- $count = PurgeDebarments(0, $confirm);
- print "$count restrictions were deleted.\nDone with all restrictions purge.\n" if $verbose;
+ my $count = PurgeDebarments(0, $confirm);
+ if ( $verbose ) {
+ say $confirm ? "$count restrictions were deleted." : "$count restrictions would have been deleted";
+ say "Done with all restrictions purge.";
+ }
+}
+
+# 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;
-$count = $unsubscribed_patrons->count;
+my $count = $unsubscribed_patrons->count;
$unsubscribed_patrons->lock( { expire => 1, remove => 1 } ) if $confirm;
-say sprintf "Locked %d patrons", $count if $verbose;
+say $confirm ? sprintf("Locked %d patrons", $count) : sprintf("%d patrons would have been locked", $count) if $verbose;
# Anonymize patron data, depending on PatronAnonymizeDelay
my $anonymize_candidates = Koha::Patrons->search_anonymize_candidates( { locked => 1 } );
$count = $anonymize_candidates->count;
$anonymize_candidates->anonymize if $confirm;
-say sprintf "Anonymized %s patrons", $count if $verbose;
+say $confirm ? sprintf("Anonymized %d patrons", $count) : sprintf("%d patrons would have been anonymized", $count) if $verbose;
# Remove patron data, depending on PatronRemovalDelay (will raise an exception if problem encountered
my $anonymized_patrons = Koha::Patrons->search_anonymized;
if ($@) {
warn $@;
}
- elsif ($verbose) {
- say sprintf "Deleted %d patrons", $count;
- }
-} else {
- say sprintf "Deleted %d patrons", $count;
+}
+if ($verbose) {
+ say $confirm ? sprintf("Deleted %d patrons", $count) : sprintf("%d patrons would have been deleted", $count);
}
# FIXME The output for dry-run mode needs to be improved
my $tokens = Koha::OAuthAccessTokens->search({ expires => { '<=', time } });
my $count = $tokens->count;
$tokens->delete if $confirm;
- say sprintf "Removed %s expired OAuth2 tokens", $count if $verbose;
+ if ( $verbose ) {
+ say $confirm
+ ? sprintf( "Removed %d expired OAuth2 tokens", $count )
+ : sprintf( "%d expired OAuth tokens would have been removed", $count );
+ }
}
if ($pStatistics) {
{ timestamp_column_name => 'datetime', days => $pStatistics } );
my $count = $statistics->count;
$statistics->delete if $confirm;
- say sprintf "Done with purging %s statistics.", $count if $verbose;
+ if ( $verbose ) {
+ say $confirm
+ ? sprintf( "Done with purging %d statistics", $count )
+ : sprintf( "%d statistics would have been removed", $count );
+ }
+}
+
+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) {
$old_biblioitems->delete;
$old_biblios->delete;
}
- say sprintf
- "Done with purging deleted catalog (%d items, %d biblioitems, %d biblios).",
- $c_i, $c_bi, $c_b
- if $verbose;
+ if ($verbose) {
+ say sprintf(
+ $confirm
+ ? "Done with purging deleted catalog (%d items, %d biblioitems, %d biblios)."
+ : "Deleted catalog would have been removed (%d items, %d biblioitems, %d biblios).",
+ $c_i, $c_bi, $c_b);
+ }
}
if ($pDeletedPatrons) {
{ timestamp_column_name => 'updated_on', days => $pDeletedPatrons } );
my $count = $old_patrons->count;
$old_patrons->delete if $confirm;
- say sprintf "Done with purging %d deleted patrons.", $count if $verbose;
+ if ($verbose) {
+ say $confirm
+ ? sprintf "Done with purging %d deleted patrons.", $count
+ : sprintf "%d deleted patrons would have been purged.", $count;
+ }
}
if ($pOldIssues) {
my $old_checkouts = Koha::Old::Checkouts->filter_by_last_update( { days => $pOldIssues } );
my $count = $old_checkouts->count;
$old_checkouts->delete if $confirm;
- say sprintf "Done with purging %d old checkouts.", $count if $verbose;
+ if ($verbose) {
+ say $confirm
+ ? sprintf "Done with purging %d old checkouts.", $count
+ : sprintf "%d old checkouts would have been purged.", $count;
+ }
}
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;
- say sprintf "Done with purging %d old reserves.", $count if $verbose;
+ $old_reserves->delete if $confirm;
+ if ($verbose) {
+ say $confirm
+ ? sprintf "Done with purging %d old reserves.", $count
+ : sprintf "%d old reserves would have been purged.", $count;
+ }
}
if ($pTransfers) {
}
);
my $count = $transfers->count;
- $transfers->delete if $verbose;
- say sprintf "Done with purging %d transfers.", $count if $verbose;
+ $transfers->delete if $confirm;
+ if ($verbose) {
+ say $confirm
+ ? sprintf "Done with purging %d transfers.", $count
+ : sprintf "%d transfers would have been purged.", $count;
+ }
}
if (defined $pPseudoTransactions or $pPseudoTransactionsFrom or $pPseudoTransactionsTo ) {
);
my $count = $anonymized_transactions->count;
$anonymized_transactions->delete if $confirm;
- say sprintf "Done with purging %d pseudonymized transactions.", $count if $verbose;
+ if ($verbose) {
+ say $confirm
+ ? sprintf "Done with purging %d pseudonymized transactions.", $count
+ : sprintf "%d pseudonymized transactions would have been purged.", $count;
+ }
}
+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;
+ }
+}
+
+cronlogaction({ action => 'End', info => "COMPLETED" });
+
exit(0);
sub RemoveOldSessions {
$sth->execute or die $dbh->errstr;
$sth->bind_columns( \$id, \$a_session );
$sth2 = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? });
- $count = 0;
+ my $count = 0;
while ( $sth->fetch ) {
$lasttime = 0;
sub PurgeDebarments {
require Koha::Patron::Debarments;
my ( $days, $doit ) = @_;
- $count = 0;
+ my $count = 0;
$sth = $dbh->prepare(
q{
SELECT borrower_debarment_id
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;