Bug 5144: Duplicate holds allowed if patron clicks back button after placing hold
[koha.git] / C4 / Reserves.pm
1 package C4::Reserves;
2
3 # Copyright 2000-2002 Katipo Communications
4 #           2006 SAN Ouest Provence
5 #           2007-2010 BibLibre Paul POULAIN
6 #           2011 Catalyst IT
7 #
8 # This file is part of Koha.
9 #
10 # Koha is free software; you can redistribute it and/or modify it
11 # under the terms of the GNU General Public License as published by
12 # the Free Software Foundation; either version 3 of the License, or
13 # (at your option) any later version.
14 #
15 # Koha is distributed in the hope that it will be useful, but
16 # WITHOUT ANY WARRANTY; without even the implied warranty of
17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 # GNU General Public License for more details.
19 #
20 # You should have received a copy of the GNU General Public License
21 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22
23
24 use strict;
25 #use warnings; FIXME - Bug 2505
26 use C4::Context;
27 use C4::Biblio;
28 use C4::Members;
29 use C4::Items;
30 use C4::Circulation;
31 use C4::Accounts;
32
33 # for _koha_notify_reserve
34 use C4::Members::Messaging;
35 use C4::Members qw();
36 use C4::Letters;
37 use C4::Branch qw( GetBranchDetail );
38 use C4::Dates qw( format_date_in_iso );
39
40 use Koha::DateUtils;
41 use Koha::Calendar;
42 use Koha::Database;
43 use Koha::Hold;
44 use Koha::Holds;
45
46 use List::MoreUtils qw( firstidx any );
47 use Carp;
48
49 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
50
51 =head1 NAME
52
53 C4::Reserves - Koha functions for dealing with reservation.
54
55 =head1 SYNOPSIS
56
57   use C4::Reserves;
58
59 =head1 DESCRIPTION
60
61 This modules provides somes functions to deal with reservations.
62
63   Reserves are stored in reserves table.
64   The following columns contains important values :
65   - priority >0      : then the reserve is at 1st stage, and not yet affected to any item.
66              =0      : then the reserve is being dealed
67   - found : NULL       : means the patron requested the 1st available, and we haven't chosen the item
68             T(ransit)  : the reserve is linked to an item but is in transit to the pickup branch
69             W(aiting)  : the reserve is linked to an item, is at the pickup branch, and is waiting on the hold shelf
70             F(inished) : the reserve has been completed, and is done
71   - itemnumber : empty : the reserve is still unaffected to an item
72                  filled: the reserve is attached to an item
73   The complete workflow is :
74   ==== 1st use case ====
75   patron request a document, 1st available :                      P >0, F=NULL, I=NULL
76   a library having it run "transfertodo", and clic on the list
77          if there is no transfer to do, the reserve waiting
78          patron can pick it up                                    P =0, F=W,    I=filled
79          if there is a transfer to do, write in branchtransfer    P =0, F=T,    I=filled
80            The pickup library receive the book, it check in       P =0, F=W,    I=filled
81   The patron borrow the book                                      P =0, F=F,    I=filled
82
83   ==== 2nd use case ====
84   patron requests a document, a given item,
85     If pickup is holding branch                                   P =0, F=W,   I=filled
86     If transfer needed, write in branchtransfer                   P =0, F=T,    I=filled
87         The pickup library receive the book, it checks it in      P =0, F=W,    I=filled
88   The patron borrow the book                                      P =0, F=F,    I=filled
89
90 =head1 FUNCTIONS
91
92 =cut
93
94 BEGIN {
95     # set the version for version checking
96     $VERSION = 3.07.00.049;
97     require Exporter;
98     @ISA = qw(Exporter);
99     @EXPORT = qw(
100         &AddReserve
101
102         &GetReserve
103         &GetReservesFromItemnumber
104         &GetReservesFromBiblionumber
105         &GetReservesFromBorrowernumber
106         &GetReservesForBranch
107         &GetReservesToBranch
108         &GetReserveCount
109         &GetReserveInfo
110         &GetReserveStatus
111
112         &GetOtherReserves
113
114         &ModReserveFill
115         &ModReserveAffect
116         &ModReserve
117         &ModReserveStatus
118         &ModReserveCancelAll
119         &ModReserveMinusPriority
120         &MoveReserve
121
122         &CheckReserves
123         &CanBookBeReserved
124         &CanItemBeReserved
125         &CanReserveBeCanceledFromOpac
126         &CancelReserve
127         &CancelExpiredReserves
128
129         &AutoUnsuspendReserves
130
131         &IsAvailableForItemLevelRequest
132
133         &OPACItemHoldsAllowed
134
135         &AlterPriority
136         &ToggleLowestPriority
137
138         &ReserveSlip
139         &ToggleSuspend
140         &SuspendAll
141
142         &GetReservesControlBranch
143
144         IsItemOnHoldAndFound
145     );
146     @EXPORT_OK = qw( MergeHolds );
147 }
148
149 =head2 AddReserve
150
151     AddReserve($branch,$borrowernumber,$biblionumber,$bibitems,$priority,$resdate,$expdate,$notes,$title,$checkitem,$found)
152
153 =cut
154
155 sub AddReserve {
156     my (
157         $branch,    $borrowernumber, $biblionumber,
158         $bibitems,  $priority, $resdate, $expdate, $notes,
159         $title,      $checkitem, $found
160     ) = @_;
161
162     if ( Koha::Holds->search( { borrowernumber => $borrowernumber, biblionumber => $biblionumber } )->count() > 0 ) {
163         carp("AddReserve: borrower $borrowernumber already has a hold for biblionumber $biblionumber");
164         return;
165     }
166
167     my $dbh     = C4::Context->dbh;
168
169     $resdate = format_date_in_iso( $resdate ) if ( $resdate );
170     $resdate = C4::Dates->today( 'iso' ) unless ( $resdate );
171
172     if ($expdate) {
173         $expdate = format_date_in_iso( $expdate );
174     } else {
175         undef $expdate; # make reserves.expirationdate default to null rather than '0000-00-00'
176     }
177
178     if ( C4::Context->preference('AllowHoldDateInFuture') ) {
179
180         # Make room in reserves for this before those of a later reserve date
181         $priority = _ShiftPriorityByDateAndPriority( $biblionumber, $resdate, $priority );
182     }
183
184     my $waitingdate;
185
186     # If the reserv had the waiting status, we had the value of the resdate
187     if ( $found eq 'W' ) {
188         $waitingdate = $resdate;
189     }
190
191     # updates take place here
192     my $hold = Koha::Hold->new(
193         {
194             borrowernumber => $borrowernumber,
195             biblionumber   => $biblionumber,
196             reservedate    => $resdate,
197             branchcode     => $branch,
198             priority       => $priority,
199             reservenotes   => $notes,
200             itemnumber     => $checkitem,
201             found          => $found,
202             waitingdate    => $waitingdate,
203             expirationdate => $expdate
204         }
205     )->store();
206     my $reserve_id = $hold->id();
207
208     # add a reserve fee if needed
209     my $fee = GetReserveFee( $borrowernumber, $biblionumber );
210     ChargeReserveFee( $borrowernumber, $fee, $title );
211
212     _FixPriority({ biblionumber => $biblionumber});
213
214     # Send e-mail to librarian if syspref is active
215     if(C4::Context->preference("emailLibrarianWhenHoldIsPlaced")){
216         my $borrower = C4::Members::GetMember(borrowernumber => $borrowernumber);
217         my $branch_details = C4::Branch::GetBranchDetail($borrower->{branchcode});
218         if ( my $letter =  C4::Letters::GetPreparedLetter (
219             module => 'reserves',
220             letter_code => 'HOLDPLACED',
221             branchcode => $branch,
222             tables => {
223                 'branches'  => $branch_details,
224                 'borrowers' => $borrower,
225                 'biblio'    => $biblionumber,
226                 'items'     => $checkitem,
227             },
228         ) ) {
229
230             my $admin_email_address =$branch_details->{'branchemail'} || C4::Context->preference('KohaAdminEmailAddress');
231
232             C4::Letters::EnqueueLetter(
233                 {   letter                 => $letter,
234                     borrowernumber         => $borrowernumber,
235                     message_transport_type => 'email',
236                     from_address           => $admin_email_address,
237                     to_address           => $admin_email_address,
238                 }
239             );
240         }
241     }
242
243     return $reserve_id;
244 }
245
246 =head2 GetReserve
247
248     $res = GetReserve( $reserve_id );
249
250     Return the current reserve.
251
252 =cut
253
254 sub GetReserve {
255     my ($reserve_id) = @_;
256
257     my $dbh = C4::Context->dbh;
258     my $query = "SELECT * FROM reserves WHERE reserve_id = ?";
259     my $sth = $dbh->prepare( $query );
260     $sth->execute( $reserve_id );
261     return $sth->fetchrow_hashref();
262 }
263
264 =head2 GetReservesFromBiblionumber
265
266   my $reserves = GetReservesFromBiblionumber({
267     biblionumber => $biblionumber,
268     [ itemnumber => $itemnumber, ]
269     [ all_dates => 1|0 ]
270   });
271
272 This function gets the list of reservations for one C<$biblionumber>,
273 returning an arrayref pointing to the reserves for C<$biblionumber>.
274
275 By default, only reserves whose start date falls before the current
276 time are returned.  To return all reserves, including future ones,
277 the C<all_dates> parameter can be included and set to a true value.
278
279 If the C<itemnumber> parameter is supplied, reserves must be targeted
280 to that item or not targeted to any item at all; otherwise, they
281 are excluded from the list.
282
283 =cut
284
285 sub GetReservesFromBiblionumber {
286     my ( $params ) = @_;
287     my $biblionumber = $params->{biblionumber} or return [];
288     my $itemnumber = $params->{itemnumber};
289     my $all_dates = $params->{all_dates} // 0;
290     my $dbh   = C4::Context->dbh;
291
292     # Find the desired items in the reserves
293     my @params;
294     my $query = "
295         SELECT  reserve_id,
296                 branchcode,
297                 timestamp AS rtimestamp,
298                 priority,
299                 biblionumber,
300                 borrowernumber,
301                 reservedate,
302                 found,
303                 itemnumber,
304                 reservenotes,
305                 expirationdate,
306                 lowestPriority,
307                 suspend,
308                 suspend_until
309         FROM     reserves
310         WHERE biblionumber = ? ";
311     push( @params, $biblionumber );
312     unless ( $all_dates ) {
313         $query .= " AND reservedate <= CAST(NOW() AS DATE) ";
314     }
315     if ( $itemnumber ) {
316         $query .= " AND ( itemnumber IS NULL OR itemnumber = ? )";
317         push( @params, $itemnumber );
318     }
319     $query .= "ORDER BY priority";
320     my $sth = $dbh->prepare($query);
321     $sth->execute( @params );
322     my @results;
323     while ( my $data = $sth->fetchrow_hashref ) {
324         push @results, $data;
325     }
326     return \@results;
327 }
328
329 =head2 GetReservesFromItemnumber
330
331  ( $reservedate, $borrowernumber, $branchcode, $reserve_id, $waitingdate ) = GetReservesFromItemnumber($itemnumber);
332
333 Get the first reserve for a specific item number (based on priority). Returns the abovementioned values for that reserve.
334
335 The routine does not look at future reserves (read: item level holds), but DOES include future waits (a confirmed future hold).
336
337 =cut
338
339 sub GetReservesFromItemnumber {
340     my ($itemnumber) = @_;
341
342     my $schema = Koha::Database->new()->schema();
343
344     my $r = $schema->resultset('Reserve')->search(
345         {
346             itemnumber => $itemnumber,
347             suspend    => 0,
348             -or        => [
349                 reservedate => \'<= CAST( NOW() AS DATE )',
350                 waitingdate => { '!=', undef }
351             ]
352         },
353         {
354             order_by => 'priority',
355         }
356     )->first();
357
358     return unless $r;
359
360     return (
361         $r->reservedate(),
362         $r->get_column('borrowernumber'),
363         $r->get_column('branchcode'),
364         $r->reserve_id(),
365         $r->waitingdate(),
366     );
367 }
368
369 =head2 GetReservesFromBorrowernumber
370
371     $borrowerreserv = GetReservesFromBorrowernumber($borrowernumber,$tatus);
372
373 TODO :: Descritpion
374
375 =cut
376
377 sub GetReservesFromBorrowernumber {
378     my ( $borrowernumber, $status ) = @_;
379     my $dbh   = C4::Context->dbh;
380     my $sth;
381     if ($status) {
382         $sth = $dbh->prepare("
383             SELECT *
384             FROM   reserves
385             WHERE  borrowernumber=?
386                 AND found =?
387             ORDER BY reservedate
388         ");
389         $sth->execute($borrowernumber,$status);
390     } else {
391         $sth = $dbh->prepare("
392             SELECT *
393             FROM   reserves
394             WHERE  borrowernumber=?
395             ORDER BY reservedate
396         ");
397         $sth->execute($borrowernumber);
398     }
399     my $data = $sth->fetchall_arrayref({});
400     return @$data;
401 }
402
403 =head2 CanBookBeReserved
404
405   $canReserve = &CanBookBeReserved($borrowernumber, $biblionumber)
406   if ($canReserve eq 'OK') { #We can reserve this Item! }
407
408 See CanItemBeReserved() for possible return values.
409
410 =cut
411
412 sub CanBookBeReserved{
413     my ($borrowernumber, $biblionumber) = @_;
414
415     my $items = GetItemnumbersForBiblio($biblionumber);
416     #get items linked via host records
417     my @hostitems = get_hostitemnumbers_of($biblionumber);
418     if (@hostitems){
419     push (@$items,@hostitems);
420     }
421
422     my $canReserve;
423     foreach my $item (@$items) {
424         $canReserve = CanItemBeReserved( $borrowernumber, $item );
425         return 'OK' if $canReserve eq 'OK';
426     }
427     return $canReserve;
428 }
429
430 =head2 CanItemBeReserved
431
432   $canReserve = &CanItemBeReserved($borrowernumber, $itemnumber)
433   if ($canReserve eq 'OK') { #We can reserve this Item! }
434
435 @RETURNS OK,              if the Item can be reserved.
436          ageRestricted,   if the Item is age restricted for this borrower.
437          damaged,         if the Item is damaged.
438          cannotReserveFromOtherBranches, if syspref 'canreservefromotherbranches' is OK.
439          tooManyReserves, if the borrower has exceeded his maximum reserve amount.
440          notReservable,   if holds on this item are not allowed
441
442 =cut
443
444 sub CanItemBeReserved{
445     my ($borrowernumber, $itemnumber) = @_;
446
447     my $dbh             = C4::Context->dbh;
448     my $ruleitemtype; # itemtype of the matching issuing rule
449     my $allowedreserves = 0;
450             
451     # we retrieve borrowers and items informations #
452     # item->{itype} will come for biblioitems if necessery
453     my $item = GetItem($itemnumber);
454     my $biblioData = C4::Biblio::GetBiblioData( $item->{biblionumber} );
455     my $borrower = C4::Members::GetMember('borrowernumber'=>$borrowernumber);
456
457     # If an item is damaged and we don't allow holds on damaged items, we can stop right here
458     return 'damaged' if ( $item->{damaged} && !C4::Context->preference('AllowHoldsOnDamagedItems') );
459
460     #Check for the age restriction
461     my ($ageRestriction, $daysToAgeRestriction) = C4::Circulation::GetAgeRestriction( $biblioData->{agerestriction}, $borrower );
462     return 'ageRestricted' if $daysToAgeRestriction && $daysToAgeRestriction > 0;
463
464     my $controlbranch = C4::Context->preference('ReservesControlBranch');
465
466     # we retrieve user rights on this itemtype and branchcode
467     my $sth = $dbh->prepare("SELECT categorycode, itemtype, branchcode, reservesallowed
468                              FROM issuingrules
469                              WHERE (categorycode in (?,'*') )
470                              AND (itemtype IN (?,'*'))
471                              AND (branchcode IN (?,'*'))
472                              ORDER BY
473                                categorycode DESC,
474                                itemtype     DESC,
475                                branchcode   DESC;"
476                            );
477
478     my $querycount ="SELECT
479                             count(*) as count
480                             FROM reserves
481                                 LEFT JOIN items USING (itemnumber)
482                                 LEFT JOIN biblioitems ON (reserves.biblionumber=biblioitems.biblionumber)
483                                 LEFT JOIN borrowers USING (borrowernumber)
484                             WHERE borrowernumber = ?
485                                 ";
486     
487     
488     my $branchcode   = "";
489     my $branchfield  = "reserves.branchcode";
490
491     if( $controlbranch eq "ItemHomeLibrary" ){
492         $branchfield = "items.homebranch";
493         $branchcode = $item->{homebranch};
494     }elsif( $controlbranch eq "PatronLibrary" ){
495         $branchfield = "borrowers.branchcode";
496         $branchcode = $borrower->{branchcode};
497     }
498     
499     # we retrieve rights 
500     $sth->execute($borrower->{'categorycode'}, $item->{'itype'}, $branchcode);
501     if(my $rights = $sth->fetchrow_hashref()){
502         $ruleitemtype    = $rights->{itemtype};
503         $allowedreserves = $rights->{reservesallowed}; 
504     }else{
505         $ruleitemtype = '*';
506     }
507
508     # we retrieve count
509
510     $querycount .= "AND $branchfield = ?";
511     
512     # If using item-level itypes, fall back to the record
513     # level itemtype if the hold has no associated item
514     $querycount .=
515       C4::Context->preference('item-level_itypes')
516       ? " AND COALESCE( itype, itemtype ) = ?"
517       : " AND itemtype = ?"
518       if ( $ruleitemtype ne "*" );
519
520     my $sthcount = $dbh->prepare($querycount);
521     
522     if($ruleitemtype eq "*"){
523         $sthcount->execute($borrowernumber, $branchcode);
524     }else{
525         $sthcount->execute($borrowernumber, $branchcode, $ruleitemtype);
526     }
527
528     my $reservecount = "0";
529     if(my $rowcount = $sthcount->fetchrow_hashref()){
530         $reservecount = $rowcount->{count};
531     }
532     # we check if it's ok or not
533     if( $reservecount >= $allowedreserves ){
534         return 'tooManyReserves';
535     }
536
537     my $circ_control_branch = C4::Circulation::_GetCircControlBranch($item,
538         $borrower);
539     my $branchitemrule = C4::Circulation::GetBranchItemRule($circ_control_branch,
540         $item->{itype});
541
542     if ( $branchitemrule->{holdallowed} == 0 ) {
543         return 'notReservable';
544     }
545
546     if (   $branchitemrule->{holdallowed} == 1
547         && $borrower->{branchcode} ne $item->{homebranch} )
548     {
549           return 'cannotReserveFromOtherBranches';
550     }
551
552     # If reservecount is ok, we check item branch if IndependentBranches is ON
553     # and canreservefromotherbranches is OFF
554     if ( C4::Context->preference('IndependentBranches')
555         and !C4::Context->preference('canreservefromotherbranches') )
556     {
557         my $itembranch = $item->{homebranch};
558         if ($itembranch ne $borrower->{branchcode}) {
559             return 'cannotReserveFromOtherBranches';
560         }
561     }
562
563     return 'OK';
564 }
565
566 =head2 CanReserveBeCanceledFromOpac
567
568     $number = CanReserveBeCanceledFromOpac($reserve_id, $borrowernumber);
569
570     returns 1 if reserve can be cancelled by user from OPAC.
571     First check if reserve belongs to user, next checks if reserve is not in
572     transfer or waiting status
573
574 =cut
575
576 sub CanReserveBeCanceledFromOpac {
577     my ($reserve_id, $borrowernumber) = @_;
578
579     return unless $reserve_id and $borrowernumber;
580     my $reserve = GetReserve($reserve_id);
581
582     return 0 unless $reserve->{borrowernumber} == $borrowernumber;
583     return 0 if ( $reserve->{found} eq 'W' ) or ( $reserve->{found} eq 'T' );
584
585     return 1;
586
587 }
588
589 =head2 GetReserveCount
590
591   $number = &GetReserveCount($borrowernumber);
592
593 this function returns the number of reservation for a borrower given on input arg.
594
595 =cut
596
597 sub GetReserveCount {
598     my ($borrowernumber) = @_;
599
600     my $dbh = C4::Context->dbh;
601
602     my $query = "
603         SELECT COUNT(*) AS counter
604         FROM reserves
605         WHERE borrowernumber = ?
606     ";
607     my $sth = $dbh->prepare($query);
608     $sth->execute($borrowernumber);
609     my $row = $sth->fetchrow_hashref;
610     return $row->{counter};
611 }
612
613 =head2 GetOtherReserves
614
615   ($messages,$nextreservinfo)=$GetOtherReserves(itemnumber);
616
617 Check queued list of this document and check if this document must be transferred
618
619 =cut
620
621 sub GetOtherReserves {
622     my ($itemnumber) = @_;
623     my $messages;
624     my $nextreservinfo;
625     my ( undef, $checkreserves, undef ) = CheckReserves($itemnumber);
626     if ($checkreserves) {
627         my $iteminfo = GetItem($itemnumber);
628         if ( $iteminfo->{'holdingbranch'} ne $checkreserves->{'branchcode'} ) {
629             $messages->{'transfert'} = $checkreserves->{'branchcode'};
630             #minus priorities of others reservs
631             ModReserveMinusPriority(
632                 $itemnumber,
633                 $checkreserves->{'reserve_id'},
634             );
635
636             #launch the subroutine dotransfer
637             C4::Items::ModItemTransfer(
638                 $itemnumber,
639                 $iteminfo->{'holdingbranch'},
640                 $checkreserves->{'branchcode'}
641               ),
642               ;
643         }
644
645      #step 2b : case of a reservation on the same branch, set the waiting status
646         else {
647             $messages->{'waiting'} = 1;
648             ModReserveMinusPriority(
649                 $itemnumber,
650                 $checkreserves->{'reserve_id'},
651             );
652             ModReserveStatus($itemnumber,'W');
653         }
654
655         $nextreservinfo = $checkreserves->{'borrowernumber'};
656     }
657
658     return ( $messages, $nextreservinfo );
659 }
660
661 =head2 ChargeReserveFee
662
663     $fee = ChargeReserveFee( $borrowernumber, $fee, $title );
664
665     Charge the fee for a reserve (if $fee > 0)
666
667 =cut
668
669 sub ChargeReserveFee {
670     my ( $borrowernumber, $fee, $title ) = @_;
671     return if !$fee || $fee==0; # the last test is needed to include 0.00
672     my $accquery = qq{
673 INSERT INTO accountlines ( borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding ) VALUES (?, ?, NOW(), ?, ?, 'Res', ?)
674     };
675     my $dbh = C4::Context->dbh;
676     my $nextacctno = &getnextacctno( $borrowernumber );
677     $dbh->do( $accquery, undef, ( $borrowernumber, $nextacctno, $fee, "Reserve Charge - $title", $fee ) );
678 }
679
680 =head2 GetReserveFee
681
682     $fee = GetReserveFee( $borrowernumber, $biblionumber );
683
684     Calculate the fee for a reserve (if applicable).
685
686 =cut
687
688 sub GetReserveFee {
689     my ( $borrowernumber, $biblionumber ) = @_;
690     my $borquery = qq{
691 SELECT reservefee FROM borrowers LEFT JOIN categories ON borrowers.categorycode = categories.categorycode WHERE borrowernumber = ?
692     };
693     my $issue_qry = qq{
694 SELECT COUNT(*) FROM items
695 LEFT JOIN issues USING (itemnumber)
696 WHERE items.biblionumber=? AND issues.issue_id IS NULL
697     };
698     my $holds_qry = qq{
699 SELECT COUNT(*) FROM reserves WHERE biblionumber=? AND borrowernumber<>?
700     };
701
702     my $dbh = C4::Context->dbh;
703     my ( $fee ) = $dbh->selectrow_array( $borquery, undef, ($borrowernumber) );
704     if( $fee && $fee > 0 ) {
705         # This is a reconstruction of the old code:
706         # Compare number of items with items issued, and optionally check holds
707         # If not all items are issued and there are no holds: charge no fee
708         # NOTE: Lost, damaged, not-for-loan, etc. are just ignored here
709         my ( $notissued, $reserved );
710         ( $notissued ) = $dbh->selectrow_array( $issue_qry, undef,
711             ( $biblionumber ) );
712         if( $notissued ) {
713             ( $reserved ) = $dbh->selectrow_array( $holds_qry, undef,
714                 ( $biblionumber, $borrowernumber ) );
715             $fee = 0 if $reserved == 0;
716         }
717     }
718     return $fee;
719 }
720
721 =head2 GetReservesToBranch
722
723   @transreserv = GetReservesToBranch( $frombranch );
724
725 Get reserve list for a given branch
726
727 =cut
728
729 sub GetReservesToBranch {
730     my ( $frombranch ) = @_;
731     my $dbh = C4::Context->dbh;
732     my $sth = $dbh->prepare(
733         "SELECT reserve_id,borrowernumber,reservedate,itemnumber,timestamp
734          FROM reserves 
735          WHERE priority='0' 
736            AND branchcode=?"
737     );
738     $sth->execute( $frombranch );
739     my @transreserv;
740     my $i = 0;
741     while ( my $data = $sth->fetchrow_hashref ) {
742         $transreserv[$i] = $data;
743         $i++;
744     }
745     return (@transreserv);
746 }
747
748 =head2 GetReservesForBranch
749
750   @transreserv = GetReservesForBranch($frombranch);
751
752 =cut
753
754 sub GetReservesForBranch {
755     my ($frombranch) = @_;
756     my $dbh = C4::Context->dbh;
757
758     my $query = "
759         SELECT reserve_id,borrowernumber,reservedate,itemnumber,waitingdate
760         FROM   reserves 
761         WHERE   priority='0'
762         AND found='W'
763     ";
764     $query .= " AND branchcode=? " if ( $frombranch );
765     $query .= "ORDER BY waitingdate" ;
766
767     my $sth = $dbh->prepare($query);
768     if ($frombranch){
769      $sth->execute($frombranch);
770     } else {
771         $sth->execute();
772     }
773
774     my @transreserv;
775     my $i = 0;
776     while ( my $data = $sth->fetchrow_hashref ) {
777         $transreserv[$i] = $data;
778         $i++;
779     }
780     return (@transreserv);
781 }
782
783 =head2 GetReserveStatus
784
785   $reservestatus = GetReserveStatus($itemnumber);
786
787 Takes an itemnumber and returns the status of the reserve placed on it.
788 If several reserves exist, the reserve with the lower priority is given.
789
790 =cut
791
792 ## FIXME: I don't think this does what it thinks it does.
793 ## It only ever checks the first reserve result, even though
794 ## multiple reserves for that bib can have the itemnumber set
795 ## the sub is only used once in the codebase.
796 sub GetReserveStatus {
797     my ($itemnumber) = @_;
798
799     my $dbh = C4::Context->dbh;
800
801     my ($sth, $found, $priority);
802     if ( $itemnumber ) {
803         $sth = $dbh->prepare("SELECT found, priority FROM reserves WHERE itemnumber = ? order by priority LIMIT 1");
804         $sth->execute($itemnumber);
805         ($found, $priority) = $sth->fetchrow_array;
806     }
807
808     if(defined $found) {
809         return 'Waiting'  if $found eq 'W' and $priority == 0;
810         return 'Finished' if $found eq 'F';
811     }
812
813     return 'Reserved' if $priority > 0;
814
815     return ''; # empty string here will remove need for checking undef, or less log lines
816 }
817
818 =head2 CheckReserves
819
820   ($status, $reserve, $all_reserves) = &CheckReserves($itemnumber);
821   ($status, $reserve, $all_reserves) = &CheckReserves(undef, $barcode);
822   ($status, $reserve, $all_reserves) = &CheckReserves($itemnumber,undef,$lookahead);
823
824 Find a book in the reserves.
825
826 C<$itemnumber> is the book's item number.
827 C<$lookahead> is the number of days to look in advance for future reserves.
828
829 As I understand it, C<&CheckReserves> looks for the given item in the
830 reserves. If it is found, that's a match, and C<$status> is set to
831 C<Waiting>.
832
833 Otherwise, it finds the most important item in the reserves with the
834 same biblio number as this book (I'm not clear on this) and returns it
835 with C<$status> set to C<Reserved>.
836
837 C<&CheckReserves> returns a two-element list:
838
839 C<$status> is either C<Waiting>, C<Reserved> (see above), or 0.
840
841 C<$reserve> is the reserve item that matched. It is a
842 reference-to-hash whose keys are mostly the fields of the reserves
843 table in the Koha database.
844
845 =cut
846
847 sub CheckReserves {
848     my ( $item, $barcode, $lookahead_days, $ignore_borrowers) = @_;
849     my $dbh = C4::Context->dbh;
850     my $sth;
851     my $select;
852     if (C4::Context->preference('item-level_itypes')){
853         $select = "
854            SELECT items.biblionumber,
855            items.biblioitemnumber,
856            itemtypes.notforloan,
857            items.notforloan AS itemnotforloan,
858            items.itemnumber,
859            items.damaged,
860            items.homebranch,
861            items.holdingbranch
862            FROM   items
863            LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
864            LEFT JOIN itemtypes   ON items.itype   = itemtypes.itemtype
865         ";
866     }
867     else {
868         $select = "
869            SELECT items.biblionumber,
870            items.biblioitemnumber,
871            itemtypes.notforloan,
872            items.notforloan AS itemnotforloan,
873            items.itemnumber,
874            items.damaged,
875            items.homebranch,
876            items.holdingbranch
877            FROM   items
878            LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
879            LEFT JOIN itemtypes   ON biblioitems.itemtype   = itemtypes.itemtype
880         ";
881     }
882
883     if ($item) {
884         $sth = $dbh->prepare("$select WHERE itemnumber = ?");
885         $sth->execute($item);
886     }
887     else {
888         $sth = $dbh->prepare("$select WHERE barcode = ?");
889         $sth->execute($barcode);
890     }
891     # note: we get the itemnumber because we might have started w/ just the barcode.  Now we know for sure we have it.
892     my ( $biblio, $bibitem, $notforloan_per_itemtype, $notforloan_per_item, $itemnumber, $damaged, $item_homebranch, $item_holdingbranch ) = $sth->fetchrow_array;
893
894     return if ( $damaged && !C4::Context->preference('AllowHoldsOnDamagedItems') );
895
896     return unless $itemnumber; # bail if we got nothing.
897
898     # if item is not for loan it cannot be reserved either.....
899     # except where items.notforloan < 0 :  This indicates the item is holdable.
900     return if  ( $notforloan_per_item > 0 ) or $notforloan_per_itemtype;
901
902     # Find this item in the reserves
903     my @reserves = _Findgroupreserve( $bibitem, $biblio, $itemnumber, $lookahead_days, $ignore_borrowers);
904
905     # $priority and $highest are used to find the most important item
906     # in the list returned by &_Findgroupreserve. (The lower $priority,
907     # the more important the item.)
908     # $highest is the most important item we've seen so far.
909     my $highest;
910     if (scalar @reserves) {
911         my $LocalHoldsPriority = C4::Context->preference('LocalHoldsPriority');
912         my $LocalHoldsPriorityPatronControl = C4::Context->preference('LocalHoldsPriorityPatronControl');
913         my $LocalHoldsPriorityItemControl = C4::Context->preference('LocalHoldsPriorityItemControl');
914
915         my $priority = 10000000;
916         foreach my $res (@reserves) {
917             if ( $res->{'itemnumber'} == $itemnumber && $res->{'priority'} == 0) {
918                 return ( "Waiting", $res, \@reserves ); # Found it
919             } else {
920                 my $borrowerinfo;
921                 my $iteminfo;
922                 my $local_hold_match;
923
924                 if ($LocalHoldsPriority) {
925                     $borrowerinfo = C4::Members::GetMember( borrowernumber => $res->{'borrowernumber'} );
926                     $iteminfo = C4::Items::GetItem($itemnumber);
927
928                     my $local_holds_priority_item_branchcode =
929                       $iteminfo->{$LocalHoldsPriorityItemControl};
930                     my $local_holds_priority_patron_branchcode =
931                       ( $LocalHoldsPriorityPatronControl eq 'PickupLibrary' )
932                       ? $res->{branchcode}
933                       : ( $LocalHoldsPriorityPatronControl eq 'HomeLibrary' )
934                       ? $borrowerinfo->{branchcode}
935                       : undef;
936                     $local_hold_match =
937                       $local_holds_priority_item_branchcode eq
938                       $local_holds_priority_patron_branchcode;
939                 }
940
941                 # See if this item is more important than what we've got so far
942                 if ( ( $res->{'priority'} && $res->{'priority'} < $priority ) || $local_hold_match ) {
943                     $borrowerinfo ||= C4::Members::GetMember( borrowernumber => $res->{'borrowernumber'} );
944                     $iteminfo ||= C4::Items::GetItem($itemnumber);
945                     my $branch = GetReservesControlBranch( $iteminfo, $borrowerinfo );
946                     my $branchitemrule = C4::Circulation::GetBranchItemRule($branch,$iteminfo->{'itype'});
947                     next if ($branchitemrule->{'holdallowed'} == 0);
948                     next if (($branchitemrule->{'holdallowed'} == 1) && ($branch ne $borrowerinfo->{'branchcode'}));
949                     $priority = $res->{'priority'};
950                     $highest  = $res;
951                     last if $local_hold_match;
952                 }
953             }
954         }
955     }
956
957     # If we get this far, then no exact match was found.
958     # We return the most important (i.e. next) reservation.
959     if ($highest) {
960         $highest->{'itemnumber'} = $item;
961         return ( "Reserved", $highest, \@reserves );
962     }
963
964     return ( '' );
965 }
966
967 =head2 CancelExpiredReserves
968
969   CancelExpiredReserves();
970
971 Cancels all reserves with an expiration date from before today.
972
973 =cut
974
975 sub CancelExpiredReserves {
976
977     # Cancel reserves that have passed their expiration date.
978     my $dbh = C4::Context->dbh;
979     my $sth = $dbh->prepare( "
980         SELECT * FROM reserves WHERE DATE(expirationdate) < DATE( CURDATE() )
981         AND expirationdate IS NOT NULL
982         AND found IS NULL
983     " );
984     $sth->execute();
985
986     while ( my $res = $sth->fetchrow_hashref() ) {
987         CancelReserve({ reserve_id => $res->{'reserve_id'} });
988     }
989
990     # Cancel reserves that have been waiting too long
991     if ( C4::Context->preference("ExpireReservesMaxPickUpDelay") ) {
992         my $max_pickup_delay = C4::Context->preference("ReservesMaxPickUpDelay");
993         my $cancel_on_holidays = C4::Context->preference('ExpireReservesOnHolidays');
994
995         my $today = dt_from_string();
996
997         my $query = "SELECT * FROM reserves WHERE TO_DAYS( NOW() ) - TO_DAYS( waitingdate ) > ? AND found = 'W' AND priority = 0";
998         $sth = $dbh->prepare( $query );
999         $sth->execute( $max_pickup_delay );
1000
1001         while ( my $res = $sth->fetchrow_hashref ) {
1002             my $do_cancel = 1;
1003             unless ( $cancel_on_holidays ) {
1004                 my $calendar = Koha::Calendar->new( branchcode => $res->{'branchcode'} );
1005                 my $is_holiday = $calendar->is_holiday( $today );
1006
1007                 if ( $is_holiday ) {
1008                     $do_cancel = 0;
1009                 }
1010             }
1011
1012             if ( $do_cancel ) {
1013                 CancelReserve({ reserve_id => $res->{'reserve_id'}, charge_cancel_fee => 1 });
1014             }
1015         }
1016     }
1017
1018 }
1019
1020 =head2 AutoUnsuspendReserves
1021
1022   AutoUnsuspendReserves();
1023
1024 Unsuspends all suspended reserves with a suspend_until date from before today.
1025
1026 =cut
1027
1028 sub AutoUnsuspendReserves {
1029
1030     my $dbh = C4::Context->dbh;
1031
1032     my $query = "UPDATE reserves SET suspend = 0, suspend_until = NULL WHERE DATE( suspend_until ) < DATE( CURDATE() )";
1033     my $sth = $dbh->prepare( $query );
1034     $sth->execute();
1035
1036 }
1037
1038 =head2 CancelReserve
1039
1040   CancelReserve({ reserve_id => $reserve_id, [ biblionumber => $biblionumber, borrowernumber => $borrrowernumber, itemnumber => $itemnumber, ] [ charge_cancel_fee => 1 ] });
1041
1042 Cancels a reserve. If C<charge_cancel_fee> is passed and the C<ExpireReservesMaxPickUpDelayCharge> syspref is set, charge that fee to the patron's account.
1043
1044 =cut
1045
1046 sub CancelReserve {
1047     my ( $params ) = @_;
1048
1049     my $reserve_id = $params->{'reserve_id'};
1050     # Filter out only the desired keys; this will insert undefined values for elements missing in
1051     # \%params, but GetReserveId filters them out anyway.
1052     $reserve_id = GetReserveId( { biblionumber => $params->{'biblionumber'}, borrowernumber => $params->{'borrowernumber'}, itemnumber => $params->{'itemnumber'} } ) unless ( $reserve_id );
1053
1054     return unless ( $reserve_id );
1055
1056     my $dbh = C4::Context->dbh;
1057
1058     my $reserve = GetReserve( $reserve_id );
1059     if ($reserve) {
1060         my $query = "
1061             UPDATE reserves
1062             SET    cancellationdate = now(),
1063                    found            = Null,
1064                    priority         = 0
1065             WHERE  reserve_id = ?
1066         ";
1067         my $sth = $dbh->prepare($query);
1068         $sth->execute( $reserve_id );
1069
1070         $query = "
1071             INSERT INTO old_reserves
1072             SELECT * FROM reserves
1073             WHERE  reserve_id = ?
1074         ";
1075         $sth = $dbh->prepare($query);
1076         $sth->execute( $reserve_id );
1077
1078         $query = "
1079             DELETE FROM reserves
1080             WHERE  reserve_id = ?
1081         ";
1082         $sth = $dbh->prepare($query);
1083         $sth->execute( $reserve_id );
1084
1085         # now fix the priority on the others....
1086         _FixPriority({ biblionumber => $reserve->{biblionumber} });
1087
1088         # and, if desired, charge a cancel fee
1089         my $charge = C4::Context->preference("ExpireReservesMaxPickUpDelayCharge");
1090         if ( $charge && $params->{'charge_cancel_fee'} ) {
1091             manualinvoice($reserve->{'borrowernumber'}, $reserve->{'itemnumber'}, 'Hold waiting too long', 'F', $charge);
1092         }
1093     }
1094
1095     return $reserve;
1096 }
1097
1098 =head2 ModReserve
1099
1100   ModReserve({ rank => $rank,
1101                reserve_id => $reserve_id,
1102                branchcode => $branchcode
1103                [, itemnumber => $itemnumber ]
1104                [, biblionumber => $biblionumber, $borrowernumber => $borrowernumber ]
1105               });
1106
1107 Change a hold request's priority or cancel it.
1108
1109 C<$rank> specifies the effect of the change.  If C<$rank>
1110 is 'W' or 'n', nothing happens.  This corresponds to leaving a
1111 request alone when changing its priority in the holds queue
1112 for a bib.
1113
1114 If C<$rank> is 'del', the hold request is cancelled.
1115
1116 If C<$rank> is an integer greater than zero, the priority of
1117 the request is set to that value.  Since priority != 0 means
1118 that the item is not waiting on the hold shelf, setting the
1119 priority to a non-zero value also sets the request's found
1120 status and waiting date to NULL.
1121
1122 The optional C<$itemnumber> parameter is used only when
1123 C<$rank> is a non-zero integer; if supplied, the itemnumber
1124 of the hold request is set accordingly; if omitted, the itemnumber
1125 is cleared.
1126
1127 B<FIXME:> Note that the forgoing can have the effect of causing
1128 item-level hold requests to turn into title-level requests.  This
1129 will be fixed once reserves has separate columns for requested
1130 itemnumber and supplying itemnumber.
1131
1132 =cut
1133
1134 sub ModReserve {
1135     my ( $params ) = @_;
1136
1137     my $rank = $params->{'rank'};
1138     my $reserve_id = $params->{'reserve_id'};
1139     my $branchcode = $params->{'branchcode'};
1140     my $itemnumber = $params->{'itemnumber'};
1141     my $suspend_until = $params->{'suspend_until'};
1142     my $borrowernumber = $params->{'borrowernumber'};
1143     my $biblionumber = $params->{'biblionumber'};
1144
1145     return if $rank eq "W";
1146     return if $rank eq "n";
1147
1148     return unless ( $reserve_id || ( $borrowernumber && ( $biblionumber || $itemnumber ) ) );
1149     $reserve_id = GetReserveId({ biblionumber => $biblionumber, borrowernumber => $borrowernumber, itemnumber => $itemnumber }) unless ( $reserve_id );
1150
1151     my $dbh = C4::Context->dbh;
1152     if ( $rank eq "del" ) {
1153         CancelReserve({ reserve_id => $reserve_id });
1154     }
1155     elsif ($rank =~ /^\d+/ and $rank > 0) {
1156         my $query = "
1157             UPDATE reserves SET priority = ? ,branchcode = ?, itemnumber = ?, found = NULL, waitingdate = NULL
1158             WHERE reserve_id = ?
1159         ";
1160         my $sth = $dbh->prepare($query);
1161         $sth->execute( $rank, $branchcode, $itemnumber, $reserve_id );
1162
1163         if ( defined( $suspend_until ) ) {
1164             if ( $suspend_until ) {
1165                 $suspend_until = C4::Dates->new( $suspend_until )->output("iso");
1166                 $dbh->do("UPDATE reserves SET suspend = 1, suspend_until = ? WHERE reserve_id = ?", undef, ( $suspend_until, $reserve_id ) );
1167             } else {
1168                 $dbh->do("UPDATE reserves SET suspend_until = NULL WHERE reserve_id = ?", undef, ( $reserve_id ) );
1169             }
1170         }
1171
1172         _FixPriority({ reserve_id => $reserve_id, rank =>$rank });
1173     }
1174 }
1175
1176 =head2 ModReserveFill
1177
1178   &ModReserveFill($reserve);
1179
1180 Fill a reserve. If I understand this correctly, this means that the
1181 reserved book has been found and given to the patron who reserved it.
1182
1183 C<$reserve> specifies the reserve to fill. It is a reference-to-hash
1184 whose keys are fields from the reserves table in the Koha database.
1185
1186 =cut
1187
1188 sub ModReserveFill {
1189     my ($res) = @_;
1190     my $dbh = C4::Context->dbh;
1191     # fill in a reserve record....
1192     my $reserve_id = $res->{'reserve_id'};
1193     my $biblionumber = $res->{'biblionumber'};
1194     my $borrowernumber    = $res->{'borrowernumber'};
1195     my $resdate = $res->{'reservedate'};
1196
1197     # get the priority on this record....
1198     my $priority;
1199     my $query = "SELECT priority
1200                  FROM   reserves
1201                  WHERE  biblionumber   = ?
1202                   AND   borrowernumber = ?
1203                   AND   reservedate    = ?";
1204     my $sth = $dbh->prepare($query);
1205     $sth->execute( $biblionumber, $borrowernumber, $resdate );
1206     ($priority) = $sth->fetchrow_array;
1207
1208     # update the database...
1209     $query = "UPDATE reserves
1210                   SET    found            = 'F',
1211                          priority         = 0
1212                  WHERE  biblionumber     = ?
1213                     AND reservedate      = ?
1214                     AND borrowernumber   = ?
1215                 ";
1216     $sth = $dbh->prepare($query);
1217     $sth->execute( $biblionumber, $resdate, $borrowernumber );
1218
1219     # move to old_reserves
1220     $query = "INSERT INTO old_reserves
1221                  SELECT * FROM reserves
1222                  WHERE  biblionumber     = ?
1223                     AND reservedate      = ?
1224                     AND borrowernumber   = ?
1225                 ";
1226     $sth = $dbh->prepare($query);
1227     $sth->execute( $biblionumber, $resdate, $borrowernumber );
1228     $query = "DELETE FROM reserves
1229                  WHERE  biblionumber     = ?
1230                     AND reservedate      = ?
1231                     AND borrowernumber   = ?
1232                 ";
1233     $sth = $dbh->prepare($query);
1234     $sth->execute( $biblionumber, $resdate, $borrowernumber );
1235
1236     # now fix the priority on the others (if the priority wasn't
1237     # already sorted!)....
1238     unless ( $priority == 0 ) {
1239         _FixPriority({ reserve_id => $reserve_id, biblionumber => $biblionumber });
1240     }
1241 }
1242
1243 =head2 ModReserveStatus
1244
1245   &ModReserveStatus($itemnumber, $newstatus);
1246
1247 Update the reserve status for the active (priority=0) reserve.
1248
1249 $itemnumber is the itemnumber the reserve is on
1250
1251 $newstatus is the new status.
1252
1253 =cut
1254
1255 sub ModReserveStatus {
1256
1257     #first : check if we have a reservation for this item .
1258     my ($itemnumber, $newstatus) = @_;
1259     my $dbh = C4::Context->dbh;
1260
1261     my $query = "UPDATE reserves SET found = ?, waitingdate = NOW() WHERE itemnumber = ? AND found IS NULL AND priority = 0";
1262     my $sth_set = $dbh->prepare($query);
1263     $sth_set->execute( $newstatus, $itemnumber );
1264
1265     if ( C4::Context->preference("ReturnToShelvingCart") && $newstatus ) {
1266       CartToShelf( $itemnumber );
1267     }
1268 }
1269
1270 =head2 ModReserveAffect
1271
1272   &ModReserveAffect($itemnumber,$borrowernumber,$diffBranchSend);
1273
1274 This function affect an item and a status for a given reserve
1275 The itemnumber parameter is used to find the biblionumber.
1276 with the biblionumber & the borrowernumber, we can affect the itemnumber
1277 to the correct reserve.
1278
1279 if $transferToDo is not set, then the status is set to "Waiting" as well.
1280 otherwise, a transfer is on the way, and the end of the transfer will
1281 take care of the waiting status
1282
1283 =cut
1284
1285 sub ModReserveAffect {
1286     my ( $itemnumber, $borrowernumber,$transferToDo ) = @_;
1287     my $dbh = C4::Context->dbh;
1288
1289     # we want to attach $itemnumber to $borrowernumber, find the biblionumber
1290     # attached to $itemnumber
1291     my $sth = $dbh->prepare("SELECT biblionumber FROM items WHERE itemnumber=?");
1292     $sth->execute($itemnumber);
1293     my ($biblionumber) = $sth->fetchrow;
1294
1295     # get request - need to find out if item is already
1296     # waiting in order to not send duplicate hold filled notifications
1297     my $reserve_id = GetReserveId({
1298         borrowernumber => $borrowernumber,
1299         biblionumber   => $biblionumber,
1300     });
1301     return unless defined $reserve_id;
1302     my $request = GetReserveInfo($reserve_id);
1303     my $already_on_shelf = ($request && $request->{found} eq 'W') ? 1 : 0;
1304
1305     # If we affect a reserve that has to be transferred, don't set to Waiting
1306     my $query;
1307     if ($transferToDo) {
1308     $query = "
1309         UPDATE reserves
1310         SET    priority = 0,
1311                itemnumber = ?,
1312                found = 'T'
1313         WHERE borrowernumber = ?
1314           AND biblionumber = ?
1315     ";
1316     }
1317     else {
1318     # affect the reserve to Waiting as well.
1319         $query = "
1320             UPDATE reserves
1321             SET     priority = 0,
1322                     found = 'W',
1323                     waitingdate = NOW(),
1324                     itemnumber = ?
1325             WHERE borrowernumber = ?
1326               AND biblionumber = ?
1327         ";
1328     }
1329     $sth = $dbh->prepare($query);
1330     $sth->execute( $itemnumber, $borrowernumber,$biblionumber);
1331     _koha_notify_reserve( $itemnumber, $borrowernumber, $biblionumber ) if ( !$transferToDo && !$already_on_shelf );
1332     _FixPriority( { biblionumber => $biblionumber } );
1333     if ( C4::Context->preference("ReturnToShelvingCart") ) {
1334       CartToShelf( $itemnumber );
1335     }
1336
1337     return;
1338 }
1339
1340 =head2 ModReserveCancelAll
1341
1342   ($messages,$nextreservinfo) = &ModReserveCancelAll($itemnumber,$borrowernumber);
1343
1344 function to cancel reserv,check other reserves, and transfer document if it's necessary
1345
1346 =cut
1347
1348 sub ModReserveCancelAll {
1349     my $messages;
1350     my $nextreservinfo;
1351     my ( $itemnumber, $borrowernumber ) = @_;
1352
1353     #step 1 : cancel the reservation
1354     my $CancelReserve = CancelReserve({ itemnumber => $itemnumber, borrowernumber => $borrowernumber });
1355
1356     #step 2 launch the subroutine of the others reserves
1357     ( $messages, $nextreservinfo ) = GetOtherReserves($itemnumber);
1358
1359     return ( $messages, $nextreservinfo );
1360 }
1361
1362 =head2 ModReserveMinusPriority
1363
1364   &ModReserveMinusPriority($itemnumber,$borrowernumber,$biblionumber)
1365
1366 Reduce the values of queued list
1367
1368 =cut
1369
1370 sub ModReserveMinusPriority {
1371     my ( $itemnumber, $reserve_id ) = @_;
1372
1373     #first step update the value of the first person on reserv
1374     my $dbh   = C4::Context->dbh;
1375     my $query = "
1376         UPDATE reserves
1377         SET    priority = 0 , itemnumber = ? 
1378         WHERE  reserve_id = ?
1379     ";
1380     my $sth_upd = $dbh->prepare($query);
1381     $sth_upd->execute( $itemnumber, $reserve_id );
1382     # second step update all others reserves
1383     _FixPriority({ reserve_id => $reserve_id, rank => '0' });
1384 }
1385
1386 =head2 GetReserveInfo
1387
1388   &GetReserveInfo($reserve_id);
1389
1390 Get item and borrower details for a current hold.
1391 Current implementation this query should have a single result.
1392
1393 =cut
1394
1395 sub GetReserveInfo {
1396     my ( $reserve_id ) = @_;
1397     my $dbh = C4::Context->dbh;
1398     my $strsth="SELECT
1399                    reserve_id,
1400                    reservedate,
1401                    reservenotes,
1402                    reserves.borrowernumber,
1403                    reserves.biblionumber,
1404                    reserves.branchcode,
1405                    reserves.waitingdate,
1406                    notificationdate,
1407                    reminderdate,
1408                    priority,
1409                    found,
1410                    firstname,
1411                    surname,
1412                    phone,
1413                    email,
1414                    address,
1415                    address2,
1416                    cardnumber,
1417                    city,
1418                    zipcode,
1419                    biblio.title,
1420                    biblio.author,
1421                    items.holdingbranch,
1422                    items.itemcallnumber,
1423                    items.itemnumber,
1424                    items.location,
1425                    barcode,
1426                    notes
1427                 FROM reserves
1428                 LEFT JOIN items USING(itemnumber)
1429                 LEFT JOIN borrowers USING(borrowernumber)
1430                 LEFT JOIN biblio ON  (reserves.biblionumber=biblio.biblionumber)
1431                 WHERE reserves.reserve_id = ?";
1432     my $sth = $dbh->prepare($strsth);
1433     $sth->execute($reserve_id);
1434
1435     my $data = $sth->fetchrow_hashref;
1436     return $data;
1437 }
1438
1439 =head2 IsAvailableForItemLevelRequest
1440
1441   my $is_available = IsAvailableForItemLevelRequest($item_record,$borrower_record);
1442
1443 Checks whether a given item record is available for an
1444 item-level hold request.  An item is available if
1445
1446 * it is not lost AND
1447 * it is not damaged AND
1448 * it is not withdrawn AND
1449 * does not have a not for loan value > 0
1450
1451 Need to check the issuingrules onshelfholds column,
1452 if this is set items on the shelf can be placed on hold
1453
1454 Note that IsAvailableForItemLevelRequest() does not
1455 check if the staff operator is authorized to place
1456 a request on the item - in particular,
1457 this routine does not check IndependentBranches
1458 and canreservefromotherbranches.
1459
1460 =cut
1461
1462 sub IsAvailableForItemLevelRequest {
1463     my $item = shift;
1464     my $borrower = shift;
1465
1466     my $dbh = C4::Context->dbh;
1467     # must check the notforloan setting of the itemtype
1468     # FIXME - a lot of places in the code do this
1469     #         or something similar - need to be
1470     #         consolidated
1471     my $itype = _get_itype($item);
1472     my $notforloan_per_itemtype
1473       = $dbh->selectrow_array("SELECT notforloan FROM itemtypes WHERE itemtype = ?",
1474                               undef, $itype);
1475
1476     return 0 if
1477         $notforloan_per_itemtype ||
1478         $item->{itemlost}        ||
1479         $item->{notforloan} > 0  ||
1480         $item->{withdrawn}        ||
1481         ($item->{damaged} && !C4::Context->preference('AllowHoldsOnDamagedItems'));
1482
1483
1484     return 1 if _OnShelfHoldsAllowed($itype,$borrower->{categorycode},$item->{holdingbranch});
1485
1486     return $item->{onloan} || GetReserveStatus($item->{itemnumber}) eq "Waiting";
1487 }
1488
1489 =head2 OnShelfHoldsAllowed
1490
1491   OnShelfHoldsAllowed($itemtype,$borrowercategory,$branchcode);
1492
1493 Checks issuingrules, using the borrowers categorycode, the itemtype, and branchcode to see if onshelf
1494 holds are allowed, returns true if so.
1495
1496 =cut
1497
1498 sub OnShelfHoldsAllowed {
1499     my ($item, $borrower) = @_;
1500
1501     my $itype = _get_itype($item);
1502     return _OnShelfHoldsAllowed($itype,$borrower->{categorycode},$item->{holdingbranch});
1503 }
1504
1505 sub _get_itype {
1506     my $item = shift;
1507
1508     my $itype;
1509     if (C4::Context->preference('item-level_itypes')) {
1510         # We can't trust GetItem to honour the syspref, so safest to do it ourselves
1511         # When GetItem is fixed, we can remove this
1512         $itype = $item->{itype};
1513     }
1514     else {
1515         # XXX This is a bit dodgy. It relies on biblio itemtype column having different name.
1516         # So if we already have a biblioitems join when calling this function,
1517         # we don't need to access the database again
1518         $itype = $item->{itemtype};
1519     }
1520     unless ($itype) {
1521         my $dbh = C4::Context->dbh;
1522         my $query = "SELECT itemtype FROM biblioitems WHERE biblioitemnumber = ? ";
1523         my $sth = $dbh->prepare($query);
1524         $sth->execute($item->{biblioitemnumber});
1525         if (my $data = $sth->fetchrow_hashref()){
1526             $itype = $data->{itemtype};
1527         }
1528     }
1529     return $itype;
1530 }
1531
1532 sub _OnShelfHoldsAllowed {
1533     my ($itype,$borrowercategory,$branchcode) = @_;
1534
1535     my $rule = C4::Circulation::GetIssuingRule($borrowercategory, $itype, $branchcode);
1536     return $rule->{onshelfholds};
1537 }
1538
1539 =head2 AlterPriority
1540
1541   AlterPriority( $where, $reserve_id );
1542
1543 This function changes a reserve's priority up, down, to the top, or to the bottom.
1544 Input: $where is 'up', 'down', 'top' or 'bottom'. Biblionumber, Date reserve was placed
1545
1546 =cut
1547
1548 sub AlterPriority {
1549     my ( $where, $reserve_id ) = @_;
1550
1551     my $dbh = C4::Context->dbh;
1552
1553     my $reserve = GetReserve( $reserve_id );
1554
1555     if ( $reserve->{cancellationdate} ) {
1556         warn "I cannot alter the priority for reserve_id $reserve_id, the reserve has been cancelled (".$reserve->{cancellationdate}.')';
1557         return;
1558     }
1559
1560     if ( $where eq 'up' || $where eq 'down' ) {
1561
1562       my $priority = $reserve->{'priority'};
1563       $priority = $where eq 'up' ? $priority - 1 : $priority + 1;
1564       _FixPriority({ reserve_id => $reserve_id, rank => $priority })
1565
1566     } elsif ( $where eq 'top' ) {
1567
1568       _FixPriority({ reserve_id => $reserve_id, rank => '1' })
1569
1570     } elsif ( $where eq 'bottom' ) {
1571
1572       _FixPriority({ reserve_id => $reserve_id, rank => '999999' });
1573
1574     }
1575 }
1576
1577 =head2 ToggleLowestPriority
1578
1579   ToggleLowestPriority( $borrowernumber, $biblionumber );
1580
1581 This function sets the lowestPriority field to true if is false, and false if it is true.
1582
1583 =cut
1584
1585 sub ToggleLowestPriority {
1586     my ( $reserve_id ) = @_;
1587
1588     my $dbh = C4::Context->dbh;
1589
1590     my $sth = $dbh->prepare( "UPDATE reserves SET lowestPriority = NOT lowestPriority WHERE reserve_id = ?");
1591     $sth->execute( $reserve_id );
1592     
1593     _FixPriority({ reserve_id => $reserve_id, rank => '999999' });
1594 }
1595
1596 =head2 ToggleSuspend
1597
1598   ToggleSuspend( $reserve_id );
1599
1600 This function sets the suspend field to true if is false, and false if it is true.
1601 If the reserve is currently suspended with a suspend_until date, that date will
1602 be cleared when it is unsuspended.
1603
1604 =cut
1605
1606 sub ToggleSuspend {
1607     my ( $reserve_id, $suspend_until ) = @_;
1608
1609     $suspend_until = output_pref(
1610         {
1611             dt         => dt_from_string($suspend_until),
1612             dateformat => 'iso',
1613             dateonly   => 1
1614         }
1615     ) if ($suspend_until);
1616
1617     my $do_until = ( $suspend_until ) ? '?' : 'NULL';
1618
1619     my $dbh = C4::Context->dbh;
1620
1621     my $sth = $dbh->prepare(
1622         "UPDATE reserves SET suspend = NOT suspend,
1623         suspend_until = CASE WHEN suspend = 0 THEN NULL ELSE $do_until END
1624         WHERE reserve_id = ?
1625     ");
1626
1627     my @params;
1628     push( @params, $suspend_until ) if ( $suspend_until );
1629     push( @params, $reserve_id );
1630
1631     $sth->execute( @params );
1632 }
1633
1634 =head2 SuspendAll
1635
1636   SuspendAll(
1637       borrowernumber   => $borrowernumber,
1638       [ biblionumber   => $biblionumber, ]
1639       [ suspend_until  => $suspend_until, ]
1640       [ suspend        => $suspend ]
1641   );
1642
1643   This function accepts a set of hash keys as its parameters.
1644   It requires either borrowernumber or biblionumber, or both.
1645
1646   suspend_until is wholly optional.
1647
1648 =cut
1649
1650 sub SuspendAll {
1651     my %params = @_;
1652
1653     my $borrowernumber = $params{'borrowernumber'} || undef;
1654     my $biblionumber   = $params{'biblionumber'}   || undef;
1655     my $suspend_until  = $params{'suspend_until'}  || undef;
1656     my $suspend        = defined( $params{'suspend'} ) ? $params{'suspend'} :  1;
1657
1658     $suspend_until = C4::Dates->new( $suspend_until )->output("iso") if ( defined( $suspend_until ) );
1659
1660     return unless ( $borrowernumber || $biblionumber );
1661
1662     my ( $query, $sth, $dbh, @query_params );
1663
1664     $query = "UPDATE reserves SET suspend = ? ";
1665     push( @query_params, $suspend );
1666     if ( !$suspend ) {
1667         $query .= ", suspend_until = NULL ";
1668     } elsif ( $suspend_until ) {
1669         $query .= ", suspend_until = ? ";
1670         push( @query_params, $suspend_until );
1671     }
1672     $query .= " WHERE ";
1673     if ( $borrowernumber ) {
1674         $query .= " borrowernumber = ? ";
1675         push( @query_params, $borrowernumber );
1676     }
1677     $query .= " AND " if ( $borrowernumber && $biblionumber );
1678     if ( $biblionumber ) {
1679         $query .= " biblionumber = ? ";
1680         push( @query_params, $biblionumber );
1681     }
1682     $query .= " AND found IS NULL ";
1683
1684     $dbh = C4::Context->dbh;
1685     $sth = $dbh->prepare( $query );
1686     $sth->execute( @query_params );
1687 }
1688
1689
1690 =head2 _FixPriority
1691
1692   _FixPriority({
1693     reserve_id => $reserve_id,
1694     [rank => $rank,]
1695     [ignoreSetLowestRank => $ignoreSetLowestRank]
1696   });
1697
1698   or
1699
1700   _FixPriority({ biblionumber => $biblionumber});
1701
1702 This routine adjusts the priority of a hold request and holds
1703 on the same bib.
1704
1705 In the first form, where a reserve_id is passed, the priority of the
1706 hold is set to supplied rank, and other holds for that bib are adjusted
1707 accordingly.  If the rank is "del", the hold is cancelled.  If no rank
1708 is supplied, all of the holds on that bib have their priority adjusted
1709 as if the second form had been used.
1710
1711 In the second form, where a biblionumber is passed, the holds on that
1712 bib (that are not captured) are sorted in order of increasing priority,
1713 then have reserves.priority set so that the first non-captured hold
1714 has its priority set to 1, the second non-captured hold has its priority
1715 set to 2, and so forth.
1716
1717 In both cases, holds that have the lowestPriority flag on are have their
1718 priority adjusted to ensure that they remain at the end of the line.
1719
1720 Note that the ignoreSetLowestRank parameter is meant to be used only
1721 when _FixPriority calls itself.
1722
1723 =cut
1724
1725 sub _FixPriority {
1726     my ( $params ) = @_;
1727     my $reserve_id = $params->{reserve_id};
1728     my $rank = $params->{rank} // '';
1729     my $ignoreSetLowestRank = $params->{ignoreSetLowestRank};
1730     my $biblionumber = $params->{biblionumber};
1731
1732     my $dbh = C4::Context->dbh;
1733
1734     unless ( $biblionumber ) {
1735         my $res = GetReserve( $reserve_id );
1736         $biblionumber = $res->{biblionumber};
1737     }
1738
1739     if ( $rank eq "del" ) {
1740          CancelReserve({ reserve_id => $reserve_id });
1741     }
1742     elsif ( $rank eq "W" || $rank eq "0" ) {
1743
1744         # make sure priority for waiting or in-transit items is 0
1745         my $query = "
1746             UPDATE reserves
1747             SET    priority = 0
1748             WHERE reserve_id = ?
1749             AND found IN ('W', 'T')
1750         ";
1751         my $sth = $dbh->prepare($query);
1752         $sth->execute( $reserve_id );
1753     }
1754     my @priority;
1755
1756     # get whats left
1757     my $query = "
1758         SELECT reserve_id, borrowernumber, reservedate
1759         FROM   reserves
1760         WHERE  biblionumber   = ?
1761           AND  ((found <> 'W' AND found <> 'T') OR found IS NULL)
1762         ORDER BY priority ASC
1763     ";
1764     my $sth = $dbh->prepare($query);
1765     $sth->execute( $biblionumber );
1766     while ( my $line = $sth->fetchrow_hashref ) {
1767         push( @priority,     $line );
1768     }
1769
1770     # To find the matching index
1771     my $i;
1772     my $key = -1;    # to allow for 0 to be a valid result
1773     for ( $i = 0 ; $i < @priority ; $i++ ) {
1774         if ( $reserve_id == $priority[$i]->{'reserve_id'} ) {
1775             $key = $i;    # save the index
1776             last;
1777         }
1778     }
1779
1780     # if index exists in array then move it to new position
1781     if ( $key > -1 && $rank ne 'del' && $rank > 0 ) {
1782         my $new_rank = $rank -
1783           1;    # $new_rank is what you want the new index to be in the array
1784         my $moving_item = splice( @priority, $key, 1 );
1785         splice( @priority, $new_rank, 0, $moving_item );
1786     }
1787
1788     # now fix the priority on those that are left....
1789     $query = "
1790         UPDATE reserves
1791         SET    priority = ?
1792         WHERE  reserve_id = ?
1793     ";
1794     $sth = $dbh->prepare($query);
1795     for ( my $j = 0 ; $j < @priority ; $j++ ) {
1796         $sth->execute(
1797             $j + 1,
1798             $priority[$j]->{'reserve_id'}
1799         );
1800     }
1801     
1802     $sth = $dbh->prepare( "SELECT reserve_id FROM reserves WHERE lowestPriority = 1 ORDER BY priority" );
1803     $sth->execute();
1804
1805     unless ( $ignoreSetLowestRank ) {
1806       while ( my $res = $sth->fetchrow_hashref() ) {
1807         _FixPriority({
1808             reserve_id => $res->{'reserve_id'},
1809             rank => '999999',
1810             ignoreSetLowestRank => 1
1811         });
1812       }
1813     }
1814 }
1815
1816 =head2 _Findgroupreserve
1817
1818   @results = &_Findgroupreserve($biblioitemnumber, $biblionumber, $itemnumber, $lookahead, $ignore_borrowers);
1819
1820 Looks for a holds-queue based item-specific match first, then for a holds-queue title-level match, returning the
1821 first match found.  If neither, then we look for non-holds-queue based holds.
1822 Lookahead is the number of days to look in advance.
1823
1824 C<&_Findgroupreserve> returns :
1825 C<@results> is an array of references-to-hash whose keys are mostly
1826 fields from the reserves table of the Koha database, plus
1827 C<biblioitemnumber>.
1828
1829 =cut
1830
1831 sub _Findgroupreserve {
1832     my ( $bibitem, $biblio, $itemnumber, $lookahead, $ignore_borrowers) = @_;
1833     my $dbh   = C4::Context->dbh;
1834
1835     # TODO: consolidate at least the SELECT portion of the first 2 queries to a common $select var.
1836     # check for exact targeted match
1837     my $item_level_target_query = qq{
1838         SELECT reserves.biblionumber        AS biblionumber,
1839                reserves.borrowernumber      AS borrowernumber,
1840                reserves.reservedate         AS reservedate,
1841                reserves.branchcode          AS branchcode,
1842                reserves.cancellationdate    AS cancellationdate,
1843                reserves.found               AS found,
1844                reserves.reservenotes        AS reservenotes,
1845                reserves.priority            AS priority,
1846                reserves.timestamp           AS timestamp,
1847                biblioitems.biblioitemnumber AS biblioitemnumber,
1848                reserves.itemnumber          AS itemnumber,
1849                reserves.reserve_id          AS reserve_id
1850         FROM reserves
1851         JOIN biblioitems USING (biblionumber)
1852         JOIN hold_fill_targets USING (biblionumber, borrowernumber, itemnumber)
1853         WHERE found IS NULL
1854         AND priority > 0
1855         AND item_level_request = 1
1856         AND itemnumber = ?
1857         AND reservedate <= DATE_ADD(NOW(),INTERVAL ? DAY)
1858         AND suspend = 0
1859         ORDER BY priority
1860     };
1861     my $sth = $dbh->prepare($item_level_target_query);
1862     $sth->execute($itemnumber, $lookahead||0);
1863     my @results;
1864     if ( my $data = $sth->fetchrow_hashref ) {
1865         push( @results, $data )
1866           unless any{ $data->{borrowernumber} eq $_ } @$ignore_borrowers ;
1867     }
1868     return @results if @results;
1869
1870     # check for title-level targeted match
1871     my $title_level_target_query = qq{
1872         SELECT reserves.biblionumber        AS biblionumber,
1873                reserves.borrowernumber      AS borrowernumber,
1874                reserves.reservedate         AS reservedate,
1875                reserves.branchcode          AS branchcode,
1876                reserves.cancellationdate    AS cancellationdate,
1877                reserves.found               AS found,
1878                reserves.reservenotes        AS reservenotes,
1879                reserves.priority            AS priority,
1880                reserves.timestamp           AS timestamp,
1881                biblioitems.biblioitemnumber AS biblioitemnumber,
1882                reserves.itemnumber          AS itemnumber,
1883                reserves.reserve_id          AS reserve_id
1884         FROM reserves
1885         JOIN biblioitems USING (biblionumber)
1886         JOIN hold_fill_targets USING (biblionumber, borrowernumber)
1887         WHERE found IS NULL
1888         AND priority > 0
1889         AND item_level_request = 0
1890         AND hold_fill_targets.itemnumber = ?
1891         AND reservedate <= DATE_ADD(NOW(),INTERVAL ? DAY)
1892         AND suspend = 0
1893         ORDER BY priority
1894     };
1895     $sth = $dbh->prepare($title_level_target_query);
1896     $sth->execute($itemnumber, $lookahead||0);
1897     @results = ();
1898     if ( my $data = $sth->fetchrow_hashref ) {
1899         push( @results, $data )
1900           unless any{ $data->{borrowernumber} eq $_ } @$ignore_borrowers ;
1901     }
1902     return @results if @results;
1903
1904     my $query = qq{
1905         SELECT reserves.biblionumber               AS biblionumber,
1906                reserves.borrowernumber             AS borrowernumber,
1907                reserves.reservedate                AS reservedate,
1908                reserves.waitingdate                AS waitingdate,
1909                reserves.branchcode                 AS branchcode,
1910                reserves.cancellationdate           AS cancellationdate,
1911                reserves.found                      AS found,
1912                reserves.reservenotes               AS reservenotes,
1913                reserves.priority                   AS priority,
1914                reserves.timestamp                  AS timestamp,
1915                reserves.itemnumber                 AS itemnumber,
1916                reserves.reserve_id                 AS reserve_id
1917         FROM reserves
1918         WHERE reserves.biblionumber = ?
1919           AND (reserves.itemnumber IS NULL OR reserves.itemnumber = ?)
1920           AND reserves.reservedate <= DATE_ADD(NOW(),INTERVAL ? DAY)
1921           AND suspend = 0
1922           ORDER BY priority
1923     };
1924     $sth = $dbh->prepare($query);
1925     $sth->execute( $biblio, $itemnumber, $lookahead||0);
1926     @results = ();
1927     while ( my $data = $sth->fetchrow_hashref ) {
1928         push( @results, $data )
1929           unless any{ $data->{borrowernumber} eq $_ } @$ignore_borrowers ;
1930     }
1931     return @results;
1932 }
1933
1934 =head2 _koha_notify_reserve
1935
1936   _koha_notify_reserve( $itemnumber, $borrowernumber, $biblionumber );
1937
1938 Sends a notification to the patron that their hold has been filled (through
1939 ModReserveAffect, _not_ ModReserveFill)
1940
1941 =cut
1942
1943 sub _koha_notify_reserve {
1944     my ($itemnumber, $borrowernumber, $biblionumber) = @_;
1945
1946     my $dbh = C4::Context->dbh;
1947     my $borrower = C4::Members::GetMember(borrowernumber => $borrowernumber);
1948
1949     # Try to get the borrower's email address
1950     my $to_address = C4::Members::GetNoticeEmailAddress($borrowernumber);
1951
1952     my $messagingprefs = C4::Members::Messaging::GetMessagingPreferences( {
1953             borrowernumber => $borrowernumber,
1954             message_name => 'Hold_Filled'
1955     } );
1956
1957     my $sth = $dbh->prepare("
1958         SELECT *
1959         FROM   reserves
1960         WHERE  borrowernumber = ?
1961             AND biblionumber = ?
1962     ");
1963     $sth->execute( $borrowernumber, $biblionumber );
1964     my $reserve = $sth->fetchrow_hashref;
1965     my $branch_details = GetBranchDetail( $reserve->{'branchcode'} );
1966
1967     my $admin_email_address = $branch_details->{'branchemail'} || C4::Context->preference('KohaAdminEmailAddress');
1968
1969     my %letter_params = (
1970         module => 'reserves',
1971         branchcode => $reserve->{branchcode},
1972         tables => {
1973             'branches'  => $branch_details,
1974             'borrowers' => $borrower,
1975             'biblio'    => $biblionumber,
1976             'reserves'  => $reserve,
1977             'items', $reserve->{'itemnumber'},
1978         },
1979         substitute => { today => C4::Dates->new()->output() },
1980     );
1981
1982     my $notification_sent = 0; #Keeping track if a Hold_filled message is sent. If no message can be sent, then default to a print message.
1983     my $send_notification = sub {
1984         my ( $mtt, $letter_code ) = (@_);
1985         return unless defined $letter_code;
1986         $letter_params{letter_code} = $letter_code;
1987         $letter_params{message_transport_type} = $mtt;
1988         my $letter =  C4::Letters::GetPreparedLetter ( %letter_params );
1989         unless ($letter) {
1990             warn "Could not find a letter called '$letter_params{'letter_code'}' for $mtt in the 'reserves' module";
1991             return;
1992         }
1993
1994         C4::Letters::EnqueueLetter( {
1995             letter => $letter,
1996             borrowernumber => $borrowernumber,
1997             from_address => $admin_email_address,
1998             message_transport_type => $mtt,
1999         } );
2000     };
2001
2002     while ( my ( $mtt, $letter_code ) = each %{ $messagingprefs->{transports} } ) {
2003         next if (
2004                ( $mtt eq 'email' and not $to_address ) # No email address
2005             or ( $mtt eq 'sms'   and not $borrower->{smsalertnumber} ) # No SMS number
2006             or ( $mtt eq 'phone' and C4::Context->preference('TalkingTechItivaPhoneNotification') ) # Notice is handled by TalkingTech_itiva_outbound.pl
2007         );
2008
2009         &$send_notification($mtt, $letter_code);
2010         $notification_sent++;
2011     }
2012     #Making sure that a print notification is sent if no other transport types can be utilized.
2013     if (! $notification_sent) {
2014         &$send_notification('print', 'HOLD');
2015     }
2016     
2017 }
2018
2019 =head2 _ShiftPriorityByDateAndPriority
2020
2021   $new_priority = _ShiftPriorityByDateAndPriority( $biblionumber, $reservedate, $priority );
2022
2023 This increments the priority of all reserves after the one
2024 with either the lowest date after C<$reservedate>
2025 or the lowest priority after C<$priority>.
2026
2027 It effectively makes room for a new reserve to be inserted with a certain
2028 priority, which is returned.
2029
2030 This is most useful when the reservedate can be set by the user.  It allows
2031 the new reserve to be placed before other reserves that have a later
2032 reservedate.  Since priority also is set by the form in reserves/request.pl
2033 the sub accounts for that too.
2034
2035 =cut
2036
2037 sub _ShiftPriorityByDateAndPriority {
2038     my ( $biblio, $resdate, $new_priority ) = @_;
2039
2040     my $dbh = C4::Context->dbh;
2041     my $query = "SELECT priority FROM reserves WHERE biblionumber = ? AND ( reservedate > ? OR priority > ? ) ORDER BY priority ASC LIMIT 1";
2042     my $sth = $dbh->prepare( $query );
2043     $sth->execute( $biblio, $resdate, $new_priority );
2044     my $min_priority = $sth->fetchrow;
2045     # if no such matches are found, $new_priority remains as original value
2046     $new_priority = $min_priority if ( $min_priority );
2047
2048     # Shift the priority up by one; works in conjunction with the next SQL statement
2049     $query = "UPDATE reserves
2050               SET priority = priority+1
2051               WHERE biblionumber = ?
2052               AND borrowernumber = ?
2053               AND reservedate = ?
2054               AND found IS NULL";
2055     my $sth_update = $dbh->prepare( $query );
2056
2057     # Select all reserves for the biblio with priority greater than $new_priority, and order greatest to least
2058     $query = "SELECT borrowernumber, reservedate FROM reserves WHERE priority >= ? AND biblionumber = ? ORDER BY priority DESC";
2059     $sth = $dbh->prepare( $query );
2060     $sth->execute( $new_priority, $biblio );
2061     while ( my $row = $sth->fetchrow_hashref ) {
2062         $sth_update->execute( $biblio, $row->{borrowernumber}, $row->{reservedate} );
2063     }
2064
2065     return $new_priority;  # so the caller knows what priority they wind up receiving
2066 }
2067
2068 =head2 OPACItemHoldsAllowed
2069
2070   OPACItemHoldsAllowed($item_record,$borrower_record);
2071
2072 Checks issuingrules, using the borrowers categorycode, the itemtype, and branchcode to see
2073 if specific item holds are allowed, returns true if so.
2074
2075 =cut
2076
2077 sub OPACItemHoldsAllowed {
2078     my ($item,$borrower) = @_;
2079
2080     my $branchcode = $item->{homebranch} or die "No homebranch";
2081     my $itype;
2082     my $dbh = C4::Context->dbh;
2083     if (C4::Context->preference('item-level_itypes')) {
2084        # We can't trust GetItem to honour the syspref, so safest to do it ourselves
2085        # When GetItem is fixed, we can remove this
2086        $itype = $item->{itype};
2087     }
2088     else {
2089        my $query = "SELECT itemtype FROM biblioitems WHERE biblioitemnumber = ? ";
2090        my $sth = $dbh->prepare($query);
2091        $sth->execute($item->{biblioitemnumber});
2092        if (my $data = $sth->fetchrow_hashref()){
2093            $itype = $data->{itemtype};
2094        }
2095     }
2096
2097     my $query = "SELECT opacitemholds,categorycode,itemtype,branchcode FROM issuingrules WHERE
2098           (issuingrules.categorycode = ? OR issuingrules.categorycode = '*')
2099         AND
2100           (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
2101         AND
2102           (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')
2103         ORDER BY
2104           issuingrules.categorycode desc,
2105           issuingrules.itemtype desc,
2106           issuingrules.branchcode desc
2107        LIMIT 1";
2108     my $sth = $dbh->prepare($query);
2109     $sth->execute($borrower->{categorycode},$itype,$branchcode);
2110     my $data = $sth->fetchrow_hashref;
2111     my $opacitemholds = uc substr ($data->{opacitemholds}, 0, 1);
2112     return '' if $opacitemholds eq 'N';
2113     return $opacitemholds;
2114 }
2115
2116 =head2 MoveReserve
2117
2118   MoveReserve( $itemnumber, $borrowernumber, $cancelreserve )
2119
2120 Use when checking out an item to handle reserves
2121 If $cancelreserve boolean is set to true, it will remove existing reserve
2122
2123 =cut
2124
2125 sub MoveReserve {
2126     my ( $itemnumber, $borrowernumber, $cancelreserve ) = @_;
2127
2128     my $lookahead = C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
2129     my ( $restype, $res, $all_reserves ) = CheckReserves( $itemnumber, undef, $lookahead );
2130     return unless $res;
2131
2132     my $biblionumber     =  $res->{biblionumber};
2133     my $biblioitemnumber = $res->{biblioitemnumber};
2134
2135     if ($res->{borrowernumber} == $borrowernumber) {
2136         ModReserveFill($res);
2137     }
2138     else {
2139         # warn "Reserved";
2140         # The item is reserved by someone else.
2141         # Find this item in the reserves
2142
2143         my $borr_res;
2144         foreach (@$all_reserves) {
2145             $_->{'borrowernumber'} == $borrowernumber or next;
2146             $_->{'biblionumber'}   == $biblionumber   or next;
2147
2148             $borr_res = $_;
2149             last;
2150         }
2151
2152         if ( $borr_res ) {
2153             # The item is reserved by the current patron
2154             ModReserveFill($borr_res);
2155         }
2156
2157         if ( $cancelreserve eq 'revert' ) { ## Revert waiting reserve to priority 1
2158             RevertWaitingStatus({ itemnumber => $itemnumber });
2159         }
2160         elsif ( $cancelreserve eq 'cancel' || $cancelreserve ) { # cancel reserves on this item
2161             CancelReserve( { reserve_id => $res->{'reserve_id'} } );
2162         }
2163     }
2164 }
2165
2166 =head2 MergeHolds
2167
2168   MergeHolds($dbh,$to_biblio, $from_biblio);
2169
2170 This shifts the holds from C<$from_biblio> to C<$to_biblio> and reorders them by the date they were placed
2171
2172 =cut
2173
2174 sub MergeHolds {
2175     my ( $dbh, $to_biblio, $from_biblio ) = @_;
2176     my $sth = $dbh->prepare(
2177         "SELECT count(*) as reserve_count FROM reserves WHERE biblionumber = ?"
2178     );
2179     $sth->execute($from_biblio);
2180     if ( my $data = $sth->fetchrow_hashref() ) {
2181
2182         # holds exist on old record, if not we don't need to do anything
2183         $sth = $dbh->prepare(
2184             "UPDATE reserves SET biblionumber = ? WHERE biblionumber = ?");
2185         $sth->execute( $to_biblio, $from_biblio );
2186
2187         # Reorder by date
2188         # don't reorder those already waiting
2189
2190         $sth = $dbh->prepare(
2191 "SELECT * FROM reserves WHERE biblionumber = ? AND (found <> ? AND found <> ? OR found is NULL) ORDER BY reservedate ASC"
2192         );
2193         my $upd_sth = $dbh->prepare(
2194 "UPDATE reserves SET priority = ? WHERE biblionumber = ? AND borrowernumber = ?
2195         AND reservedate = ? AND (itemnumber = ? or itemnumber is NULL) "
2196         );
2197         $sth->execute( $to_biblio, 'W', 'T' );
2198         my $priority = 1;
2199         while ( my $reserve = $sth->fetchrow_hashref() ) {
2200             $upd_sth->execute(
2201                 $priority,                    $to_biblio,
2202                 $reserve->{'borrowernumber'}, $reserve->{'reservedate'},
2203                 $reserve->{'itemnumber'}
2204             );
2205             $priority++;
2206         }
2207     }
2208 }
2209
2210 =head2 RevertWaitingStatus
2211
2212   RevertWaitingStatus({ itemnumber => $itemnumber });
2213
2214   Reverts a 'waiting' hold back to a regular hold with a priority of 1.
2215
2216   Caveat: Any waiting hold fixed with RevertWaitingStatus will be an
2217           item level hold, even if it was only a bibliolevel hold to
2218           begin with. This is because we can no longer know if a hold
2219           was item-level or bib-level after a hold has been set to
2220           waiting status.
2221
2222 =cut
2223
2224 sub RevertWaitingStatus {
2225     my ( $params ) = @_;
2226     my $itemnumber = $params->{'itemnumber'};
2227
2228     return unless ( $itemnumber );
2229
2230     my $dbh = C4::Context->dbh;
2231
2232     ## Get the waiting reserve we want to revert
2233     my $query = "
2234         SELECT * FROM reserves
2235         WHERE itemnumber = ?
2236         AND found IS NOT NULL
2237     ";
2238     my $sth = $dbh->prepare( $query );
2239     $sth->execute( $itemnumber );
2240     my $reserve = $sth->fetchrow_hashref();
2241
2242     ## Increment the priority of all other non-waiting
2243     ## reserves for this bib record
2244     $query = "
2245         UPDATE reserves
2246         SET
2247           priority = priority + 1
2248         WHERE
2249           biblionumber =  ?
2250         AND
2251           priority > 0
2252     ";
2253     $sth = $dbh->prepare( $query );
2254     $sth->execute( $reserve->{'biblionumber'} );
2255
2256     ## Fix up the currently waiting reserve
2257     $query = "
2258     UPDATE reserves
2259     SET
2260       priority = 1,
2261       found = NULL,
2262       waitingdate = NULL
2263     WHERE
2264       reserve_id = ?
2265     ";
2266     $sth = $dbh->prepare( $query );
2267     $sth->execute( $reserve->{'reserve_id'} );
2268     _FixPriority( { biblionumber => $reserve->{biblionumber} } );
2269 }
2270
2271 =head2 GetReserveId
2272
2273   $reserve_id = GetReserveId({ biblionumber => $biblionumber, borrowernumber => $borrowernumber [, itemnumber => $itemnumber ] });
2274
2275   Returnes the first reserve id that matches the given criteria
2276
2277 =cut
2278
2279 sub GetReserveId {
2280     my ( $params ) = @_;
2281
2282     return unless ( ( $params->{'biblionumber'} || $params->{'itemnumber'} ) && $params->{'borrowernumber'} );
2283
2284     my $dbh = C4::Context->dbh();
2285
2286     my $sql = "SELECT reserve_id FROM reserves WHERE ";
2287
2288     my @params;
2289     my @limits;
2290     foreach my $key ( keys %$params ) {
2291         if ( defined( $params->{$key} ) ) {
2292             push( @limits, "$key = ?" );
2293             push( @params, $params->{$key} );
2294         }
2295     }
2296
2297     $sql .= join( " AND ", @limits );
2298
2299     my $sth = $dbh->prepare( $sql );
2300     $sth->execute( @params );
2301     my $row = $sth->fetchrow_hashref();
2302
2303     return $row->{'reserve_id'};
2304 }
2305
2306 =head2 ReserveSlip
2307
2308   ReserveSlip($branchcode, $borrowernumber, $biblionumber)
2309
2310   Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
2311
2312 =cut
2313
2314 sub ReserveSlip {
2315     my ($branch, $borrowernumber, $biblionumber) = @_;
2316
2317 #   return unless ( C4::Context->boolean_preference('printreserveslips') );
2318
2319     my $reserve_id = GetReserveId({
2320         biblionumber => $biblionumber,
2321         borrowernumber => $borrowernumber
2322     }) or return;
2323     my $reserve = GetReserveInfo($reserve_id) or return;
2324
2325     return  C4::Letters::GetPreparedLetter (
2326         module => 'circulation',
2327         letter_code => 'RESERVESLIP',
2328         branchcode => $branch,
2329         tables => {
2330             'reserves'    => $reserve,
2331             'branches'    => $reserve->{branchcode},
2332             'borrowers'   => $reserve->{borrowernumber},
2333             'biblio'      => $reserve->{biblionumber},
2334             'items'       => $reserve->{itemnumber},
2335         },
2336     );
2337 }
2338
2339 =head2 GetReservesControlBranch
2340
2341   my $reserves_control_branch = GetReservesControlBranch($item, $borrower);
2342
2343   Return the branchcode to be used to determine which reserves
2344   policy applies to a transaction.
2345
2346   C<$item> is a hashref for an item. Only 'homebranch' is used.
2347
2348   C<$borrower> is a hashref to borrower. Only 'branchcode' is used.
2349
2350 =cut
2351
2352 sub GetReservesControlBranch {
2353     my ( $item, $borrower ) = @_;
2354
2355     my $reserves_control = C4::Context->preference('ReservesControlBranch');
2356
2357     my $branchcode =
2358         ( $reserves_control eq 'ItemHomeLibrary' ) ? $item->{'homebranch'}
2359       : ( $reserves_control eq 'PatronLibrary' )   ? $borrower->{'branchcode'}
2360       :                                              undef;
2361
2362     return $branchcode;
2363 }
2364
2365 =head2 CalculatePriority
2366
2367     my $p = CalculatePriority($biblionumber, $resdate);
2368
2369 Calculate priority for a new reserve on biblionumber, placing it at
2370 the end of the line of all holds whose start date falls before
2371 the current system time and that are neither on the hold shelf
2372 or in transit.
2373
2374 The reserve date parameter is optional; if it is supplied, the
2375 priority is based on the set of holds whose start date falls before
2376 the parameter value.
2377
2378 After calculation of this priority, it is recommended to call
2379 _ShiftPriorityByDateAndPriority. Note that this is currently done in
2380 AddReserves.
2381
2382 =cut
2383
2384 sub CalculatePriority {
2385     my ( $biblionumber, $resdate ) = @_;
2386
2387     my $sql = q{
2388         SELECT COUNT(*) FROM reserves
2389         WHERE biblionumber = ?
2390         AND   priority > 0
2391         AND   (found IS NULL OR found = '')
2392     };
2393     #skip found==W or found==T (waiting or transit holds)
2394     if( $resdate ) {
2395         $sql.= ' AND ( reservedate <= ? )';
2396     }
2397     else {
2398         $sql.= ' AND ( reservedate < NOW() )';
2399     }
2400     my $dbh = C4::Context->dbh();
2401     my @row = $dbh->selectrow_array(
2402         $sql,
2403         undef,
2404         $resdate ? ($biblionumber, $resdate) : ($biblionumber)
2405     );
2406
2407     return @row ? $row[0]+1 : 1;
2408 }
2409
2410 =head2 IsItemOnHoldAndFound
2411
2412     my $bool = IsItemFoundHold( $itemnumber );
2413
2414     Returns true if the item is currently on hold
2415     and that hold has a non-null found status ( W, T, etc. )
2416
2417 =cut
2418
2419 sub IsItemOnHoldAndFound {
2420     my ($itemnumber) = @_;
2421
2422     my $rs = Koha::Database->new()->schema()->resultset('Reserve');
2423
2424     my $found = $rs->count(
2425         {
2426             itemnumber => $itemnumber,
2427             found      => { '!=' => undef }
2428         }
2429     );
2430
2431     return $found;
2432 }
2433
2434 =head1 AUTHOR
2435
2436 Koha Development Team <http://koha-community.org/>
2437
2438 =cut
2439
2440 1;