# with Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-use strict;
-use warnings;
-
-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_SEARCHHISTORY_PURGEDAYS => 30;
+use Modern::Perl;
+
+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_SEARCHHISTORY_PURGEDAYS => 30;
use constant DEFAULT_SHARE_INVITATION_EXPIRY_DAYS => 14;
-use constant DEFAULT_DEBARMENTS_PURGEDAYS => 30;
+use constant DEFAULT_DEBARMENTS_PURGEDAYS => 30;
BEGIN {
# find Koha's Perl modules
}
my (
- $help, $sessions, $sess_days, $verbose,
- $zebraqueue_days, $mail, $purge_merged, $pImport,
- $pLogs, $pSearchhistory, $pZ3950,
- $pListShareInvites, $pDebarments,
+ $help, $sessions, $sess_days, $verbose, $zebraqueue_days,
+ $mail, $purge_merged, $pImport, $pLogs, $pSearchhistory,
+ $pZ3950, $pListShareInvites, $pDebarments,
);
GetOptions(
- 'h|help' => \$help,
- 'sessions' => \$sessions,
- 'sessdays:i' => \$sess_days,
- 'v|verbose' => \$verbose,
- 'm|mail:i' => \$mail,
- 'zebraqueue:i' => \$zebraqueue_days,
- 'merged' => \$purge_merged,
- 'import:i' => \$pImport,
- 'z3950' => \$pZ3950,
- 'logs:i' => \$pLogs,
+ 'h|help' => \$help,
+ 'sessions' => \$sessions,
+ 'sessdays:i' => \$sess_days,
+ 'v|verbose' => \$verbose,
+ 'm|mail:i' => \$mail,
+ 'zebraqueue:i' => \$zebraqueue_days,
+ 'merged' => \$purge_merged,
+ 'import:i' => \$pImport,
+ 'z3950' => \$pZ3950,
+ 'logs:i' => \$pLogs,
'searchhistory:i' => \$pSearchhistory,
'list-invites:i' => \$pListShareInvites,
- 'restrictions:i' => \$pDebarments,
+ 'restrictions:i' => \$pDebarments,
) || usage(1);
-$sessions=1 if $sess_days && $sess_days>0;
-# if --import, --logs, --zebraqueue or --searchhistory were passed without number of days,
-# use defaults
-$pImport= DEFAULT_IMPORT_PURGEDAYS if defined($pImport) && $pImport==0;
-$pLogs= DEFAULT_LOGS_PURGEDAYS if defined($pLogs) && $pLogs==0;
-$zebraqueue_days= DEFAULT_ZEBRAQ_PURGEDAYS if defined($zebraqueue_days) && $zebraqueue_days==0;
-$mail= DEFAULT_MAIL_PURGEDAYS if defined($mail) && $mail==0;
-$pSearchhistory= DEFAULT_SEARCHHISTORY_PURGEDAYS if defined($pSearchhistory) && $pSearchhistory==0;
+# Use default values
+$sessions = 1 if $sess_days && $sess_days > 0;
+$pImport = DEFAULT_IMPORT_PURGEDAYS if defined($pImport) && $pImport == 0;
+$pLogs = DEFAULT_LOGS_PURGEDAYS if defined($pLogs) && $pLogs == 0;
+$zebraqueue_days = DEFAULT_ZEBRAQ_PURGEDAYS if defined($zebraqueue_days) && $zebraqueue_days == 0;
+$mail = DEFAULT_MAIL_PURGEDAYS if defined($mail) && $mail == 0;
+$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;
+$pDebarments = DEFAULT_DEBARMENTS_PURGEDAYS if defined($pDebarments) && $pDebarments == 0;
if ($help) {
usage(0);
if ( $sessions && !$sess_days ) {
if ($verbose) {
print "Session purge triggered.\n";
- $sth = $dbh->prepare("SELECT COUNT(*) FROM sessions");
+ $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";
}
- $sth = $dbh->prepare("TRUNCATE sessions");
+ $sth = $dbh->prepare(q{ TRUNCATE sessions });
$sth->execute() or die $dbh->errstr;
if ($verbose) {
print "Done with session purge.\n";
}
-} elsif ( $sessions && $sess_days > 0 ) {
- if ($verbose) {
- print "Session purge triggered with days>$sess_days.\n";
- }
+}
+elsif ( $sessions && $sess_days > 0 ) {
+ print "Session purge triggered with days>$sess_days.\n" if $verbose;
RemoveOldSessions();
- if ($verbose) {
- print "Done with session purge with days>$sess_days.\n";
- }
+ print "Done with session purge with days>$sess_days.\n" if $verbose;
}
if ($zebraqueue_days) {
$count = 0;
- if ($verbose) {
- print "Zebraqueue purge triggered for $zebraqueue_days days.\n";
- }
+ print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
$sth = $dbh->prepare(
- "SELECT id,biblio_auth_number,server,time FROM zebraqueue
- WHERE done=1 and time < date_sub(curdate(), interval ? day)"
+ q{
+ SELECT id,biblio_auth_number,server,time
+ FROM zebraqueue
+ WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY)
+ }
);
$sth->execute($zebraqueue_days) or die $dbh->errstr;
- $sth2 = $dbh->prepare("DELETE FROM zebraqueue WHERE id=?");
+ $sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? });
while ( my $record = $sth->fetchrow_hashref ) {
$sth2->execute( $record->{id} ) or die $dbh->errstr;
$count++;
}
- if ($verbose) {
- print "$count records were deleted.\nDone with zebraqueue purge.\n";
- }
+ print "$count records were deleted.\nDone with zebraqueue purge.\n" if $verbose;
}
if ($mail) {
- print "Mail queue purge triggered for $mail days.\n" if ($verbose);
-
- $sth = $dbh->prepare("DELETE FROM message_queue WHERE time_queued < date_sub(curdate(), interval ? day)");
+ print "Mail queue purge triggered for $mail days.\n" if $verbose;
+ $sth = $dbh->prepare(
+ q{
+ DELETE FROM message_queue
+ WHERE time_queued < date_sub(curdate(), INTERVAL ? DAY)
+ }
+ );
$sth->execute($mail) or die $dbh->errstr;
$count = $sth->rows;
$sth->finish;
-
- print "$count messages were deleted from the mail queue.\nDone with message_queue purge.\n" if ($verbose);
+ print "$count messages were deleted from the mail queue.\nDone with message_queue purge.\n" if $verbose;
}
-if($purge_merged) {
+if ($purge_merged) {
print "Purging completed entries from need_merge_authorities.\n" if $verbose;
- $sth = $dbh->prepare("DELETE FROM need_merge_authorities WHERE done=1");
+ $sth = $dbh->prepare(q{ DELETE FROM need_merge_authorities WHERE done=1 });
$sth->execute() or die $dbh->errstr;
print "Done with purging need_merge_authorities.\n" if $verbose;
}
-if($pImport) {
+if ($pImport) {
print "Purging records from import tables.\n" if $verbose;
PurgeImportTables();
print "Done with purging import tables.\n" if $verbose;
}
-if($pZ3950) {
+if ($pZ3950) {
print "Purging Z39.50 records from import tables.\n" if $verbose;
PurgeZ3950();
print "Done with purging Z39.50 records from import tables.\n" if $verbose;
}
-if($pLogs) {
+if ($pLogs) {
print "Purging records from action_logs.\n" if $verbose;
- $sth = $dbh->prepare("DELETE FROM action_logs WHERE timestamp < date_sub(curdate(), interval ? DAY)");
+ $sth = $dbh->prepare(
+ q{
+ DELETE FROM action_logs
+ WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY)
+ }
+ );
$sth->execute($pLogs) or die $dbh->errstr;
print "Done with purging action_logs.\n" if $verbose;
}
-if($pSearchhistory) {
+if ($pSearchhistory) {
print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;
PurgeSearchHistory($pSearchhistory);
print "Done with purging search_history.\n" if $verbose;
if ($pListShareInvites) {
print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;
- $sth = $dbh->prepare("
- DELETE FROM virtualshelfshares
- WHERE invitekey IS NOT NULL
- AND (sharedate + INTERVAL ? DAY) < NOW()
- ");
+ $sth = $dbh->prepare(
+ q{
+ DELETE FROM virtualshelfshares
+ WHERE invitekey IS NOT NULL
+ AND (sharedate + INTERVAL ? DAY) < NOW()
+ }
+ );
$sth->execute($pListShareInvites);
print "Done with purging unaccepted list share invites.\n" if $verbose;
}
-if($pDebarments) {
+if ($pDebarments) {
print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
$count = PurgeDebarments();
print "$count restrictions were deleted.\nDone with restrictions purge.\n" if $verbose;
my ( $id, $a_session, $limit, $lasttime );
$limit = time() - 24 * 3600 * $sess_days;
- $sth = $dbh->prepare("SELECT id, a_session FROM sessions");
+ $sth = $dbh->prepare(q{ SELECT id, a_session FROM sessions });
$sth->execute or die $dbh->errstr;
$sth->bind_columns( \$id, \$a_session );
- $sth2 = $dbh->prepare("DELETE FROM sessions WHERE id=?");
+ $sth2 = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? });
$count = 0;
while ( $sth->fetch ) {
$lasttime = 0;
if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
$lasttime = $1;
- } elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
+ }
+ elsif ( $a_session =~ /(ATIME|CTIME):\s+'?(\d+)/ ) {
$lasttime = $2;
}
if ( $lasttime && $lasttime < $limit ) {
}
sub PurgeImportTables {
+
#First purge import_records
#Delete cascades to import_biblios, import_items and import_record_matches
- $sth = $dbh->prepare("DELETE FROM import_records WHERE upload_timestamp < date_sub(curdate(), interval ? DAY)");
+ $sth = $dbh->prepare(
+ q{
+ DELETE FROM import_records
+ WHERE upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
+ }
+ );
$sth->execute($pImport) or die $dbh->errstr;
# Now purge import_batches
# continuously to batches without updating timestamp (Z39.50 search).
# So we only delete older empty batches.
# This delete will therefore not have a cascading effect.
- $sth = $dbh->prepare("DELETE ba
- FROM import_batches ba
- LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
- WHERE re.import_record_id IS NULL AND
- ba.upload_timestamp < date_sub(curdate(), interval ? DAY)");
+ $sth = $dbh->prepare(
+ q{
+ DELETE ba
+ FROM import_batches ba
+ LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
+ WHERE re.import_record_id IS NULL AND
+ ba.upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
+ }
+ );
$sth->execute($pImport) or die $dbh->errstr;
}
-
sub PurgeZ3950 {
- $sth = $dbh->prepare(q{
- DELETE FROM import_batches WHERE batch_type = 'z3950'
- });
+ $sth = $dbh->prepare(
+ q{
+ DELETE FROM import_batches
+ WHERE batch_type = 'z3950'
+ }
+ );
$sth->execute() or die $dbh->errstr;
}
sub PurgeDebarments {
require Koha::Borrower::Debarments;
$count = 0;
- $sth = $dbh->prepare(q{
- SELECT borrower_debarment_id FROM borrower_debarments WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
- });
+ $sth = $dbh->prepare(
+ q{
+ SELECT borrower_debarment_id
+ FROM borrower_debarments
+ WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
+ }
+ );
$sth->execute($pDebarments) or die $dbh->errstr;
while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
Koha::Borrower::Debarments::DelDebarment($borrower_debarment_id);
projects / koha.git / commitdiff