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

(-)a/misc/cronjobs/purge_orders.pl (-1 / +130 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# Copyright 2012 BibLibre
4
# This file is part of Koha.
5
#
6
# Koha is free software; you can redistribute it and/or modify it under the
7
# terms of the GNU General Public License as published by the Free Software
8
# Foundation; either version 2 of the License, or (at your option) any later
9
# version.
10
#
11
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
12
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
13
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License along with
16
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
17
# Suite 330, Boston, MA  02111-1307 USA
18
19
use Modern::Perl;
20
21
use Pod::Usage;
22
use Getopt::Long;
23
24
use C4::Context;
25
use C4::Dates;
26
27
my ( $help, $verbose, $until );
28
GetOptions(
29
    'h'      => \$help,
30
    'v'      => \$verbose,
31
    'until:s' => \$until,
32
);
33
34
if ( $help or not $until ) {
35
    usage();
36
    exit;
37
}
38
39
eval {
40
    $until = C4::Dates->new( $until )->output('iso')
41
        if not $until =~ /^\d{4}-\d{2}-\d{2}$/;
42
};
43
if ( $@ or not $until) {
44
    usage();
45
    say "The until parameter is not in a good format.";
46
    exit 1;
47
}
48
49
delete_orders( $until );
50
51
sub delete_orders {
52
    my ( $date ) = @_;
53
    say "I'm going to delete all orders received until $date"
54
        if $verbose;
55
    my $dbh = C4::Context->dbh;
56
    my $query = qq /
57
        SELECT ordernumber,biblionumber FROM aqorders
58
        WHERE datereceived <= ?
59
    /;
60
    my $sth = $dbh->prepare( $query );
61
    $sth->execute( $date );
62
    my $to_delete = $sth->fetchall_arrayref( {} );
63
64
    if ( $verbose ) {
65
        say "There is " . plural($to_delete, "order") . " to delete";
66
        for my $order ( @$to_delete ) {
67
            say "\t- ordernumber $order->{ordernumber} with biblionumber $order->{biblionumber}";
68
        }
69
    }
70
71
    return if @$to_delete == 0;
72
73
    $query = qq /
74
        DELETE FROM aqorders
75
        WHERE datereceived <= ?
76
    /;
77
    $sth = $dbh->prepare( $query );
78
    my $deleted = $sth->execute( $date );
79
    $deleted = 0 if $deleted eq '0E0';
80
    say "" . plural ( $deleted, "order" ) . " deleted"
81
        if $verbose;
82
83
    if ( $deleted != scalar @$to_delete ) {
84
        say "ERROR: I want to delete " . plural ( $to_delete, "order" ) . " but I deleted " . $deleted;
85
    }
86
}
87
88
sub plural {
89
    my ( $value, $string ) = @_;
90
    my $n = ref $value ? scalar @$value : $value;
91
    return $n . " " . $string . 's' if ( $n > 1 );
92
    return "1 $string" if $n;
93
    return "0 $string";
94
}
95
96
sub usage {
97
    pod2usage( -verbose => 2 );
98
    exit;
99
}
100
101
=head1 NAME
102
103
purge_orders.pl - This script delete old orders
104
105
=head1 USAGE
106
107
purge_orders.pl [-h -until=<untildate> -v]
108
109
example: perl purge_orders.pl -until `date -d '-12 month' "+%Y-%m-%d"`
110
111
=head1 PARAMETERS
112
113
=over
114
115
=item B<-h>
116
117
Print a brief help message
118
119
=item B<-until>
120
121
Delete orders before this date (format YYYY-MM-DD or like the "metric" syspref)
122
123
=item B<-v>
124
125
Verbose mode.
126
127
=back
128
129
=cut
130

Return to bug 8991