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

(-)a/C4/Suggestions.pm (-1 / +19 lines)
Lines 1-6 Link Here
1
package C4::Suggestions;
1
package C4::Suggestions;
2
2
3
# Copyright 2000-2002 Katipo Communications
3
# Copyright 2000-2002 Katipo Communications
4
# Parts Copyright Biblibre 2011
4
#
5
#
5
# This file is part of Koha.
6
# This file is part of Koha.
6
#
7
#
Lines 43-51 our @EXPORT = qw< Link Here
43
    ModSuggestion
44
    ModSuggestion
44
    NewSuggestion
45
    NewSuggestion
45
    SearchSuggestion
46
    SearchSuggestion
47
    DelSuggestionsOlderThan
46
>;
48
>;
47
49
48
49
=head1 NAME
50
=head1 NAME
50
51
51
C4::Suggestions - Some useful functions for dealings with aqorders.
52
C4::Suggestions - Some useful functions for dealings with aqorders.
Lines 429-434 sub DelSuggestion { Link Here
429
    }
430
    }
430
}
431
}
431
432
433
=head2 DelSuggestionsOlderThan
434
    &DelSuggestionsOlderThan($days)
435
    
436
    Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
437
    
438
=cut
439
sub DelSuggestionsOlderThan {
440
    my ($days) = @_;
441
    return if not $days;
442
    my $dbh = C4::Context->dbh;
443
    
444
    my $sth = $dbh->prepare("
445
        DELETE FROM suggestions WHERE STATUS <> 'ASKED' AND date < ADDDATE(NOW(), ?);
446
    ");
447
    $sth->execute("-$days");
448
}
449
432
1;
450
1;
433
__END__
451
__END__
434
452
(-)a/misc/cronjobs/purge_suggestions.pl (-1 / +60 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl -w
2
3
# Copyright 2010 Biblibre SARL
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 2 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use strict;
21
use warnings;
22
use utf8;
23
24
BEGIN {
25
26
    # find Koha's Perl modules
27
    # test carefully before changing this
28
    use FindBin;
29
    eval { require "$FindBin::Bin/../kohalib.pl" };
30
}
31
32
use Getopt::Long;
33
use Pod::Usage;
34
use C4::Suggestions;
35
36
my ($help, $days);
37
38
GetOptions(
39
    'help|?'         => \$help,
40
    'days=s'         => \$days,
41
);
42
43
if($help or not $days){
44
    print <<EOF
45
    This script delete olds suggestions
46
    Parameters :
47
    -help|? This message
48
    -days TTT to define the age of suggestions to delete
49
50
     example :
51
     export PERL5LIB=/path/to/koha;export KOHA_CONF=/etc/koha/koha-conf.xml;./purge_suggestions.pl -days 30
52
EOF
53
;
54
    exit;
55
}
56
57
if($days){
58
    DelSuggestionsOlderThan($days);
59
}
60

Return to bug 5944