Attachment 18941 Details for Bug 8991 – Bug 8991: New cronjobs script: purge_orders

[patch] Bug 8991: New cronjobs script: purge_orders

Bug-8991-New-cronjobs-script-purgeorders.patch (text/plain), 6.04 KB, created by Jonathan Druart on 2013-06-13 14:29:26 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Jonathan Druart

Created: 2013-06-13 14:29:26 UTC

Size: 6.04 KB

patch

obsolete

>From dfcfb1a613e99e000459e19579eff10c5c519ada Mon Sep 17 00:00:00 2001
>From: Jonathan Druart <jonathan.druart@biblibre.com>
>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=<untildate> -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

Actions: View | Diff | Splinter Review

Attachments on bug 8991: 13128 | 15367 | 18603 | 18941