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