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