C4/Reserves2.pm

   1 # -*- tab-width: 8 -*-
   2 # NOTE: This file uses standard 8-character tabs
   3
   4 package C4::Reserves2;
   5
   6 # Copyright 2000-2002 Katipo Communications
   7 #
   8 # This file is part of Koha.
   9 #
  10 # Koha is free software; you can redistribute it and/or modify it under the
  11 # terms of the GNU General Public License as published by the Free Software
  12 # Foundation; either version 2 of the License, or (at your option) any later
  13 # version.
  14 #
  15 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  16 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  17 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License along with
  20 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  21 # Suite 330, Boston, MA  02111-1307 USA
  22
  23 # $Id$
  24
  25 use strict;
  26 require Exporter;
  27 use C4::Context;
  28 use C4::Biblio;
  29 use C4::Search;
  30 use C4::Circulation::Circ2;
  31
  32 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  33 my $library_name = C4::Context->preference("LibraryName");
  34
  35 # set the version for version checking
  36 $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
  37
  38 =head1 NAME
  39
  40 C4::Reserves2 - Koha functions for dealing with reservation.
  41
  42 =head1 SYNOPSIS
  43
  44   use C4::Reserves2;
  45
  46 =head1 DESCRIPTION
  47
  48 this modules provides somes functions to deal with reservations.
  49
  50 =head1 FUNCTIONS
  51
  52 =over 2
  53
  54 =cut
  55
  56 @ISA = qw(Exporter);
  57
  58 # FIXME Take out CalcReserveFee after it can be removed from opac-reserves.pl
  59 @EXPORT = qw(
  60   &FindReserves
  61   &CheckReserves
  62   &GetWaitingReserves
  63   &CancelReserve
  64   &CalcReserveFee
  65   &FillReserve
  66   &ReserveWaiting
  67   &CreateReserve
  68   &UpdateReserve
  69   &GetReserveTitle
  70   &GetReservations
  71   &SetWaitingStatus
  72   &GlobalCancel
  73   &MinusPriority
  74   &OtherReserves
  75   &GetFirstReserveDateFromItem
  76   &CountReservesFromBorrower
  77   &FixPriority
  78   &FindReservesInQueue
  79 );
  80
  81 # make all your functions, whether exported or not;
  82
  83 =item GlobalCancel
  84
  85 ($messages,$nextreservinfo) = &GlobalCancel($itemnumber,$borrowernumber);
  86
  87     New op dev for the circulation based on item, global is a function to cancel reserv,check other reserves, and transfer document if it's necessary
  88
  89 =cut
  90
  91 #'
  92 sub GlobalCancel {
  93     my $messages;
  94     my $nextreservinfo;
  95     my ( $itemnumber, $borrowernumber ) = @_;
  96
  97     #step 1 : cancel the reservation
  98     my $CancelReserve = CancelReserve( undef, $itemnumber, $borrowernumber );
  99
 100     #step 2 launch the subroutine of the others reserves
 101     ( $messages, $nextreservinfo ) = OtherReserves($itemnumber);
 102
 103     return ( $messages, $nextreservinfo );
 104 }
 105
 106 =item OtherReserves
 107
 108 ($messages,$nextreservinfo)=$OtherReserves(itemnumber);
 109
 110 Check queued list of this document and check if this document must be  transfered
 111
 112 =cut
 113
 114 #'
 115 sub OtherReserves {
 116     my ($itemnumber) = @_;
 117     my $messages;
 118     my $nextreservinfo;
 119     my ( $restype, $checkreserves ) = CheckReserves($itemnumber);
 120     if ($checkreserves) {
 121         my $iteminfo = C4::Circulation::Circ2::getiteminformation($itemnumber,undef);
 122         if ( $iteminfo->{'holdingbranch'} ne $checkreserves->{'branchcode'} ) {
 123             $messages->{'transfert'} = $checkreserves->{'branchcode'};
 124             #minus priorities of others reservs
 125             MinusPriority(
 126                 $itemnumber,
 127                 $checkreserves->{'borrowernumber'},
 128                 $iteminfo->{'biblionumber'}
 129             );
 130
 131             #launch the subroutine dotransfer
 132             C4::Circulation::Circ2::dotransfer(
 133                 $itemnumber,
 134                 $iteminfo->{'holdingbranch'},
 135                 $checkreserves->{'branchcode'}
 136               ),
 137               ;
 138         }
 139
 140      #step 2b : case of a reservation on the same branch, set the waiting status
 141         else {
 142             $messages->{'waiting'} = 1;
 143             MinusPriority(
 144                 $itemnumber,
 145                 $checkreserves->{'borrowernumber'},
 146                 $iteminfo->{'biblionumber'}
 147             );
 148             SetWaitingStatus($itemnumber);
 149         }
 150
 151         $nextreservinfo = $checkreserves->{'borrowernumber'};
 152     }
 153
 154     return ( $messages, $nextreservinfo );
 155 }
 156
 157 =item MinusPriority
 158
 159 &MinusPriority($itemnumber,$borrowernumber,$biblionumber)
 160
 161 Reduce the values of queuded list
 162
 163 =cut
 164
 165 #'
 166 sub MinusPriority {
 167     my ( $itemnumber, $borrowernumber, $biblionumber ) = @_;
 168
 169     #first step update the value of the first person on reserv
 170     my $dbh   = C4::Context->dbh;
 171     my $query = qq/
 172         UPDATE reserves
 173         SET    priority = 0 , itemnumber = ?
 174         WHERE  cancellationdate IS NULL
 175           AND  borrowernumber=?
 176           AND  biblionumber=?
 177     /;
 178     my $sth_upd = $dbh->prepare($query);
 179     $sth_upd->execute( $itemnumber, $borrowernumber, $biblionumber );
 180     $sth_upd->finish;
 181     # second step update all others reservs
 182     $query = qq/
 183         SELECT priority,borrowernumber,biblionumber,reservedate
 184         FROM   reserves
 185         WHERE  priority !='0'
 186         AND biblionumber = ?
 187           AND  cancellationdate IS NULL
 188     /;
 189     my $sth_oth = $dbh->prepare($query);
 190     $sth_oth->execute($biblionumber);
 191     while ( my ( $priority, $borrowernumber, $biblionumber, $reservedate ) =
 192         $sth_oth->fetchrow_array )
 193     {
 194         $priority--;
 195         $query = qq/
 196              UPDATE reserves
 197              SET    priority = ?
 198              WHERE  biblionumber = ?
 199                AND  borrowernumber   = ?
 200                AND  reservedate      = ?
 201         /;
 202         my $sth_upd_oth = $dbh->prepare($query);
 203         $sth_upd_oth->execute( $priority, $biblionumber, $borrowernumber,
 204             $reservedate );
 205         $sth_upd_oth->finish;
 206     }
 207     $sth_oth->finish;
 208 }
 209
 210 =item SetWaitingStatus
 211
 212 &SetWaitingStatus($itemnumber);
 213
 214 we check if we have a reserves with itemnumber (New op system of reserves), if we found one, we update the status of the reservation when we have : 'priority' = 0, and we have an itemnumber
 215
 216 =cut
 217
 218 sub SetWaitingStatus {
 219
 220     #first : check if we have a reservation for this item .
 221     my ($itemnumber) = @_;
 222     my $dbh          = C4::Context->dbh;
 223     my $query        = qq/
 224         SELECT priority,borrowernumber
 225         FROM   reserves
 226         WHERE  itemnumber=?
 227            AND cancellationdate IS NULL
 228            AND found IS NULL AND priority='0'
 229     /;
 230     my $sth_find = $dbh->prepare($query);
 231     $sth_find->execute($itemnumber);
 232     my ( $priority, $borrowernumber ) = $sth_find->fetchrow_array;
 233     $sth_find->finish;
 234     return unless $borrowernumber;
 235
 236 # step 2 : if we have a borrowernumber, we update the value found to 'W' to notify the borrower
 237     $query = qq/
 238     UPDATE reserves
 239     SET    found='W',waitingdate = now()
 240     WHERE  borrowernumber=?
 241       AND itemnumber=?
 242       AND found IS NULL
 243     /;
 244     my $sth_set = $dbh->prepare($query);
 245     $sth_set->execute( $borrowernumber, $itemnumber );
 246     $sth_set->finish;
 247 }
 248
 249 =item GetReservations
 250
 251 @borrowerreserv=&GetReservations($itemnumber,$borrowernumber);
 252
 253 this function get the list of reservation for an C<$itemnumber> or C<$borrowernumber>
 254 given on input arg. You should give $itemnumber OR $borrowernumber but not both.
 255
 256 =cut
 257
 258 sub GetReservations {
 259     my ( $itemnumber, $borrowernumber ) = @_;
 260     if ($itemnumber) {
 261         my $dbh   = C4::Context->dbh;
 262         my $query = qq/
 263             SELECT reservedate,borrowernumber
 264             FROM   reserves
 265             WHERE  itemnumber=?
 266               AND  cancellationdate IS NULL
 267               AND  (found <> 'F' OR found IS NULL)
 268         /;
 269         my $sth_res = $dbh->prepare($query);
 270         $sth_res->execute($itemnumber);
 271         my ( $reservedate, $borrowernumber ) = $sth_res->fetchrow_array;
 272         return ( $reservedate, $borrowernumber );
 273     }
 274     if ($borrowernumber) {
 275         my $dbh   = C4::Context->dbh;
 276         my $query = qq/
 277             SELECT *
 278             FROM   reserves
 279             WHERE  borrowernumber=?
 280               AND  cancellationdate IS NULL
 281               AND (found != 'F' or found is null)
 282             ORDER BY reservedate
 283         /;
 284
 285         my $sth_find = $dbh->prepare($query);
 286         $sth_find->execute($borrowernumber);
 287         my @borrowerreserv;
 288         while ( my $data = $sth_find->fetchrow_hashref ) {
 289             push @borrowerreserv, $data;
 290         }
 291         return @borrowerreserv;
 292     }
 293 }
 294
 295 =item FindReserves
 296
 297   $results = &FindReserves($biblionumber, $borrowernumber);
 298
 299 Looks books up in the reserves. C<$biblionumber> is the biblionumber
 300 of the book to look up. C<$borrowernumber> is the borrower number of a
 301 patron whose books to look up.
 302
 303 Either C<$biblionumber> or C<$borrowernumber> may be the empty string,
 304 but not both. If both are specified, C<&FindReserves> looks up the
 305 given book for the given patron. If only C<$biblionumber> is
 306 specified, C<&FindReserves> looks up that book for all patrons. If
 307 only C<$borrowernumber> is specified, C<&FindReserves> looks up all of
 308 that patron's reserves. If neither is specified, C<&FindReserves>
 309 barfs.
 310
 311 For each book thus found, C<&FindReserves> checks the reserve
 312 constraints and does something I don't understand.
 313
 314 C<&FindReserves> returns a two-element array:
 315
 316 C<$results> is a reference to an array of references of hashes. Each hash
 317 has for keys a list of column from reserves table (see details in function).
 318
 319 =cut
 320
 321 #'
 322 sub FindReserves {
 323     my ( $biblionumber, $bor ) = @_;
 324     my $dbh = C4::Context->dbh;
 325     my @bind;
 326
 327     # Find the desired items in the reserves
 328     my $query = qq/
 329         SELECT  branchcode,
 330                 timestamp AS rtimestamp,
 331                 priority,
 332                 biblionumber,
 333                 borrowernumber,
 334                 reservedate,
 335                 constrainttype,
 336                 found,
 337                 itemnumber
 338           FROM     reserves
 339           WHERE     cancellationdate IS NULL
 340           AND    (found <> \'F\' OR found IS NULL)
 341     /;
 342
 343     if ( $biblionumber ne '' ) {
 344         $query .= '
 345             AND biblionumber = ?
 346         ';
 347         push @bind, $biblionumber;
 348     }
 349
 350     if ( $bor ne '' ) {
 351         $query .= '
 352             AND borrowernumber = ?
 353         ';
 354         push @bind, $bor;
 355     }
 356
 357     $query .= '
 358           ORDER BY priority
 359     ';
 360     my $sth = $dbh->prepare($query);
 361     $sth->execute(@bind);
 362     my @results;
 363     my $i = 0;
 364     while ( my $data = $sth->fetchrow_hashref ) {
 365
 366         # FIXME - What is this if-statement doing? How do constraints work?
 367         if ( $data->{constrainttype} eq 'o' ) {
 368             $query = '
 369                 SELECT biblioitemnumber
 370                 FROM reserveconstraints
 371                 WHERE biblionumber   = ?
 372                     AND borrowernumber = ?
 373                   AND reservedate    = ?
 374             ';
 375             my $csth = $dbh->prepare($query);
 376             $csth->execute( $data->{biblionumber}, $data->{borrowernumber},
 377                 $data->{reservedate}, );
 378
 379             my @bibitemno;
 380             while ( my $bibitemnos = $csth->fetchrow_array ) {
 381                 push( @bibitemno, $bibitemnos );
 382             }
 383             my $count = @bibitemno;
 384
 385             # if we have two or more different specific itemtypes
 386             # reserved by same person on same day
 387             my $bdata;
 388             if ( $count > 1 ) {
 389                 $bdata = GetBiblioItemData( $bibitemno[$i] );
 390                 $i++;
 391             }
 392             else {
 393
 394                 # Look up the book we just found.
 395                 $bdata = GetBiblioItemData( $bibitemno[0] );
 396             }
 397             $csth->finish;
 398
 399             # Add the results of this latest search to the current
 400             # results.
 401             # FIXME - An 'each' would probably be more efficient.
 402             foreach my $key ( keys %$bdata ) {
 403                 $data->{$key} = $bdata->{$key};
 404             }
 405         }
 406         push @results, $data;
 407     }
 408     $sth->finish;
 409
 410     return ( $#results + 1, \@results );
 411 }
 412
 413 #-------------------------------------------------------------------------------------
 414
 415 =item CountReservesFromBorrower
 416
 417 $number = &CountReservesFromBorrower($borrowernumber);
 418
 419 this function returns the number of reservation for a borrower given on input arg.
 420
 421 =cut
 422
 423 sub CountReservesFromBorrower {
 424     my ($borrowernumber) = @_;
 425
 426     my $dbh = C4::Context->dbh;
 427
 428     my $query = '
 429         SELECT COUNT(*) AS counter
 430         FROM reserves
 431           WHERE borrowernumber = ?
 432           AND cancellationdate IS NULL
 433           AND (found != \'F\' OR found IS NULL)
 434     ';
 435     my $sth = $dbh->prepare($query);
 436     $sth->execute($borrowernumber);
 437     my $row = $sth->fetchrow_hashref;
 438     $sth->finish;
 439
 440     return $row->{counter};
 441 }
 442
 443 #-------------------------------------------------------------------------------------
 444
 445 =item GetFirstReserveDateFromItem
 446
 447 $date = GetFirstReserveDateFromItem($itemnumber)
 448
 449 this function returns the first date a item has been reserved.
 450
 451 =cut
 452
 453 sub GetFirstReserveDateFromItem {
 454     my ($itemnumber) = @_;
 455
 456     my $dbh = C4::Context->dbh;
 457
 458     my $query = '
 459         SELECT reservedate,
 460         borrowernumber,
 461         branchcode
 462         FROM   reserves
 463         WHERE  itemnumber = ?
 464           AND  cancellationdate IS NULL
 465           AND (found != \'F\' OR found IS NULL)
 466     ';
 467     my $sth = $dbh->prepare($query);
 468     $sth->execute($itemnumber);
 469     my $row = $sth->fetchrow_hashref;
 470
 471     return ($row->{reservedate},$row->{borrowernumber},$row->{branchcode});
 472 }
 473
 474 #-------------------------------------------------------------------------------------
 475
 476 =item CheckReserves
 477
 478   ($status, $reserve) = &CheckReserves($itemnumber, $barcode);
 479
 480 Find a book in the reserves.
 481
 482 C<$itemnumber> is the book's item number. C<$barcode> is its barcode.
 483 Either one, but not both, may be false. If both are specified,
 484 C<&CheckReserves> uses C<$itemnumber>.
 485
 486 $itemnubmer can be false, in which case uses the barcode. (Never uses
 487 both. $itemnumber gets priority).
 488
 489 As I understand it, C<&CheckReserves> looks for the given item in the
 490 reserves. If it is found, that's a match, and C<$status> is set to
 491 C<Waiting>.
 492
 493 Otherwise, it finds the most important item in the reserves with the
 494 same biblio number as this book (I'm not clear on this) and returns it
 495 with C<$status> set to C<Reserved>.
 496
 497 C<&CheckReserves> returns a two-element list:
 498
 499 C<$status> is either C<Waiting>, C<Reserved> (see above), or 0.
 500
 501 C<$reserve> is the reserve item that matched. It is a
 502 reference-to-hash whose keys are mostly the fields of the reserves
 503 table in the Koha database.
 504
 505 =cut
 506
 507 #'
 508 sub CheckReserves {
 509     my ( $item, $barcode ) = @_;
 510     my $dbh = C4::Context->dbh;
 511     my $sth;
 512     if ($item) {
 513         my $qitem = $dbh->quote($item);
 514         # Look up the item by itemnumber
 515         my $query = qq(
 516             SELECT items.biblionumber, items.biblioitemnumber, itemtypes.notforloan
 517             FROM   items, biblioitems, itemtypes
 518             WHERE  items.biblioitemnumber = biblioitems.biblioitemnumber
 519                AND biblioitems.itemtype = itemtypes.itemtype
 520                AND itemnumber=$qitem
 521         );
 522         $sth = $dbh->prepare($query);
 523     }
 524     else {
 525         my $qbc = $dbh->quote($barcode);
 526         # Look up the item by barcode
 527         my $query = qq(
 528             SELECT items.biblionumber, items.biblioitemnumber, itemtypes.notforloan
 529             FROM   items, biblioitems, itemtypes
 530             WHERE  items.biblioitemnumber = biblioitems.biblioitemnumber
 531               AND biblioitems.itemtype = itemtypes.itemtype
 532               AND barcode=$qbc
 533         );
 534         $sth = $dbh->prepare($query);
 535
 536         # FIXME - This function uses $item later on. Ought to set it here.
 537     }
 538     $sth->execute;
 539     my ( $biblio, $bibitem, $notforloan ) = $sth->fetchrow_array;
 540     $sth->finish;
 541
 542     # if item is not for loan it cannot be reserved either.....
 543     return ( 0, 0 ) if $notforloan;
 544
 545     # get the reserves...
 546     # Find this item in the reserves
 547     my @reserves = Findgroupreserve( $bibitem, $biblio );
 548     my $count    = scalar @reserves;
 549
 550     # $priority and $highest are used to find the most important item
 551     # in the list returned by &Findgroupreserve. (The lower $priority,
 552     # the more important the item.)
 553     # $highest is the most important item we've seen so far.
 554     my $priority = 10000000;
 555     my $highest;
 556     if ($count) {
 557         foreach my $res (@reserves) {
 558             # FIXME - $item might be undefined or empty: the caller
 559             # might be searching by barcode.
 560             if ( $res->{'itemnumber'} == $item ) {
 561                 # Found it
 562                 return ( "Waiting", $res );
 563             }
 564             else {
 565                 # See if this item is more important than what we've got
 566                 # so far.
 567                 if ( $res->{'priority'} != 0 && $res->{'priority'} < $priority )
 568                 {
 569                     $priority = $res->{'priority'};
 570                     $highest  = $res;
 571                 }
 572             }
 573         }
 574     }
 575
 576     # If we get this far, then no exact match was found. Print the
 577     # most important item on the list. I think this tells us who's
 578     # next in line to get this book.
 579     if ($highest) {    # FIXME - $highest might be undefined
 580         $highest->{'itemnumber'} = $item;
 581         return ( "Reserved", $highest );
 582     }
 583     else {
 584         return ( 0, 0 );
 585     }
 586 }
 587
 588 #-------------------------------------------------------------------------------------
 589
 590 =item CancelReserve
 591
 592   &CancelReserve($biblionumber, $itemnumber, $borrowernumber);
 593
 594 Cancels a reserve.
 595
 596 Use either C<$biblionumber> or C<$itemnumber> to specify the item to
 597 cancel, but not both: if both are given, C<&CancelReserve> does
 598 nothing.
 599
 600 C<$borrowernumber> is the borrower number of the patron on whose
 601 behalf the book was reserved.
 602
 603 If C<$biblionumber> was given, C<&CancelReserve> also adjusts the
 604 priorities of the other people who are waiting on the book.
 605
 606 =cut
 607
 608 #'
 609 sub CancelReserve {
 610     my ( $biblio, $item, $borr ) = @_;
 611     my $dbh = C4::Context->dbh;
 612         if ( ( $item and $borr ) and ( not $biblio ) ) {
 613         # removing a waiting reserve record....
 614         # update the database...
 615         my $query = qq/
 616             UPDATE reserves
 617             SET    cancellationdate = now(),
 618                    found            = Null,
 619                    priority         = 0
 620             WHERE  itemnumber       = ?
 621              AND   borrowernumber   = ?
 622         /;
 623         my $sth = $dbh->prepare($query);
 624         $sth->execute( $item, $borr );
 625         $sth->finish;
 626     }
 627     if ( ( $biblio and $borr ) and ( not $item ) ) {
 628         # removing a reserve record....
 629         # get the prioritiy on this record....
 630         my $priority;
 631         my $query = qq/
 632             SELECT priority FROM reserves
 633             WHERE biblionumber   = ?
 634               AND borrowernumber = ?
 635               AND cancellationdate IS NULL
 636               AND itemnumber IS NULL
 637               AND (found <> 'F' OR found IS NULL)
 638         /;
 639         my $sth = $dbh->prepare($query);
 640         $sth->execute( $biblio, $borr );
 641         ($priority) = $sth->fetchrow_array;
 642         $sth->finish;
 643         $query = qq/
 644             UPDATE reserves
 645             SET    cancellationdate = now(),
 646                    found            = Null,
 647                    priority         = 0
 648             WHERE  biblionumber     = ?
 649               AND  borrowernumber   = ?
 650               AND cancellationdate IS NULL
 651               AND (found <> 'F' or found IS NULL)
 652         /;
 653
 654         # update the database, removing the record...
 655         $sth = $dbh->prepare($query);
 656         $sth->execute( $biblio, $borr );
 657         $sth->finish;
 658
 659         # now fix the priority on the others....
 660         FixPriority( $priority, $biblio );
 661     }
 662 }
 663
 664 #-------------------------------------------------------------------------------------
 665
 666 =item FillReserve
 667
 668   &FillReserve($reserve);
 669
 670 Fill a reserve. If I understand this correctly, this means that the
 671 reserved book has been found and given to the patron who reserved it.
 672
 673 C<$reserve> specifies the reserve to fill. It is a reference-to-hash
 674 whose keys are fields from the reserves table in the Koha database.
 675
 676 =cut
 677
 678 #'
 679 sub FillReserve {
 680     my ($res) = @_;
 681     my $dbh = C4::Context->dbh;
 682     # fill in a reserve record....
 683     my $qbiblio = $res->{'biblionumber'};
 684     my $borr    = $res->{'borrowernumber'};
 685     my $resdate = $res->{'reservedate'};
 686
 687     # get the priority on this record....
 688     my $priority;
 689     my $query = "SELECT priority
 690                  FROM   reserves
 691                  WHERE  biblionumber   = ?
 692                   AND   borrowernumber = ?
 693                   AND   reservedate    = ?";
 694     my $sth = $dbh->prepare($query);
 695     $sth->execute( $qbiblio, $borr, $resdate );
 696     ($priority) = $sth->fetchrow_array;
 697     $sth->finish;
 698
 699     # update the database...
 700     $query = "UPDATE reserves
 701                   SET    found            = 'F',
 702                          priority         = 0
 703                  WHERE  biblionumber     = ?
 704                     AND reservedate      = ?
 705                     AND borrowernumber   = ?
 706                 ";
 707     $sth = $dbh->prepare($query);
 708     $sth->execute( $qbiblio, $resdate, $borr );
 709     $sth->finish;
 710
 711     # now fix the priority on the others (if the priority wasn't
 712     # already sorted!)....
 713     unless ( $priority == 0 ) {
 714         FixPriority( $priority, $qbiblio );
 715     }
 716 }
 717
 718 #-------------------------------------------------------------------------------------
 719
 720 =item FixPriority
 721
 722 &FixPriority($biblio,$borrowernumber,$rank);
 723
 724  Only used internally (so don't export it)
 725  Changed how this functions works #
 726  Now just gets an array of reserves in the rank order and updates them with
 727  the array index (+1 as array starts from 0)
 728  and if $rank is supplied will splice item from the array and splice it back in again
 729  in new priority rank
 730
 731 =cut
 732
 733 sub FixPriority {
 734     my ( $biblio, $borrowernumber, $rank ) = @_;
 735     my $dbh = C4::Context->dbh;
 736      if ( $rank eq "del" ) {
 737          CancelReserve( $biblio, undef, $borrowernumber );
 738      }
 739     if ( $rank eq "W" || $rank eq "0" ) {
 740
 741         # make sure priority for waiting items is 0
 742         my $query = qq/
 743             UPDATE reserves
 744             SET    priority = 0
 745             WHERE biblionumber = ?
 746               AND borrowernumber = ?
 747               AND cancellationdate IS NULL
 748               AND found ='W'
 749         /;
 750         my $sth = $dbh->prepare($query);
 751         $sth->execute( $biblio, $borrowernumber );
 752     }
 753     my @priority;
 754     my @reservedates;
 755
 756     # get whats left
 757 # FIXME adding a new security in returned elements for changing priority,
 758 # now, we don't care anymore any reservations with itemnumber linked (suppose a waiting reserve)
 759     my $query = qq/
 760         SELECT borrowernumber, reservedate, constrainttype
 761         FROM   reserves
 762         WHERE  biblionumber   = ?
 763           AND  cancellationdate IS NULL
 764           AND  itemnumber IS NULL
 765           AND  ((found <> 'F' and found <> 'W') or found is NULL)
 766         ORDER BY priority ASC
 767     /;
 768     my $sth = $dbh->prepare($query);
 769     $sth->execute($biblio);
 770     while ( my $line = $sth->fetchrow_hashref ) {
 771         push( @reservedates, $line );
 772         push( @priority,     $line );
 773     }
 774
 775     # To find the matching index
 776     my $i;
 777     my $key = -1;    # to allow for 0 to be a valid result
 778     for ( $i = 0 ; $i < @priority ; $i++ ) {
 779         if ( $borrowernumber == $priority[$i]->{'borrowernumber'} ) {
 780             $key = $i;    # save the index
 781             last;
 782         }
 783     }
 784
 785     # if index exists in array then move it to new position
 786     if ( $key > -1 && $rank ne 'del' && $rank > 0 ) {
 787         my $new_rank = $rank -
 788           1;    # $new_rank is what you want the new index to be in the array
 789         my $moving_item = splice( @priority, $key, 1 );
 790         splice( @priority, $new_rank, 0, $moving_item );
 791     }
 792
 793     # now fix the priority on those that are left....
 794     $query = "
 795             UPDATE reserves
 796             SET    priority = ?
 797                 WHERE  biblionumber = ?
 798                  AND borrowernumber   = ?
 799                  AND reservedate = ?
 800          AND found IS NULL
 801     ";
 802     $sth = $dbh->prepare($query);
 803     for ( my $j = 0 ; $j < @priority ; $j++ ) {
 804         $sth->execute(
 805             $j + 1, $biblio,
 806             $priority[$j]->{'borrowernumber'},
 807             $priority[$j]->{'reservedate'}
 808         );
 809         $sth->finish;
 810     }
 811 }
 812
 813 #-------------------------------------------------------------------------------------
 814
 815 =item ReserveWaiting
 816
 817 branchcode = &ReserveWaiting($item,$borr);
 818 this function set FOUND to 'W' for Waiting into the database.
 819
 820 =cut
 821
 822 sub ReserveWaiting {
 823     my ( $item, $borr,$diffBranchSend ) = @_;
 824     my $dbh = C4::Context->dbh;
 825
 826     # get priority and biblionumber....
 827     my $query = qq/
 828         SELECT reserves.priority as priority,
 829                reserves.biblionumber as biblionumber,
 830                reserves.branchcode as branchcode,
 831                reserves.timestamp as timestamp
 832         FROM   reserves,items
 833         WHERE  reserves.biblionumber = items.biblionumber
 834           AND  items.itemnumber = ?
 835           AND reserves.borrowernumber = ?
 836           AND reserves.cancellationdate IS NULL
 837           AND (reserves.found <> 'F' OR reserves.found IS NULL)
 838     /;
 839     my $sth = $dbh->prepare($query);
 840     $sth->execute( $item, $borr );
 841     my $data = $sth->fetchrow_hashref;
 842     $sth->finish;
 843     my $biblio    = $data->{'biblionumber'};
 844     my $timestamp = $data->{'timestamp'};
 845
 846     # update reserves record....
 847     if ($diffBranchSend) {
 848     $query = qq/
 849         UPDATE reserves
 850         SET    priority = 0,
 851                itemnumber = ?
 852         WHERE borrowernumber = ?
 853           AND biblionumber = ?
 854           AND timestamp = ?
 855     /;
 856     }
 857     else {
 858     $query = qq/
 859         UPDATE reserves
 860         SET    priority = 0,
 861                found = 'W',
 862             waitingdate=now(),
 863                itemnumber = ?
 864         WHERE borrowernumber = ?
 865           AND biblionumber = ?
 866           AND timestamp = ?
 867     /;
 868     }
 869     $sth = $dbh->prepare($query);
 870     $sth->execute( $item, $borr, $biblio, $timestamp );
 871     $sth->finish;
 872
 873     # now fix up the remaining priorities....
 874     FixPriority( $data->{'priority'}, $biblio );
 875     my $branchcode = $data->{'branchcode'};
 876     return $branchcode;
 877 }
 878
 879 #-------------------------------------------------------------------------------------
 880
 881 =item GetWaitingReserves
 882
 883 \@itemswaiting=GetWaitingReserves($borr);
 884
 885 this funtion fetch the list of waiting reserves from database.
 886
 887 =cut
 888
 889 sub GetWaitingReserves {
 890     my ($borr) = @_;
 891     my $dbh = C4::Context->dbh;
 892     my @itemswaiting;
 893     my $query = qq/
 894         SELECT *
 895         FROM reserves
 896         WHERE borrowernumber = ?
 897           AND reserves.found = 'W'
 898           AND cancellationdate IS NULL
 899     /;
 900     my $sth = $dbh->prepare($query);
 901     $sth->execute($borr);
 902     while ( my $data = $sth->fetchrow_hashref ) {
 903         push( @itemswaiting, $data );
 904     }
 905     $sth->finish;
 906     return \@itemswaiting;
 907 }
 908
 909 #-------------------------------------------------------------------------------------
 910
 911 =item Findgroupreserve
 912
 913   @results = &Findgroupreserve($biblioitemnumber, $biblionumber);
 914
 915 ****** FIXME ******
 916 I don't know what this does, because I don't understand how reserve
 917 constraints work. I think the idea is that you reserve a particular
 918 biblio, and the constraint allows you to restrict it to a given
 919 biblioitem (e.g., if you want to borrow the audio book edition of "The
 920 Prophet", rather than the first available publication).
 921
 922 C<&Findgroupreserve> returns :
 923 C<@results> is an array of references-to-hash whose keys are mostly
 924 fields from the reserves table of the Koha database, plus
 925 C<biblioitemnumber>.
 926
 927 =cut
 928
 929 #'
 930 sub Findgroupreserve {
 931     my ( $bibitem, $biblio ) = @_;
 932     my $dbh   = C4::Context->dbh;
 933     my $query = qq/
 934         SELECT reserves.biblionumber AS biblionumber,
 935                reserves.borrowernumber AS borrowernumber,
 936                reserves.reservedate AS reservedate,
 937                reserves.branchcode AS branchcode,
 938                reserves.cancellationdate AS cancellationdate,
 939                reserves.found AS found,
 940                reserves.reservenotes AS reservenotes,
 941                reserves.priority AS priority,
 942                reserves.timestamp AS timestamp,
 943                reserveconstraints.biblioitemnumber AS biblioitemnumber,
 944                reserves.itemnumber AS itemnumber
 945         FROM reserves
 946           LEFT JOIN reserveconstraints ON reserves.biblionumber = reserveconstraints.biblionumber
 947         WHERE reserves.biblionumber = ?
 948           AND ( ( reserveconstraints.biblioitemnumber = ?
 949           AND reserves.borrowernumber = reserveconstraints.borrowernumber
 950           AND reserves.reservedate    =reserveconstraints.reservedate )
 951           OR  reserves.constrainttype='a' )
 952           AND reserves.cancellationdate is NULL
 953           AND (reserves.found <> 'F' or reserves.found is NULL)
 954     /;
 955     my $sth = $dbh->prepare($query);
 956     $sth->execute( $biblio, $bibitem );
 957     my @results;
 958     while ( my $data = $sth->fetchrow_hashref ) {
 959         push( @results, $data );
 960     }
 961     $sth->finish;
 962     return @results;
 963 }
 964
 965 =item CreateReserve
 966
 967 CreateReserve($env,$branch,$borrowernumber,$biblionumber,$constraint,$bibitems,$priority,$notes,$title,$checkitem,$found)
 968
 969 FIXME - A somewhat different version of this function appears in
 970 C4::Reserves. Pick one and stick with it.
 971
 972 =cut
 973
 974 sub CreateReserve {
 975     my (
 976         $env,        $branch,    $borrowernumber, $biblionumber,
 977         $constraint, $bibitems,  $priority,       $notes,
 978         $title,      $checkitem, $found
 979     ) = @_;
 980     my $fee;
 981     if ( $library_name =~ /Horowhenua/ ) {
 982         $fee =
 983           CalcHLTReserveFee( $env, $borrowernumber, $biblionumber, $constraint,
 984             $bibitems );
 985     }
 986     else {
 987         $fee =
 988           CalcReserveFee( $env, $borrowernumber, $biblionumber, $constraint,
 989             $bibitems );
 990     }
 991     my $dbh     = C4::Context->dbh;
 992     my $const   = lc substr( $constraint, 0, 1 );
 993     my @datearr = localtime(time);
 994     my $resdate =
 995       ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
 996     my $waitingdate;
 997
 998     # If the reserv had the waiting status, we had the value of the resdate
 999     if ( $found eq 'W' ) {
1000         $waitingdate = $resdate;
1001     }
1002
1003     #eval {
1004     # updates take place here
1005     if ( $fee > 0 ) {
1006         my $nextacctno = &getnextacctno( $env, $borrowernumber, $dbh );
1007         my $query      = qq/
1008         INSERT INTO accountlines
1009             (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1010         VALUES
1011             (?,?,now(),?,?,'Res',?)
1012     /;
1013         my $usth = $dbh->prepare($query);
1014         $usth->execute( $borrowernumber, $nextacctno, $fee,
1015             "Reserve Charge - $title", $fee );
1016         $usth->finish;
1017     }
1018
1019     #if ($const eq 'a'){
1020     my $query = qq/
1021         INSERT INTO reserves
1022             (borrowernumber,biblionumber,reservedate,branchcode,constrainttype,
1023             priority,reservenotes,itemnumber,found,waitingdate)
1024         VALUES
1025              (?,?,?,?,?,
1026              ?,?,?,?,?)
1027     /;
1028     my $sth = $dbh->prepare($query);
1029     $sth->execute(
1030         $borrowernumber, $biblionumber, $resdate, $branch,
1031         $const,          $priority,     $notes,   $checkitem,
1032         $found,          $waitingdate
1033     );
1034     $sth->finish;
1035
1036     #}
1037     if ( ( $const eq "o" ) || ( $const eq "e" ) ) {
1038         my $numitems = @$bibitems;
1039         my $i        = 0;
1040         while ( $i < $numitems ) {
1041             my $biblioitem = @$bibitems[$i];
1042             my $query      = qq/
1043           INSERT INTO reserveconstraints
1044               (borrowernumber,biblionumber,reservedate,biblioitemnumber)
1045           VALUES
1046             (?,?,?,?)
1047       /;
1048             my $sth = $dbh->prepare("");
1049             $sth->execute( $borrowernumber, $biblionumber, $resdate,
1050                 $biblioitem );
1051             $sth->finish;
1052             $i++;
1053         }
1054     }
1055     return;
1056 }
1057
1058 # FIXME - A functionally identical version of this function appears in
1059 # C4::Reserves. Pick one and stick with it.
1060 # XXX - Internal use only
1061 # FIXME - opac-reserves.pl need to use it, temporarily put into @EXPORT
1062
1063 sub CalcReserveFee {
1064     my ( $env, $borrowernumber, $biblionumber, $constraint, $bibitems ) = @_;
1065
1066     #check for issues;
1067     my $dbh   = C4::Context->dbh;
1068     my $const = lc substr( $constraint, 0, 1 );
1069     my $query = qq/
1070       SELECT * FROM borrowers,categories
1071     WHERE borrowernumber = ?
1072       AND borrowers.categorycode = categories.categorycode
1073     /;
1074     my $sth = $dbh->prepare($query);
1075     $sth->execute($borrowernumber);
1076     my $data = $sth->fetchrow_hashref;
1077     $sth->finish();
1078     my $fee      = $data->{'reservefee'};
1079     my $cntitems = @- > $bibitems;
1080
1081     if ( $fee > 0 ) {
1082
1083         # check for items on issue
1084         # first find biblioitem records
1085         my @biblioitems;
1086         my $sth1 = $dbh->prepare(
1087             "SELECT * FROM biblio,biblioitems
1088                    WHERE (biblio.biblionumber = ?)
1089                      AND (biblio.biblionumber = biblioitems.biblionumber)"
1090         );
1091         $sth1->execute($biblionumber);
1092         while ( my $data1 = $sth1->fetchrow_hashref ) {
1093             if ( $const eq "a" ) {
1094                 push @biblioitems, $data1;
1095             }
1096             else {
1097                 my $found = 0;
1098                 my $x     = 0;
1099                 while ( $x < $cntitems ) {
1100                     if ( @$bibitems->{'biblioitemnumber'} ==
1101                         $data->{'biblioitemnumber'} )
1102                     {
1103                         $found = 1;
1104                     }
1105                     $x++;
1106                 }
1107                 if ( $const eq 'o' ) {
1108                     if ( $found == 1 ) {
1109                         push @biblioitems, $data1;
1110                     }
1111                 }
1112                 else {
1113                     if ( $found == 0 ) {
1114                         push @biblioitems, $data1;
1115                     }
1116                 }
1117             }
1118         }
1119         $sth1->finish;
1120         my $cntitemsfound = @biblioitems;
1121         my $issues        = 0;
1122         my $x             = 0;
1123         my $allissued     = 1;
1124         while ( $x < $cntitemsfound ) {
1125             my $bitdata = $biblioitems[$x];
1126             my $sth2    = $dbh->prepare(
1127                 "SELECT * FROM items
1128                      WHERE biblioitemnumber = ?"
1129             );
1130             $sth2->execute( $bitdata->{'biblioitemnumber'} );
1131             while ( my $itdata = $sth2->fetchrow_hashref ) {
1132                 my $sth3 = $dbh->prepare(
1133                     "SELECT * FROM issues
1134                        WHERE itemnumber = ?
1135                          AND returndate IS NULL"
1136                 );
1137                 $sth3->execute( $itdata->{'itemnumber'} );
1138                 if ( my $isdata = $sth3->fetchrow_hashref ) {
1139                 }
1140                 else {
1141                     $allissued = 0;
1142                 }
1143             }
1144             $x++;
1145         }
1146         if ( $allissued == 0 ) {
1147             my $rsth =
1148               $dbh->prepare("SELECT * FROM reserves WHERE biblionumber = ?");
1149             $rsth->execute($biblionumber);
1150             if ( my $rdata = $rsth->fetchrow_hashref ) {
1151             }
1152             else {
1153                 $fee = 0;
1154             }
1155         }
1156     }
1157
1158     #  print "fee $fee";
1159     return $fee;
1160 }
1161
1162 # The following are junior and young adult item types that should not incur a
1163 # reserve charge.
1164 #
1165 # Juniors: BJC, BJCN, BJF, BJK, BJM, BJN, BJP, BJSF, BJSN, DJ, DJP, FJ, JVID,
1166 #  VJ, VJP, PJ, TJ, TJP, VJ, VJP.
1167 #
1168 # Young adults: BYF, BYN, BYP, DY, DYP, PY, PYP, TY, TYP, VY, VYP.
1169 #
1170 # All other item types should incur a reserve charge.
1171 sub CalcHLTReserveFee {
1172     my ( $env, $borrowernumber, $biblionumber, $constraint, $bibitems ) = @_;
1173     my $dbh = C4::Context->dbh;
1174     my $sth = $dbh->prepare(
1175         "SELECT * FROM borrowers,categories
1176                   WHERE (borrowernumber = ?)
1177                     AND (borrowers.categorycode = categories.categorycode)"
1178     );
1179     $sth->execute($borrowernumber);
1180     my $data = $sth->fetchrow_hashref;
1181     $sth->finish();
1182     my $fee = $data->{'reservefee'};
1183
1184     my $matchno;
1185     my @nocharge =
1186       qw/BJC BJCN BJF BJK BJM BJN BJP BJSF BJSN DJ DJP FJ NJ CJ VJ VJP PJ TJ TJP BYF BYN BYP DY DYP PY PYP TY TYP VY VYP/;
1187     $sth = $dbh->prepare(
1188         "SELECT * FROM biblio,biblioitems
1189                      WHERE (biblio.biblionumber = ?)
1190                        AND (biblio.biblionumber = biblioitems.biblionumber)"
1191     );
1192     $sth->execute($biblionumber);
1193     $data = $sth->fetchrow_hashref;
1194     my $itemtype = $data->{'itemtype'};
1195     for ( my $i = 0 ; $i < @nocharge ; $i++ ) {
1196         if ( $itemtype eq $nocharge[$i] ) {
1197             $matchno++;
1198             last;
1199         }
1200     }
1201
1202     if ( $matchno > 0 ) {
1203         $fee = 0;
1204     }
1205     return $fee;
1206 }
1207
1208 =item GetNextAccountNumber
1209
1210 GetNextAccountNumber()
1211
1212 =cut
1213
1214 sub GetNextAccountNumber {
1215     my ( $env, $borrowernumber, $dbh ) = @_;
1216     my $nextaccntno = 1;
1217     my $sth         = $dbh->prepare(
1218         "select * from accountlines
1219   where (borrowernumber = ?)
1220   order by accountno desc"
1221     );
1222     $sth->execute($borrowernumber);
1223     if ( my $accdata = $sth->fetchrow_hashref ) {
1224         $nextaccntno = $accdata->{'accountno'} + 1;
1225     }
1226     $sth->finish;
1227     return ($nextaccntno);
1228 }
1229
1230 #-------------------------------------------------------------------------------------
1231
1232 =item UpdateReserve
1233
1234 &UpdateReserve($rank,$biblio,$borrower,$branch)
1235
1236 =cut
1237
1238 sub UpdateReserve {
1239     #subroutine to update a reserve
1240     my ( $rank, $biblio, $borrower, $branch , $itemnumber) = @_;
1241      return if $rank eq "W";
1242      return if $rank eq "n";
1243     my $dbh = C4::Context->dbh;
1244     if ( $rank eq "del" ) {
1245         my $query = qq/
1246             UPDATE reserves
1247             SET    cancellationdate=now()
1248             WHERE  biblionumber   = ?
1249              AND   borrowernumber = ?
1250              AND   cancellationdate is NULL
1251              AND   (found <> 'F' or found is NULL)
1252         /;
1253         my $sth = $dbh->prepare($query);
1254         $sth->execute( $biblio, $borrower );
1255         $sth->finish;
1256
1257     }
1258     else {
1259         my $query = qq/
1260         UPDATE reserves SET priority = ? ,branchcode = ?, itemnumber = ?, found = NULL
1261             WHERE biblionumber   = ?
1262              AND borrowernumber = ?
1263              AND cancellationdate is NULL
1264              AND (found <> 'F' or found is NULL)
1265         /;
1266         my $sth = $dbh->prepare($query);
1267         $sth->execute( $rank, $branch,$itemnumber, $biblio, $borrower);
1268         $sth->finish;
1269         FixPriority( $biblio, $borrower, $rank);
1270     }
1271 }
1272
1273 =item GetReserveTitle
1274
1275 $data = GetReserveTitle($biblio,$bor,$date,$timestamp);
1276
1277 =cut
1278
1279 sub GetReserveTitle {
1280     my ( $biblio, $bor, $date, $timestamp ) = @_;
1281     my $dbh   = C4::Context->dbh;
1282     my $query = qq/
1283         SELECT *
1284         FROM   reserveconstraints,biblioitems
1285         WHERE  reserveconstraints.biblioitemnumber=biblioitems.biblioitemnumber
1286           AND   reserveconstraints.biblionumber=?
1287          AND   reserveconstraints.borrowernumber = ?
1288          AND   reserveconstraints.reservedate=?
1289          AND   reserveconstraints.timestamp=?
1290     /;
1291     my $sth = $dbh->prepare($query);
1292     $sth->execute( $biblio, $bor, $date, $timestamp );
1293     my $data = $sth->fetchrow_hashref;
1294     $sth->finish;
1295     return $data;
1296 }
1297
1298 =item FindReservesInQueue
1299
1300   $results = &FindReservesInQueue($biblionumber);
1301
1302 Simple variant of FindReserves, exept the result is now displaying only the queue list of reservations with the same biblionumber (At this time only displayed in request.pl)
1303
1304 C<&FindReservesInQueue> returns a two-element array:
1305
1306 C<$results> is a reference to an array of references of hashes. Each hash
1307 has for keys a list of column from reserves table (see details in function).
1308
1309 =cut
1310
1311 #'
1312
1313 sub FindReservesInQueue {
1314     my ($biblionumber) = @_;
1315     my $dbh = C4::Context->dbh;
1316
1317     # Find the desired items in the reserves
1318     my $query = qq/
1319         SELECT  branchcode,
1320                 timestamp AS rtimestamp,
1321                 priority,
1322                 biblionumber,
1323                 borrowernumber,
1324                 reservedate,
1325                 constrainttype,
1326                 found,
1327                 itemnumber
1328           FROM     reserves
1329           WHERE     cancellationdate IS NULL
1330         AND biblionumber = ?
1331           AND    (found <> \'F\' OR found IS NULL)
1332           AND priority <> \'0\'
1333           ORDER BY priority
1334     /;
1335     my $sth = $dbh->prepare($query);
1336     $sth->execute($biblionumber);
1337     my @results;
1338     my $i = 0;
1339     while ( my $data = $sth->fetchrow_hashref ) {
1340
1341         # FIXME - What is this if-statement doing? How do constraints work?
1342         if ( $data->{constrainttype} eq 'o' ) {
1343             $query = '
1344                 SELECT biblioitemnumber
1345                 FROM reserveconstraints
1346                 WHERE biblionumber   = ?
1347                     AND borrowernumber = ?
1348                   AND reservedate    = ?
1349             ';
1350             my $csth = $dbh->prepare($query);
1351             $csth->execute( $data->{biblionumber}, $data->{borrowernumber},
1352                 $data->{reservedate}, );
1353
1354             my @bibitemno;
1355             while ( my $bibitemnos = $csth->fetchrow_array ) {
1356                 push( @bibitemno, $bibitemnos );
1357             }
1358             my $count = @bibitemno;
1359
1360             # if we have two or more different specific itemtypes
1361             # reserved by same person on same day
1362             my $bdata;
1363             if ( $count > 1 ) {
1364                 $bdata = GetBiblioItemData( $bibitemno[$i] );
1365                 $i++;
1366             }
1367             else {
1368                 # Look up the book we just found.
1369                 $bdata = GetBiblioItemData( $bibitemno[0] );
1370             }
1371             $csth->finish;
1372
1373             # Add the results of this latest search to the current
1374             # results.
1375             # FIXME - An 'each' would probably be more efficient.
1376             foreach my $key ( keys %$bdata ) {
1377                 $data->{$key} = $bdata->{$key};
1378             }
1379         }
1380         push @results, $data;
1381     }
1382     $sth->finish;
1383
1384     return ( $#results + 1, \@results );
1385 }
1386
1387 =back
1388
1389 =head1 AUTHOR
1390
1391 Koha Developement team <info@koha.org>
1392
1393 =cut
1394