C4/Circulation/Circ2.pm

   1 # -*- tab-width: 8 -*-
   2 # Please use 8-character tabs for this file (indents are every 4 characters)
   3
   4 package C4::Circulation::Circ2;
   5
   6 # $Id$
   7
   8 #package to deal with Returns
   9 #written 3/11/99 by olwen@katipo.co.nz
  10
  11
  12 # Copyright 2000-2002 Katipo Communications
  13 #
  14 # This file is part of Koha.
  15 #
  16 # Koha is free software; you can redistribute it and/or modify it under the
  17 # terms of the GNU General Public License as published by the Free Software
  18 # Foundation; either version 2 of the License, or (at your option) any later
  19 # version.
  20 #
  21 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  22 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  23 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  24 #
  25 # You should have received a copy of the GNU General Public License along with
  26 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  27 # Suite 330, Boston, MA  02111-1307 USA
  28
  29 use strict;
  30 # use warnings;
  31 require Exporter;
  32 use DBI;
  33 use C4::Context;
  34 #use C4::Accounts;
  35 #use C4::InterfaceCDK;
  36 #use C4::Circulation::Main;
  37 #use C4::Circulation::Renewals;
  38 #use C4::Scan;
  39 use C4::Stats;
  40 use C4::Reserves2;
  41 use C4::Koha;
  42 #use C4::Search;
  43 #use C4::Print;
  44
  45 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  46
  47 # set the version for version checking
  48 $VERSION = 0.01;
  49
  50 =head1 NAME
  51
  52 C4::Circulation::Circ2 - Koha circulation module
  53
  54 =head1 SYNOPSIS
  55
  56   use C4::Circulation::Circ2;
  57
  58 =head1 DESCRIPTION
  59
  60 The functions in this module deal with circulation, issues, and
  61 returns, as well as general information about the library.
  62
  63 =head1 FUNCTIONS
  64
  65 =over 2
  66
  67 =cut
  68
  69 @ISA = qw(Exporter);
  70 @EXPORT = qw(&getpatroninformation
  71         &currentissues &getissues &getiteminformation &findborrower
  72         &issuebook &returnbook &find_reserves &transferbook &decode
  73         &calc_charges);
  74
  75 # &getbranches &getprinters &getbranch &getprinter => moved to C4::Koha.pm
  76
  77 =item getpatroninformation
  78
  79   ($borrower, $flags) = &getpatroninformation($env, $borrowernumber,
  80                                         $cardnumber);
  81
  82 Looks up a patron and returns information about him or her. If
  83 C<$borrowernumber> is true (nonzero), C<&getpatroninformation> looks
  84 up the borrower by number; otherwise, it looks up the borrower by card
  85 number.
  86
  87 C<$env> is effectively ignored, but should be a reference-to-hash.
  88
  89 C<$borrower> is a reference-to-hash whose keys are the fields of the
  90 borrowers table in the Koha database. In addition,
  91 C<$borrower-E<gt>{flags}> is the same as C<$flags>.
  92
  93 C<$flags> is a reference-to-hash giving more detailed information
  94 about the patron. Its keys act as flags: if they are set, then the key
  95 is a reference-to-hash that gives further details:
  96
  97   if (exists($flags->{LOST}))
  98   {
  99           # Patron's card was reported lost
 100           print $flags->{LOST}{message}, "\n";
 101   }
 102
 103 Each flag has a C<message> key, giving a human-readable explanation of
 104 the flag. If the state of a flag means that the patron should not be
 105 allowed to borrow any more books, then it will have a C<noissues> key
 106 with a true value.
 107
 108 The possible flags are:
 109
 110 =over 4
 111
 112 =item CHARGES
 113
 114 Shows the patron's credit or debt, if any.
 115
 116 =item GNA
 117
 118 (Gone, no address.) Set if the patron has left without giving a
 119 forwarding address.
 120
 121 =item LOST
 122
 123 Set if the patron's card has been reported as lost.
 124
 125 =item DBARRED
 126
 127 Set if the patron has been debarred.
 128
 129 =item NOTES
 130
 131 Any additional notes about the patron.
 132
 133 =item ODUES
 134
 135 Set if the patron has overdue items. This flag has several keys:
 136
 137 C<$flags-E<gt>{ODUES}{itemlist}> is a reference-to-array listing the
 138 overdue items. Its elements are references-to-hash, each describing an
 139 overdue item. The keys are selected fields from the issues, biblio,
 140 biblioitems, and items tables of the Koha database.
 141
 142 C<$flags-E<gt>{ODUES}{itemlist}> is a string giving a text listing of
 143 the overdue items, one per line.
 144
 145 =item WAITING
 146
 147 Set if any items that the patron has reserved are available.
 148
 149 C<$flags-E<gt>{WAITING}{itemlist}> is a reference-to-array listing the
 150 available items. Each element is a reference-to-hash whose keys are
 151 fields from the reserves table of the Koha database.
 152
 153 =back
 154
 155 =cut
 156 #'
 157 sub getpatroninformation {
 158 # returns
 159     my ($env, $borrowernumber,$cardnumber) = @_;
 160     my $dbh = C4::Context->dbh;
 161     my $query;
 162     my $sth;
 163     if ($borrowernumber) {
 164         $query = "select * from borrowers where borrowernumber=$borrowernumber";
 165     } elsif ($cardnumber) {
 166         $query = "select * from borrowers where cardnumber=$cardnumber";
 167     } else {
 168         $env->{'apierror'} = "invalid borrower information passed to getpatroninformation subroutine";
 169         return();
 170     }
 171     $env->{'mess'} = $query;
 172     $sth = $dbh->prepare($query);
 173     $sth->execute;
 174     my $borrower = $sth->fetchrow_hashref;
 175     my $amount = checkaccount($env, $borrowernumber, $dbh);
 176     $borrower->{'amountoutstanding'} = $amount;
 177     my $flags = patronflags($env, $borrower, $dbh);
 178     my $accessflagshash;
 179
 180     $sth=$dbh->prepare("select bit,flag from userflags");
 181     $sth->execute;
 182     while (my ($bit, $flag) = $sth->fetchrow) {
 183         if ($borrower->{'flags'} & 2**$bit) {
 184             $accessflagshash->{$flag}=1;
 185         }
 186     }
 187     $sth->finish;
 188     $borrower->{'flags'}=$flags;
 189     return ($borrower, $flags, $accessflagshash);
 190 }
 191
 192 =item decode
 193
 194   $str = &decode($chunk);
 195
 196 Decodes a segment of a string emitted by a CueCat barcode scanner and
 197 returns it.
 198
 199 =cut
 200 #'
 201 # FIXME - At least, I'm pretty sure this is for decoding CueCat stuff.
 202 sub decode {
 203     my ($encoded) = @_;
 204     my $seq = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
 205     my @s = map { index($seq,$_); } split(//,$encoded);
 206     my $l = ($#s+1) % 4;
 207     if ($l)
 208     {
 209         if ($l == 1)
 210         {
 211             print "Error!";
 212             return;
 213         }
 214         $l = 4-$l;
 215         $#s += $l;
 216     }
 217     my $r = '';
 218     while ($#s >= 0)
 219     {
 220         my $n = (($s[0] << 6 | $s[1]) << 6 | $s[2]) << 6 | $s[3];
 221         $r .=chr(($n >> 16) ^ 67) .
 222              chr(($n >> 8 & 255) ^ 67) .
 223              chr(($n & 255) ^ 67);
 224         @s = @s[4..$#s];
 225     }
 226     $r = substr($r,0,length($r)-$l);
 227     return $r;
 228 }
 229
 230 =item getiteminformation
 231
 232   $item = &getiteminformation($env, $itemnumber, $barcode);
 233
 234 Looks up information about an item, given either its item number or
 235 its barcode. If C<$itemnumber> is a nonzero value, it is used;
 236 otherwise, C<$barcode> is used.
 237
 238 C<$env> is effectively ignored, but should be a reference-to-hash.
 239
 240 C<$item> is a reference-to-hash whose keys are fields from the biblio,
 241 items, and biblioitems tables of the Koha database. It may also
 242 contain the following keys:
 243
 244 =over 4
 245
 246 =item C<date_due>
 247
 248 The due date on this item, if it has been borrowed and not returned
 249 yet. The date is in YYYY-MM-DD format.
 250
 251 =item C<loanlength>
 252
 253 The length of time for which the item can be borrowed, in days.
 254
 255 =item C<notforloan>
 256
 257 True if the item may not be borrowed.
 258
 259 =back
 260
 261 =cut
 262 #'
 263 sub getiteminformation {
 264 # returns a hash of item information given either the itemnumber or the barcode
 265     my ($env, $itemnumber, $barcode) = @_;
 266     my $dbh = C4::Context->dbh;
 267     my $sth;
 268     if ($itemnumber) {
 269         $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.itemnumber=$itemnumber and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
 270     } elsif ($barcode) {
 271         my $q_barcode=$dbh->quote($barcode);
 272         $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.barcode=$q_barcode and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
 273     } else {
 274         $env->{'apierror'}="getiteminformation() subroutine must be called with either an itemnumber or a barcode";
 275         # Error condition.
 276         return();
 277     }
 278     $sth->execute;
 279     my $iteminformation=$sth->fetchrow_hashref;
 280     $sth->finish;
 281     # FIXME - Style: instead of putting the entire rest of the
 282     # function in a block, just say
 283     #   return undef unless $iteminformation;
 284     # That way, the rest of the function needn't be indented as much.
 285     if ($iteminformation) {
 286         $sth=$dbh->prepare("select date_due from issues where itemnumber=$iteminformation->{'itemnumber'} and isnull(returndate)");
 287         $sth->execute;
 288         my ($date_due) = $sth->fetchrow;
 289         $iteminformation->{'date_due'}=$date_due;
 290         $sth->finish;
 291         # FIXME - The Dewey code is a string, not a number. Besides,
 292         # "000" is a perfectly valid Dewey code.
 293         #$iteminformation->{'dewey'}=~s/0*$//;
 294         ($iteminformation->{'dewey'} == 0) && ($iteminformation->{'dewey'}='');
 295         # FIXME - fetchrow_hashref is documented as being inefficient.
 296         # Perhaps this should be rewritten as
 297         #       $sth = $dbh->prepare("select loanlength, notforloan ...");
 298         #       $sth->execute;
 299         #       ($iteminformation->{loanlength},
 300         #        $iteminformation->{notforloan}) = fetchrow_array;
 301         $sth=$dbh->prepare("select * from itemtypes where itemtype='$iteminformation->{'itemtype'}'");
 302         $sth->execute;
 303         my $itemtype=$sth->fetchrow_hashref;
 304         $iteminformation->{'loanlength'}=$itemtype->{'loanlength'};
 305         $iteminformation->{'notforloan'}=$itemtype->{'notforloan'};
 306         $sth->finish;
 307     }
 308     return($iteminformation);
 309 }
 310
 311 =item findborrower
 312
 313   $borrowers = &findborrower($env, $key);
 314   print $borrowers->[0]{surname};
 315
 316 Looks up patrons and returns information about them.
 317
 318 C<$env> is ignored.
 319
 320 C<$key> is either a card number or a string. C<&findborrower> tries to
 321 look it up as a card number first. If that fails, C<&findborrower>
 322 looks up all patrons whose surname begins with C<$key>.
 323
 324 C<$borrowers> is a reference-to-array. Each element is a
 325 reference-to-hash whose keys are the fields of the borrowers table in
 326 the Koha database.
 327
 328 =cut
 329 #'
 330 # If you really want to throw a monkey wrench into the works, change
 331 # your last name to "V10000008" :-)
 332
 333 # FIXME - This is different from &C4::Borrower::findborrower, but I
 334 # think that one's obsolete.
 335 sub findborrower {
 336 # returns an array of borrower hash references, given a cardnumber or a partial
 337 # surname
 338     my ($env, $key) = @_;
 339     my $dbh = C4::Context->dbh;
 340     my @borrowers;
 341     my $sth=$dbh->prepare("select * from borrowers where cardnumber=?");
 342     $sth->execute($key);
 343     if ($sth->rows) {
 344         my ($borrower)=$sth->fetchrow_hashref;
 345         push (@borrowers, $borrower);
 346     } else {
 347         $sth->finish;
 348         $sth=$dbh->prepare("select * from borrowers where surname like ?");
 349         $sth->execute($key."%");
 350         while (my $borrower = $sth->fetchrow_hashref) {
 351             push (@borrowers, $borrower);
 352         }
 353     }
 354     $sth->finish;
 355     return(\@borrowers);
 356 }
 357
 358
 359 =item transferbook
 360
 361   ($dotransfer, $messages, $iteminformation) =
 362         &transferbook($newbranch, $barcode, $ignore_reserves);
 363
 364 Transfers an item to a new branch. If the item is currently on loan,
 365 it is automatically returned before the actual transfer.
 366
 367 C<$newbranch> is the code for the branch to which the item should be
 368 transferred.
 369
 370 C<$barcode> is the barcode of the item to be transferred.
 371
 372 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
 373 Otherwise, if an item is reserved, the transfer fails.
 374
 375 Returns three values:
 376
 377 C<$dotransfer> is true iff the transfer was successful.
 378
 379 C<$messages> is a reference-to-hash which may have any of the
 380 following keys:
 381
 382 =over 4
 383
 384 =item C<BadBarcode>
 385
 386 There is no item in the catalog with the given barcode. The value is
 387 C<$barcode>.
 388
 389 =item C<IsPermanent>
 390
 391 The item's home branch is permanent. This doesn't prevent the item
 392 from being transferred, though. The value is the code of the item's
 393 home branch.
 394
 395 =item C<DestinationEqualsHolding>
 396
 397 The item is already at the branch to which it is being transferred.
 398 The transfer is nonetheless considered to have failed. The value
 399 should be ignored.
 400
 401 =item C<WasReturned>
 402
 403 The item was on loan, and C<&transferbook> automatically returned it
 404 before transferring it. The value is the borrower number of the patron
 405 who had the item.
 406
 407 =item C<ResFound>
 408
 409 The item was reserved. The value is a reference-to-hash whose keys are
 410 fields from the reserves table of the Koha database, and
 411 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
 412 either C<Waiting> or C<Reserved>.
 413
 414 =item C<WasTransferred>
 415
 416 The item was eligible to be transferred. Barring problems
 417 communicating with the database, the transfer should indeed have
 418 succeeded. The value should be ignored.
 419
 420 =back
 421
 422 =cut
 423 #'
 424 # FIXME - This function tries to do too much, and its API is clumsy.
 425 # If it didn't also return books, it could be used to change the home
 426 # branch of a book while the book is on loan.
 427 #
 428 # Is there any point in returning the item information? The caller can
 429 # look that up elsewhere if ve cares.
 430 #
 431 # This leaves the ($dotransfer, $messages) tuple. This seems clumsy.
 432 # If the transfer succeeds, that's all the caller should need to know.
 433 # Thus, this function could simply return 1 or 0 to indicate success
 434 # or failure, and set $C4::Circulation::Circ2::errmsg in case of
 435 # failure. Or this function could return undef if successful, and an
 436 # error message in case of failure (this would feel more like C than
 437 # Perl, though).
 438 sub transferbook {
 439 # transfer book code....
 440     my ($tbr, $barcode, $ignoreRs) = @_;
 441     my $messages;
 442     my %env;
 443     my $dotransfer = 1;
 444     my $branches = getbranches();
 445     my $iteminformation = getiteminformation(\%env, 0, $barcode);
 446 # bad barcode..
 447     if (not $iteminformation) {
 448         $messages->{'BadBarcode'} = $barcode;
 449         $dotransfer = 0;
 450     }
 451 # get branches of book...
 452     my $hbr = $iteminformation->{'homebranch'};
 453     my $fbr = $iteminformation->{'holdingbranch'};
 454 # if is permanent...
 455     if ($branches->{$hbr}->{'PE'}) {
 456         $messages->{'IsPermanent'} = $hbr;
 457     }
 458 # can't transfer book if is already there....
 459 # FIXME - Why not? Shouldn't it trivially succeed?
 460     if ($fbr eq $tbr) {
 461         $messages->{'DestinationEqualsHolding'} = 1;
 462         $dotransfer = 0;
 463     }
 464 # check if it is still issued to someone, return it...
 465     my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
 466     if ($currentborrower) {
 467         returnbook($barcode, $fbr);
 468         $messages->{'WasReturned'} = $currentborrower;
 469     }
 470 # find reserves.....
 471     # FIXME - Don't call &CheckReserves unless $ignoreRs is true.
 472     # That'll save a database query.
 473     my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
 474     if ($resfound and not $ignoreRs) {
 475         $resrec->{'ResFound'} = $resfound;
 476         $messages->{'ResFound'} = $resrec;
 477         $dotransfer = 0;
 478     }
 479 #actually do the transfer....
 480     if ($dotransfer) {
 481         dotransfer($iteminformation->{'itemnumber'}, $fbr, $tbr);
 482         $messages->{'WasTransfered'} = 1;
 483     }
 484     return ($dotransfer, $messages, $iteminformation);
 485 }
 486
 487 # Not exported
 488 # FIXME - This is only used in &transferbook. Why bother making it a
 489 # separate function?
 490 sub dotransfer {
 491     my ($itm, $fbr, $tbr) = @_;
 492     my $dbh = C4::Context->dbh;
 493     $itm = $dbh->quote($itm);
 494     $fbr = $dbh->quote($fbr);
 495     $tbr = $dbh->quote($tbr);
 496     #new entry in branchtransfers....
 497     $dbh->do(<<EOT);
 498         INSERT INTO     branchtransfers
 499                         (itemnumber, frombranch, datearrived, tobranch)
 500         VALUES          ($itm, $fbr, now(), $tbr)
 501 EOT
 502
 503     #update holdingbranch in items .....
 504     $dbh->do(<<EOT);
 505         UPDATE  items
 506         SET     datelastseen  = now(),
 507                 holdingbranch = $tbr
 508         WHERE   items.itemnumber = $itm
 509 EOT
 510     return;
 511 }
 512
 513 =item issuebook
 514
 515   ($iteminformation, $datedue, $rejected, $question, $questionnumber,
 516    $defaultanswer, $message) =
 517         &issuebook($env, $patroninformation, $barcode, $responses, $date);
 518
 519 Issue a book to a patron.
 520
 521 C<$env-E<gt>{usercode}> will be used in the usercode field of the
 522 statistics table of the Koha database when this transaction is
 523 recorded.
 524
 525 C<$env-E<gt>{datedue}>, if given, specifies the date on which the book
 526 is due back. This should be a string of the form "YYYY-MM-DD".
 527
 528 C<$env-E<gt>{branchcode}> is the code of the branch where this
 529 transaction is taking place.
 530
 531 C<$patroninformation> is a reference-to-hash giving information about
 532 the person borrowing the book. This is the first value returned by
 533 C<&getpatroninformation>.
 534
 535 C<$barcode> is the bar code of the book being issued.
 536
 537 C<$responses> is a reference-to-hash. It represents the answers to the
 538 questions asked by the C<$question>, C<$questionnumber>, and
 539 C<$defaultanswer> return values (see below). The keys are numbers, and
 540 the values can be "Y" or "N".
 541
 542 C<$date> is an optional date in the form "YYYY-MM-DD". If specified,
 543 then only fines and charges up to that date will be considered when
 544 checking to see whether the patron owes too much money to be lent a
 545 book.
 546
 547 C<&issuebook> returns an array of seven values:
 548
 549 C<$iteminformation> is a reference-to-hash describing the item just
 550 issued. This in a form similar to that returned by
 551 C<&getiteminformation>.
 552
 553 C<$datedue> is a string giving the date when the book is due, in the
 554 form "YYYY-MM-DD".
 555
 556 C<$rejected> is either a string, or -1. If it is defined and is a
 557 string, then the book may not be issued, and C<$rejected> gives the
 558 reason for this. If C<$rejected> is -1, then the book may not be
 559 issued, but no reason is given.
 560
 561 If there is a problem or question (e.g., the book is reserved for
 562 another patron), then C<$question>, C<$questionnumber>, and
 563 C<$defaultanswer> will be set. C<$questionnumber> indicates the
 564 problem. C<$question> is a text string asking how to resolve the
 565 problem, as a yes-or-no question, and C<$defaultanswer> is either "Y"
 566 or "N", giving the default answer. The questions, their numbers, and
 567 default answers are:
 568
 569 =over 4
 570
 571 =item 1: "Issued to <name>. Mark as returned?" (Y)
 572
 573 =item 2: "Waiting for <patron> at <branch>. Allow issue?" (N)
 574
 575 =item 3: "Cancel reserve for <patron>?" (N)
 576
 577 =item 4: "Book is issued to this borrower. Renew?" (Y)
 578
 579 =item 5: "Reserved for <patron> at <branch> since <date>. Allow issue?" (N)
 580
 581 =item 6: "Set reserve for <patron> to waiting and transfer to <branch>?" (Y)
 582
 583 This is asked if the answer to question 5 was "N".
 584
 585 =item 7: "Cancel reserve for <patron>?" (N)
 586
 587 =back
 588
 589 C<$message>, if defined, is an additional information message, e.g., a
 590 rental fee notice.
 591
 592 =cut
 593 #'
 594 # FIXME - The business with $responses is absurd. For one thing, these
 595 # questions should have names, not numbers. For another, it'd be
 596 # better to have the last argument be %extras. Then scripts can call
 597 # this function with
 598 #       &issuebook(...,
 599 #               -renew          => 1,
 600 #               -mark_returned  => 0,
 601 #               -cancel_reserve => 1,
 602 #               ...
 603 #               );
 604 # and the script can use
 605 #       if (defined($extras{"-mark_returned"}) && $extras{"-mark_returned"})
 606 # Heck, the $date argument should go in there as well.
 607 #
 608 # Also, there might be several reasons why a book can't be issued, but
 609 # this API only supports asking one question at a time. Perhaps it'd
 610 # be better to return a ref-to-list of problem IDs. Then the calling
 611 # script can display a list of all of the problems at once.
 612 #
 613 # Is it this function's place to decide the default answer to the
 614 # various questions? Why not document the various problems and allow
 615 # the caller to decide?
 616 sub issuebook {
 617     my ($env, $patroninformation, $barcode, $responses, $date) = @_;
 618     my $dbh = C4::Context->dbh;
 619     my $iteminformation = getiteminformation($env, 0, $barcode);
 620     my ($datedue);
 621     my ($rejected,$question,$defaultanswer,$questionnumber, $noissue);
 622     my $message;
 623
 624     # See if there's any reason this book shouldn't be issued to this
 625     # patron.
 626     SWITCH: {   # FIXME - Yes, we know it's a switch. Tell us what it's for.
 627         if ($patroninformation->{'gonenoaddress'}) {
 628             $rejected="Patron is gone, with no known address.";
 629             last SWITCH;
 630         }
 631         if ($patroninformation->{'lost'}) {
 632             $rejected="Patron's card has been reported lost.";
 633             last SWITCH;
 634         }
 635         if ($patroninformation->{'debarred'}) {
 636             $rejected="Patron is Debarred";
 637             last SWITCH;
 638         }
 639         my $amount = checkaccount($env,$patroninformation->{'borrowernumber'}, $dbh,$date);
 640         # FIXME - "5" shouldn't be hardcoded. An Italian library might
 641         # be generous enough to lend a book to a patron even if he
 642         # does still owe them 5 lire.
 643         if ($amount > 5 && $patroninformation->{'categorycode'} ne 'L' &&
 644                            $patroninformation->{'categorycode'} ne 'W' &&
 645                            $patroninformation->{'categorycode'} ne 'I' &&
 646                            $patroninformation->{'categorycode'} ne 'B' &&
 647                            $patroninformation->{'categorycode'} ne 'P') {
 648                            # FIXME - What do these category codes mean?
 649             $rejected = sprintf "Patron owes \$%.02f.", $amount;
 650             last SWITCH;
 651         }
 652         # FIXME - This sort of error-checking should be placed closer
 653         # to the test; in this case, this error-checking should be
 654         # done immediately after the call to &getiteminformation.
 655         unless ($iteminformation) {
 656             $rejected = "$barcode is not a valid barcode.";
 657             last SWITCH;
 658         }
 659         if ($iteminformation->{'notforloan'} == 1) {
 660             $rejected="Item not for loan.";
 661             last SWITCH;
 662         }
 663         if ($iteminformation->{'wthdrawn'} == 1) {
 664             $rejected="Item withdrawn.";
 665             last SWITCH;
 666         }
 667         if ($iteminformation->{'restricted'} == 1) {
 668             $rejected="Restricted item.";
 669             last SWITCH;
 670         }
 671         if ($iteminformation->{'itemtype'} eq 'REF') {
 672             $rejected="Reference item:  Not for loan.";
 673             last SWITCH;
 674         }
 675         my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
 676         if ($currentborrower eq $patroninformation->{'borrowernumber'}) {
 677 # Already issued to current borrower. Ask whether the loan should
 678 # be renewed.
 679             my ($renewstatus) = renewstatus($env,$dbh,$patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
 680             if ($renewstatus == 0) {
 681                 $rejected="No more renewals allowed for this item.";
 682                 last SWITCH;
 683             } else {
 684                 if ($responses->{4} eq '') {
 685                     $questionnumber = 4;
 686                     $question = "Book is issued to this borrower.\nRenew?";
 687                     $defaultanswer = 'Y';
 688                     last SWITCH;
 689                 } elsif ($responses->{4} eq 'Y') {
 690                     my $charge = calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'});
 691                     if ($charge > 0) {
 692                         createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'}, $charge);
 693                         $iteminformation->{'charge'} = $charge;
 694                     }
 695                     &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'});
 696                     renewbook($env,$dbh, $patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
 697                     $noissue=1;
 698                 } else {
 699                     $rejected=-1;
 700                     last SWITCH;
 701                 }
 702             }
 703         } elsif ($currentborrower ne '') {
 704             # This book is currently on loan, but not to the person
 705             # who wants to borrow it now.
 706             my ($currborrower, $cbflags) = getpatroninformation($env,$currentborrower,0);
 707             if ($responses->{1} eq '') {
 708                 $questionnumber=1;
 709                 $question = "Issued to $currborrower->{'firstname'} $currborrower->{'surname'} ($currborrower->{'cardnumber'}).\nMark as returned?";
 710                 $defaultanswer='Y';
 711                 last SWITCH;
 712             } elsif ($responses->{1} eq 'Y') {
 713                 returnbook($iteminformation->{'barcode'}, $env->{'branch'});
 714             } else {
 715                 $rejected=-1;
 716                 last SWITCH;
 717             }
 718         }
 719
 720         # See if the item is on reserve.
 721         my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'});
 722         if ($restype) {
 723             my $resbor = $res->{'borrowernumber'};
 724             if ($resbor eq $patroninformation->{'borrowernumber'}) {
 725                 # The item is on reserve to the current patron
 726                 FillReserve($res);
 727             } elsif ($restype eq "Waiting") {
 728                 # The item is on reserve and waiting, but has been
 729                 # reserved by some other patron.
 730                 my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
 731                 my $branches = getbranches();
 732                 my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
 733                 if ($responses->{2} eq '') {
 734                     $questionnumber=2;
 735                     # FIXME - Assumes HTML
 736                     $question="<font color=red>Waiting</font> for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) at $branchname \nAllow issue?";
 737                     $defaultanswer='N';
 738                     last SWITCH;
 739                 } elsif ($responses->{2} eq 'N') {
 740                     $rejected=-1;
 741                     last SWITCH;
 742                 } else {
 743                     if ($responses->{3} eq '') {
 744                         $questionnumber=3;
 745                         $question="Cancel reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})?";
 746                         $defaultanswer='N';
 747                         last SWITCH;
 748                     } elsif ($responses->{3} eq 'Y') {
 749                         CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
 750                     }
 751                 }
 752             } elsif ($restype eq "Reserved") {
 753                 # The item is on reserve for someone else.
 754                 my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
 755                 my $branches = getbranches();
 756                 my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
 757                 if ($responses->{5} eq '') {
 758                     $questionnumber=5;
 759                     $question="Reserved for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) since $res->{'reservedate'} \nAllow issue?";
 760                     $defaultanswer='N';
 761                     last SWITCH;
 762                 } elsif ($responses->{5} eq 'N') {
 763                     if ($responses->{6} eq '') {
 764                         $questionnumber=6;
 765                         $question="Set reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) to waiting and transfer to $branchname?";
 766                         $defaultanswer='N';
 767                     } elsif ($responses->{6} eq 'Y') {
 768                         my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'});
 769                         transferbook($tobrcd, $barcode, 1);
 770                         $message = "Item should now be waiting at $branchname";
 771                     }
 772                     $rejected=-1;
 773                     last SWITCH;
 774                 } else {
 775                     if ($responses->{7} eq '') {
 776                         $questionnumber=7;
 777                         $question="Cancel reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})?";
 778                         $defaultanswer='N';
 779                         last SWITCH;
 780                     } elsif ($responses->{7} eq 'Y') {
 781                         CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
 782                     }
 783                 }
 784             }
 785         }
 786     }
 787     my $dateduef;
 788     unless (($question) || ($rejected) || ($noissue)) {
 789         # There's no reason why the item can't be issued.
 790         # FIXME - my $loanlength = $iteminformation->{loanlength} || 21;
 791         my $loanlength=21;
 792         if ($iteminformation->{'loanlength'}) {
 793             $loanlength=$iteminformation->{'loanlength'};
 794         }
 795         my $ti=time;            # FIXME - Never used
 796         my $datedue=time+($loanlength)*86400;
 797         # FIXME - Could just use POSIX::strftime("%Y-%m-%d", localtime);
 798         # That's what it's for. Or, in this case:
 799         #       $dateduef = $env->{datedue} ||
 800         #               strftime("%Y-%m-%d", localtime(time +
 801         #                                    $loanlength * 86400));
 802         my @datearr = localtime($datedue);
 803         $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
 804         if ($env->{'datedue'}) {
 805             $dateduef=$env->{'datedue'};
 806         }
 807         $dateduef=~ s/2001\-4\-25/2001\-4\-26/;
 808                 # FIXME - What's this for? Leftover from debugging?
 809
 810         # Record in the database the fact that the book was issued.
 811         # FIXME - Use $dbh->do();
 812         my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode) values ($patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'}, '$dateduef', '$env->{'branchcode'}')");
 813         $sth->execute;
 814         $sth->finish;
 815         $iteminformation->{'issues'}++;
 816         # FIXME - Use $dbh->do();
 817         $sth=$dbh->prepare("update items set issues=$iteminformation->{'issues'},datelastseen=now() where itemnumber=$iteminformation->{'itemnumber'}");
 818         $sth->execute;
 819         $sth->finish;
 820         # If it costs to borrow this book, charge it to the patron's account.
 821         my $charge=calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'});
 822         if ($charge > 0) {
 823             createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'}, $charge);
 824             $iteminformation->{'charge'}=$charge;
 825         }
 826         # Record the fact that this book was issued.
 827         &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'});
 828     }
 829     if ($iteminformation->{'charge'}) {
 830         $message=sprintf "Rental charge of \$%.02f applies.", $iteminformation->{'charge'};
 831     }
 832     return ($iteminformation, $dateduef, $rejected, $question, $questionnumber, $defaultanswer, $message);
 833 }
 834
 835
 836
 837 =item returnbook
 838
 839   ($doreturn, $messages, $iteminformation, $borrower) =
 840           &returnbook($barcode, $branch);
 841
 842 Returns a book.
 843
 844 C<$barcode> is the bar code of the book being returned. C<$branch> is
 845 the code of the branch where the book is being returned.
 846
 847 C<&returnbook> returns a list of four items:
 848
 849 C<$doreturn> is true iff the return succeeded.
 850
 851 C<$messages> is a reference-to-hash giving the reason for failure:
 852
 853 =over 4
 854
 855 =item C<BadBarcode>
 856
 857 No item with this barcode exists. The value is C<$barcode>.
 858
 859 =item C<NotIssued>
 860
 861 The book is not currently on loan. The value is C<$barcode>.
 862
 863 =item C<IsPermanent>
 864
 865 The book's home branch is a permanent collection. If you have borrowed
 866 this book, you are not allowed to return it. The value is the code for
 867 the book's home branch.
 868
 869 =item C<wthdrawn>
 870
 871 This book has been withdrawn/cancelled. The value should be ignored.
 872
 873 =item C<ResFound>
 874
 875 The item was reserved. The value is a reference-to-hash whose keys are
 876 fields from the reserves table of the Koha database, and
 877 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
 878 either C<Waiting>, C<Reserved>, or 0.
 879
 880 =back
 881
 882 C<$borrower> is a reference-to-hash, giving information about the
 883 patron who last borrowed the book.
 884
 885 =cut
 886 #'
 887 # FIXME - This API is bogus. There's no need to return $borrower and
 888 # $iteminformation; the caller can ask about those separately, if it
 889 # cares (it'd be inefficient to make two database calls instead of
 890 # one, but &getpatroninformation and &getiteminformation can be
 891 # memoized if this is an issue).
 892 #
 893 # The ($doreturn, $messages) tuple is redundant: if the return
 894 # succeeded, that's all the caller needs to know. So &returnbook can
 895 # return 1 and 0 on success and failure, and set
 896 # $C4::Circulation::Circ2::errmsg to indicate the error. Or it can
 897 # return undef for success, and an error message on error (though this
 898 # is more C-ish than Perl-ish).
 899 sub returnbook {
 900     my ($barcode, $branch) = @_;
 901     my %env;
 902     my $messages;
 903     my $doreturn = 1;
 904     die '$branch not defined' unless defined $branch; # just in case (bug 170)
 905 # get information on item
 906     my ($iteminformation) = getiteminformation(\%env, 0, $barcode);
 907     if (not $iteminformation) {
 908         $messages->{'BadBarcode'} = $barcode;
 909         $doreturn = 0;
 910     }
 911 # find the borrower
 912     my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
 913     if ((not $currentborrower) && $doreturn) {
 914         $messages->{'NotIssued'} = $barcode;
 915         $doreturn = 0;
 916     }
 917 # check if the book is in a permanent collection....
 918     my $hbr = $iteminformation->{'homebranch'};
 919     my $branches = getbranches();
 920     if ($branches->{$hbr}->{'PE'}) {
 921         $messages->{'IsPermanent'} = $hbr;
 922     }
 923 # check that the book has been cancelled
 924     if ($iteminformation->{'wthdrawn'}) {
 925         $messages->{'wthdrawn'} = 1;
 926         $doreturn = 0;
 927     }
 928 # update issues, thereby returning book (should push this out into another subroutine
 929     my ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
 930     if ($doreturn) {
 931         doreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
 932         $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
 933     }
 934     ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
 935 # transfer book to the current branch
 936     my ($transfered, $mess, $item) = transferbook($branch, $barcode, 1);
 937     if ($transfered) {
 938         $messages->{'WasTransfered'} = 1; # FIXME is the "= 1" right?
 939     }
 940 # fix up the accounts.....
 941     if ($iteminformation->{'itemlost'}) {
 942         # Mark the item as not being lost.
 943         updateitemlost($iteminformation->{'itemnumber'});
 944         fixaccountforlostandreturned($iteminformation, $borrower);
 945         $messages->{'WasLost'} = 1; # FIXME is the "= 1" right?
 946     }
 947 # fix up the overdues in accounts...
 948     fixoverduesonreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
 949 # find reserves.....
 950     my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
 951     if ($resfound) {
 952 #       my $tobrcd = ReserveWaiting($resrec->{'itemnumber'}, $resrec->{'borrowernumber'});
 953         $resrec->{'ResFound'} = $resfound;
 954         $messages->{'ResFound'} = $resrec;
 955     }
 956 # update stats?
 957 # Record the fact that this book was returned.
 958     UpdateStats(\%env, $branch ,'return','0','',$iteminformation->{'itemnumber'});
 959     return ($doreturn, $messages, $iteminformation, $borrower);
 960 }
 961
 962 # doreturn
 963 # Takes a borrowernumber and an itemnuber.
 964 # Updates the 'issues' table to mark the item as returned (assuming
 965 # that it's currently on loan to the given borrower. Otherwise, the
 966 # item remains on loan.
 967 # Updates items.datelastseen for the item.
 968 # Not exported
 969 # FIXME - This is only used in &returnbook. Why make it into a
 970 # separate function? (is this a recognizable step in the return process? - acli)
 971 sub doreturn {
 972     my ($brn, $itm) = @_;
 973     my $dbh = C4::Context->dbh;
 974     $brn = $dbh->quote($brn);
 975     $itm = $dbh->quote($itm);
 976     my $query = "update issues set returndate = now() where (borrowernumber = $brn)
 977         and (itemnumber = $itm) and (returndate is null)";
 978     my $sth = $dbh->prepare($query);
 979     $sth->execute;
 980     $sth->finish;
 981     $query="update items set datelastseen=now() where itemnumber=$itm";
 982     $sth=$dbh->prepare($query);
 983     $sth->execute;
 984     $sth->finish;
 985     return;
 986 }
 987
 988 # updateitemlost
 989 # Marks an item as not being lost.
 990 # Not exported
 991 sub updateitemlost{
 992   my ($itemno)=@_;
 993   my $dbh = C4::Context->dbh;
 994
 995   $dbh->do(<<EOT);
 996         UPDATE  items
 997         SET     itemlost = 0
 998         WHERE   itemnumber = $itemno
 999 EOT
1000 }
1001
1002 # Not exported
1003 sub fixaccountforlostandreturned {
1004     my ($iteminfo, $borrower) = @_;
1005     my %env;
1006     my $dbh = C4::Context->dbh;
1007     my $itm = $dbh->quote($iteminfo->{'itemnumber'});
1008 # check for charge made for lost book
1009     my $query = "select * from accountlines where (itemnumber = $itm)
1010                           and (accounttype='L' or accounttype='Rep') order by date desc";
1011     my $sth = $dbh->prepare($query);
1012     $sth->execute;
1013     if (my $data = $sth->fetchrow_hashref) {
1014 # writeoff this amount
1015         my $offset;
1016         my $amount = $data->{'amount'};
1017         my $acctno = $data->{'accountno'};
1018         my $amountleft;
1019         if ($data->{'amountoutstanding'} == $amount) {
1020             $offset = $data->{'amount'};
1021             $amountleft = 0;
1022         } else {
1023             $offset = $amount - $data->{'amountoutstanding'};
1024             $amountleft = $data->{'amountoutstanding'} - $amount;
1025         }
1026         my $uquery = "update accountlines set accounttype = 'LR',amountoutstanding='0'
1027                   where (borrowernumber = '$data->{'borrowernumber'}')
1028                   and (itemnumber = $itm) and (accountno = '$acctno') ";
1029         my $usth = $dbh->prepare($uquery);
1030         $usth->execute;
1031         $usth->finish;
1032 #check if any credit is left if so writeoff other accounts
1033         my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
1034         if ($amountleft < 0){
1035             $amountleft*=-1;
1036         }
1037         if ($amountleft > 0){
1038             my $query = "select * from accountlines where (borrowernumber = '$data->{'borrowernumber'}')
1039                                                       and (amountoutstanding >0) order by date";
1040             my $msth = $dbh->prepare($query);
1041             $msth->execute;
1042       # offset transactions
1043             my $newamtos;
1044             my $accdata;
1045             while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1046                 if ($accdata->{'amountoutstanding'} < $amountleft) {
1047                     $newamtos = 0;
1048                     $amountleft -= $accdata->{'amountoutstanding'};
1049                 }  else {
1050                     $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1051                     $amountleft = 0;
1052                 }
1053                 my $thisacct = $accdata->{'accountno'};
1054                 my $updquery = "update accountlines set amountoutstanding= '$newamtos'
1055                                  where (borrowernumber = '$data->{'borrowernumber'}')
1056                                    and (accountno='$thisacct')";
1057                 my $usth = $dbh->prepare($updquery);
1058                 $usth->execute;
1059                 $usth->finish;
1060                 $updquery = "insert into accountoffsets
1061                           (borrowernumber, accountno, offsetaccount,  offsetamount)
1062                           values
1063                           ('$data->{'borrowernumber'}','$accdata->{'accountno'}','$nextaccntno','$newamtos')";
1064                 $usth = $dbh->prepare($updquery);
1065                 $usth->execute;
1066                 $usth->finish;
1067             }
1068             $msth->finish;
1069         }
1070         if ($amountleft > 0){
1071             $amountleft*=-1;
1072         }
1073         my $desc="Book Returned ".$iteminfo->{'barcode'};
1074         $uquery = "insert into accountlines
1075                   (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1076                   values ('$data->{'borrowernumber'}','$nextaccntno',now(),0-$amount,'$desc',
1077                   'CR',$amountleft)";
1078         $usth = $dbh->prepare($uquery);
1079         $usth->execute;
1080         $usth->finish;
1081         $uquery = "insert into accountoffsets
1082                   (borrowernumber, accountno, offsetaccount,  offsetamount)
1083                   values ($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset)";
1084         $usth = $dbh->prepare($uquery);
1085         $usth->execute;
1086         $usth->finish;
1087         $uquery = "update items set paidfor='' where itemnumber=$itm";
1088         $usth = $dbh->prepare($uquery);
1089         $usth->execute;
1090         $usth->finish;
1091     }
1092     $sth->finish;
1093     return;
1094 }
1095
1096 # Not exported
1097 sub fixoverduesonreturn {
1098     my ($brn, $itm) = @_;
1099     my $dbh = C4::Context->dbh;
1100     $itm = $dbh->quote($itm);
1101     $brn = $dbh->quote($brn);
1102 # check for overdue fine
1103     my $query = "select * from accountlines where (borrowernumber=$brn)
1104                            and (itemnumber = $itm) and (accounttype='FU' or accounttype='O')";
1105     my $sth = $dbh->prepare($query);
1106     $sth->execute;
1107 # alter fine to show that the book has been returned
1108     if (my $data = $sth->fetchrow_hashref) {
1109         my $query = "update accountlines set accounttype='F' where (borrowernumber = $brn)
1110                            and (itemnumber = $itm) and (acccountno='$data->{'accountno'}')";
1111         my $usth=$dbh->prepare($query);
1112         $usth->execute();
1113         $usth->finish();
1114     }
1115     $sth->finish;
1116     return;
1117 }
1118
1119 # Not exported
1120 #
1121 # NOTE!: If you change this function, be sure to update the POD for
1122 # &getpatroninformation.
1123 #
1124 # $flags = &patronflags($env, $patron, $dbh);
1125 #
1126 # $flags->{CHARGES}
1127 #               {message}       Message showing patron's credit or debt
1128 #               {noissues}      Set if patron owes >$5.00
1129 #         {GNA}                 Set if patron gone w/o address
1130 #               {message}       "Borrower has no valid address"
1131 #               {noissues}      Set.
1132 #         {LOST}                Set if patron's card reported lost
1133 #               {message}       Message to this effect
1134 #               {noissues}      Set.
1135 #         {DBARRED}             Set is patron is debarred
1136 #               {message}       Message to this effect
1137 #               {noissues}      Set.
1138 #         {NOTES}               Set if patron has notes
1139 #               {message}       Notes about patron
1140 #         {ODUES}               Set if patron has overdue books
1141 #               {message}       "Yes"
1142 #               {itemlist}      ref-to-array: list of overdue books
1143 #               {itemlisttext}  Text list of overdue items
1144 #         {WAITING}             Set if there are items available that the
1145 #                               patron reserved
1146 #               {message}       Message to this effect
1147 #               {itemlist}      ref-to-array: list of available items
1148 sub patronflags {
1149 # Original subroutine for Circ2.pm
1150     my %flags;
1151     my ($env, $patroninformation, $dbh) = @_;
1152     my $amount = checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh);
1153     if ($amount > 0) {
1154         my %flaginfo;
1155         $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount;
1156         if ($amount > 5) {
1157             $flaginfo{'noissues'} = 1;
1158         }
1159         $flags{'CHARGES'} = \%flaginfo;
1160     } elsif ($amount < 0){
1161        my %flaginfo;
1162        $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
1163         $flags{'CHARGES'} = \%flaginfo;
1164     }
1165     if ($patroninformation->{'gonenoaddress'} == 1) {
1166         my %flaginfo;
1167         $flaginfo{'message'} = 'Borrower has no valid address.';
1168         $flaginfo{'noissues'} = 1;
1169         $flags{'GNA'} = \%flaginfo;
1170     }
1171     if ($patroninformation->{'lost'} == 1) {
1172         my %flaginfo;
1173         $flaginfo{'message'} = 'Borrower\'s card reported lost.';
1174         $flaginfo{'noissues'} = 1;
1175         $flags{'LOST'} = \%flaginfo;
1176     }
1177     if ($patroninformation->{'debarred'} == 1) {
1178         my %flaginfo;
1179         $flaginfo{'message'} = 'Borrower is Debarred.';
1180         $flaginfo{'noissues'} = 1;
1181         $flags{'DBARRED'} = \%flaginfo;
1182     }
1183     if ($patroninformation->{'borrowernotes'}) {
1184         my %flaginfo;
1185         $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
1186         $flags{'NOTES'} = \%flaginfo;
1187     }
1188     my ($odues, $itemsoverdue)
1189                   = checkoverdues($env, $patroninformation->{'borrowernumber'}, $dbh);
1190     if ($odues > 0) {
1191         my %flaginfo;
1192         $flaginfo{'message'} = "Yes";
1193         $flaginfo{'itemlist'} = $itemsoverdue;
1194         foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) {
1195             $flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
1196         }
1197         $flags{'ODUES'} = \%flaginfo;
1198     }
1199     my ($nowaiting, $itemswaiting)
1200                   = CheckWaiting($patroninformation->{'borrowernumber'});
1201     if ($nowaiting > 0) {
1202         my %flaginfo;
1203         $flaginfo{'message'} = "Reserved items available";
1204         $flaginfo{'itemlist'} = $itemswaiting;
1205         $flags{'WAITING'} = \%flaginfo;
1206     }
1207     return(\%flags);
1208 }
1209
1210
1211 # Not exported
1212 sub checkoverdues {
1213 # From Main.pm, modified to return a list of overdueitems, in addition to a count
1214   #checks whether a borrower has overdue items
1215   my ($env, $bornum, $dbh)=@_;
1216   my @datearr = localtime;
1217   my $today = ($datearr[5] + 1900)."-".($datearr[4]+1)."-".$datearr[3];
1218   my @overdueitems;
1219   my $count = 0;
1220   my $query = "SELECT * FROM issues,biblio,biblioitems,items
1221                        WHERE items.biblioitemnumber = biblioitems.biblioitemnumber
1222                          AND items.biblionumber     = biblio.biblionumber
1223                          AND issues.itemnumber      = items.itemnumber
1224                          AND issues.borrowernumber  = $bornum
1225                          AND issues.returndate is NULL
1226                          AND issues.date_due < '$today'";
1227   my $sth = $dbh->prepare($query);
1228   $sth->execute;
1229   while (my $data = $sth->fetchrow_hashref) {
1230       push (@overdueitems, $data);
1231       $count++;
1232   }
1233   $sth->finish;
1234   return ($count, \@overdueitems);
1235 }
1236
1237 # Not exported
1238 sub currentborrower {
1239 # Original subroutine for Circ2.pm
1240     my ($itemnumber) = @_;
1241     my $dbh = C4::Context->dbh;
1242     my $q_itemnumber = $dbh->quote($itemnumber);
1243     my $sth=$dbh->prepare("select borrowers.borrowernumber from
1244     issues,borrowers where issues.itemnumber=$q_itemnumber and
1245     issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
1246     NULL");
1247     $sth->execute;
1248     my ($borrower) = $sth->fetchrow;
1249     return($borrower);
1250 }
1251
1252 # FIXME - Not exported, but used in 'updateitem.pl' anyway.
1253 sub checkreserve {
1254 # Stolen from Main.pm
1255   # Check for reserves for biblio
1256   my ($env,$dbh,$itemnum)=@_;
1257   my $resbor = "";
1258   my $query = "select * from reserves,items
1259     where (items.itemnumber = '$itemnum')
1260     and (reserves.cancellationdate is NULL)
1261     and (items.biblionumber = reserves.biblionumber)
1262     and ((reserves.found = 'W')
1263     or (reserves.found is null))
1264     order by priority";
1265   my $sth = $dbh->prepare($query);
1266   $sth->execute();
1267   my $resrec;
1268   my $data=$sth->fetchrow_hashref;
1269   while ($data && $resbor eq '') {
1270     $resrec=$data;
1271     my $const = $data->{'constrainttype'};
1272     if ($const eq "a") {
1273       $resbor = $data->{'borrowernumber'};
1274     } else {
1275       my $found = 0;
1276       my $cquery = "select * from reserveconstraints,items
1277          where (borrowernumber='$data->{'borrowernumber'}')
1278          and reservedate='$data->{'reservedate'}'
1279          and reserveconstraints.biblionumber='$data->{'biblionumber'}'
1280          and (items.itemnumber=$itemnum and
1281          items.biblioitemnumber = reserveconstraints.biblioitemnumber)";
1282       my $csth = $dbh->prepare($cquery);
1283       $csth->execute;
1284       if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
1285       if ($const eq 'o') {
1286         if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
1287       } else {
1288         if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
1289       }
1290       $csth->finish();
1291     }
1292     $data=$sth->fetchrow_hashref;
1293   }
1294   $sth->finish;
1295   return ($resbor,$resrec);
1296 }
1297
1298 =item currentissues
1299
1300   $issues = &currentissues($env, $borrower);
1301
1302 Returns a list of books currently on loan to a patron.
1303
1304 If C<$env-E<gt>{todaysissues}> is set and true, C<&currentissues> only
1305 returns information about books issued today. If
1306 C<$env-E<gt>{nottodaysissues}> is set and true, C<&currentissues> only
1307 returns information about books issued before today. If both are
1308 specified, C<$env-E<gt>{todaysissues}> is ignored. If neither is
1309 specified, C<&currentissues> returns all of the patron's issues.
1310
1311 C<$borrower->{borrowernumber}> is the borrower number of the patron
1312 whose issues we want to list.
1313
1314 C<&currentissues> returns a PHP-style array: C<$issues> is a
1315 reference-to-hash whose keys are integers in the range 1...I<n>, where
1316 I<n> is the number of items on issue (either today or before today).
1317 C<$issues-E<gt>{I<n>}> is a reference-to-hash whose keys are all of
1318 the fields of the biblio, biblioitems, items, and issues fields of the
1319 Koha database for that particular item.
1320
1321 =cut
1322 #'
1323 sub currentissues {
1324 # New subroutine for Circ2.pm
1325     my ($env, $borrower) = @_;
1326     my $dbh = C4::Context->dbh;
1327     my %currentissues;
1328     my $counter=1;
1329     my $borrowernumber = $borrower->{'borrowernumber'};
1330     my $crit='';
1331
1332     # Figure out whether to get the books issued today, or earlier.
1333     # FIXME - $env->{todaysissues} and $env->{nottodaysissues} can
1334     # both be specified, but are mutually-exclusive. This is bogus.
1335     # Make this a flag. Or better yet, return everything in (reverse)
1336     # chronological order and let the caller figure out which books
1337     # were issued today.
1338     if ($env->{'todaysissues'}) {
1339         # FIXME - Could use
1340         #       $today = POSIX::strftime("%Y%m%d", localtime);
1341         # FIXME - Since $today will be used in either case, move it
1342         # out of the two if-blocks.
1343         my @datearr = localtime(time());
1344         my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
1345         # FIXME - MySQL knows about dates. Just use
1346         #       and issues.timestamp = curdate();
1347         $crit=" and issues.timestamp like '$today%' ";
1348     }
1349     if ($env->{'nottodaysissues'}) {
1350         # FIXME - Could use
1351         #       $today = POSIX::strftime("%Y%m%d", localtime);
1352         # FIXME - Since $today will be used in either case, move it
1353         # out of the two if-blocks.
1354         my @datearr = localtime(time());
1355         my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
1356         # FIXME - MySQL knows about dates. Just use
1357         #       and issues.timestamp < curdate();
1358         $crit=" and !(issues.timestamp like '$today%') ";
1359     }
1360
1361     # FIXME - Does the caller really need every single field from all
1362     # four tables?
1363     my $select="select * from issues,items,biblioitems,biblio where
1364        borrowernumber='$borrowernumber' and issues.itemnumber=items.itemnumber and
1365        items.biblionumber=biblio.biblionumber and
1366        items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is null
1367        $crit order by issues.date_due";
1368 #    warn $select;
1369     my $sth=$dbh->prepare($select);
1370     $sth->execute;
1371     while (my $data = $sth->fetchrow_hashref) {
1372         # FIXME - The Dewey code is a string, not a number.
1373         $data->{'dewey'}=~s/0*$//;
1374         ($data->{'dewey'} == 0) && ($data->{'dewey'}='');
1375         # FIXME - Could use
1376         #       $todaysdate = POSIX::strftime("%Y%m%d", localtime)
1377         # or better yet, just reuse $today which was calculated above.
1378         # This function isn't going to run until midnight, is it?
1379         # Alternately, use
1380         #       $todaysdate = POSIX::strftime("%Y-%m-%d", localtime)
1381         #       if ($data->{'date_due'} lt $todaysdate)
1382         #               ...
1383         # Either way, the date should be be formatted outside of the
1384         # loop.
1385         my @datearr = localtime(time());
1386         my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]
1387         +1)).sprintf ("%0.2d", $datearr[3]);
1388         my $datedue=$data->{'date_due'};
1389         $datedue=~s/-//g;
1390         if ($datedue < $todaysdate) {
1391             $data->{'overdue'}=1;
1392         }
1393         my $itemnumber=$data->{'itemnumber'};
1394         # FIXME - Consecutive integers as hash keys? You have GOT to
1395         # be kidding me! Use an array, fercrissakes!
1396         $currentissues{$counter}=$data;
1397         $counter++;
1398     }
1399     $sth->finish;
1400     return(\%currentissues);
1401 }
1402
1403 =item getissues
1404
1405   $issues = &getissues($borrowernumber);
1406
1407 Returns the set of books currently on loan to a patron.
1408
1409 C<$borrowernumber> is the patron's borrower number.
1410
1411 C<&getissues> returns a PHP-style array: C<$issues> is a
1412 reference-to-hash whose keys are integers in the range 0..I<n>-1,
1413 where I<n> is the number of books the patron currently has on loan.
1414
1415 The values of C<$issues> are references-to-hash whose keys are
1416 selected fields from the issues, items, biblio, and biblioitems tables
1417 of the Koha database.
1418
1419 =cut
1420 #'
1421 sub getissues {
1422 # New subroutine for Circ2.pm
1423     my ($borrower) = @_;
1424     my $dbh = C4::Context->dbh;
1425     my $borrowernumber = $borrower->{'borrowernumber'};
1426     my %currentissues;
1427     my $select = "SELECT issues.timestamp      AS timestamp,
1428                          issues.date_due       AS date_due,
1429                          items.biblionumber    AS biblionumber,
1430                          items.itemnumber    AS itemnumber,
1431                          items.barcode         AS barcode,
1432                          biblio.title          AS title,
1433                          biblio.author         AS author,
1434                          biblioitems.dewey     AS dewey,
1435                          itemtypes.description AS itemtype,
1436                          biblioitems.subclass  AS subclass
1437                     FROM issues,items,biblioitems,biblio, itemtypes
1438                    WHERE issues.borrowernumber  = ?
1439                      AND issues.itemnumber      = items.itemnumber
1440                      AND items.biblionumber     = biblio.biblionumber
1441                      AND items.biblioitemnumber = biblioitems.biblioitemnumber
1442                      AND itemtypes.itemtype     = biblioitems.itemtype
1443                      AND issues.returndate      IS NULL
1444                 ORDER BY issues.date_due";
1445 #    print $select;
1446     my $sth=$dbh->prepare($select);
1447     $sth->execute($borrowernumber);
1448     my $counter = 0;
1449     while (my $data = $sth->fetchrow_hashref) {
1450         $data->{'dewey'} =~ s/0*$//;
1451         ($data->{'dewey'} == 0) && ($data->{'dewey'} = '');
1452                 # FIXME - The Dewey code is a string, not a number.
1453         # FIXME - Use POSIX::strftime to get a text version of today's
1454         # date. That's what it's for.
1455         # FIXME - Move the date calculation outside of the loop.
1456         my @datearr = localtime(time());
1457         my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]);
1458
1459         # FIXME - Instead of converting the due date to YYYYMMDD, just
1460         # use
1461         #       $todaysdate = POSIX::strftime("%Y-%m-%d", localtime);
1462         #       ...
1463         #       if ($date->{date_due} lt $todaysdate)
1464         my $datedue = $data->{'date_due'};
1465         $datedue =~ s/-//g;
1466         if ($datedue < $todaysdate) {
1467             $data->{'overdue'} = 1;
1468         }
1469         $currentissues{$counter} = $data;
1470         $counter++;
1471                 # FIXME - This is ludicrous. If you want to return an
1472                 # array of values, just use an array. That's what
1473                 # they're there for.
1474     }
1475     $sth->finish;
1476     return(\%currentissues);
1477 }
1478
1479 # Not exported
1480 sub checkwaiting {
1481 #Stolen from Main.pm
1482   # check for reserves waiting
1483   my ($env,$dbh,$bornum)=@_;
1484   my @itemswaiting;
1485   my $query = "select * from reserves
1486     where (borrowernumber = '$bornum')
1487     and (reserves.found='W') and cancellationdate is NULL";
1488   my $sth = $dbh->prepare($query);
1489   $sth->execute();
1490   my $cnt=0;
1491   if (my $data=$sth->fetchrow_hashref) {
1492     $itemswaiting[$cnt] =$data;
1493     $cnt ++
1494   }
1495   $sth->finish;
1496   return ($cnt,\@itemswaiting);
1497 }
1498
1499 # Not exported
1500 # FIXME - This is nearly-identical to &C4::Accounts::checkaccount
1501 sub checkaccount  {
1502 # Stolen from Accounts.pm
1503   #take borrower number
1504   #check accounts and list amounts owing
1505   my ($env,$bornumber,$dbh,$date)=@_;
1506   my $select="SELECT SUM(amountoutstanding) AS total
1507                 FROM accountlines
1508                WHERE borrowernumber = $bornumber
1509                  AND amountoutstanding<>0";
1510   if ($date ne ''){
1511     $select.=" AND date < '$date'";
1512   }
1513 #  print $select;
1514   my $sth=$dbh->prepare($select);
1515   $sth->execute;
1516   my $data=$sth->fetchrow_hashref;
1517   my $total = $data->{'total'};
1518   $sth->finish;
1519   # output(1,2,"borrower owes $total");
1520   #if ($total > 0){
1521   #  # output(1,2,"borrower owes $total");
1522   #  if ($total > 5){
1523   #    reconcileaccount($env,$dbh,$bornumber,$total);
1524   #  }
1525   #}
1526   #  pause();
1527   return($total);
1528 }
1529
1530 # FIXME - This is identical to &C4::Circulation::Renewals::renewstatus.
1531 # Pick one and stick with it.
1532 sub renewstatus {
1533 # Stolen from Renewals.pm
1534   # check renewal status
1535   my ($env,$dbh,$bornum,$itemno)=@_;
1536   my $renews = 1;
1537   my $renewokay = 0;
1538   my $q1 = "select * from issues
1539     where (borrowernumber = '$bornum')
1540     and (itemnumber = '$itemno')
1541     and returndate is null";
1542   my $sth1 = $dbh->prepare($q1);
1543   $sth1->execute;
1544   if (my $data1 = $sth1->fetchrow_hashref) {
1545     my $q2 = "select renewalsallowed from items,biblioitems,itemtypes
1546        where (items.itemnumber = '$itemno')
1547        and (items.biblioitemnumber = biblioitems.biblioitemnumber)
1548        and (biblioitems.itemtype = itemtypes.itemtype)";
1549     my $sth2 = $dbh->prepare($q2);
1550     $sth2->execute;
1551     if (my $data2=$sth2->fetchrow_hashref) {
1552       $renews = $data2->{'renewalsallowed'};
1553     }
1554     if ($renews > $data1->{'renewals'}) {
1555       $renewokay = 1;
1556     }
1557     $sth2->finish;
1558   }
1559   $sth1->finish;
1560   return($renewokay);
1561 }
1562
1563 sub renewbook {
1564 # Stolen from Renewals.pm
1565   # mark book as renewed
1566   my ($env,$dbh,$bornum,$itemno,$datedue)=@_;
1567   $datedue=$env->{'datedue'};
1568   if ($datedue eq "" ) {
1569     my $loanlength=21;
1570     my $query= "Select * from biblioitems,items,itemtypes
1571        where (items.itemnumber = '$itemno')
1572        and (biblioitems.biblioitemnumber = items.biblioitemnumber)
1573        and (biblioitems.itemtype = itemtypes.itemtype)";
1574     my $sth=$dbh->prepare($query);
1575     $sth->execute;
1576     if (my $data=$sth->fetchrow_hashref) {
1577       $loanlength = $data->{'loanlength'}
1578     }
1579     $sth->finish;
1580     my $ti = time;
1581     my $datedu = time + ($loanlength * 86400);
1582     my @datearr = localtime($datedu);
1583     $datedue = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
1584   }
1585   my @date = split("-",$datedue);
1586   my $odatedue = ($date[2]+0)."-".($date[1]+0)."-".$date[0];
1587   my $issquery = "select * from issues where borrowernumber='$bornum' and
1588     itemnumber='$itemno' and returndate is null";
1589   my $sth=$dbh->prepare($issquery);
1590   $sth->execute;
1591   my $issuedata=$sth->fetchrow_hashref;
1592   $sth->finish;
1593   my $renews = $issuedata->{'renewals'} +1;
1594   my $updquery = "update issues
1595     set date_due = '$datedue', renewals = '$renews'
1596     where borrowernumber='$bornum' and
1597     itemnumber='$itemno' and returndate is null";
1598   $sth=$dbh->prepare($updquery);
1599
1600   $sth->execute;
1601   $sth->finish;
1602   return($odatedue);
1603 }
1604
1605 # FIXME - This is almost, but not quite, identical to
1606 # &C4::Circulation::Issues::calc_charges and
1607 # &C4::Circulation::Renewals2::calc_charges.
1608 # Pick one and stick with it.
1609 sub calc_charges {
1610 # Stolen from Issues.pm
1611 # calculate charges due
1612     my ($env, $dbh, $itemno, $bornum)=@_;
1613 #    if (!$dbh){
1614 #      $dbh=C4Connect();
1615 #    }
1616     my $charge=0;
1617 #    open (FILE,">>/tmp/charges");
1618     my $item_type;
1619     my $q1 = "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes
1620     where (items.itemnumber ='$itemno')
1621     and (biblioitems.biblioitemnumber = items.biblioitemnumber)
1622     and (biblioitems.itemtype = itemtypes.itemtype)";
1623     my $sth1= $dbh->prepare($q1);
1624 #    print FILE "$q1\n";
1625     $sth1->execute;
1626     if (my $data1=$sth1->fetchrow_hashref) {
1627         $item_type = $data1->{'itemtype'};
1628         $charge = $data1->{'rentalcharge'};
1629 #       print FILE "charge is $charge\n";
1630         my $q2 = "select rentaldiscount from borrowers,categoryitem
1631         where (borrowers.borrowernumber = '$bornum')
1632         and (borrowers.categorycode = categoryitem.categorycode)
1633         and (categoryitem.itemtype = '$item_type')";
1634         my $sth2=$dbh->prepare($q2);
1635 #       warn $q2;
1636         $sth2->execute;
1637         if (my $data2=$sth2->fetchrow_hashref) {
1638             my $discount = $data2->{'rentaldiscount'};
1639 #           print FILE "discount is $discount";
1640             if ($discount eq 'NULL') {
1641               $discount=0;
1642             }
1643             $charge = ($charge *(100 - $discount)) / 100;
1644         }
1645         $sth2->finish;
1646     }
1647     $sth1->finish;
1648 #    close FILE;
1649     return ($charge, $item_type);
1650 }
1651
1652 # FIXME - A virtually identical function appears in
1653 # C4::Circulation::Issues. Pick one and stick with it.
1654 sub createcharge {
1655 #Stolen from Issues.pm
1656     my ($env,$dbh,$itemno,$bornum,$charge) = @_;
1657     my $nextaccntno = getnextacctno($env,$bornum,$dbh);
1658     my $sth = $dbh->prepare(<<EOT);
1659         INSERT INTO     accountlines
1660                         (borrowernumber, itemnumber, accountno,
1661                          date, amount, description, accounttype,
1662                          amountoutstanding)
1663         VALUES          (?, ?, ?,
1664                          now(), ?, 'Rental', 'Rent',
1665                          ?)
1666 EOT
1667     $sth->execute($bornum, $itemno, $nextaccntno, $charge, $charge);
1668     $sth->finish;
1669 }
1670
1671
1672 sub getnextacctno {
1673 # Stolen from Accounts.pm
1674     my ($env,$bornumber,$dbh)=@_;
1675     my $nextaccntno = 1;
1676     my $query = "select * from accountlines where (borrowernumber = '$bornumber') order by accountno desc";
1677     my $sth = $dbh->prepare($query);
1678     $sth->execute;
1679     if (my $accdata=$sth->fetchrow_hashref){
1680         $nextaccntno = $accdata->{'accountno'} + 1;
1681     }
1682     $sth->finish;
1683     return($nextaccntno);
1684 }
1685
1686 =item find_reserves
1687
1688   ($status, $record) = &find_reserves($itemnumber);
1689
1690 Looks up an item in the reserves.
1691
1692 C<$itemnumber> is the itemnumber to look up.
1693
1694 C<$status> is true iff the search was successful.
1695
1696 C<$record> is a reference-to-hash describing the reserve. Its keys are
1697 the fields from the reserves table of the Koha database.
1698
1699 =cut
1700 #'
1701 # FIXME - This API is bogus: just return the record, or undef if none
1702 # was found.
1703 # FIXME - There's also a &C4::Circulation::Returns::find_reserves, but
1704 # that one looks rather different.
1705 sub find_reserves {
1706 # Stolen from Returns.pm
1707     my ($itemno) = @_;
1708     my %env;
1709     my $dbh = C4::Context->dbh;
1710     my ($itemdata) = getiteminformation(\%env, $itemno,0);
1711     my $bibno = $dbh->quote($itemdata->{'biblionumber'});
1712     my $bibitm = $dbh->quote($itemdata->{'biblioitemnumber'});
1713     my $query = "select * from reserves where ((found = 'W') or (found is null))
1714                        and biblionumber = $bibno and cancellationdate is NULL
1715                        order by priority, reservedate ";
1716     my $sth = $dbh->prepare($query);
1717     $sth->execute;
1718     my $resfound = 0;
1719     my $resrec;
1720     my $lastrec;
1721 # print $query;
1722
1723     # FIXME - I'm not really sure what's going on here, but since we
1724     # only want one result, wouldn't it be possible (and far more
1725     # efficient) to do something clever in SQL that only returns one
1726     # set of values?
1727     while (($resrec = $sth->fetchrow_hashref) && (not $resfound)) {
1728                 # FIXME - Unlike Pascal, Perl allows you to exit loops
1729                 # early. Take out the "&& (not $resfound)" and just
1730                 # use "last" at the appropriate point in the loop.
1731                 # (Oh, and just in passing: if you'd used "!" instead
1732                 # of "not", you wouldn't have needed the parentheses.)
1733         $lastrec = $resrec;
1734         my $brn = $dbh->quote($resrec->{'borrowernumber'});
1735         my $rdate = $dbh->quote($resrec->{'reservedate'});
1736         my $bibno = $dbh->quote($resrec->{'biblionumber'});
1737         if ($resrec->{'found'} eq "W") {
1738             if ($resrec->{'itemnumber'} eq $itemno) {
1739                 $resfound = 1;
1740             }
1741         } else {
1742             # FIXME - Use 'elsif' to avoid unnecessary indentation.
1743             if ($resrec->{'constrainttype'} eq "a") {
1744                 $resfound = 1;
1745             } else {
1746                 my $conquery = "select * from reserveconstraints where borrowernumber = $brn
1747                      and reservedate = $rdate and biblionumber = $bibno and biblioitemnumber = $bibitm";
1748                 my $consth = $dbh->prepare($conquery);
1749                 $consth->execute;
1750                 if (my $conrec = $consth->fetchrow_hashref) {
1751                     if ($resrec->{'constrainttype'} eq "o") {
1752                         $resfound = 1;
1753                     }
1754                 }
1755                 $consth->finish;
1756             }
1757         }
1758         if ($resfound) {
1759             my $updquery = "update reserves set found = 'W', itemnumber = '$itemno'
1760                   where borrowernumber = $brn and reservedate = $rdate and biblionumber = $bibno";
1761             my $updsth = $dbh->prepare($updquery);
1762             $updsth->execute;
1763             $updsth->finish;
1764             # FIXME - "last;" here to break out of the loop early.
1765         }
1766     }
1767     $sth->finish;
1768     return ($resfound,$lastrec);
1769 }
1770
1771 1;
1772 __END__
1773
1774 =back
1775
1776 =head1 AUTHOR
1777
1778 Koha Developement team <info@koha.org>
1779
1780 =cut