C4/Reserves.pm

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