Attachment #30815 for bug #12760

View | Details | Raw Unified | Return to bug 12760
Collapse All | Expand All




# with Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

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_SEARCHHISTORY_PURGEDAYS => 30;
use constant DEFAULT_SHARE_INVITATION_EXPIRY_DAYS => 14;
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,
    $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,
    'searchhistory:i' => \$pSearchhistory,
    'list-invites:i'  => \$pListShareInvites,
    'restrictions:i'  => \$pDebarments,
) || usage(1);

# 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;
$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;

if ($help) {
    usage(0);

if ( $sessions && !$sess_days ) {
    if ($verbose) {
        print "Session purge triggered.\n";
        $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(q{ TRUNCATE sessions });
    $sth->execute() or die $dbh->errstr;
    if ($verbose) {
        print "Done with session purge.\n";
    }
}
elsif ( $sessions && $sess_days > 0 ) {
    print "Session purge triggered with days>$sess_days.\n" if $verbose;
    }
    RemoveOldSessions();
    print "Done with session purge with days>$sess_days.\n" if $verbose;
        print "Done with session purge with days>$sess_days.\n";
    }
}

if ($zebraqueue_days) {
    $count = 0;
    print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
        print "Zebraqueue purge triggered for $zebraqueue_days days.\n";
    }
    $sth = $dbh->prepare(
        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(q{ DELETE FROM zebraqueue WHERE id=? });
    while ( my $record = $sth->fetchrow_hashref ) {
        $sth2->execute( $record->{id} ) or die $dbh->errstr;
        $count++;
    }
    print "$count records were deleted.\nDone with zebraqueue purge.\n" if $verbose;
        print "$count records were deleted.\nDone with zebraqueue purge.\n";
    }
}

