Bug 16187: Add a script to cancel unfilled holds after a specified number of days

This script takes parameters:
days - how many days waiting to concal an unfilled hold on or after
library - (repeatable) branches to consider
holidays - whether or not to count holidays (default is no)

This patchset adds two methods and covers them with tests:
Koha::Holds->unfilled(); To return holds where found = undef
Koha::Hold->age( $use_calendar ); To return the number of days since a
hold was placed (including or excluding holidays)

To test:
1 - Place some holds with varying reservedates
2 - Run script with different parameters to verify options are respected
(-v for verbosity will assist here)
3 - verify that script does nothing without days parameter

Sponsored by:
    Siskiyou County Library (http://www.siskiyoulibrary.info/)

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>

Bug 16187 - Followup

1 - Correct use of original (bad) script name
2 - Explain options better
3 - Remove change from 'W' to 'w'

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>

RM note: Squashed for readability

Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>

Koha/Hold.pm

@@ -32,6 +32,7 @@ use Koha::Biblios;
 use Koha::Items;
 use Koha::Libraries;
 use Koha::Old::Holds;
+use Koha::Calendar;
 
 use base qw(Koha::Object);
 
@@ -45,6 +46,34 @@ Koha::Hold - Koha Hold object class
 
 =cut
 
+=head3 age
+
+returns the number of days since a hold was placed, optionally
+using the calendar
+
+my $age = $hold->age( $use_calendar );
+
+=cut
+
+sub age {
+    my ( $self, $use_calendar ) = @_;
+
+    my $today = DateTime->now(time_zone => C4::Context->tz );
+    my $age;
+
+    if ( $use_calendar ) {
+        my $calendar = Koha::Calendar->new( branchcode => $self->branchcode );
+        $age = $calendar->days_between( dt_from_string( $self->reservedate ), $today );
+    }
+    else {
+        $age = $today->delta_days( dt_from_string( $self->reservedate ) );
+    }
+
+    $age = $age->in_units( 'days' );
+
+    return $age;
+}
+
 =head3 suspend_hold
 
 my $hold = $hold->suspend_hold( $suspend_until_dt );

Koha/Holds.pm

@@ -39,7 +39,7 @@ Koha::Holds - Koha Hold object set class
 
 =head3 waiting
 
-Returns a set of holds that are waiting from an existing set
+returns a set of holds that are waiting from an existing set
 
 =cut
 
@@ -49,6 +49,18 @@ sub waiting {
     return $self->search( { found => 'W' } );
 }
 
+=head3 unfilled
+
+returns a set of holds that are unfilled from an existing set
+
+=cut
+
+sub unfilled {
+    my ( $self ) = @_;
+
+    return $self->search( { found => undef } );
+}
+
 =head3 forced_hold_level
 
 If a patron has multiple holds for a single record,

misc/cronjobs/holds/cancel_unfilled_holds.pl

@@ -0,0 +1,152 @@
+#!/usr/bin/perl
+
+#
+# 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;
+
+BEGIN {
+    # find Koha's Perl modules
+    # test carefully before changing this
+    use FindBin;
+    eval { require "$FindBin::Bin/../kohalib.pl" };
+}
+
+use Getopt::Long;
+use Pod::Usage;
+
+use C4::Reserves;
+use C4::Log;
+use Koha::Holds;
+use Koha::Calendar;
+use Koha::DateUtils;
+use Koha::Libraries;
+
+cronlogaction();
+
+=head1 NAME
+
+cancel_unfilled_holds.pl
+
+=head1 SYNOPSIS
+
+cancel_unfilled_holds.pl
+    [-days][-library][-holidays]
+
+ Options:
+    -help                       brief help
+    -days                       cancel holds placed this many days ago which have not been filled
+    -library                    [repeatable] limit to specified branch(es)
+    -holidays                   skip holidays when calculating days waiting
+    -v                          verbose
+
+head1 OPTIONS
+
+=over 8
+
+=item B<-help>
+
+Print brief help and exit.
+
+=item B<-man>
+
+Print full documentation and exit.
+
+=item B<-days>
+
+Specify the number of days waiting since a hold that remains unfilled was placed.
+E.g. a value of 730 would cancel holds placed 2 years ago or more that have never been filled
+
+=item B<-library>
+
+Repeatable option to specify which branchcode(s) to cancel holds for.
+
+=item B<-holidays>
+
+This switch specifies whether to count holidays as days waiting. Default is no.
+
+=back
+
+=cut
+
+my $help = 0;
+my $days;
+my @branchcodes;
+my $use_calendar = 0;
+my $verbose      = 0;
+my $confirm      = 0;
+
+GetOptions(
+    'help|?'    => \$help,
+    'days=s'    => \$days,
+    'library=s' => \@branchcodes,
+    'holidays'  => \$use_calendar,
+    'v'         => \$verbose,
+    'confirm'   => \$confirm,
+) or pod2usage(1);
+pod2usage(1) if $help;
+
+unless ( defined $days ) {
+    pod2usage(
+        {
+            -exitval => 1,
+            -msg =>
+qq{\nError: You must specify a value for days waiting to cancel holds.\n},
+        }
+    );
+}
+warn "Running in test mode, no actions will be taken" unless ($confirm);
+
+$verbose and warn "Looking for unfilled holds placed $days or more days ago\n";
+
+unless ( scalar @branchcodes > 0 ) {
+    my $branches = Koha::Libraries->search->get_column('branchcode');
+    while ( my $branch = $branches->next ) {
+        push @branchcodes, $branch->branchcode;
+    }
+}
+$verbose and warn "Running for branch(es): " . join( "|", @branchcodes ) . "\n";
+
+foreach my $branch (@branchcodes) {
+
+    my $holds =
+      Koha::Holds->search( { branchcode => $branch } )->unfilled();
+
+    while ( my $hold = $holds->next ) {
+
+        my $age = $hold->age( $use_calendar );
+
+        $verbose
+          and warn "Hold #"
+          . $hold->reserve_id
+          . " has been unfilled for $age day(s)\n";
+
+        if ( $age >= $days ) {
+            my $action = $confirm ? "Cancelling " : "Would have cancelled ";
+            $verbose
+              and warn $action
+              . "reserve_id: "
+              . $hold->reserve_id
+              . " for borrower: "
+              . $hold->borrowernumber
+              . " on biblio: "
+              . $hold->biblionumber . "\n";
+            CancelReserve( { reserve_id => $hold->reserve_id } ) if $confirm;
+        }
+
+    }
+
+}

t/db_dependent/Hold.t

@@ -22,13 +22,14 @@ use C4::Context;
 use C4::Biblio qw( AddBiblio );
 use Koha::Database;
 use Koha::Libraries;
+use C4::Calendar;
 use Koha::Patrons;
 use Koha::Holds;
 use Koha::Item;
 use Koha::DateUtils;
 use t::lib::TestBuilder;
 
-use Test::More tests => 29;
+use Test::More tests => 31;
 use Test::Warn;
 
 use_ok('Koha::Hold');
@@ -66,6 +67,7 @@ my $hold = Koha::Hold->new(
     {
         biblionumber   => $biblionumber,
         itemnumber     => $item->id(),
+        reservedate    => '2017-01-01',
         waitingdate    => '2000-01-01',
         borrowernumber => $borrower->{borrowernumber},
         branchcode     => $branches[1]->{branchcode},
@@ -74,6 +76,12 @@ my $hold = Koha::Hold->new(
 );
 $hold->store();
 
+my $b1_cal = C4::Calendar->new( branchcode => $branches[1]->{branchcode} );
+$b1_cal->insert_single_holiday( day => 02, month => 01, year => 2017, title => "Morty Day", description => "Rick" ); #Add a holiday
+my $today = DateTime->now(time_zone => C4::Context->tz );
+is( $hold->age(), $today->delta_days( dt_from_string( '2017-01-01' ) )->in_units( 'days')  , "Age of hold is days from reservedate to now if calendar ignored");
+is( $hold->age(1), $today->delta_days( dt_from_string( '2017-01-01' ) )->in_units( 'days' ) - 1 , "Age of hold is days from reservedate to now minus 1 if calendar used");
+
 is( $hold->suspend, 0, "Hold is not suspended" );
 $hold->suspend_hold();
 is( $hold->suspend, 1, "Hold is suspended" );

t/db_dependent/Holds.t

@@ -7,7 +7,7 @@ use t::lib::TestBuilder;
 
 use C4::Context;
 
-use Test::More tests => 53;
+use Test::More tests => 54;
 use MARC::Record;
 use C4::Biblio;
 use C4::Items;
@@ -121,6 +121,7 @@ ok( $hold_branch == $hold->branch(), "branch method returns stashed branch" );
 my $hold_found = $hold->found();
 $hold->set({ found => 'W'})->store();
 is( Koha::Holds->waiting()->count(), 1, "Koha::Holds->waiting returns waiting holds" );
+is( Koha::Holds->unfilled()->count(), 4, "Koha::Holds->unfilled returns unfilled holds" );
 
 my $patron = Koha::Patrons->find( $borrowernumbers[0] );
 $holds = $patron->holds;