Bug 16187: Add a script to cancel unfilled holds after a specified number of days
[koha.git] / Koha / Hold.pm
blobc30649d4598f4d3192999ac73d034fd5973818e0
1 package Koha::Hold;
3 # Copyright ByWater Solutions 2014
4 # Copyright 2017 Koha Development team
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 3 of the License, or (at your option) any later
11 # version.
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21 use Modern::Perl;
23 use Carp;
24 use Data::Dumper qw(Dumper);
26 use C4::Context qw(preference);
27 use C4::Log;
29 use Koha::DateUtils qw(dt_from_string output_pref);
30 use Koha::Patrons;
31 use Koha::Biblios;
32 use Koha::Items;
33 use Koha::Libraries;
34 use Koha::Old::Holds;
35 use Koha::Calendar;
37 use base qw(Koha::Object);
39 =head1 NAME
41 Koha::Hold - Koha Hold object class
43 =head1 API
45 =head2 Class Methods
47 =cut
49 =head3 age
51 returns the number of days since a hold was placed, optionally
52 using the calendar
54 my $age = $hold->age( $use_calendar );
56 =cut
58 sub age {
59 my ( $self, $use_calendar ) = @_;
61 my $today = DateTime->now(time_zone => C4::Context->tz );
62 my $age;
64 if ( $use_calendar ) {
65 my $calendar = Koha::Calendar->new( branchcode => $self->branchcode );
66 $age = $calendar->days_between( dt_from_string( $self->reservedate ), $today );
68 else {
69 $age = $today->delta_days( dt_from_string( $self->reservedate ) );
72 $age = $age->in_units( 'days' );
74 return $age;
77 =head3 suspend_hold
79 my $hold = $hold->suspend_hold( $suspend_until_dt );
81 =cut
83 sub suspend_hold {
84 my ( $self, $dt ) = @_;
86 $dt = $dt ? $dt->clone()->truncate( to => 'day' ) : undef;
88 if ( $self->is_waiting ) { # We can't suspend waiting holds
89 carp "Unable to suspend waiting hold!";
90 return $self;
93 $self->suspend(1);
94 $self->suspend_until( $dt );
96 $self->store();
98 logaction( 'HOLDS', 'SUSPEND', $self->reserve_id, Dumper($self->unblessed) )
99 if C4::Context->preference('HoldsLog');
101 return $self;
104 =head3 resume
106 my $hold = $hold->resume();
108 =cut
110 sub resume {
111 my ( $self ) = @_;
113 $self->suspend(0);
114 $self->suspend_until( undef );
116 $self->store();
118 logaction( 'HOLDS', 'RESUME', $self->reserve_id, Dumper($self->unblessed) )
119 if C4::Context->preference('HoldsLog');
121 return $self;
124 =head3 delete
126 $hold->delete();
128 =cut
130 sub delete {
131 my ( $self ) = @_;
133 my $deleted = $self->SUPER::delete($self);
135 logaction( 'HOLDS', 'DELETE', $self->reserve_id, Dumper($self->unblessed) )
136 if C4::Context->preference('HoldsLog');
138 return $deleted;
141 =head3 set_waiting
143 =cut
145 sub set_waiting {
146 my ( $self, $transferToDo ) = @_;
148 $self->priority(0);
150 if ($transferToDo) {
151 $self->found('T')->store();
152 return $self;
155 my $today = dt_from_string();
156 my $values = {
157 found => 'W',
158 waitingdate => $today->ymd,
161 my $requested_expiration;
162 if ($self->expirationdate) {
163 $requested_expiration = dt_from_string($self->expirationdate);
166 my $max_pickup_delay = C4::Context->preference("ReservesMaxPickUpDelay");
167 my $cancel_on_holidays = C4::Context->preference('ExpireReservesOnHolidays');
168 my $calendar = Koha::Calendar->new( branchcode => $self->branchcode );
170 my $expirationdate = $today->clone;
171 $expirationdate->add(days => $max_pickup_delay);
173 if ( C4::Context->preference("ExcludeHolidaysFromMaxPickUpDelay") ) {
174 $expirationdate = $calendar->days_forward( dt_from_string(), $max_pickup_delay );
177 # If patron's requested expiration date is prior to the
178 # calculated one, we keep the patron's one.
179 my $cmp = $requested_expiration ? DateTime->compare($requested_expiration, $expirationdate) : 0;
180 $values->{expirationdate} = $cmp == -1 ? $requested_expiration->ymd : $expirationdate->ymd;
182 $self->set($values)->store();
184 return $self;
187 =head3 is_found
189 Returns true if hold is a waiting or in transit
191 =cut
193 sub is_found {
194 my ($self) = @_;
196 return 0 unless $self->found();
197 return 1 if $self->found() eq 'W';
198 return 1 if $self->found() eq 'T';
201 =head3 is_waiting
203 Returns true if hold is a waiting hold
205 =cut
207 sub is_waiting {
208 my ($self) = @_;
210 my $found = $self->found;
211 return $found && $found eq 'W';
214 =head3 is_in_transit
216 Returns true if hold is a in_transit hold
218 =cut
220 sub is_in_transit {
221 my ($self) = @_;
223 return 0 unless $self->found();
224 return $self->found() eq 'T';
227 =head3 is_cancelable
229 Returns true if hold is a cancelable hold
231 Holds may be canceled if they not found, or
232 are found and waiting. A hold found but in
233 transit cannot be canceled.
235 =cut
237 sub is_cancelable {
238 my ($self) = @_;
240 return 1 unless $self->is_found();
241 return 0 if $self->is_in_transit();
242 return 1 if $self->is_waiting();
243 return 0;
246 =head3 is_at_destination
248 Returns true if hold is waiting
249 and the hold's pickup branch matches
250 the hold item's holding branch
252 =cut
254 sub is_at_destination {
255 my ($self) = @_;
257 return $self->is_waiting() && ( $self->branchcode() eq $self->item()->holdingbranch() );
260 =head3 biblio
262 Returns the related Koha::Biblio object for this hold
264 =cut
266 sub biblio {
267 my ($self) = @_;
269 $self->{_biblio} ||= Koha::Biblios->find( $self->biblionumber() );
271 return $self->{_biblio};
274 =head3 item
276 Returns the related Koha::Item object for this Hold
278 =cut
280 sub item {
281 my ($self) = @_;
283 $self->{_item} ||= Koha::Items->find( $self->itemnumber() );
285 return $self->{_item};
288 =head3 branch
290 Returns the related Koha::Library object for this Hold
292 =cut
294 sub branch {
295 my ($self) = @_;
297 $self->{_branch} ||= Koha::Libraries->find( $self->branchcode() );
299 return $self->{_branch};
302 =head3 borrower
304 Returns the related Koha::Patron object for this Hold
306 =cut
308 sub borrower {
309 my ($self) = @_;
311 $self->{_borrower} ||= Koha::Patrons->find( $self->borrowernumber() );
313 return $self->{_borrower};
316 =head3 is_suspended
318 my $bool = $hold->is_suspended();
320 =cut
322 sub is_suspended {
323 my ( $self ) = @_;
325 return $self->suspend();
329 =head3 cancel
331 my $cancel_hold = $hold->cancel();
333 Cancel a hold:
334 - The hold will be moved to the old_reserves table with a priority=0
335 - The priority of other holds will be updated
336 - The patron will be charge (see ExpireReservesMaxPickUpDelayCharge) if the charge_cancel_fee parameter is set
337 - a CANCEL HOLDS log will be done if the pref HoldsLog is on
339 =cut
341 sub cancel {
342 my ( $self, $params ) = @_;
343 $self->_result->result_source->schema->txn_do(
344 sub {
345 $self->cancellationdate(dt_from_string);
346 $self->priority(0);
347 $self->_move_to_old;
348 $self->SUPER::delete(); # Do not add a DELETE log
350 # now fix the priority on the others....
351 C4::Reserves::_FixPriority({ biblionumber => $self->biblionumber });
353 # and, if desired, charge a cancel fee
354 my $charge = C4::Context->preference("ExpireReservesMaxPickUpDelayCharge");
355 if ( $charge && $params->{'charge_cancel_fee'} ) {
356 C4::Accounts::manualinvoice($self->borrowernumber, $self->itemnumber, '', 'HE', $charge);
359 C4::Log::logaction( 'HOLDS', 'CANCEL', $self->reserve_id, Dumper($self->unblessed) )
360 if C4::Context->preference('HoldsLog');
363 return $self;
366 =head3 _move_to_old
368 my $is_moved = $hold->_move_to_old;
370 Move a hold to the old_reserve table following the same pattern as Koha::Patron->move_to_deleted
372 =cut
374 sub _move_to_old {
375 my ($self) = @_;
376 my $hold_infos = $self->unblessed;
377 return Koha::Old::Hold->new( $hold_infos )->store;
380 =head3 type
382 =cut
384 sub _type {
385 return 'Reserve';
388 =head1 AUTHORS
390 Kyle M Hall <kyle@bywatersolutions.com>
392 Jonathan Druart <jonathan.druart@bugs.koha-community.org>
394 =cut