From c932638413c161a85cd6439e759903bde3381348 Mon Sep 17 00:00:00 2001 From: Jonathan Druart Date: Wed, 31 Oct 2012 10:31:50 +0100 Subject: [PATCH] [Signed off] Bug 8991: New cronjobs script: purge_orders The script takes a '-until' parameter and deletes all orders received before this date. Execute purge_orders.pl -h for more details. Signed-off-by: Melia Meggs --- misc/cronjobs/purge_orders.pl | 130 +++++++++++++++++++++++++++++++++++++++++ 1 files changed, 130 insertions(+), 0 deletions(-) create mode 100755 misc/cronjobs/purge_orders.pl diff --git a/misc/cronjobs/purge_orders.pl b/misc/cronjobs/purge_orders.pl new file mode 100755 index 0000000..5b44219 --- /dev/null +++ b/misc/cronjobs/purge_orders.pl @@ -0,0 +1,130 @@ +#!/usr/bin/perl + +# Copyright 2012 BibLibre +# 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., 59 Temple Place, +# Suite 330, Boston, MA 02111-1307 USA + +use Modern::Perl; + +use Pod::Usage; +use Getopt::Long; + +use C4::Context; +use C4::Dates; + +my ( $help, $verbose, $until ); +GetOptions( + 'h' => \$help, + 'v' => \$verbose, + 'until:s' => \$until, +); + +if ( $help or not $until ) { + usage(); + exit; +} + +eval { + $until = C4::Dates->new( $until )->output('iso') + if not $until =~ /^\d{4}-\d{2}-\d{2}$/; +}; +if ( $@ or not $until) { + usage(); + say "The until parameter is not in a good format."; + exit 1; +} + +delete_orders( $until ); + +sub delete_orders { + my ( $date ) = @_; + say "I'm going to delete all orders received until $date" + if $verbose; + my $dbh = C4::Context->dbh; + my $query = qq / + SELECT ordernumber,biblionumber FROM aqorders + WHERE datereceived <= ? + /; + my $sth = $dbh->prepare( $query ); + $sth->execute( $date ); + my $to_delete = $sth->fetchall_arrayref( {} ); + + if ( $verbose ) { + say "There is " . plural($to_delete, "order") . " to delete"; + for my $order ( @$to_delete ) { + say "\t- ordernumber $order->{ordernumber} with biblionumber $order->{biblionumber}"; + } + } + + return if @$to_delete == 0; + + $query = qq / + DELETE FROM aqorders + WHERE datereceived <= ? + /; + $sth = $dbh->prepare( $query ); + my $deleted = $sth->execute( $date ); + $deleted = 0 if $deleted eq '0E0'; + say "" . plural ( $deleted, "order" ) . " deleted" + if $verbose; + + if ( $deleted != scalar @$to_delete ) { + say "ERROR: I want to delete " . plural ( $to_delete, "order" ) . " but I deleted " . $deleted; + } +} + +sub plural { + my ( $value, $string ) = @_; + my $n = ref $value ? scalar @$value : $value; + return $n . " " . $string . 's' if ( $n > 1 ); + return "1 $string" if $n; + return "0 $string"; +} + +sub usage { + pod2usage( -verbose => 2 ); + exit; +} + +=head1 NAME + +purge_orders.pl - This script delete old orders + +=head1 USAGE + +purge_orders.pl [-h -until= -v] + +example: perl purge_orders.pl -until `date -d '-12 month' "+%Y-%m-%d"` + +=head1 PARAMETERS + +=over + +=item B<-h> + +Print a brief help message + +=item B<-until> + +Delete orders before this date (format YYYY-MM-DD or like the "metric" syspref) + +=item B<-v> + +Verbose mode. + +=back + +=cut + -- 1.7.2.5