if ($mail) {
    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) {
    print "Purging completed entries from need_merge_authorities.\n" if $verbose;
    $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) {
    print "Purging records from import tables.\n" if $verbose;
    PurgeImportTables();
    print "Done with purging import tables.\n" if $verbose;
}

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) {
    print "Purging records from action_logs.\n" if $verbose;
    $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) {
    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(
        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) {
    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(q{ SELECT id, a_session FROM sessions });
    $sth->execute or die $dbh->errstr;
    $sth->bind_columns( \$id, \$a_session );
    $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+)/ ) {
            $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(
        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(
        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->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->execute($pDebarments) or die $dbh->errstr;
    while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
        Koha::Borrower::Debarments::DelDebarment($borrower_debarment_id);
- 

Return to bug 12760

Lines 17-32 Link Here

(-)a/misc/cronjobs/cleanup_database.pl (-86 / +105 lines)
17	# with Koha; if not, write to the Free Software Foundation, Inc.,	17	# with Koha; if not, write to the Free Software Foundation, Inc.,
18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.	18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19		19
20	use strict;	20	use Modern::Perl;
21	use warnings;	21
22		22	use constant DEFAULT_ZEBRAQ_PURGEDAYS => 30;
23	use constant DEFAULT_ZEBRAQ_PURGEDAYS => 30;	23	use constant DEFAULT_MAIL_PURGEDAYS => 30;
24	use constant DEFAULT_MAIL_PURGEDAYS => 30;	24	use constant DEFAULT_IMPORT_PURGEDAYS => 60;
25	use constant DEFAULT_IMPORT_PURGEDAYS => 60;	25	use constant DEFAULT_LOGS_PURGEDAYS => 180;
26	use constant DEFAULT_LOGS_PURGEDAYS => 180;	26	use constant DEFAULT_SEARCHHISTORY_PURGEDAYS => 30;
27	use constant DEFAULT_SEARCHHISTORY_PURGEDAYS => 30;
28	use constant DEFAULT_SHARE_INVITATION_EXPIRY_DAYS => 14;	27	use constant DEFAULT_SHARE_INVITATION_EXPIRY_DAYS => 14;
29	use constant DEFAULT_DEBARMENTS_PURGEDAYS => 30;	28	use constant DEFAULT_DEBARMENTS_PURGEDAYS => 30;
30		29
31	BEGIN {	30	BEGIN {
32	# find Koha's Perl modules	31	# find Koha's Perl modules
Lines 75-112 USAGE Link Here
75	}	74	}
76		75
77	my (	76	my (
78	$help, $sessions, $sess_days, $verbose,	77	$help, $sessions, $sess_days, $verbose, $zebraqueue_days,
79	$zebraqueue_days, $mail, $purge_merged, $pImport,	78	$mail, $purge_merged, $pImport, $pLogs, $pSearchhistory,
80	$pLogs, $pSearchhistory, $pZ3950,	79	$pZ3950, $pListShareInvites, $pDebarments,
81	$pListShareInvites, $pDebarments,
82	);	80	);
83		81
84	GetOptions(	82	GetOptions(
85	'h\|help' => \$help,	83	'h\|help' => \$help,
86	'sessions' => \$sessions,	84	'sessions' => \$sessions,
87	'sessdays:i' => \$sess_days,	85	'sessdays:i' => \$sess_days,
88	'v\|verbose' => \$verbose,	86	'v\|verbose' => \$verbose,
89	'm\|mail:i' => \$mail,	87	'm\|mail:i' => \$mail,
90	'zebraqueue:i' => \$zebraqueue_days,	88	'zebraqueue:i' => \$zebraqueue_days,
91	'merged' => \$purge_merged,	89	'merged' => \$purge_merged,
92	'import:i' => \$pImport,	90	'import:i' => \$pImport,
93	'z3950' => \$pZ3950,	91	'z3950' => \$pZ3950,
94	'logs:i' => \$pLogs,	92	'logs:i' => \$pLogs,
95	'searchhistory:i' => \$pSearchhistory,	93	'searchhistory:i' => \$pSearchhistory,
96	'list-invites:i' => \$pListShareInvites,	94	'list-invites:i' => \$pListShareInvites,
97	'restrictions:i' => \$pDebarments,	95	'restrictions:i' => \$pDebarments,
98	) \|\| usage(1);	96	) \|\| usage(1);
99		97
100	$sessions=1 if $sess_days && $sess_days>0;	98	# Use default values
101	# if --import, --logs, --zebraqueue or --searchhistory were passed without number of days,	99	$sessions = 1 if $sess_days && $sess_days > 0;
102	# use defaults	100	$pImport = DEFAULT_IMPORT_PURGEDAYS if defined($pImport) && $pImport == 0;
103	$pImport= DEFAULT_IMPORT_PURGEDAYS if defined($pImport) && $pImport==0;	101	$pLogs = DEFAULT_LOGS_PURGEDAYS if defined($pLogs) && $pLogs == 0;
104	$pLogs= DEFAULT_LOGS_PURGEDAYS if defined($pLogs) && $pLogs==0;	102	$zebraqueue_days = DEFAULT_ZEBRAQ_PURGEDAYS if defined($zebraqueue_days) && $zebraqueue_days == 0;
105	$zebraqueue_days= DEFAULT_ZEBRAQ_PURGEDAYS if defined($zebraqueue_days) && $zebraqueue_days==0;	103	$mail = DEFAULT_MAIL_PURGEDAYS if defined($mail) && $mail == 0;
106	$mail= DEFAULT_MAIL_PURGEDAYS if defined($mail) && $mail==0;	104	$pSearchhistory = DEFAULT_SEARCHHISTORY_PURGEDAYS if defined($pSearchhistory) && $pSearchhistory == 0;
107	$pSearchhistory= DEFAULT_SEARCHHISTORY_PURGEDAYS if defined($pSearchhistory) && $pSearchhistory==0;
108	$pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0;	105	$pListShareInvites = DEFAULT_SHARE_INVITATION_EXPIRY_DAYS if defined($pListShareInvites) && $pListShareInvites == 0;
109	$pDebarments = DEFAULT_DEBARMENTS_PURGEDAYS if defined($pDebarments) && $pDebarments == 0;	106	$pDebarments = DEFAULT_DEBARMENTS_PURGEDAYS if defined($pDebarments) && $pDebarments == 0;
110		107
111	if ($help) {	108	if ($help) {
112	usage(0);	109	usage(0);
Lines 135-218 my $count; Link Here
135	if ( $sessions && !$sess_days ) {	132	if ( $sessions && !$sess_days ) {
136	if ($verbose) {	133	if ($verbose) {
137	print "Session purge triggered.\n";	134	print "Session purge triggered.\n";
138	$sth = $dbh->prepare("SELECT COUNT(*) FROM sessions");	135	$sth = $dbh->prepare(q{ SELECT COUNT(*) FROM sessions });
139	$sth->execute() or die $dbh->errstr;	136	$sth->execute() or die $dbh->errstr;
140	my @count_arr = $sth->fetchrow_array;	137	my @count_arr = $sth->fetchrow_array;
141	print "$count_arr[0] entries will be deleted.\n";	138	print "$count_arr[0] entries will be deleted.\n";
142	}	139	}
143	$sth = $dbh->prepare("TRUNCATE sessions");	140	$sth = $dbh->prepare(q{ TRUNCATE sessions });
144	$sth->execute() or die $dbh->errstr;	141	$sth->execute() or die $dbh->errstr;
145	if ($verbose) {	142	if ($verbose) {
146	print "Done with session purge.\n";	143	print "Done with session purge.\n";
147	}	144	}
148	} elsif ( $sessions && $sess_days > 0 ) {	145	}
149	if ($verbose) {	146	elsif ( $sessions && $sess_days > 0 ) {
150	print "Session purge triggered with days>$sess_days.\n";	147	print "Session purge triggered with days>$sess_days.\n" if $verbose;
151	}
152	RemoveOldSessions();	148	RemoveOldSessions();
153	if ($verbose) {	149	print "Done with session purge with days>$sess_days.\n" if $verbose;
154	print "Done with session purge with days>$sess_days.\n";
155	}
156	}	150	}
157		151
158	if ($zebraqueue_days) {	152	if ($zebraqueue_days) {
159	$count = 0;	153	$count = 0;
160	if ($verbose) {	154	print "Zebraqueue purge triggered for $zebraqueue_days days.\n" if $verbose;
161	print "Zebraqueue purge triggered for $zebraqueue_days days.\n";
162	}
163	$sth = $dbh->prepare(	155	$sth = $dbh->prepare(
164	"SELECT id,biblio_auth_number,server,time FROM zebraqueue	156	q{
165	WHERE done=1 and time < date_sub(curdate(), interval ? day)"	157	SELECT id,biblio_auth_number,server,time
		158	FROM zebraqueue
		159	WHERE done=1 AND time < date_sub(curdate(), INTERVAL ? DAY)
		160	}
166	);	161	);
167	$sth->execute($zebraqueue_days) or die $dbh->errstr;	162	$sth->execute($zebraqueue_days) or die $dbh->errstr;
168	$sth2 = $dbh->prepare("DELETE FROM zebraqueue WHERE id=?");	163	$sth2 = $dbh->prepare(q{ DELETE FROM zebraqueue WHERE id=? });
169	while ( my $record = $sth->fetchrow_hashref ) {	164	while ( my $record = $sth->fetchrow_hashref ) {
170	$sth2->execute( $record->{id} ) or die $dbh->errstr;	165	$sth2->execute( $record->{id} ) or die $dbh->errstr;
171	$count++;	166	$count++;
172	}	167	}
173	if ($verbose) {	168	print "$count records were deleted.\nDone with zebraqueue purge.\n" if $verbose;
174	print "$count records were deleted.\nDone with zebraqueue purge.\n";
175	}
176	}	169	}
177		170
178	if ($mail) {	171	if ($mail) {
179	print "Mail queue purge triggered for $mail days.\n" if ($verbose);	172	print "Mail queue purge triggered for $mail days.\n" if $verbose;
180		173	$sth = $dbh->prepare(
181	$sth = $dbh->prepare("DELETE FROM message_queue WHERE time_queued < date_sub(curdate(), interval ? day)");	174	q{
		175	DELETE FROM message_queue
		176	WHERE time_queued < date_sub(curdate(), INTERVAL ? DAY)
		177	}
		178	);
182	$sth->execute($mail) or die $dbh->errstr;	179	$sth->execute($mail) or die $dbh->errstr;
183	$count = $sth->rows;	180	$count = $sth->rows;
184	$sth->finish;	181	$sth->finish;
185		182	print "$count messages were deleted from the mail queue.\nDone with message_queue purge.\n" if $verbose;
186	print "$count messages were deleted from the mail queue.\nDone with message_queue purge.\n" if ($verbose);
187	}	183	}
188		184
189	if($purge_merged) {	185	if ($purge_merged) {
190	print "Purging completed entries from need_merge_authorities.\n" if $verbose;	186	print "Purging completed entries from need_merge_authorities.\n" if $verbose;
191	$sth = $dbh->prepare("DELETE FROM need_merge_authorities WHERE done=1");	187	$sth = $dbh->prepare(q{ DELETE FROM need_merge_authorities WHERE done=1 });
192	$sth->execute() or die $dbh->errstr;	188	$sth->execute() or die $dbh->errstr;
193	print "Done with purging need_merge_authorities.\n" if $verbose;	189	print "Done with purging need_merge_authorities.\n" if $verbose;
194	}	190	}
195		191
196	if($pImport) {	192	if ($pImport) {
197	print "Purging records from import tables.\n" if $verbose;	193	print "Purging records from import tables.\n" if $verbose;
198	PurgeImportTables();	194	PurgeImportTables();
199	print "Done with purging import tables.\n" if $verbose;	195	print "Done with purging import tables.\n" if $verbose;
200	}	196	}
201		197
202	if($pZ3950) {	198	if ($pZ3950) {
203	print "Purging Z39.50 records from import tables.\n" if $verbose;	199	print "Purging Z39.50 records from import tables.\n" if $verbose;
204	PurgeZ3950();	200	PurgeZ3950();
205	print "Done with purging Z39.50 records from import tables.\n" if $verbose;	201	print "Done with purging Z39.50 records from import tables.\n" if $verbose;
206	}	202	}
207		203
208	if($pLogs) {	204	if ($pLogs) {
209	print "Purging records from action_logs.\n" if $verbose;	205	print "Purging records from action_logs.\n" if $verbose;
210	$sth = $dbh->prepare("DELETE FROM action_logs WHERE timestamp < date_sub(curdate(), interval ? DAY)");	206	$sth = $dbh->prepare(
		207	q{
		208	DELETE FROM action_logs
		209	WHERE timestamp < date_sub(curdate(), INTERVAL ? DAY)
		210	}
		211	);
211	$sth->execute($pLogs) or die $dbh->errstr;	212	$sth->execute($pLogs) or die $dbh->errstr;
212	print "Done with purging action_logs.\n" if $verbose;	213	print "Done with purging action_logs.\n" if $verbose;
213	}	214	}
214		215
215	if($pSearchhistory) {	216	if ($pSearchhistory) {
216	print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;	217	print "Purging records older than $pSearchhistory from search_history.\n" if $verbose;
217	PurgeSearchHistory($pSearchhistory);	218	PurgeSearchHistory($pSearchhistory);
218	print "Done with purging search_history.\n" if $verbose;	219	print "Done with purging search_history.\n" if $verbose;
Lines 220-235 if($pSearchhistory) { Link Here
220		221
221	if ($pListShareInvites) {	222	if ($pListShareInvites) {
222	print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;	223	print "Purging unaccepted list share invites older than $pListShareInvites days.\n" if $verbose;
223	$sth = $dbh->prepare("	224	$sth = $dbh->prepare(
224	DELETE FROM virtualshelfshares	225	q{
225	WHERE invitekey IS NOT NULL	226	DELETE FROM virtualshelfshares
226	AND (sharedate + INTERVAL ? DAY) < NOW()	227	WHERE invitekey IS NOT NULL
227	");	228	AND (sharedate + INTERVAL ? DAY) < NOW()
		229	}
		230	);
228	$sth->execute($pListShareInvites);	231	$sth->execute($pListShareInvites);
229	print "Done with purging unaccepted list share invites.\n" if $verbose;	232	print "Done with purging unaccepted list share invites.\n" if $verbose;
230	}	233	}
231		234
232	if($pDebarments) {	235	if ($pDebarments) {
233	print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;	236	print "Expired patrons restrictions purge triggered for $pDebarments days.\n" if $verbose;
234	$count = PurgeDebarments();	237	$count = PurgeDebarments();
235	print "$count restrictions were deleted.\nDone with restrictions purge.\n" if $verbose;	238	print "$count restrictions were deleted.\nDone with restrictions purge.\n" if $verbose;
Lines 241-257 sub RemoveOldSessions { Link Here
241	my ( $id, $a_session, $limit, $lasttime );	244	my ( $id, $a_session, $limit, $lasttime );
242	$limit = time() - 24 * 3600 * $sess_days;	245	$limit = time() - 24 * 3600 * $sess_days;
243		246
244	$sth = $dbh->prepare("SELECT id, a_session FROM sessions");	247	$sth = $dbh->prepare(q{ SELECT id, a_session FROM sessions });
245	$sth->execute or die $dbh->errstr;	248	$sth->execute or die $dbh->errstr;
246	$sth->bind_columns( \$id, \$a_session );	249	$sth->bind_columns( \$id, \$a_session );
247	$sth2 = $dbh->prepare("DELETE FROM sessions WHERE id=?");	250	$sth2 = $dbh->prepare(q{ DELETE FROM sessions WHERE id=? });
248	$count = 0;	251	$count = 0;
249		252
250	while ( $sth->fetch ) {	253	while ( $sth->fetch ) {
251	$lasttime = 0;	254	$lasttime = 0;
252	if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {	255	if ( $a_session =~ /lasttime:\s+'?(\d+)/ ) {
253	$lasttime = $1;	256	$lasttime = $1;
254	} elsif ( $a_session =~ /(ATIME\|CTIME):\s+'?(\d+)/ ) {	257	}
		258	elsif ( $a_session =~ /(ATIME\|CTIME):\s+'?(\d+)/ ) {
255	$lasttime = $2;	259	$lasttime = $2;
256	}	260	}
257	if ( $lasttime && $lasttime < $limit ) {	261	if ( $lasttime && $lasttime < $limit ) {
Lines 265-273 sub RemoveOldSessions { Link Here
265	}	269	}
266		270
267	sub PurgeImportTables {	271	sub PurgeImportTables {
		272
268	#First purge import_records	273	#First purge import_records
269	#Delete cascades to import_biblios, import_items and import_record_matches	274	#Delete cascades to import_biblios, import_items and import_record_matches
270	$sth = $dbh->prepare("DELETE FROM import_records WHERE upload_timestamp < date_sub(curdate(), interval ? DAY)");	275	$sth = $dbh->prepare(
		276	q{
		277	DELETE FROM import_records
		278	WHERE upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
		279	}
		280	);
271	$sth->execute($pImport) or die $dbh->errstr;	281	$sth->execute($pImport) or die $dbh->errstr;
272		282
273	# Now purge import_batches	283	# Now purge import_batches
Lines 275-302 sub PurgeImportTables { Link Here
275	# continuously to batches without updating timestamp (Z39.50 search).	285	# continuously to batches without updating timestamp (Z39.50 search).
276	# So we only delete older empty batches.	286	# So we only delete older empty batches.
277	# This delete will therefore not have a cascading effect.	287	# This delete will therefore not have a cascading effect.
278	$sth = $dbh->prepare("DELETE ba	288	$sth = $dbh->prepare(
279	FROM import_batches ba	289	q{
280	LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id	290	DELETE ba
281	WHERE re.import_record_id IS NULL AND	291	FROM import_batches ba
282	ba.upload_timestamp < date_sub(curdate(), interval ? DAY)");	292	LEFT JOIN import_records re ON re.import_batch_id=ba.import_batch_id
		293	WHERE re.import_record_id IS NULL AND
		294	ba.upload_timestamp < date_sub(curdate(), INTERVAL ? DAY)
		295	}
		296	);
283	$sth->execute($pImport) or die $dbh->errstr;	297	$sth->execute($pImport) or die $dbh->errstr;
284	}	298	}
285		299
286
287	sub PurgeZ3950 {	300	sub PurgeZ3950 {
288	$sth = $dbh->prepare(q{	301	$sth = $dbh->prepare(
289	DELETE FROM import_batches WHERE batch_type = 'z3950'	302	q{
290	});	303	DELETE FROM import_batches
		304	WHERE batch_type = 'z3950'
		305	}
		306	);
291	$sth->execute() or die $dbh->errstr;	307	$sth->execute() or die $dbh->errstr;
292	}	308	}
293		309
294	sub PurgeDebarments {	310	sub PurgeDebarments {
295	require Koha::Borrower::Debarments;	311	require Koha::Borrower::Debarments;
296	$count = 0;	312	$count = 0;
297	$sth = $dbh->prepare(q{	313	$sth = $dbh->prepare(
298	SELECT borrower_debarment_id FROM borrower_debarments WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)	314	q{
299	});	315	SELECT borrower_debarment_id
		316	FROM borrower_debarments
		317	WHERE expiration < date_sub(curdate(), INTERVAL ? DAY)
		318	}
		319	);
300	$sth->execute($pDebarments) or die $dbh->errstr;	320	$sth->execute($pDebarments) or die $dbh->errstr;
301	while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {	321	while ( my ($borrower_debarment_id) = $sth->fetchrow_array ) {
302	Koha::Borrower::Debarments::DelDebarment($borrower_debarment_id);	322	Koha::Borrower::Debarments::DelDebarment($borrower_debarment_id);
303	-