[Koha-patches] [PATCH] Bug 5944 : (MT #3000) new cronjob script to delete old suggestions
Chris Cormack
chrisc at catalyst.net.nz
Thu Mar 24 03:39:42 CET 2011
From: Henri-Damien LAURENT <henridamien.laurent at biblibre.com>
This patch is a new script that delete suggestion that have be processed by librarians.
It take on argument, it's a number of days to keep suggestions. Suggestions olders than TODAY - $days will be deleted.
This script should be used to purge suggestions and clean the table in intranet.
---
C4/Suggestions.pm | 20 +++++++++++-
misc/cronjobs/purge_suggestions.pl | 60 ++++++++++++++++++++++++++++++++++++
2 files changed, 79 insertions(+), 1 deletions(-)
create mode 100755 misc/cronjobs/purge_suggestions.pl
diff --git a/C4/Suggestions.pm b/C4/Suggestions.pm
index 81ff731..9cb2c18 100644
--- a/C4/Suggestions.pm
+++ b/C4/Suggestions.pm
@@ -1,6 +1,7 @@
package C4::Suggestions;
# Copyright 2000-2002 Katipo Communications
+# Parts Copyright Biblibre 2011
#
# This file is part of Koha.
#
@@ -43,9 +44,9 @@ our @EXPORT = qw<
ModSuggestion
NewSuggestion
SearchSuggestion
+ DelSuggestionsOlderThan
>;
-
=head1 NAME
C4::Suggestions - Some useful functions for dealings with aqorders.
@@ -429,6 +430,23 @@ sub DelSuggestion {
}
}
+=head2 DelSuggestionsOlderThan
+ &DelSuggestionsOlderThan($days)
+
+ Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
+
+=cut
+sub DelSuggestionsOlderThan {
+ my ($days) = @_;
+ return if not $days;
+ my $dbh = C4::Context->dbh;
+
+ my $sth = $dbh->prepare("
+ DELETE FROM suggestions WHERE STATUS <> 'ASKED' AND date < ADDDATE(NOW(), ?);
+ ");
+ $sth->execute("-$days");
+}
+
1;
__END__
diff --git a/misc/cronjobs/purge_suggestions.pl b/misc/cronjobs/purge_suggestions.pl
new file mode 100755
index 0000000..d38a7bf
--- /dev/null
+++ b/misc/cronjobs/purge_suggestions.pl
@@ -0,0 +1,60 @@
+#!/usr/bin/perl -w
+
+# Copyright 2010 Biblibre SARL
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# 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 utf8;
+
+BEGIN {
+
+ # find Koha's Perl modules
+ # test carefully before changing this
+ use FindBin;
+ eval { require "$FindBin::Bin/../kohalib.pl" };
+}
+
+use Getopt::Long;
+use Pod::Usage;
+use C4::Suggestions;
+
+my ($help, $days);
+
+GetOptions(
+ 'help|?' => \$help,
+ 'days=s' => \$days,
+);
+
+if($help or not $days){
+ print <<EOF
+ This script delete olds suggestions
+ Parameters :
+ -help|? This message
+ -days TTT to define the age of suggestions to delete
+
+ example :
+ export PERL5LIB=/path/to/koha;export KOHA_CONF=/etc/koha/koha-conf.xml;./purge_suggestions.pl -days 30
+EOF
+;
+ exit;
+}
+
+if($days){
+ DelSuggestionsOlderThan($days);
+}
+
--
1.7.1
More information about the Koha-patches
mailing list