Bug 23140: Fix typo in branchcode parameters for print slip
[koha.git] / Koha / Hold.pm
1 package Koha::Hold;
2
3 # Copyright ByWater Solutions 2014
4 # Copyright 2017 Koha Development team
5 #
6 # This file is part of Koha.
7 #
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.
12 #
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.
16 #
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.
20
21 use Modern::Perl;
22
23 use Carp;
24 use Data::Dumper qw(Dumper);
25
26 use C4::Context qw(preference);
27 use C4::Log;
28
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;
36
37 use Koha::Exceptions::Hold;
38
39 use base qw(Koha::Object);
40
41 =head1 NAME
42
43 Koha::Hold - Koha Hold object class
44
45 =head1 API
46
47 =head2 Class Methods
48
49 =cut
50
51 =head3 age
52
53 returns the number of days since a hold was placed, optionally
54 using the calendar
55
56 my $age = $hold->age( $use_calendar );
57
58 =cut
59
60 sub age {
61     my ( $self, $use_calendar ) = @_;
62
63     my $today = dt_from_string;
64     my $age;
65
66     if ( $use_calendar ) {
67         my $calendar = Koha::Calendar->new( branchcode => $self->branchcode );
68         $age = $calendar->days_between( dt_from_string( $self->reservedate ), $today );
69     }
70     else {
71         $age = $today->delta_days( dt_from_string( $self->reservedate ) );
72     }
73
74     $age = $age->in_units( 'days' );
75
76     return $age;
77 }
78
79 =head3 suspend_hold
80
81 my $hold = $hold->suspend_hold( $suspend_until_dt );
82
83 =cut
84
85 sub suspend_hold {
86     my ( $self, $dt ) = @_;
87
88     my $date = $dt ? $dt->clone()->truncate( to => 'day' )->datetime : undef;
89
90     if ( $self->is_found ) {    # We can't suspend found holds
91         if ( $self->is_waiting ) {
92             Koha::Exceptions::Hold::CannotSuspendFound->throw( status => 'W' );
93         }
94         elsif ( $self->is_in_transit ) {
95             Koha::Exceptions::Hold::CannotSuspendFound->throw( status => 'T' );
96         }
97         else {
98             Koha::Exceptions::Hold::CannotSuspendFound->throw(
99                       'Unhandled data exception on found hold (id='
100                     . $self->id
101                     . ', found='
102                     . $self->found
103                     . ')' );
104         }
105     }
106
107     $self->suspend(1);
108     $self->suspend_until($date);
109     $self->store();
110
111     logaction( 'HOLDS', 'SUSPEND', $self->reserve_id, Dumper( $self->unblessed ) )
112         if C4::Context->preference('HoldsLog');
113
114     return $self;
115 }
116
117 =head3 resume
118
119 my $hold = $hold->resume();
120
121 =cut
122
123 sub resume {
124     my ( $self ) = @_;
125
126     $self->suspend(0);
127     $self->suspend_until( undef );
128
129     $self->store();
130
131     logaction( 'HOLDS', 'RESUME', $self->reserve_id, Dumper($self->unblessed) )
132         if C4::Context->preference('HoldsLog');
133
134     return $self;
135 }
136
137 =head3 delete
138
139 $hold->delete();
140
141 =cut
142
143 sub delete {
144     my ( $self ) = @_;
145
146     my $deleted = $self->SUPER::delete($self);
147
148     logaction( 'HOLDS', 'DELETE', $self->reserve_id, Dumper($self->unblessed) )
149         if C4::Context->preference('HoldsLog');
150
151     return $deleted;
152 }
153
154 =head3 set_waiting
155
156 =cut
157
158 sub set_waiting {
159     my ( $self, $transferToDo ) = @_;
160
161     $self->priority(0);
162
163     if ($transferToDo) {
164         $self->found('T')->store();
165         return $self;
166     }
167
168     my $today = dt_from_string();
169     my $values = {
170         found => 'W',
171         waitingdate => $today->ymd,
172     };
173
174     my $requested_expiration;
175     if ($self->expirationdate) {
176         $requested_expiration = dt_from_string($self->expirationdate);
177     }
178
179     my $max_pickup_delay = C4::Context->preference("ReservesMaxPickUpDelay");
180     my $cancel_on_holidays = C4::Context->preference('ExpireReservesOnHolidays');
181     my $calendar = Koha::Calendar->new( branchcode => $self->branchcode );
182
183     my $expirationdate = $today->clone;
184     $expirationdate->add(days => $max_pickup_delay);
185
186     if ( C4::Context->preference("ExcludeHolidaysFromMaxPickUpDelay") ) {
187         $expirationdate = $calendar->days_forward( dt_from_string(), $max_pickup_delay );
188     }
189
190     # If patron's requested expiration date is prior to the
191     # calculated one, we keep the patron's one.
192     my $cmp = $requested_expiration ? DateTime->compare($requested_expiration, $expirationdate) : 0;
193     $values->{expirationdate} = $cmp == -1 ? $requested_expiration->ymd : $expirationdate->ymd;
194
195     $self->set($values)->store();
196
197     return $self;
198 }
199
200 =head3 is_found
201
202 Returns true if hold is a waiting or in transit
203
204 =cut
205
206 sub is_found {
207     my ($self) = @_;
208
209     return 0 unless $self->found();
210     return 1 if $self->found() eq 'W';
211     return 1 if $self->found() eq 'T';
212 }
213
214 =head3 is_waiting
215
216 Returns true if hold is a waiting hold
217
218 =cut
219
220 sub is_waiting {
221     my ($self) = @_;
222
223     my $found = $self->found;
224     return $found && $found eq 'W';
225 }
226
227 =head3 is_in_transit
228
229 Returns true if hold is a in_transit hold
230
231 =cut
232
233 sub is_in_transit {
234     my ($self) = @_;
235
236     return 0 unless $self->found();
237     return $self->found() eq 'T';
238 }
239
240 =head3 is_cancelable_from_opac
241
242 Returns true if hold is a cancelable hold
243
244 Holds may be only canceled if they are not found.
245
246 This is used from the OPAC.
247
248 =cut
249
250 sub is_cancelable_from_opac {
251     my ($self) = @_;
252
253     return 1 unless $self->is_found();
254     return 0; # if ->is_in_transit or if ->is_waiting
255 }
256
257 =head3 is_at_destination
258
259 Returns true if hold is waiting
260 and the hold's pickup branch matches
261 the hold item's holding branch
262
263 =cut
264
265 sub is_at_destination {
266     my ($self) = @_;
267
268     return $self->is_waiting() && ( $self->branchcode() eq $self->item()->holdingbranch() );
269 }
270
271 =head3 biblio
272
273 Returns the related Koha::Biblio object for this hold
274
275 =cut
276
277 sub biblio {
278     my ($self) = @_;
279
280     $self->{_biblio} ||= Koha::Biblios->find( $self->biblionumber() );
281
282     return $self->{_biblio};
283 }
284
285 =head3 item
286
287 Returns the related Koha::Item object for this Hold
288
289 =cut
290
291 sub item {
292     my ($self) = @_;
293
294     $self->{_item} ||= Koha::Items->find( $self->itemnumber() );
295
296     return $self->{_item};
297 }
298
299 =head3 branch
300
301 Returns the related Koha::Library object for this Hold
302
303 =cut
304
305 sub branch {
306     my ($self) = @_;
307
308     $self->{_branch} ||= Koha::Libraries->find( $self->branchcode() );
309
310     return $self->{_branch};
311 }
312
313 =head3 borrower
314
315 Returns the related Koha::Patron object for this Hold
316
317 =cut
318
319 # FIXME Should be renamed with ->patron
320 sub borrower {
321     my ($self) = @_;
322
323     $self->{_borrower} ||= Koha::Patrons->find( $self->borrowernumber() );
324
325     return $self->{_borrower};
326 }
327
328 =head3 is_suspended
329
330 my $bool = $hold->is_suspended();
331
332 =cut
333
334 sub is_suspended {
335     my ( $self ) = @_;
336
337     return $self->suspend();
338 }
339
340
341 =head3 cancel
342
343 my $cancel_hold = $hold->cancel();
344
345 Cancel a hold:
346 - The hold will be moved to the old_reserves table with a priority=0
347 - The priority of other holds will be updated
348 - The patron will be charge (see ExpireReservesMaxPickUpDelayCharge) if the charge_cancel_fee parameter is set
349 - a CANCEL HOLDS log will be done if the pref HoldsLog is on
350
351 =cut
352
353 sub cancel {
354     my ( $self, $params ) = @_;
355     $self->_result->result_source->schema->txn_do(
356         sub {
357             $self->cancellationdate(dt_from_string);
358             $self->priority(0);
359             $self->_move_to_old;
360             $self->SUPER::delete(); # Do not add a DELETE log
361
362             # now fix the priority on the others....
363             C4::Reserves::_FixPriority({ biblionumber => $self->biblionumber });
364
365             # and, if desired, charge a cancel fee
366             my $charge = C4::Context->preference("ExpireReservesMaxPickUpDelayCharge");
367             if ( $charge && $params->{'charge_cancel_fee'} ) {
368                 my $account =
369                   Koha::Account->new( { patron_id => $self->borrowernumber } );
370                 $account->add_debit(
371                     {
372                         amount     => $charge,
373                         user_id    => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
374                         interface  => C4::Context->interface,
375                         library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
376                         type       => 'hold_expired',
377                         item_id    => $self->itemnumber
378                     }
379                 );
380             }
381
382             C4::Log::logaction( 'HOLDS', 'CANCEL', $self->reserve_id, Dumper($self->unblessed) )
383                 if C4::Context->preference('HoldsLog');
384         }
385     );
386     return $self;
387 }
388
389 =head3 _move_to_old
390
391 my $is_moved = $hold->_move_to_old;
392
393 Move a hold to the old_reserve table following the same pattern as Koha::Patron->move_to_deleted
394
395 =cut
396
397 sub _move_to_old {
398     my ($self) = @_;
399     my $hold_infos = $self->unblessed;
400     return Koha::Old::Hold->new( $hold_infos )->store;
401 }
402
403 =head3 type
404
405 =cut
406
407 sub _type {
408     return 'Reserve';
409 }
410
411 =head1 AUTHORS
412
413 Kyle M Hall <kyle@bywatersolutions.com>
414 Jonathan Druart <jonathan.druart@bugs.koha-community.org>
415 Martin Renvoize <martin.renvoize@ptfs-europe.com>
416
417 =cut
418
419 1;