From ff100b59fc66b411136e43332b413deba431ca91 Mon Sep 17 00:00:00 2001 From: Henri-Damien LAURENT Date: Mon, 10 May 2010 15:21:48 +0200 Subject: [PATCH] Bug 5944 : (MT #3000) new cronjob script to delete old suggestions 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 <