[Koha-patches] [PATCH] [SIGNED-OFF] Bug 5944 : (MT #3000) new cronjob script to delete old suggestions

[Julian Maurice]

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.

Signed-off-by: Julian Maurice <julian.maurice at biblibre.com>
---
 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.4.1