@@ -, +, @@ purge_orders.pl -h --- misc/cronjobs/purge_orders.pl | 191 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 191 insertions(+) create mode 100755 misc/cronjobs/purge_orders.pl --- a/misc/cronjobs/purge_orders.pl +++ a/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 --