=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);

    }

}

#!/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 <http://www.gnu.org/licenses>.

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] };

}