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