Bug 18290: Fix t/db_dependent/Koha/Object.t, Mojo::JSON::Bool is a JSON::PP::Boolean :)
[koha.git] / Koha / Hold.pm
blobd27bbae693a8eef176af0e1a6bf591c0164aa807
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;
36 use base qw(Koha::Object);
38 =head1 NAME
40 Koha::Hold - Koha Hold object class
42 =head1 API
44 =head2 Class Methods
46 =cut
48 =head3 suspend_hold
50 my $hold = $hold->suspend_hold( $suspend_until_dt );
52 =cut
54 sub suspend_hold {
55 my ( $self, $dt ) = @_;
57 $dt = $dt ? $dt->clone()->truncate( to => 'day' ) : undef;
59 if ( $self->is_waiting ) { # We can't suspend waiting holds
60 carp "Unable to suspend waiting hold!";
61 return $self;
64 $self->suspend(1);
65 $self->suspend_until( $dt );
67 $self->store();
69 logaction( 'HOLDS', 'SUSPEND', $self->reserve_id, Dumper($self->unblessed) )
70 if C4::Context->preference('HoldsLog');
72 return $self;
75 =head3 resume
77 my $hold = $hold->resume();
79 =cut
81 sub resume {
82 my ( $self ) = @_;
84 $self->suspend(0);
85 $self->suspend_until( undef );
87 $self->store();
89 logaction( 'HOLDS', 'RESUME', $self->reserve_id, Dumper($self->unblessed) )
90 if C4::Context->preference('HoldsLog');
92 return $self;
95 =head3 delete
97 $hold->delete();
99 =cut
101 sub delete {
102 my ( $self ) = @_;
104 my $deleted = $self->SUPER::delete($self);
106 logaction( 'HOLDS', 'DELETE', $self->reserve_id, Dumper($self->unblessed) )
107 if C4::Context->preference('HoldsLog');
109 return $deleted;
112 =head3 set_waiting
114 =cut
116 sub set_waiting {
117 my ( $self, $transferToDo ) = @_;
119 $self->priority(0);
121 if ($transferToDo) {
122 $self->found('T')->store();
123 return $self;
126 my $today = dt_from_string();
127 my $values = {
128 found => 'W',
129 waitingdate => $today->ymd,
132 my $requested_expiration;
133 if ($self->expirationdate) {
134 $requested_expiration = dt_from_string($self->expirationdate);
137 my $max_pickup_delay = C4::Context->preference("ReservesMaxPickUpDelay");
138 my $cancel_on_holidays = C4::Context->preference('ExpireReservesOnHolidays');
139 my $calendar = Koha::Calendar->new( branchcode => $self->branchcode );
141 my $expirationdate = $today->clone;
142 $expirationdate->add(days => $max_pickup_delay);
144 if ( C4::Context->preference("ExcludeHolidaysFromMaxPickUpDelay") ) {
145 $expirationdate = $calendar->days_forward( dt_from_string(), $max_pickup_delay );
148 # If patron's requested expiration date is prior to the
149 # calculated one, we keep the patron's one.
150 my $cmp = $requested_expiration ? DateTime->compare($requested_expiration, $expirationdate) : 0;
151 $values->{expirationdate} = $cmp == -1 ? $requested_expiration->ymd : $expirationdate->ymd;
153 $self->set($values)->store();
155 return $self;
158 =head3 is_found
160 Returns true if hold is a waiting or in transit
162 =cut
164 sub is_found {
165 my ($self) = @_;
167 return 0 unless $self->found();
168 return 1 if $self->found() eq 'W';
169 return 1 if $self->found() eq 'T';
172 =head3 is_waiting
174 Returns true if hold is a waiting hold
176 =cut
178 sub is_waiting {
179 my ($self) = @_;
181 my $found = $self->found;
182 return $found && $found eq 'W';
185 =head3 is_in_transit
187 Returns true if hold is a in_transit hold
189 =cut
191 sub is_in_transit {
192 my ($self) = @_;
194 return 0 unless $self->found();
195 return $self->found() eq 'T';
198 =head3 is_cancelable
200 Returns true if hold is a cancelable hold
202 Holds may be canceled if they not found, or
203 are found and waiting. A hold found but in
204 transit cannot be canceled.
206 =cut
208 sub is_cancelable {
209 my ($self) = @_;
211 return 1 unless $self->is_found();
212 return 0 if $self->is_in_transit();
213 return 1 if $self->is_waiting();
214 return 0;
217 =head3 is_at_destination
219 Returns true if hold is waiting
220 and the hold's pickup branch matches
221 the hold item's holding branch
223 =cut
225 sub is_at_destination {
226 my ($self) = @_;
228 return $self->is_waiting() && ( $self->branchcode() eq $self->item()->holdingbranch() );
231 =head3 biblio
233 Returns the related Koha::Biblio object for this hold
235 =cut
237 sub biblio {
238 my ($self) = @_;
240 $self->{_biblio} ||= Koha::Biblios->find( $self->biblionumber() );
242 return $self->{_biblio};
245 =head3 item
247 Returns the related Koha::Item object for this Hold
249 =cut
251 sub item {
252 my ($self) = @_;
254 $self->{_item} ||= Koha::Items->find( $self->itemnumber() );
256 return $self->{_item};
259 =head3 branch
261 Returns the related Koha::Library object for this Hold
263 =cut
265 sub branch {
266 my ($self) = @_;
268 $self->{_branch} ||= Koha::Libraries->find( $self->branchcode() );
270 return $self->{_branch};
273 =head3 borrower
275 Returns the related Koha::Patron object for this Hold
277 =cut
279 sub borrower {
280 my ($self) = @_;
282 $self->{_borrower} ||= Koha::Patrons->find( $self->borrowernumber() );
284 return $self->{_borrower};
287 =head3 is_suspended
289 my $bool = $hold->is_suspended();
291 =cut
293 sub is_suspended {
294 my ( $self ) = @_;
296 return $self->suspend();
300 =head3 cancel
302 my $cancel_hold = $hold->cancel();
304 Cancel a hold:
305 - The hold will be moved to the old_reserves table with a priority=0
306 - The priority of other holds will be updated
307 - The patron will be charge (see ExpireReservesMaxPickUpDelayCharge) if the charge_cancel_fee parameter is set
308 - a CANCEL HOLDS log will be done if the pref HoldsLog is on
310 =cut
312 sub cancel {
313 my ( $self, $params ) = @_;
314 $self->_result->result_source->schema->txn_do(
315 sub {
316 $self->cancellationdate(dt_from_string);
317 $self->priority(0);
318 $self->_move_to_old;
319 $self->SUPER::delete(); # Do not add a DELETE log
321 # now fix the priority on the others....
322 C4::Reserves::_FixPriority({ biblionumber => $self->biblionumber });
324 # and, if desired, charge a cancel fee
325 my $charge = C4::Context->preference("ExpireReservesMaxPickUpDelayCharge");
326 if ( $charge && $params->{'charge_cancel_fee'} ) {
327 C4::Accounts::manualinvoice($self->borrowernumber, $self->itemnumber, '', 'HE', $charge);
330 C4::Log::logaction( 'HOLDS', 'CANCEL', $self->reserve_id, Dumper($self->unblessed) )
331 if C4::Context->preference('HoldsLog');
334 return $self;
337 =head3 _move_to_old
339 my $is_moved = $hold->_move_to_old;
341 Move a hold to the old_reserve table following the same pattern as Koha::Patron->move_to_deleted
343 =cut
345 sub _move_to_old {
346 my ($self) = @_;
347 my $hold_infos = $self->unblessed;
348 return Koha::Old::Hold->new( $hold_infos )->store;
351 =head3 type
353 =cut
355 sub _type {
356 return 'Reserve';
359 =head1 AUTHORS
361 Kyle M Hall <kyle@bywatersolutions.com>
363 Jonathan Druart <jonathan.druart@bugs.koha-community.org>
365 =cut