From dfcfb1a613e99e000459e19579eff10c5c519ada Mon Sep 17 00:00:00 2001 From: Jonathan Druart Date: Wed, 31 Oct 2012 10:31:50 +0100 Subject: [PATCH] Bug 8991: New cronjobs script: purge_orders The script takes a '-until' parameter and deletes all orders received before this date. If baskets exist without order, they will delete too. If the script is called without the confirm flag, nothing is done and the output contains all actions to do. Execute purge_orders.pl -h for more details. --- misc/cronjobs/purge_orders.pl | 191 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 191 insertions(+) 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..bd039fe --- /dev/null +++ b/misc/cronjobs/purge_orders.pl @@ -0,0 +1,191 @@ +#!/usr/bin/perl + +# Copyright 2013 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::Acquisition qw( DelBasket ); +use C4::Context; +use Koha::DateUtils; + +my ( $help, $verbose, $until, $confirm, $basketno ); +GetOptions( + 'h' => \$help, + 'v' => \$verbose, + 'until:s' => \$until, + '' => \$basketno, + 'c|confirm' => \$confirm, +); + +if ( $help or not $until ) { + usage(); + exit; +} + +# Check if the date is well formatted +eval { + $until = output_pref( dt_from_string( $until ), '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; +} + +# If confirm is not set, we want to display the output +$verbose = 1 unless $confirm; + +say "All orders received until $until will be deleted" + if $verbose; +my $orders_to_delete = get_orders_to_delete( $until, $verbose ); +say plural($orders_to_delete, "order") . " to delete" + if $verbose; + +# We have orders to delete +if ( @$orders_to_delete ) { + if ( $verbose ) { + # Display ordernumber and biblionumber for each one + for my $order ( @$orders_to_delete ) { + say "\t- ordernumber $order->{ordernumber} with biblionumber " . ( $order->{biblionumber} ? $order->{biblionumber} : " NULL " ); + } + } + + my $deleted; + if ( $confirm ) { + # We really want to delete them! + $deleted = delete_orders( $until, $confirm, $verbose ); + + # Not all orders have been deleted, displaying an error message. + if ( $deleted != scalar @$orders_to_delete ) { + say "ERROR: " . plural ( $orders_to_delete, "order" ) . " deleted (" . $deleted . "expected)"; + } elsif ( $deleted ) { + say "" . plural ( $deleted, "order" ) . " deleted" + if $verbose; + } + } + # At least 1 order has been deleted or we are in the dry-run mode + # We want to delete empty closed baskets + if ( $deleted or not $confirm ) { + my $baskets_to_delete = get_baskets_to_delete(); + say "" . plural( $baskets_to_delete, "basket" ) . " to delete" + if $verbose; + for my $basket ( @$baskets_to_delete ) { + say "\t- basket " . $basket->{basketno} . " (" . $basket->{basketname} . ")" + if $verbose; + C4::Acquisition::DelBasket( $basket->{basketno} ) + if $confirm; + } + } +} + +# Returns orders received before a given date. +sub get_orders_to_delete { + my ( $date ) = @_; + return unless $date; + my $dbh = C4::Context->dbh; + my $query = q{ + SELECT ordernumber,biblionumber,basketno + FROM aqorders + WHERE datereceived <= ? + }; + my $sth = $dbh->prepare( $query ); + $sth->execute( $date ); + return $sth->fetchall_arrayref( {} ); +} + +# Delete orders received before a given date. +# Returns the number of deletions. +sub delete_orders { + my ( $date ) = @_; + + my $dbh = C4::Context->dbh; + my $query = q{ + DELETE FROM aqorders + WHERE datereceived <= ? + }; + my $sth = $dbh->prepare( $query ); + my $deleted = $sth->execute( $date ); + $deleted = 0 if $deleted eq '0E0'; + + return $deleted; +} + +# Returns closed baskets without orders. +sub get_baskets_to_delete { + my $dbh = C4::Context->dbh; + my $query = q{ + SELECT DISTINCT(b.basketno), b.basketname + FROM aqbasket b + LEFT JOIN aqorders o ON b.basketno=o.basketno + WHERE o.basketno IS NULL + AND b.closedate IS NOT NULL + }; + my $sth = $dbh->prepare( $query ); + $sth->execute(); + return $sth->fetchall_arrayref( {} ); +} + +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. + +=item B<-c|--confirm> + +Without this flag set, this script will do nothing. + +=back + +=cut -- 1.7.10.4