Bug 19025: Remove C4::Reserves::GetReserveInfo
[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::Biblios;
40 use Koha::DateUtils;
41 use Koha::Calendar;
42 use Koha::Database;
43 use Koha::Hold;
44 use Koha::Old::Hold;
45 use Koha::Holds;
46 use Koha::Libraries;
47 use Koha::IssuingRules;
48 use Koha::Items;
49 use Koha::ItemTypes;
50 use Koha::Patrons;
51
52 use List::MoreUtils qw( firstidx any );
53 use Carp;
54 use Data::Dumper;
55
56 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
57
58 =head1 NAME
59
60 C4::Reserves - Koha functions for dealing with reservation.
61
62 =head1 SYNOPSIS
63
64   use C4::Reserves;
65
66 =head1 DESCRIPTION
67
68 This modules provides somes functions to deal with reservations.
69
70   Reserves are stored in reserves table.
71   The following columns contains important values :
72   - priority >0      : then the reserve is at 1st stage, and not yet affected to any item.
73              =0      : then the reserve is being dealed
74   - found : NULL       : means the patron requested the 1st available, and we haven't chosen the item
75             T(ransit)  : the reserve is linked to an item but is in transit to the pickup branch
76             W(aiting)  : the reserve is linked to an item, is at the pickup branch, and is waiting on the hold shelf
77             F(inished) : the reserve has been completed, and is done
78   - itemnumber : empty : the reserve is still unaffected to an item
79                  filled: the reserve is attached to an item
80   The complete workflow is :
81   ==== 1st use case ====
82   patron request a document, 1st available :                      P >0, F=NULL, I=NULL
83   a library having it run "transfertodo", and clic on the list
84          if there is no transfer to do, the reserve waiting
85          patron can pick it up                                    P =0, F=W,    I=filled
86          if there is a transfer to do, write in branchtransfer    P =0, F=T,    I=filled
87            The pickup library receive the book, it check in       P =0, F=W,    I=filled
88   The patron borrow the book                                      P =0, F=F,    I=filled
89
90   ==== 2nd use case ====
91   patron requests a document, a given item,
92     If pickup is holding branch                                   P =0, F=W,   I=filled
93     If transfer needed, write in branchtransfer                   P =0, F=T,    I=filled
94         The pickup library receive the book, it checks it in      P =0, F=W,    I=filled
95   The patron borrow the book                                      P =0, F=F,    I=filled
96
97 =head1 FUNCTIONS
98
99 =cut
100
101 BEGIN {
102     require Exporter;
103     @ISA = qw(Exporter);
104     @EXPORT = qw(
105         &AddReserve
106
107         &GetReserve
108         &GetReservesForBranch
109         &GetReservesToBranch
110         &GetReserveCount
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 $biblio     = Koha::Biblios->find( $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( $biblio->biblioitem->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 IsAvailableForItemLevelRequest
1234
1235   my $is_available = IsAvailableForItemLevelRequest($item_record,$borrower_record);
1236
1237 Checks whether a given item record is available for an
1238 item-level hold request.  An item is available if
1239
1240 * it is not lost AND
1241 * it is not damaged AND
1242 * it is not withdrawn AND
1243 * does not have a not for loan value > 0
1244
1245 Need to check the issuingrules onshelfholds column,
1246 if this is set items on the shelf can be placed on hold
1247
1248 Note that IsAvailableForItemLevelRequest() does not
1249 check if the staff operator is authorized to place
1250 a request on the item - in particular,
1251 this routine does not check IndependentBranches
1252 and canreservefromotherbranches.
1253
1254 =cut
1255
1256 sub IsAvailableForItemLevelRequest {
1257     my $item = shift;
1258     my $borrower = shift;
1259
1260     my $dbh = C4::Context->dbh;
1261     # must check the notforloan setting of the itemtype
1262     # FIXME - a lot of places in the code do this
1263     #         or something similar - need to be
1264     #         consolidated
1265     my $itype = _get_itype($item);
1266     my $notforloan_per_itemtype
1267       = $dbh->selectrow_array("SELECT notforloan FROM itemtypes WHERE itemtype = ?",
1268                               undef, $itype);
1269
1270     return 0 if
1271         $notforloan_per_itemtype ||
1272         $item->{itemlost}        ||
1273         $item->{notforloan} > 0  ||
1274         $item->{withdrawn}        ||
1275         ($item->{damaged} && !C4::Context->preference('AllowHoldsOnDamagedItems'));
1276
1277     my $on_shelf_holds = _OnShelfHoldsAllowed($itype,$borrower->{categorycode},$item->{holdingbranch});
1278
1279     if ( $on_shelf_holds == 1 ) {
1280         return 1;
1281     } elsif ( $on_shelf_holds == 2 ) {
1282         my @items =
1283           Koha::Items->search( { biblionumber => $item->{biblionumber} } );
1284
1285         my $any_available = 0;
1286
1287         foreach my $i (@items) {
1288             $any_available = 1
1289               unless $i->itemlost
1290               || $i->notforloan > 0
1291               || $i->withdrawn
1292               || $i->onloan
1293               || IsItemOnHoldAndFound( $i->id )
1294               || ( $i->damaged
1295                 && !C4::Context->preference('AllowHoldsOnDamagedItems') )
1296               || Koha::ItemTypes->find( $i->effective_itemtype() )->notforloan;
1297         }
1298
1299         return $any_available ? 0 : 1;
1300     }
1301
1302     return $item->{onloan} || GetReserveStatus($item->{itemnumber}) eq "Waiting";
1303 }
1304
1305 =head2 OnShelfHoldsAllowed
1306
1307   OnShelfHoldsAllowed($itemtype,$borrowercategory,$branchcode);
1308
1309 Checks issuingrules, using the borrowers categorycode, the itemtype, and branchcode to see if onshelf
1310 holds are allowed, returns true if so.
1311
1312 =cut
1313
1314 sub OnShelfHoldsAllowed {
1315     my ($item, $borrower) = @_;
1316
1317     my $itype = _get_itype($item);
1318     return _OnShelfHoldsAllowed($itype,$borrower->{categorycode},$item->{holdingbranch});
1319 }
1320
1321 sub _get_itype {
1322     my $item = shift;
1323
1324     my $itype;
1325     if (C4::Context->preference('item-level_itypes')) {
1326         # We can't trust GetItem to honour the syspref, so safest to do it ourselves
1327         # When GetItem is fixed, we can remove this
1328         $itype = $item->{itype};
1329     }
1330     else {
1331         # XXX This is a bit dodgy. It relies on biblio itemtype column having different name.
1332         # So if we already have a biblioitems join when calling this function,
1333         # we don't need to access the database again
1334         $itype = $item->{itemtype};
1335     }
1336     unless ($itype) {
1337         my $dbh = C4::Context->dbh;
1338         my $query = "SELECT itemtype FROM biblioitems WHERE biblioitemnumber = ? ";
1339         my $sth = $dbh->prepare($query);
1340         $sth->execute($item->{biblioitemnumber});
1341         if (my $data = $sth->fetchrow_hashref()){
1342             $itype = $data->{itemtype};
1343         }
1344     }
1345     return $itype;
1346 }
1347
1348 sub _OnShelfHoldsAllowed {
1349     my ($itype,$borrowercategory,$branchcode) = @_;
1350
1351     my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule({ categorycode => $borrowercategory, itemtype => $itype, branchcode => $branchcode });
1352     return $issuing_rule ? $issuing_rule->onshelfholds : undef;
1353 }
1354
1355 =head2 AlterPriority
1356
1357   AlterPriority( $where, $reserve_id );
1358
1359 This function changes a reserve's priority up, down, to the top, or to the bottom.
1360 Input: $where is 'up', 'down', 'top' or 'bottom'. Biblionumber, Date reserve was placed
1361
1362 =cut
1363
1364 sub AlterPriority {
1365     my ( $where, $reserve_id ) = @_;
1366
1367     my $reserve = GetReserve( $reserve_id );
1368
1369     if ( $reserve->{cancellationdate} ) {
1370         warn "I cannot alter the priority for reserve_id $reserve_id, the reserve has been cancelled (".$reserve->{cancellationdate}.')';
1371         return;
1372     }
1373
1374     if ( $where eq 'up' || $where eq 'down' ) {
1375
1376       my $priority = $reserve->{'priority'};
1377       $priority = $where eq 'up' ? $priority - 1 : $priority + 1;
1378       _FixPriority({ reserve_id => $reserve_id, rank => $priority })
1379
1380     } elsif ( $where eq 'top' ) {
1381
1382       _FixPriority({ reserve_id => $reserve_id, rank => '1' })
1383
1384     } elsif ( $where eq 'bottom' ) {
1385
1386       _FixPriority({ reserve_id => $reserve_id, rank => '999999' });
1387
1388     }
1389 }
1390
1391 =head2 ToggleLowestPriority
1392
1393   ToggleLowestPriority( $borrowernumber, $biblionumber );
1394
1395 This function sets the lowestPriority field to true if is false, and false if it is true.
1396
1397 =cut
1398
1399 sub ToggleLowestPriority {
1400     my ( $reserve_id ) = @_;
1401
1402     my $dbh = C4::Context->dbh;
1403
1404     my $sth = $dbh->prepare( "UPDATE reserves SET lowestPriority = NOT lowestPriority WHERE reserve_id = ?");
1405     $sth->execute( $reserve_id );
1406
1407     _FixPriority({ reserve_id => $reserve_id, rank => '999999' });
1408 }
1409
1410 =head2 ToggleSuspend
1411
1412   ToggleSuspend( $reserve_id );
1413
1414 This function sets the suspend field to true if is false, and false if it is true.
1415 If the reserve is currently suspended with a suspend_until date, that date will
1416 be cleared when it is unsuspended.
1417
1418 =cut
1419
1420 sub ToggleSuspend {
1421     my ( $reserve_id, $suspend_until ) = @_;
1422
1423     $suspend_until = dt_from_string($suspend_until) if ($suspend_until);
1424
1425     my $hold = Koha::Holds->find( $reserve_id );
1426
1427     if ( $hold->is_suspended ) {
1428         $hold->resume()
1429     } else {
1430         $hold->suspend_hold( $suspend_until );
1431     }
1432 }
1433
1434 =head2 SuspendAll
1435
1436   SuspendAll(
1437       borrowernumber   => $borrowernumber,
1438       [ biblionumber   => $biblionumber, ]
1439       [ suspend_until  => $suspend_until, ]
1440       [ suspend        => $suspend ]
1441   );
1442
1443   This function accepts a set of hash keys as its parameters.
1444   It requires either borrowernumber or biblionumber, or both.
1445
1446   suspend_until is wholly optional.
1447
1448 =cut
1449
1450 sub SuspendAll {
1451     my %params = @_;
1452
1453     my $borrowernumber = $params{'borrowernumber'} || undef;
1454     my $biblionumber   = $params{'biblionumber'}   || undef;
1455     my $suspend_until  = $params{'suspend_until'}  || undef;
1456     my $suspend = defined( $params{'suspend'} ) ? $params{'suspend'} : 1;
1457
1458     $suspend_until = eval { dt_from_string($suspend_until) }
1459       if ( defined($suspend_until) );
1460
1461     return unless ( $borrowernumber || $biblionumber );
1462
1463     my $params;
1464     $params->{found}          = undef;
1465     $params->{borrowernumber} = $borrowernumber if $borrowernumber;
1466     $params->{biblionumber}   = $biblionumber if $biblionumber;
1467
1468     my @holds = Koha::Holds->search($params);
1469
1470     if ($suspend) {
1471         map { $_->suspend_hold($suspend_until) } @holds;
1472     }
1473     else {
1474         map { $_->resume() } @holds;
1475     }
1476 }
1477
1478
1479 =head2 _FixPriority
1480
1481   _FixPriority({
1482     reserve_id => $reserve_id,
1483     [rank => $rank,]
1484     [ignoreSetLowestRank => $ignoreSetLowestRank]
1485   });
1486
1487   or
1488
1489   _FixPriority({ biblionumber => $biblionumber});
1490
1491 This routine adjusts the priority of a hold request and holds
1492 on the same bib.
1493
1494 In the first form, where a reserve_id is passed, the priority of the
1495 hold is set to supplied rank, and other holds for that bib are adjusted
1496 accordingly.  If the rank is "del", the hold is cancelled.  If no rank
1497 is supplied, all of the holds on that bib have their priority adjusted
1498 as if the second form had been used.
1499
1500 In the second form, where a biblionumber is passed, the holds on that
1501 bib (that are not captured) are sorted in order of increasing priority,
1502 then have reserves.priority set so that the first non-captured hold
1503 has its priority set to 1, the second non-captured hold has its priority
1504 set to 2, and so forth.
1505
1506 In both cases, holds that have the lowestPriority flag on are have their
1507 priority adjusted to ensure that they remain at the end of the line.
1508
1509 Note that the ignoreSetLowestRank parameter is meant to be used only
1510 when _FixPriority calls itself.
1511
1512 =cut
1513
1514 sub _FixPriority {
1515     my ( $params ) = @_;
1516     my $reserve_id = $params->{reserve_id};
1517     my $rank = $params->{rank} // '';
1518     my $ignoreSetLowestRank = $params->{ignoreSetLowestRank};
1519     my $biblionumber = $params->{biblionumber};
1520
1521     my $dbh = C4::Context->dbh;
1522
1523     unless ( $biblionumber ) {
1524         my $res = GetReserve( $reserve_id );
1525         $biblionumber = $res->{biblionumber};
1526     }
1527
1528     if ( $rank eq "del" ) {
1529          CancelReserve({ reserve_id => $reserve_id });
1530     }
1531     elsif ( $rank eq "W" || $rank eq "0" ) {
1532
1533         # make sure priority for waiting or in-transit items is 0
1534         my $query = "
1535             UPDATE reserves
1536             SET    priority = 0
1537             WHERE reserve_id = ?
1538             AND found IN ('W', 'T')
1539         ";
1540         my $sth = $dbh->prepare($query);
1541         $sth->execute( $reserve_id );
1542     }
1543     my @priority;
1544
1545     # get whats left
1546     my $query = "
1547         SELECT reserve_id, borrowernumber, reservedate
1548         FROM   reserves
1549         WHERE  biblionumber   = ?
1550           AND  ((found <> 'W' AND found <> 'T') OR found IS NULL)
1551         ORDER BY priority ASC
1552     ";
1553     my $sth = $dbh->prepare($query);
1554     $sth->execute( $biblionumber );
1555     while ( my $line = $sth->fetchrow_hashref ) {
1556         push( @priority,     $line );
1557     }
1558
1559     # To find the matching index
1560     my $i;
1561     my $key = -1;    # to allow for 0 to be a valid result
1562     for ( $i = 0 ; $i < @priority ; $i++ ) {
1563         if ( $reserve_id == $priority[$i]->{'reserve_id'} ) {
1564             $key = $i;    # save the index
1565             last;
1566         }
1567     }
1568
1569     # if index exists in array then move it to new position
1570     if ( $key > -1 && $rank ne 'del' && $rank > 0 ) {
1571         my $new_rank = $rank -
1572           1;    # $new_rank is what you want the new index to be in the array
1573         my $moving_item = splice( @priority, $key, 1 );
1574         splice( @priority, $new_rank, 0, $moving_item );
1575     }
1576
1577     # now fix the priority on those that are left....
1578     $query = "
1579         UPDATE reserves
1580         SET    priority = ?
1581         WHERE  reserve_id = ?
1582     ";
1583     $sth = $dbh->prepare($query);
1584     for ( my $j = 0 ; $j < @priority ; $j++ ) {
1585         $sth->execute(
1586             $j + 1,
1587             $priority[$j]->{'reserve_id'}
1588         );
1589     }
1590
1591     $sth = $dbh->prepare( "SELECT reserve_id FROM reserves WHERE lowestPriority = 1 ORDER BY priority" );
1592     $sth->execute();
1593
1594     unless ( $ignoreSetLowestRank ) {
1595       while ( my $res = $sth->fetchrow_hashref() ) {
1596         _FixPriority({
1597             reserve_id => $res->{'reserve_id'},
1598             rank => '999999',
1599             ignoreSetLowestRank => 1
1600         });
1601       }
1602     }
1603 }
1604
1605 =head2 _Findgroupreserve
1606
1607   @results = &_Findgroupreserve($biblioitemnumber, $biblionumber, $itemnumber, $lookahead, $ignore_borrowers);
1608
1609 Looks for a holds-queue based item-specific match first, then for a holds-queue title-level match, returning the
1610 first match found.  If neither, then we look for non-holds-queue based holds.
1611 Lookahead is the number of days to look in advance.
1612
1613 C<&_Findgroupreserve> returns :
1614 C<@results> is an array of references-to-hash whose keys are mostly
1615 fields from the reserves table of the Koha database, plus
1616 C<biblioitemnumber>.
1617
1618 =cut
1619
1620 sub _Findgroupreserve {
1621     my ( $bibitem, $biblio, $itemnumber, $lookahead, $ignore_borrowers) = @_;
1622     my $dbh   = C4::Context->dbh;
1623
1624     # TODO: consolidate at least the SELECT portion of the first 2 queries to a common $select var.
1625     # check for exact targeted match
1626     my $item_level_target_query = qq{
1627         SELECT reserves.biblionumber        AS biblionumber,
1628                reserves.borrowernumber      AS borrowernumber,
1629                reserves.reservedate         AS reservedate,
1630                reserves.branchcode          AS branchcode,
1631                reserves.cancellationdate    AS cancellationdate,
1632                reserves.found               AS found,
1633                reserves.reservenotes        AS reservenotes,
1634                reserves.priority            AS priority,
1635                reserves.timestamp           AS timestamp,
1636                biblioitems.biblioitemnumber AS biblioitemnumber,
1637                reserves.itemnumber          AS itemnumber,
1638                reserves.reserve_id          AS reserve_id,
1639                reserves.itemtype            AS itemtype
1640         FROM reserves
1641         JOIN biblioitems USING (biblionumber)
1642         JOIN hold_fill_targets USING (biblionumber, borrowernumber, itemnumber)
1643         WHERE found IS NULL
1644         AND priority > 0
1645         AND item_level_request = 1
1646         AND itemnumber = ?
1647         AND reservedate <= DATE_ADD(NOW(),INTERVAL ? DAY)
1648         AND suspend = 0
1649         ORDER BY priority
1650     };
1651     my $sth = $dbh->prepare($item_level_target_query);
1652     $sth->execute($itemnumber, $lookahead||0);
1653     my @results;
1654     if ( my $data = $sth->fetchrow_hashref ) {
1655         push( @results, $data )
1656           unless any{ $data->{borrowernumber} eq $_ } @$ignore_borrowers ;
1657     }
1658     return @results if @results;
1659
1660     # check for title-level targeted match
1661     my $title_level_target_query = qq{
1662         SELECT reserves.biblionumber        AS biblionumber,
1663                reserves.borrowernumber      AS borrowernumber,
1664                reserves.reservedate         AS reservedate,
1665                reserves.branchcode          AS branchcode,
1666                reserves.cancellationdate    AS cancellationdate,
1667                reserves.found               AS found,
1668                reserves.reservenotes        AS reservenotes,
1669                reserves.priority            AS priority,
1670                reserves.timestamp           AS timestamp,
1671                biblioitems.biblioitemnumber AS biblioitemnumber,
1672                reserves.itemnumber          AS itemnumber,
1673                reserves.reserve_id          AS reserve_id,
1674                reserves.itemtype            AS itemtype
1675         FROM reserves
1676         JOIN biblioitems USING (biblionumber)
1677         JOIN hold_fill_targets USING (biblionumber, borrowernumber)
1678         WHERE found IS NULL
1679         AND priority > 0
1680         AND item_level_request = 0
1681         AND hold_fill_targets.itemnumber = ?
1682         AND reservedate <= DATE_ADD(NOW(),INTERVAL ? DAY)
1683         AND suspend = 0
1684         ORDER BY priority
1685     };
1686     $sth = $dbh->prepare($title_level_target_query);
1687     $sth->execute($itemnumber, $lookahead||0);
1688     @results = ();
1689     if ( my $data = $sth->fetchrow_hashref ) {
1690         push( @results, $data )
1691           unless any{ $data->{borrowernumber} eq $_ } @$ignore_borrowers ;
1692     }
1693     return @results if @results;
1694
1695     my $query = qq{
1696         SELECT reserves.biblionumber               AS biblionumber,
1697                reserves.borrowernumber             AS borrowernumber,
1698                reserves.reservedate                AS reservedate,
1699                reserves.waitingdate                AS waitingdate,
1700                reserves.branchcode                 AS branchcode,
1701                reserves.cancellationdate           AS cancellationdate,
1702                reserves.found                      AS found,
1703                reserves.reservenotes               AS reservenotes,
1704                reserves.priority                   AS priority,
1705                reserves.timestamp                  AS timestamp,
1706                reserves.itemnumber                 AS itemnumber,
1707                reserves.reserve_id                 AS reserve_id,
1708                reserves.itemtype                   AS itemtype
1709         FROM reserves
1710         WHERE reserves.biblionumber = ?
1711           AND (reserves.itemnumber IS NULL OR reserves.itemnumber = ?)
1712           AND reserves.reservedate <= DATE_ADD(NOW(),INTERVAL ? DAY)
1713           AND suspend = 0
1714           ORDER BY priority
1715     };
1716     $sth = $dbh->prepare($query);
1717     $sth->execute( $biblio, $itemnumber, $lookahead||0);
1718     @results = ();
1719     while ( my $data = $sth->fetchrow_hashref ) {
1720         push( @results, $data )
1721           unless any{ $data->{borrowernumber} eq $_ } @$ignore_borrowers ;
1722     }
1723     return @results;
1724 }
1725
1726 =head2 _koha_notify_reserve
1727
1728   _koha_notify_reserve( $hold->reserve_id );
1729
1730 Sends a notification to the patron that their hold has been filled (through
1731 ModReserveAffect, _not_ ModReserveFill)
1732
1733 The letter code for this notice may be found using the following query:
1734
1735     select distinct letter_code
1736     from message_transports
1737     inner join message_attributes using (message_attribute_id)
1738     where message_name = 'Hold_Filled'
1739
1740 This will probably sipmly be 'HOLD', but because it is defined in the database,
1741 it is subject to addition or change.
1742
1743 The following tables are availalbe witin the notice:
1744
1745     branches
1746     borrowers
1747     biblio
1748     biblioitems
1749     reserves
1750     items
1751
1752 =cut
1753
1754 sub _koha_notify_reserve {
1755     my $reserve_id = shift;
1756     my $hold = Koha::Holds->find($reserve_id);
1757     my $borrowernumber = $hold->borrowernumber;
1758
1759     my $patron = Koha::Patrons->find( $borrowernumber );
1760
1761     # Try to get the borrower's email address
1762     my $to_address = C4::Members::GetNoticeEmailAddress($borrowernumber);
1763
1764     my $messagingprefs = C4::Members::Messaging::GetMessagingPreferences( {
1765             borrowernumber => $borrowernumber,
1766             message_name => 'Hold_Filled'
1767     } );
1768
1769     my $library = Koha::Libraries->find( $hold->branchcode )->unblessed;
1770
1771     my $admin_email_address = $library->{branchemail} || C4::Context->preference('KohaAdminEmailAddress');
1772
1773     my %letter_params = (
1774         module => 'reserves',
1775         branchcode => $hold->branchcode,
1776         lang => $patron->lang,
1777         tables => {
1778             'branches'       => $library,
1779             'borrowers'      => $patron->unblessed,
1780             'biblio'         => $hold->biblionumber,
1781             'biblioitems'    => $hold->biblionumber,
1782             'reserves'       => $hold->unblessed,
1783             'items'          => $hold->itemnumber,
1784         },
1785     );
1786
1787     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.
1788     my $send_notification = sub {
1789         my ( $mtt, $letter_code ) = (@_);
1790         return unless defined $letter_code;
1791         $letter_params{letter_code} = $letter_code;
1792         $letter_params{message_transport_type} = $mtt;
1793         my $letter =  C4::Letters::GetPreparedLetter ( %letter_params );
1794         unless ($letter) {
1795             warn "Could not find a letter called '$letter_params{'letter_code'}' for $mtt in the 'reserves' module";
1796             return;
1797         }
1798
1799         C4::Letters::EnqueueLetter( {
1800             letter => $letter,
1801             borrowernumber => $borrowernumber,
1802             from_address => $admin_email_address,
1803             message_transport_type => $mtt,
1804         } );
1805     };
1806
1807     while ( my ( $mtt, $letter_code ) = each %{ $messagingprefs->{transports} } ) {
1808         next if (
1809                ( $mtt eq 'email' and not $to_address ) # No email address
1810             or ( $mtt eq 'sms'   and not $patron->smsalertnumber ) # No SMS number
1811             or ( $mtt eq 'phone' and C4::Context->preference('TalkingTechItivaPhoneNotification') ) # Notice is handled by TalkingTech_itiva_outbound.pl
1812         );
1813
1814         &$send_notification($mtt, $letter_code);
1815         $notification_sent++;
1816     }
1817     #Making sure that a print notification is sent if no other transport types can be utilized.
1818     if (! $notification_sent) {
1819         &$send_notification('print', 'HOLD');
1820     }
1821
1822 }
1823
1824 =head2 _ShiftPriorityByDateAndPriority
1825
1826   $new_priority = _ShiftPriorityByDateAndPriority( $biblionumber, $reservedate, $priority );
1827
1828 This increments the priority of all reserves after the one
1829 with either the lowest date after C<$reservedate>
1830 or the lowest priority after C<$priority>.
1831
1832 It effectively makes room for a new reserve to be inserted with a certain
1833 priority, which is returned.
1834
1835 This is most useful when the reservedate can be set by the user.  It allows
1836 the new reserve to be placed before other reserves that have a later
1837 reservedate.  Since priority also is set by the form in reserves/request.pl
1838 the sub accounts for that too.
1839
1840 =cut
1841
1842 sub _ShiftPriorityByDateAndPriority {
1843     my ( $biblio, $resdate, $new_priority ) = @_;
1844
1845     my $dbh = C4::Context->dbh;
1846     my $query = "SELECT priority FROM reserves WHERE biblionumber = ? AND ( reservedate > ? OR priority > ? ) ORDER BY priority ASC LIMIT 1";
1847     my $sth = $dbh->prepare( $query );
1848     $sth->execute( $biblio, $resdate, $new_priority );
1849     my $min_priority = $sth->fetchrow;
1850     # if no such matches are found, $new_priority remains as original value
1851     $new_priority = $min_priority if ( $min_priority );
1852
1853     # Shift the priority up by one; works in conjunction with the next SQL statement
1854     $query = "UPDATE reserves
1855               SET priority = priority+1
1856               WHERE biblionumber = ?
1857               AND borrowernumber = ?
1858               AND reservedate = ?
1859               AND found IS NULL";
1860     my $sth_update = $dbh->prepare( $query );
1861
1862     # Select all reserves for the biblio with priority greater than $new_priority, and order greatest to least
1863     $query = "SELECT borrowernumber, reservedate FROM reserves WHERE priority >= ? AND biblionumber = ? ORDER BY priority DESC";
1864     $sth = $dbh->prepare( $query );
1865     $sth->execute( $new_priority, $biblio );
1866     while ( my $row = $sth->fetchrow_hashref ) {
1867         $sth_update->execute( $biblio, $row->{borrowernumber}, $row->{reservedate} );
1868     }
1869
1870     return $new_priority;  # so the caller knows what priority they wind up receiving
1871 }
1872
1873 =head2 OPACItemHoldsAllowed
1874
1875   OPACItemHoldsAllowed($item_record,$borrower_record);
1876
1877 Checks issuingrules, using the borrowers categorycode, the itemtype, and branchcode to see
1878 if specific item holds are allowed, returns true if so.
1879
1880 =cut
1881
1882 sub OPACItemHoldsAllowed {
1883     my ($item,$borrower) = @_;
1884
1885     my $branchcode = $item->{homebranch} or die "No homebranch";
1886     my $itype;
1887     my $dbh = C4::Context->dbh;
1888     if (C4::Context->preference('item-level_itypes')) {
1889        # We can't trust GetItem to honour the syspref, so safest to do it ourselves
1890        # When GetItem is fixed, we can remove this
1891        $itype = $item->{itype};
1892     }
1893     else {
1894        my $query = "SELECT itemtype FROM biblioitems WHERE biblioitemnumber = ? ";
1895        my $sth = $dbh->prepare($query);
1896        $sth->execute($item->{biblioitemnumber});
1897        if (my $data = $sth->fetchrow_hashref()){
1898            $itype = $data->{itemtype};
1899        }
1900     }
1901
1902     my $query = "SELECT opacitemholds,categorycode,itemtype,branchcode FROM issuingrules WHERE
1903           (issuingrules.categorycode = ? OR issuingrules.categorycode = '*')
1904         AND
1905           (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
1906         AND
1907           (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')
1908         ORDER BY
1909           issuingrules.categorycode desc,
1910           issuingrules.itemtype desc,
1911           issuingrules.branchcode desc
1912        LIMIT 1";
1913     my $sth = $dbh->prepare($query);
1914     $sth->execute($borrower->{categorycode},$itype,$branchcode);
1915     my $data = $sth->fetchrow_hashref;
1916     my $opacitemholds = uc substr ($data->{opacitemholds}, 0, 1);
1917     return '' if $opacitemholds eq 'N';
1918     return $opacitemholds;
1919 }
1920
1921 =head2 MoveReserve
1922
1923   MoveReserve( $itemnumber, $borrowernumber, $cancelreserve )
1924
1925 Use when checking out an item to handle reserves
1926 If $cancelreserve boolean is set to true, it will remove existing reserve
1927
1928 =cut
1929
1930 sub MoveReserve {
1931     my ( $itemnumber, $borrowernumber, $cancelreserve ) = @_;
1932
1933     my $lookahead = C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
1934     my ( $restype, $res, $all_reserves ) = CheckReserves( $itemnumber, undef, $lookahead );
1935     return unless $res;
1936
1937     my $biblionumber     =  $res->{biblionumber};
1938
1939     if ($res->{borrowernumber} == $borrowernumber) {
1940         ModReserveFill($res);
1941     }
1942     else {
1943         # warn "Reserved";
1944         # The item is reserved by someone else.
1945         # Find this item in the reserves
1946
1947         my $borr_res;
1948         foreach (@$all_reserves) {
1949             $_->{'borrowernumber'} == $borrowernumber or next;
1950             $_->{'biblionumber'}   == $biblionumber   or next;
1951
1952             $borr_res = $_;
1953             last;
1954         }
1955
1956         if ( $borr_res ) {
1957             # The item is reserved by the current patron
1958             ModReserveFill($borr_res);
1959         }
1960
1961         if ( $cancelreserve eq 'revert' ) { ## Revert waiting reserve to priority 1
1962             RevertWaitingStatus({ itemnumber => $itemnumber });
1963         }
1964         elsif ( $cancelreserve eq 'cancel' || $cancelreserve ) { # cancel reserves on this item
1965             CancelReserve( { reserve_id => $res->{'reserve_id'} } );
1966         }
1967     }
1968 }
1969
1970 =head2 MergeHolds
1971
1972   MergeHolds($dbh,$to_biblio, $from_biblio);
1973
1974 This shifts the holds from C<$from_biblio> to C<$to_biblio> and reorders them by the date they were placed
1975
1976 =cut
1977
1978 sub MergeHolds {
1979     my ( $dbh, $to_biblio, $from_biblio ) = @_;
1980     my $sth = $dbh->prepare(
1981         "SELECT count(*) as reserve_count FROM reserves WHERE biblionumber = ?"
1982     );
1983     $sth->execute($from_biblio);
1984     if ( my $data = $sth->fetchrow_hashref() ) {
1985
1986         # holds exist on old record, if not we don't need to do anything
1987         $sth = $dbh->prepare(
1988             "UPDATE reserves SET biblionumber = ? WHERE biblionumber = ?");
1989         $sth->execute( $to_biblio, $from_biblio );
1990
1991         # Reorder by date
1992         # don't reorder those already waiting
1993
1994         $sth = $dbh->prepare(
1995 "SELECT * FROM reserves WHERE biblionumber = ? AND (found <> ? AND found <> ? OR found is NULL) ORDER BY reservedate ASC"
1996         );
1997         my $upd_sth = $dbh->prepare(
1998 "UPDATE reserves SET priority = ? WHERE biblionumber = ? AND borrowernumber = ?
1999         AND reservedate = ? AND (itemnumber = ? or itemnumber is NULL) "
2000         );
2001         $sth->execute( $to_biblio, 'W', 'T' );
2002         my $priority = 1;
2003         while ( my $reserve = $sth->fetchrow_hashref() ) {
2004             $upd_sth->execute(
2005                 $priority,                    $to_biblio,
2006                 $reserve->{'borrowernumber'}, $reserve->{'reservedate'},
2007                 $reserve->{'itemnumber'}
2008             );
2009             $priority++;
2010         }
2011     }
2012 }
2013
2014 =head2 RevertWaitingStatus
2015
2016   RevertWaitingStatus({ itemnumber => $itemnumber });
2017
2018   Reverts a 'waiting' hold back to a regular hold with a priority of 1.
2019
2020   Caveat: Any waiting hold fixed with RevertWaitingStatus will be an
2021           item level hold, even if it was only a bibliolevel hold to
2022           begin with. This is because we can no longer know if a hold
2023           was item-level or bib-level after a hold has been set to
2024           waiting status.
2025
2026 =cut
2027
2028 sub RevertWaitingStatus {
2029     my ( $params ) = @_;
2030     my $itemnumber = $params->{'itemnumber'};
2031
2032     return unless ( $itemnumber );
2033
2034     my $dbh = C4::Context->dbh;
2035
2036     ## Get the waiting reserve we want to revert
2037     my $query = "
2038         SELECT * FROM reserves
2039         WHERE itemnumber = ?
2040         AND found IS NOT NULL
2041     ";
2042     my $sth = $dbh->prepare( $query );
2043     $sth->execute( $itemnumber );
2044     my $reserve = $sth->fetchrow_hashref();
2045
2046     ## Increment the priority of all other non-waiting
2047     ## reserves for this bib record
2048     $query = "
2049         UPDATE reserves
2050         SET
2051           priority = priority + 1
2052         WHERE
2053           biblionumber =  ?
2054         AND
2055           priority > 0
2056     ";
2057     $sth = $dbh->prepare( $query );
2058     $sth->execute( $reserve->{'biblionumber'} );
2059
2060     ## Fix up the currently waiting reserve
2061     $query = "
2062     UPDATE reserves
2063     SET
2064       priority = 1,
2065       found = NULL,
2066       waitingdate = NULL
2067     WHERE
2068       reserve_id = ?
2069     ";
2070     $sth = $dbh->prepare( $query );
2071     $sth->execute( $reserve->{'reserve_id'} );
2072     _FixPriority( { biblionumber => $reserve->{biblionumber} } );
2073 }
2074
2075 =head2 GetReserveId
2076
2077   $reserve_id = GetReserveId({ biblionumber => $biblionumber, borrowernumber => $borrowernumber [, itemnumber => $itemnumber ] });
2078
2079   Returnes the first reserve id that matches the given criteria
2080
2081 =cut
2082
2083 sub GetReserveId {
2084     my ( $params ) = @_;
2085
2086     return unless ( ( $params->{'biblionumber'} || $params->{'itemnumber'} ) && $params->{'borrowernumber'} );
2087
2088     foreach my $key ( keys %$params ) {
2089         delete $params->{$key} unless defined( $params->{$key} );
2090     }
2091
2092     my $hold = Koha::Holds->search( $params )->next();
2093
2094     return unless $hold;
2095
2096     return $hold->id();
2097 }
2098
2099 =head2 ReserveSlip
2100
2101   ReserveSlip($branchcode, $borrowernumber, $biblionumber)
2102
2103 Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
2104
2105 The letter code will be HOLD_SLIP, and the following tables are
2106 available within the slip:
2107
2108     reserves
2109     branches
2110     borrowers
2111     biblio
2112     biblioitems
2113     items
2114
2115 =cut
2116
2117 sub ReserveSlip {
2118     my ($branch, $borrowernumber, $biblionumber) = @_;
2119
2120 #   return unless ( C4::Context->boolean_preference('printreserveslips') );
2121     my $patron = Koha::Patrons->find( $borrowernumber );
2122
2123     my $reserve_id = GetReserveId({
2124         biblionumber => $biblionumber,
2125         borrowernumber => $borrowernumber
2126     }) or return;
2127     my $reserve = Koha::Holds->find($reserve_id) or return;
2128     $reserve = $reserve->unblessed;
2129
2130     return  C4::Letters::GetPreparedLetter (
2131         module => 'circulation',
2132         letter_code => 'HOLD_SLIP',
2133         branchcode => $branch,
2134         lang => $patron->lang,
2135         tables => {
2136             'reserves'    => $reserve,
2137             'branches'    => $reserve->{branchcode},
2138             'borrowers'   => $reserve->{borrowernumber},
2139             'biblio'      => $reserve->{biblionumber},
2140             'biblioitems' => $reserve->{biblionumber},
2141             'items'       => $reserve->{itemnumber},
2142         },
2143     );
2144 }
2145
2146 =head2 GetReservesControlBranch
2147
2148   my $reserves_control_branch = GetReservesControlBranch($item, $borrower);
2149
2150   Return the branchcode to be used to determine which reserves
2151   policy applies to a transaction.
2152
2153   C<$item> is a hashref for an item. Only 'homebranch' is used.
2154
2155   C<$borrower> is a hashref to borrower. Only 'branchcode' is used.
2156
2157 =cut
2158
2159 sub GetReservesControlBranch {
2160     my ( $item, $borrower ) = @_;
2161
2162     my $reserves_control = C4::Context->preference('ReservesControlBranch');
2163
2164     my $branchcode =
2165         ( $reserves_control eq 'ItemHomeLibrary' ) ? $item->{'homebranch'}
2166       : ( $reserves_control eq 'PatronLibrary' )   ? $borrower->{'branchcode'}
2167       :                                              undef;
2168
2169     return $branchcode;
2170 }
2171
2172 =head2 CalculatePriority
2173
2174     my $p = CalculatePriority($biblionumber, $resdate);
2175
2176 Calculate priority for a new reserve on biblionumber, placing it at
2177 the end of the line of all holds whose start date falls before
2178 the current system time and that are neither on the hold shelf
2179 or in transit.
2180
2181 The reserve date parameter is optional; if it is supplied, the
2182 priority is based on the set of holds whose start date falls before
2183 the parameter value.
2184
2185 After calculation of this priority, it is recommended to call
2186 _ShiftPriorityByDateAndPriority. Note that this is currently done in
2187 AddReserves.
2188
2189 =cut
2190
2191 sub CalculatePriority {
2192     my ( $biblionumber, $resdate ) = @_;
2193
2194     my $sql = q{
2195         SELECT COUNT(*) FROM reserves
2196         WHERE biblionumber = ?
2197         AND   priority > 0
2198         AND   (found IS NULL OR found = '')
2199     };
2200     #skip found==W or found==T (waiting or transit holds)
2201     if( $resdate ) {
2202         $sql.= ' AND ( reservedate <= ? )';
2203     }
2204     else {
2205         $sql.= ' AND ( reservedate < NOW() )';
2206     }
2207     my $dbh = C4::Context->dbh();
2208     my @row = $dbh->selectrow_array(
2209         $sql,
2210         undef,
2211         $resdate ? ($biblionumber, $resdate) : ($biblionumber)
2212     );
2213
2214     return @row ? $row[0]+1 : 1;
2215 }
2216
2217 =head2 IsItemOnHoldAndFound
2218
2219     my $bool = IsItemFoundHold( $itemnumber );
2220
2221     Returns true if the item is currently on hold
2222     and that hold has a non-null found status ( W, T, etc. )
2223
2224 =cut
2225
2226 sub IsItemOnHoldAndFound {
2227     my ($itemnumber) = @_;
2228
2229     my $rs = Koha::Database->new()->schema()->resultset('Reserve');
2230
2231     my $found = $rs->count(
2232         {
2233             itemnumber => $itemnumber,
2234             found      => { '!=' => undef }
2235         }
2236     );
2237
2238     return $found;
2239 }
2240
2241 =head2 GetMaxPatronHoldsForRecord
2242
2243 my $holds_per_record = ReservesControlBranch( $borrowernumber, $biblionumber );
2244
2245 For multiple holds on a given record for a given patron, the max
2246 number of record level holds that a patron can be placed is the highest
2247 value of the holds_per_record rule for each item if the record for that
2248 patron. This subroutine finds and returns the highest holds_per_record
2249 rule value for a given patron id and record id.
2250
2251 =cut
2252
2253 sub GetMaxPatronHoldsForRecord {
2254     my ( $borrowernumber, $biblionumber ) = @_;
2255
2256     my $patron = Koha::Patrons->find($borrowernumber);
2257     my @items = Koha::Items->search( { biblionumber => $biblionumber } );
2258
2259     my $controlbranch = C4::Context->preference('ReservesControlBranch');
2260
2261     my $categorycode = $patron->categorycode;
2262     my $branchcode;
2263     $branchcode = $patron->branchcode if ( $controlbranch eq "PatronLibrary" );
2264
2265     my $max = 0;
2266     foreach my $item (@items) {
2267         my $itemtype = $item->effective_itemtype();
2268
2269         $branchcode = $item->homebranch if ( $controlbranch eq "ItemHomeLibrary" );
2270
2271         my $rule = GetHoldRule( $categorycode, $itemtype, $branchcode );
2272         my $holds_per_record = $rule ? $rule->{holds_per_record} : 0;
2273         $max = $holds_per_record if $holds_per_record > $max;
2274     }
2275
2276     return $max;
2277 }
2278
2279 =head2 GetHoldRule
2280
2281 my $rule = GetHoldRule( $categorycode, $itemtype, $branchcode );
2282
2283 Returns the matching hold related issuingrule fields for a given
2284 patron category, itemtype, and library.
2285
2286 =cut
2287
2288 sub GetHoldRule {
2289     my ( $categorycode, $itemtype, $branchcode ) = @_;
2290
2291     my $dbh = C4::Context->dbh;
2292
2293     my $sth = $dbh->prepare(
2294         q{
2295          SELECT categorycode, itemtype, branchcode, reservesallowed, holds_per_record
2296            FROM issuingrules
2297           WHERE (categorycode in (?,'*') )
2298             AND (itemtype IN (?,'*'))
2299             AND (branchcode IN (?,'*'))
2300        ORDER BY categorycode DESC,
2301                 itemtype     DESC,
2302                 branchcode   DESC
2303         }
2304     );
2305
2306     $sth->execute( $categorycode, $itemtype, $branchcode );
2307
2308     return $sth->fetchrow_hashref();
2309 }
2310
2311 =head1 AUTHOR
2312
2313 Koha Development Team <http://koha-community.org/>
2314
2315 =cut
2316
2317 1;