From e50582293bb74ea8cb7ebf57344a89c368d43185 Mon Sep 17 00:00:00 2001 From: Marcel de Rooy Date: Thu, 8 Feb 2024 15:29:30 +0000 Subject: [PATCH] Bug 36068: Add maint script acq_cancel_obsolete_orders.pl Introducing $orders->filter_by_obsolete and $orders->cancel. Test plan: Run t/db_dependent/Koha/Acquisition/Orders.t Create basket with few orders. Remove some biblio records. Run acq_cancel_obsolete_orders.pl -c Signed-off-by: Marcel de Rooy Signed-off-by: David Nind Signed-off-by: Martin Renvoize Signed-off-by: Katrin Fischer --- Koha/Acquisition/Orders.pm | 77 +++++++++++++++++++ .../maintenance/acq_cancel_obsolete_orders.pl | 74 ++++++++++++++++++ t/db_dependent/Koha/Acquisition/Orders.t | 48 +++++++++++- 3 files changed, 198 insertions(+), 1 deletion(-) create mode 100755 misc/maintenance/acq_cancel_obsolete_orders.pl diff --git a/Koha/Acquisition/Orders.pm b/Koha/Acquisition/Orders.pm index 2438886ac8..69fe134ba6 100644 --- a/Koha/Acquisition/Orders.pm +++ b/Koha/Acquisition/Orders.pm @@ -231,6 +231,83 @@ sub filter_by_id_including_transfers { ); } +=head3 filter_by_obsolete + + $orders->filter_by_obsolete( $age ); + + What are obsolete orders here? + [1] Order lines that have no biblio anymore but are still considered open + (received < ordered, not cancelled). + [2] Order lines with status 'cancelled' but no cancellation date. + [3] Order lines with cancellation date and no status 'cancelled'. + + An optional parameter age may limit the selection by entrydate older than $age days. + +=cut + +sub filter_by_obsolete { + my ( $self, $params ) = @_; + my $rs = $self->search( + { + -or => [ + { datecancellationprinted => undef, orderstatus => 'cancelled' }, + { datecancellationprinted => { '!=', undef }, orderstatus => { '!=', 'cancelled' } }, + -and => [ + orderstatus => [ 'ordered', 'partial', 'new' ], + biblionumber => undef, + datecancellationprinted => undef, + -or => [ + { quantity => [ undef, 0 ] }, + { quantityreceived => { '<', \['quantity'] } }, + ], + ], + ], + } + ); + if ( $params->{age} ) { + my $dtf = Koha::Database->new->schema->storage->datetime_parser; + my $dt = Koha::DateUtils::dt_from_string->subtract( days => $params->{age} )->truncate( to => 'day' ); + $rs = $rs->search( { entrydate => { '<', $dtf->format_datetime($dt) } } ); + } + return $rs; +} + + +=head3 cancel + + $orders_rs->cancel( { delete_biblio => 0|1 } ); + + Returns a count and diagnostic object messages. + +=cut + +sub cancel { + my ( $self, $params ) = @_; + my $delete_biblio = $params->{delete_biblio} || 0; # keep by default :) + my $count = 0; + my @messages; + while ( my $order = $self->next ) { + _correct_quantity($order); # historical ballast + $order->cancel( { delete_biblio => $delete_biblio } ); + if ( @{ $order->object_messages } ) { + push @messages, @{ $order->object_messages }; + } else { + $count++; + } + } + return ( $count, [@messages] ); +} + +sub _correct_quantity { + my ($order) = @_; + if ( !$order->quantity ) { + + # This may be the case in old data .. But ->store needs a quantity even when cancelling + # Note also that the quantity column def still has NULL -- 2024-02-14 + $order->quantity(1); + } +} + =head2 Internal methods =head3 _type diff --git a/misc/maintenance/acq_cancel_obsolete_orders.pl b/misc/maintenance/acq_cancel_obsolete_orders.pl new file mode 100755 index 0000000000..24e9753d8a --- /dev/null +++ b/misc/maintenance/acq_cancel_obsolete_orders.pl @@ -0,0 +1,74 @@ +#!/usr/bin/perl + +=head1 NAME + +acq_cancel_obsolete_orders.pl - Script for cancelling obsolete orders + +=head1 SYNOPSIS + + # Help + misc/maintenance/acq_cancel_obsolete_orders.pl --help + + # Count obsolete orders (with/without age) + misc/maintenance/acq_cancel_obsolete_orders.pl + misc/maintenance/acq_cancel_obsolete_orders.pl --age 365 + + # Cancel obsolete orders (with/without age) + misc/maintenance/acq_cancel_obsolete_orders.pl -c + misc/maintenance/acq_cancel_obsolete_orders.pl -c --age 365 + +=head1 DESCRIPTION + + Obsolete order lines (in table aqorders) are defined here as: + + [1] Biblionumber is null but received < ordered and not cancelled. + [2] Status 'cancelled' but no cancellation date. + [3] Filled cancellation date, but status is not 'cancelled'. + + This script may count those orders or cancel them. + + Optionally, you may pass an age in DAYS to limit the + selected set to records with an older entrydate. + +=cut + +# Copyright 2024 Rijksmuseum +# +# 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 3 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, see . + +use Modern::Perl; +use Getopt::Long qw( GetOptions ); +use Pod::Usage qw( pod2usage ); + +use Koha::Acquisition::Orders; +use Koha::Script; + +my ($params); +GetOptions( + 'confirm' => \$params->{confirm}, 'help' => \$params->{help}, 'age:i' => \$params->{age}, +); +if ( $params->{help} ) { + pod2usage( -verbose => 2 ); + exit; +} + +my $rs = Koha::Acquisition::Orders->filter_by_obsolete( { age => $params->{age} } ); +print sprintf( "Found %d obsolete orders\n", $rs->count ); +if ( $params->{confirm} ) { + my @results = $rs->cancel; + print sprintf( "Cancelled %d obsolete orders\n", $results[0] ); + print sprintf( "Got %d warnings\n", @{ $results[1] } ) if @{ $results[1] }; +} diff --git a/t/db_dependent/Koha/Acquisition/Orders.t b/t/db_dependent/Koha/Acquisition/Orders.t index cf28bd07b7..0fb2bc4031 100755 --- a/t/db_dependent/Koha/Acquisition/Orders.t +++ b/t/db_dependent/Koha/Acquisition/Orders.t @@ -19,7 +19,7 @@ use Modern::Perl; -use Test::More tests => 2; +use Test::More tests => 3; use Test::Exception; use t::lib::TestBuilder; @@ -158,3 +158,49 @@ subtest 'filter_by_id_including_transfers() tests' => sub { $schema->storage->txn_rollback; }; + +subtest 'filter_by_obsolete and cancel' => sub { + plan tests => 11; + $schema->storage->txn_begin; + + my $order_1 = $builder->build_object( { class => 'Koha::Acquisition::Orders' } ); + my $order_2 = $builder->build_object( { class => 'Koha::Acquisition::Orders' } ); + my $order_3 = $builder->build_object( { class => 'Koha::Acquisition::Orders' } ); + + # First make order 1 obsolete by removing biblio, and order 3 by status problem. + my $date = Koha::DateUtils::dt_from_string->subtract( days => 7 ); + $order_1->orderstatus('ordered')->quantity(2)->quantityreceived(0)->datecancellationprinted(undef) + ->entrydate($date)->store; + Koha::Biblios->find( $order_1->biblionumber )->delete; + $order_1->discard_changes; + $order_2->orderstatus('ordered')->quantity(3)->quantityreceived(0)->datecancellationprinted(undef)->store; + $order_3->orderstatus('cancelled')->datecancellationprinted(undef)->store; + + my $limit = { ordernumber => { '>=', $order_1->ordernumber } }; + my $rs = Koha::Acquisition::Orders->filter_by_obsolete->search($limit); + is( $rs->count, 2, 'Two obsolete' ); + is( $rs->search( { ordernumber => $order_1->ordernumber } )->count, 1, 'Including order_1' ); + is( $rs->search( { ordernumber => $order_2->ordernumber } )->count, 0, 'Excluding order_2' ); + + # Test param age + $rs = Koha::Acquisition::Orders->filter_by_obsolete( { age => 6 } )->search($limit); + is( $rs->count, 1, 'Age 6: Including order_1' ); + $rs = Koha::Acquisition::Orders->filter_by_obsolete( { age => 7 } )->search($limit); + is( $rs->count, 0, 'Age 7: Excluding order_1' ); + + # Make order 2 obsolete too + Koha::Biblios->find( $order_2->biblionumber )->delete; + $order_2->discard_changes; + + # Use the plural cancel method + $rs = Koha::Acquisition::Orders->filter_by_obsolete->search($limit); + is( $rs->count, 3, 'Three obsolete' ); + my @results = $rs->cancel; + is( $results[0], 3, 'All should be cancelled' ); + is( @{ $results[1] }, 0, 'No messages' ); + is( $order_1->discard_changes->orderstatus, 'cancelled', 'Check orderstatus of order_1' ); + isnt( $order_2->discard_changes->datecancellationprinted, undef, 'Cancellation date of order_2 filled' ); + isnt( $order_3->discard_changes->datecancellationprinted, undef, 'Cancellation date of order_3 filled' ); + + $schema->storage->txn_rollback; +}; -- 2.39.5