C4/Reserves.pm

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