Attachment #112350 for bug #12656

View | Details | Raw Unified | Return to bug 12656
Collapse All | Expand All

Lines 901-906 Cancels all reserves with an expiration date from before today. Link Here

(-)a/C4/Reserves.pm (-1 / +3 lines)
901	=cut	901	=cut
902		902
903	sub CancelExpiredReserves {	903	sub CancelExpiredReserves {
		904	my $cancellation_reason = shift;
904	my $today = dt_from_string();	905	my $today = dt_from_string();
905	my $cancel_on_holidays = C4::Context->preference('ExpireReservesOnHolidays');	906	my $cancel_on_holidays = C4::Context->preference('ExpireReservesOnHolidays');
906	my $expireWaiting = C4::Context->preference('ExpireReservesMaxPickUpDelay');	907	my $expireWaiting = C4::Context->preference('ExpireReservesMaxPickUpDelay');
Lines 918-924 sub CancelExpiredReserves { Link Here
918	next if !$cancel_on_holidays && $calendar->is_holiday( $today );	919	next if !$cancel_on_holidays && $calendar->is_holiday( $today );
919		920
920	my $cancel_params = {};	921	my $cancel_params = {};
921	if ( $hold->found eq 'W' ) {	922	$cancel_params->{cancellation_reason} = $cancellation_reason if defined($cancellation_reason);
		923	if ( defined($hold->found) && $hold->found eq 'W' ) {
922	$cancel_params->{charge_cancel_fee} = 1;	924	$cancel_params->{charge_cancel_fee} = 1;
923	}	925	}
924	$hold->cancel( $cancel_params );	926	$hold->cancel( $cancel_params );




#!/usr/bin/perl

# Copyright 2009-2010 Kyle Hall
# Copyright 2020 PTFS Europe
#
# This file is part of Koha.
#

# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

=head1 NAME

cancel_expired_holds.pl - cron script to cancel holds as they expire

=head1 SYNOPSIS

  ./cancel_expired_holds.pl
  ./cancel_expired_holds.pl --reason="EXPIRED"

or, in crontab:

  0 1 * * * cancel_expired_holds.pl
  0 1 * * * cancel_expired_holds.pl --reason="EXPIRED"

=head1 DESCRIPTION

This script calls C4::Reserves::CancelExpiredReserves which will find and cancel all expired reseves in the system.

=cut

use Modern::Perl;
use Getopt::Long;
use Pod::Usage;

BEGIN {
    # find Koha's Perl modules

    eval { require "$FindBin::Bin/../kohalib.pl" };
}

# cancel all expired hold requests

use Koha::Script -cron;
use C4::Reserves;
use C4::Log;

=head1 OPTIONS

=over 8

=item B<--help>

Print a brief help message and exits.

=item B<--reason>

Optionally adds a reason for cancellation (which will trigger a notice to be sent to the patron)

=back

=cut

my $help = 0;
my $reason;

GetOptions(
    'help|?'   => \$help,
    'reason=s' => \$reason
) or pod2usage(1);
pod2usage(1) if $help;

cronlogaction();

CancelExpiredReserves($reason);




#!/usr/bin/perl

use Modern::Perl;
use Test::More tests => 4;

use t::lib::Mocks;
use t::lib::TestBuilder;


};

subtest 'Test handling of cancellation reason if passed' => sub {
    plan tests => 2;

    my $builder = t::lib::TestBuilder->new();

    my $expdate = dt_from_string->add( days => -2 );
    my $reserve = $builder->build({
        source => 'Reserve',
        value  => {
            expirationdate => '2018-01-01',
            found => 'T',
            cancellationdate => undef,
            suspend => 0,
            suspend_until => undef
        }
    });
    my $reserve_id = $reserve->{reserve_id};
    my $count = Koha::Holds->search->count;
    CancelExpiredReserves("EXPIRED");
    is(Koha::Holds->search->count, $count-1, "Hold is cancelled when reason is passed");
    my $old_reserve = Koha::Old::Holds->find($reserve_id);
    is($old_reserve->cancellation_reason, 'EXPIRED', "Hold cancellation_reason was set correctly");
};

$schema->storage->txn_rollback;
- 

Return to bug 12656

Lines 1-6 Link Here

(-)a/misc/cronjobs/holds/cancel_expired_holds.pl (-3 / +49 lines)
1	#!/usr/bin/perl	1	#!/usr/bin/perl
2		2
3	# Copyright 2009-2010 Kyle Hall	3	# Copyright 2009-2010 Kyle Hall
		4	# Copyright 2020 PTFS Europe
4	#	5	#
5	# This file is part of Koha.	6	# This file is part of Koha.
6	#	7	#
Lines 17-23 Link Here
17	# You should have received a copy of the GNU General Public License	18	# You should have received a copy of the GNU General Public License
18	# along with Koha; if not, see <http://www.gnu.org/licenses>.	19	# along with Koha; if not, see <http://www.gnu.org/licenses>.
19		20
		21	=head1 NAME
		22
		23	cancel_expired_holds.pl - cron script to cancel holds as they expire
		24
		25	=head1 SYNOPSIS
		26
		27	./cancel_expired_holds.pl
		28	./cancel_expired_holds.pl --reason="EXPIRED"
		29
		30	or, in crontab:
		31
		32	0 1 * * * cancel_expired_holds.pl
		33	0 1 * * * cancel_expired_holds.pl --reason="EXPIRED"
		34
		35	=head1 DESCRIPTION
		36
		37	This script calls C4::Reserves::CancelExpiredReserves which will find and cancel all expired reseves in the system.
		38
		39	=cut
		40
20	use Modern::Perl;	41	use Modern::Perl;
		42	use Getopt::Long;
		43	use Pod::Usage;
21		44
22	BEGIN {	45	BEGIN {
23	# find Koha's Perl modules	46	# find Koha's Perl modules
Lines 26-37 BEGIN { Link Here
26	eval { require "$FindBin::Bin/../kohalib.pl" };	49	eval { require "$FindBin::Bin/../kohalib.pl" };
27	}	50	}
28		51
29	# cancel all expired hold requests
30
31	use Koha::Script -cron;	52	use Koha::Script -cron;
32	use C4::Reserves;	53	use C4::Reserves;
33	use C4::Log;	54	use C4::Log;
34		55
		56	=head1 OPTIONS
		57
		58	=over 8
		59
		60	=item B<--help>
		61
		62	Print a brief help message and exits.
		63
		64	=item B<--reason>
		65
		66	Optionally adds a reason for cancellation (which will trigger a notice to be sent to the patron)
		67
		68	=back
		69
		70	=cut
		71
		72	my $help = 0;
		73	my $reason;
		74
		75	GetOptions(
		76	'help\|?' => \$help,
		77	'reason=s' => \$reason
		78	) or pod2usage(1);
		79	pod2usage(1) if $help;
		80
35	cronlogaction();	81	cronlogaction();
36		82
37	CancelExpiredReserves();	83	CancelExpiredReserves($reason);

Lines 1-7 Link Here

(-)a/t/db_dependent/Reserves/CancelExpiredReserves.t (-2 / +25 lines)
1	#!/usr/bin/perl	1	#!/usr/bin/perl
2		2
3	use Modern::Perl;	3	use Modern::Perl;
4	use Test::More tests => 3;	4	use Test::More tests => 4;
5		5
6	use t::lib::Mocks;	6	use t::lib::Mocks;
7	use t::lib::TestBuilder;	7	use t::lib::TestBuilder;
Lines 199-202 subtest 'Test handling of in transit reserves by CancelExpiredReserves' => sub { Link Here
199		199
200	};	200	};
201		201
		202	subtest 'Test handling of cancellation reason if passed' => sub {
		203	plan tests => 2;
		204
		205	my $builder = t::lib::TestBuilder->new();
		206
		207	my $expdate = dt_from_string->add( days => -2 );
		208	my $reserve = $builder->build({
		209	source => 'Reserve',
		210	value => {
		211	expirationdate => '2018-01-01',
		212	found => 'T',
		213	cancellationdate => undef,
		214	suspend => 0,
		215	suspend_until => undef
		216	}
		217	});
		218	my $reserve_id = $reserve->{reserve_id};
		219	my $count = Koha::Holds->search->count;
		220	CancelExpiredReserves("EXPIRED");
		221	is(Koha::Holds->search->count, $count-1, "Hold is cancelled when reason is passed");
		222	my $old_reserve = Koha::Old::Holds->find($reserve_id);
		223	is($old_reserve->cancellation_reason, 'EXPIRED', "Hold cancellation_reason was set correctly");
		224	};
		225
202	$schema->storage->txn_rollback;	226	$schema->storage->txn_rollback;
203	-