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
 830         if ($iteminformation->{'charge'}) {
 831                 $message=sprintf "Rental charge of \$%.02f applies.", $iteminformation->{'charge'};
 832         }
 833         return ($iteminformation, $dateduef, $rejected, $question, $questionnumber, $defaultanswer, $message);
 834 }
 835
 836
 837
 838 =item returnbook
 839
 840   ($doreturn, $messages, $iteminformation, $borrower) =
 841           &returnbook($barcode, $branch);
 842
 843 Returns a book.
 844
 845 C<$barcode> is the bar code of the book being returned. C<$branch> is
 846 the code of the branch where the book is being returned.
 847
 848 C<&returnbook> returns a list of four items:
 849
 850 C<$doreturn> is true iff the return succeeded.
 851
 852 C<$messages> is a reference-to-hash giving the reason for failure:
 853
 854 =over 4
 855
 856 =item C<BadBarcode>
 857
 858 No item with this barcode exists. The value is C<$barcode>.
 859
 860 =item C<NotIssued>
 861
 862 The book is not currently on loan. The value is C<$barcode>.
 863
 864 =item C<IsPermanent>
 865
 866 The book's home branch is a permanent collection. If you have borrowed
 867 this book, you are not allowed to return it. The value is the code for
 868 the book's home branch.
 869
 870 =item C<wthdrawn>
 871
 872 This book has been withdrawn/cancelled. The value should be ignored.
 873
 874 =item C<ResFound>
 875
 876 The item was reserved. The value is a reference-to-hash whose keys are
 877 fields from the reserves table of the Koha database, and
 878 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
 879 either C<Waiting>, C<Reserved>, or 0.
 880
 881 =back
 882
 883 C<$borrower> is a reference-to-hash, giving information about the
 884 patron who last borrowed the book.
 885
 886 =cut
 887 #'
 888 # FIXME - This API is bogus. There's no need to return $borrower and
 889 # $iteminformation; the caller can ask about those separately, if it
 890 # cares (it'd be inefficient to make two database calls instead of
 891 # one, but &getpatroninformation and &getiteminformation can be
 892 # memoized if this is an issue).
 893 #
 894 # The ($doreturn, $messages) tuple is redundant: if the return
 895 # succeeded, that's all the caller needs to know. So &returnbook can
 896 # return 1 and 0 on success and failure, and set
 897 # $C4::Circulation::Circ2::errmsg to indicate the error. Or it can
 898 # return undef for success, and an error message on error (though this
 899 # is more C-ish than Perl-ish).
 900 sub returnbook {
 901     my ($barcode, $branch) = @_;
 902     my %env;
 903     my $messages;
 904     my $doreturn = 1;
 905     die '$branch not defined' unless defined $branch; # just in case (bug 170)
 906 # get information on item
 907     my ($iteminformation) = getiteminformation(\%env, 0, $barcode);
 908     if (not $iteminformation) {
 909         $messages->{'BadBarcode'} = $barcode;
 910         $doreturn = 0;
 911     }
 912 # find the borrower
 913     my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
 914     if ((not $currentborrower) && $doreturn) {
 915         $messages->{'NotIssued'} = $barcode;
 916         $doreturn = 0;
 917     }
 918 # check if the book is in a permanent collection....
 919     my $hbr = $iteminformation->{'homebranch'};
 920     my $branches = getbranches();
 921     if ($branches->{$hbr}->{'PE'}) {
 922         $messages->{'IsPermanent'} = $hbr;
 923     }
 924 # check that the book has been cancelled
 925     if ($iteminformation->{'wthdrawn'}) {
 926         $messages->{'wthdrawn'} = 1;
 927         $doreturn = 0;
 928     }
 929 # update issues, thereby returning book (should push this out into another subroutine
 930     my ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
 931     if ($doreturn) {
 932         doreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
 933         $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
 934     }
 935     ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
 936 # transfer book to the current branch
 937     my ($transfered, $mess, $item) = transferbook($branch, $barcode, 1);
 938     if ($transfered) {
 939         $messages->{'WasTransfered'} = 1; # FIXME is the "= 1" right?
 940     }
 941 # fix up the accounts.....
 942     if ($iteminformation->{'itemlost'}) {
 943         # Mark the item as not being lost.
 944         updateitemlost($iteminformation->{'itemnumber'});
 945         fixaccountforlostandreturned($iteminformation, $borrower);
 946         $messages->{'WasLost'} = 1; # FIXME is the "= 1" right?
 947     }
 948 # fix up the overdues in accounts...
 949     fixoverduesonreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
 950 # find reserves.....
 951     my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
 952     if ($resfound) {
 953 #       my $tobrcd = ReserveWaiting($resrec->{'itemnumber'}, $resrec->{'borrowernumber'});
 954         $resrec->{'ResFound'} = $resfound;
 955 #       $messages->{'ResFound'} = $resrec;
 956     }
 957 # update stats?
 958 # Record the fact that this book was returned.
 959     UpdateStats(\%env, $branch ,'return','0','',$iteminformation->{'itemnumber'});
 960     return ($doreturn, $messages, $iteminformation, $borrower);
 961 }
 962
 963 # doreturn
 964 # Takes a borrowernumber and an itemnuber.
 965 # Updates the 'issues' table to mark the item as returned (assuming
 966 # that it's currently on loan to the given borrower. Otherwise, the
 967 # item remains on loan.
 968 # Updates items.datelastseen for the item.
 969 # Not exported
 970 # FIXME - This is only used in &returnbook. Why make it into a
 971 # separate function? (is this a recognizable step in the return process? - acli)
 972 sub doreturn {
 973     my ($brn, $itm) = @_;
 974     my $dbh = C4::Context->dbh;
 975     $brn = $dbh->quote($brn);
 976     $itm = $dbh->quote($itm);
 977     my $query = "update issues set returndate = now() where (borrowernumber = $brn)
 978         and (itemnumber = $itm) and (returndate is null)";
 979     my $sth = $dbh->prepare($query);
 980     $sth->execute;
 981     $sth->finish;
 982     $query="update items set datelastseen=now() where itemnumber=$itm";
 983     $sth=$dbh->prepare($query);
 984     $sth->execute;
 985     $sth->finish;
 986     return;
 987 }
 988
 989 # updateitemlost
 990 # Marks an item as not being lost.
 991 # Not exported
 992 sub updateitemlost{
 993   my ($itemno)=@_;
 994   my $dbh = C4::Context->dbh;
 995
 996   $dbh->do(<<EOT);
 997         UPDATE  items
 998         SET     itemlost = 0
 999         WHERE   itemnumber = $itemno
1000 EOT
1001 }
1002
1003 # Not exported
1004 sub fixaccountforlostandreturned {
1005     my ($iteminfo, $borrower) = @_;
1006     my %env;
1007     my $dbh = C4::Context->dbh;
1008     my $itm = $dbh->quote($iteminfo->{'itemnumber'});
1009 # check for charge made for lost book
1010     my $query = "select * from accountlines where (itemnumber = $itm)
1011                           and (accounttype='L' or accounttype='Rep') order by date desc";
1012     my $sth = $dbh->prepare($query);
1013     $sth->execute;
1014     if (my $data = $sth->fetchrow_hashref) {
1015 # writeoff this amount
1016         my $offset;
1017         my $amount = $data->{'amount'};
1018         my $acctno = $data->{'accountno'};
1019         my $amountleft;
1020         if ($data->{'amountoutstanding'} == $amount) {
1021             $offset = $data->{'amount'};
1022             $amountleft = 0;
1023         } else {
1024             $offset = $amount - $data->{'amountoutstanding'};
1025             $amountleft = $data->{'amountoutstanding'} - $amount;
1026         }
1027         my $uquery = "update accountlines set accounttype = 'LR',amountoutstanding='0'
1028                   where (borrowernumber = '$data->{'borrowernumber'}')
1029                   and (itemnumber = $itm) and (accountno = '$acctno') ";
1030         my $usth = $dbh->prepare($uquery);
1031         $usth->execute;
1032         $usth->finish;
1033 #check if any credit is left if so writeoff other accounts
1034         my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
1035         if ($amountleft < 0){
1036             $amountleft*=-1;
1037         }
1038         if ($amountleft > 0){
1039             my $query = "select * from accountlines where (borrowernumber = '$data->{'borrowernumber'}')
1040                                                       and (amountoutstanding >0) order by date";
1041             my $msth = $dbh->prepare($query);
1042             $msth->execute;
1043       # offset transactions
1044             my $newamtos;
1045             my $accdata;
1046             while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1047                 if ($accdata->{'amountoutstanding'} < $amountleft) {
1048                     $newamtos = 0;
1049                     $amountleft -= $accdata->{'amountoutstanding'};
1050                 }  else {
1051                     $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1052                     $amountleft = 0;
1053                 }
1054                 my $thisacct = $accdata->{'accountno'};
1055                 my $updquery = "update accountlines set amountoutstanding= '$newamtos'
1056                                  where (borrowernumber = '$data->{'borrowernumber'}')
1057                                    and (accountno='$thisacct')";
1058                 my $usth = $dbh->prepare($updquery);
1059                 $usth->execute;
1060                 $usth->finish;
1061                 $updquery = "insert into accountoffsets
1062                           (borrowernumber, accountno, offsetaccount,  offsetamount)
1063                           values
1064                           ('$data->{'borrowernumber'}','$accdata->{'accountno'}','$nextaccntno','$newamtos')";
1065                 $usth = $dbh->prepare($updquery);
1066                 $usth->execute;
1067                 $usth->finish;
1068             }
1069             $msth->finish;
1070         }
1071         if ($amountleft > 0){
1072             $amountleft*=-1;
1073         }
1074         my $desc="Book Returned ".$iteminfo->{'barcode'};
1075         $uquery = "insert into accountlines
1076                   (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1077                   values ('$data->{'borrowernumber'}','$nextaccntno',now(),0-$amount,'$desc',
1078                   'CR',$amountleft)";
1079         $usth = $dbh->prepare($uquery);
1080         $usth->execute;
1081         $usth->finish;
1082         $uquery = "insert into accountoffsets
1083                   (borrowernumber, accountno, offsetaccount,  offsetamount)
1084                   values ($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset)";
1085         $usth = $dbh->prepare($uquery);
1086         $usth->execute;
1087         $usth->finish;
1088         $uquery = "update items set paidfor='' where itemnumber=$itm";
1089         $usth = $dbh->prepare($uquery);
1090         $usth->execute;
1091         $usth->finish;
1092     }
1093     $sth->finish;
1094     return;
1095 }
1096
1097 # Not exported
1098 sub fixoverduesonreturn {
1099     my ($brn, $itm) = @_;
1100     my $dbh = C4::Context->dbh;
1101     $itm = $dbh->quote($itm);
1102     $brn = $dbh->quote($brn);
1103 # check for overdue fine
1104     my $query = "select * from accountlines where (borrowernumber=$brn)
1105                            and (itemnumber = $itm) and (accounttype='FU' or accounttype='O')";
1106     my $sth = $dbh->prepare($query);
1107     $sth->execute;
1108 # alter fine to show that the book has been returned
1109     if (my $data = $sth->fetchrow_hashref) {
1110         my $query = "update accountlines set accounttype='F' where (borrowernumber = $brn)
1111                            and (itemnumber = $itm) and (acccountno='$data->{'accountno'}')";
1112         my $usth=$dbh->prepare($query);
1113         $usth->execute();
1114         $usth->finish();
1115     }
1116     $sth->finish;
1117     return;
1118 }
1119
1120 # Not exported
1121 #
1122 # NOTE!: If you change this function, be sure to update the POD for
1123 # &getpatroninformation.
1124 #
1125 # $flags = &patronflags($env, $patron, $dbh);
1126 #
1127 # $flags->{CHARGES}
1128 #               {message}       Message showing patron's credit or debt
1129 #               {noissues}      Set if patron owes >$5.00
1130 #         {GNA}                 Set if patron gone w/o address
1131 #               {message}       "Borrower has no valid address"
1132 #               {noissues}      Set.
1133 #         {LOST}                Set if patron's card reported lost
1134 #               {message}       Message to this effect
1135 #               {noissues}      Set.
1136 #         {DBARRED}             Set is patron is debarred
1137 #               {message}       Message to this effect
1138 #               {noissues}      Set.
1139 #         {NOTES}               Set if patron has notes
1140 #               {message}       Notes about patron
1141 #         {ODUES}               Set if patron has overdue books
1142 #               {message}       "Yes"
1143 #               {itemlist}      ref-to-array: list of overdue books
1144 #               {itemlisttext}  Text list of overdue items
1145 #         {WAITING}             Set if there are items available that the
1146 #                               patron reserved
1147 #               {message}       Message to this effect
1148 #               {itemlist}      ref-to-array: list of available items
1149 sub patronflags {
1150 # Original subroutine for Circ2.pm
1151     my %flags;
1152     my ($env, $patroninformation, $dbh) = @_;
1153     my $amount = checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh);
1154     if ($amount > 0) {
1155         my %flaginfo;
1156         $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount;
1157         if ($amount > 5) {
1158             $flaginfo{'noissues'} = 1;
1159         }
1160         $flags{'CHARGES'} = \%flaginfo;
1161     } elsif ($amount < 0){
1162        my %flaginfo;
1163        $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
1164         $flags{'CHARGES'} = \%flaginfo;
1165     }
1166     if ($patroninformation->{'gonenoaddress'} == 1) {
1167         my %flaginfo;
1168         $flaginfo{'message'} = 'Borrower has no valid address.';
1169         $flaginfo{'noissues'} = 1;
1170         $flags{'GNA'} = \%flaginfo;
1171     }
1172     if ($patroninformation->{'lost'} == 1) {
1173         my %flaginfo;
1174         $flaginfo{'message'} = 'Borrower\'s card reported lost.';
1175         $flaginfo{'noissues'} = 1;
1176         $flags{'LOST'} = \%flaginfo;
1177     }
1178     if ($patroninformation->{'debarred'} == 1) {
1179         my %flaginfo;
1180         $flaginfo{'message'} = 'Borrower is Debarred.';
1181         $flaginfo{'noissues'} = 1;
1182         $flags{'DBARRED'} = \%flaginfo;
1183     }
1184     if ($patroninformation->{'borrowernotes'}) {
1185         my %flaginfo;
1186         $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
1187         $flags{'NOTES'} = \%flaginfo;
1188     }
1189     my ($odues, $itemsoverdue)
1190                   = checkoverdues($env, $patroninformation->{'borrowernumber'}, $dbh);
1191     if ($odues > 0) {
1192         my %flaginfo;
1193         $flaginfo{'message'} = "Yes";
1194         $flaginfo{'itemlist'} = $itemsoverdue;
1195         foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) {
1196             $flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
1197         }
1198         $flags{'ODUES'} = \%flaginfo;
1199     }
1200     my ($nowaiting, $itemswaiting)
1201                   = CheckWaiting($patroninformation->{'borrowernumber'});
1202     if ($nowaiting > 0) {
1203         my %flaginfo;
1204         $flaginfo{'message'} = "Reserved items available";
1205         $flaginfo{'itemlist'} = $itemswaiting;
1206         $flags{'WAITING'} = \%flaginfo;
1207     }
1208     return(\%flags);
1209 }
1210
1211
1212 # Not exported
1213 sub checkoverdues {
1214 # From Main.pm, modified to return a list of overdueitems, in addition to a count
1215   #checks whether a borrower has overdue items
1216   my ($env, $bornum, $dbh)=@_;
1217   my @datearr = localtime;
1218   my $today = ($datearr[5] + 1900)."-".($datearr[4]+1)."-".$datearr[3];
1219   my @overdueitems;
1220   my $count = 0;
1221   my $query = "SELECT * FROM issues,biblio,biblioitems,items
1222                        WHERE items.biblioitemnumber = biblioitems.biblioitemnumber
1223                          AND items.biblionumber     = biblio.biblionumber
1224                          AND issues.itemnumber      = items.itemnumber
1225                          AND issues.borrowernumber  = $bornum
1226                          AND issues.returndate is NULL
1227                          AND issues.date_due < '$today'";
1228   my $sth = $dbh->prepare($query);
1229   $sth->execute;
1230   while (my $data = $sth->fetchrow_hashref) {
1231       push (@overdueitems, $data);
1232       $count++;
1233   }
1234   $sth->finish;
1235   return ($count, \@overdueitems);
1236 }
1237
1238 # Not exported
1239 sub currentborrower {
1240 # Original subroutine for Circ2.pm
1241     my ($itemnumber) = @_;
1242     my $dbh = C4::Context->dbh;
1243     my $q_itemnumber = $dbh->quote($itemnumber);
1244     my $sth=$dbh->prepare("select borrowers.borrowernumber from
1245     issues,borrowers where issues.itemnumber=$q_itemnumber and
1246     issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
1247     NULL");
1248     $sth->execute;
1249     my ($borrower) = $sth->fetchrow;
1250     return($borrower);
1251 }
1252
1253 # FIXME - Not exported, but used in 'updateitem.pl' anyway.
1254 sub checkreserve {
1255 # Stolen from Main.pm
1256   # Check for reserves for biblio
1257   my ($env,$dbh,$itemnum)=@_;
1258   my $resbor = "";
1259   my $query = "select * from reserves,items
1260     where (items.itemnumber = '$itemnum')
1261     and (reserves.cancellationdate is NULL)
1262     and (items.biblionumber = reserves.biblionumber)
1263     and ((reserves.found = 'W')
1264     or (reserves.found is null))
1265     order by priority";
1266   my $sth = $dbh->prepare($query);
1267   $sth->execute();
1268   my $resrec;
1269   my $data=$sth->fetchrow_hashref;
1270   while ($data && $resbor eq '') {
1271     $resrec=$data;
1272     my $const = $data->{'constrainttype'};
1273     if ($const eq "a") {
1274       $resbor = $data->{'borrowernumber'};
1275     } else {
1276       my $found = 0;
1277       my $cquery = "select * from reserveconstraints,items
1278          where (borrowernumber='$data->{'borrowernumber'}')
1279          and reservedate='$data->{'reservedate'}'
1280          and reserveconstraints.biblionumber='$data->{'biblionumber'}'
1281          and (items.itemnumber=$itemnum and
1282          items.biblioitemnumber = reserveconstraints.biblioitemnumber)";
1283       my $csth = $dbh->prepare($cquery);
1284       $csth->execute;
1285       if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
1286       if ($const eq 'o') {
1287         if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
1288       } else {
1289         if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
1290       }
1291       $csth->finish();
1292     }
1293     $data=$sth->fetchrow_hashref;
1294   }
1295   $sth->finish;
1296   return ($resbor,$resrec);
1297 }
1298
1299 =item currentissues
1300
1301   $issues = &currentissues($env, $borrower);
1302
1303 Returns a list of books currently on loan to a patron.
1304
1305 If C<$env-E<gt>{todaysissues}> is set and true, C<&currentissues> only
1306 returns information about books issued today. If
1307 C<$env-E<gt>{nottodaysissues}> is set and true, C<&currentissues> only
1308 returns information about books issued before today. If both are
1309 specified, C<$env-E<gt>{todaysissues}> is ignored. If neither is
1310 specified, C<&currentissues> returns all of the patron's issues.
1311
1312 C<$borrower->{borrowernumber}> is the borrower number of the patron
1313 whose issues we want to list.
1314
1315 C<&currentissues> returns a PHP-style array: C<$issues> is a
1316 reference-to-hash whose keys are integers in the range 1...I<n>, where
1317 I<n> is the number of items on issue (either today or before today).
1318 C<$issues-E<gt>{I<n>}> is a reference-to-hash whose keys are all of
1319 the fields of the biblio, biblioitems, items, and issues fields of the
1320 Koha database for that particular item.
1321
1322 =cut
1323 #'
1324 sub currentissues {
1325 # New subroutine for Circ2.pm
1326     my ($env, $borrower) = @_;
1327     my $dbh = C4::Context->dbh;
1328     my %currentissues;
1329     my $counter=1;
1330     my $borrowernumber = $borrower->{'borrowernumber'};
1331     my $crit='';
1332
1333     # Figure out whether to get the books issued today, or earlier.
1334     # FIXME - $env->{todaysissues} and $env->{nottodaysissues} can
1335     # both be specified, but are mutually-exclusive. This is bogus.
1336     # Make this a flag. Or better yet, return everything in (reverse)
1337     # chronological order and let the caller figure out which books
1338     # were issued today.
1339     if ($env->{'todaysissues'}) {
1340         # FIXME - Could use
1341         #       $today = POSIX::strftime("%Y%m%d", localtime);
1342         # FIXME - Since $today will be used in either case, move it
1343         # out of the two if-blocks.
1344         my @datearr = localtime(time());
1345         my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
1346         # FIXME - MySQL knows about dates. Just use
1347         #       and issues.timestamp = curdate();
1348         $crit=" and issues.timestamp like '$today%' ";
1349     }
1350     if ($env->{'nottodaysissues'}) {
1351         # FIXME - Could use
1352         #       $today = POSIX::strftime("%Y%m%d", localtime);
1353         # FIXME - Since $today will be used in either case, move it
1354         # out of the two if-blocks.
1355         my @datearr = localtime(time());
1356         my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
1357         # FIXME - MySQL knows about dates. Just use
1358         #       and issues.timestamp < curdate();
1359         $crit=" and !(issues.timestamp like '$today%') ";
1360     }
1361
1362     # FIXME - Does the caller really need every single field from all
1363     # four tables?
1364     my $select="select * from issues,items,biblioitems,biblio where
1365        borrowernumber='$borrowernumber' and issues.itemnumber=items.itemnumber and
1366        items.biblionumber=biblio.biblionumber and
1367        items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is null
1368        $crit order by issues.date_due";
1369 #    warn $select;
1370     my $sth=$dbh->prepare($select);
1371     $sth->execute;
1372     while (my $data = $sth->fetchrow_hashref) {
1373         # FIXME - The Dewey code is a string, not a number.
1374         $data->{'dewey'}=~s/0*$//;
1375         ($data->{'dewey'} == 0) && ($data->{'dewey'}='');
1376         # FIXME - Could use
1377         #       $todaysdate = POSIX::strftime("%Y%m%d", localtime)
1378         # or better yet, just reuse $today which was calculated above.
1379         # This function isn't going to run until midnight, is it?
1380         # Alternately, use
1381         #       $todaysdate = POSIX::strftime("%Y-%m-%d", localtime)
1382         #       if ($data->{'date_due'} lt $todaysdate)
1383         #               ...
1384         # Either way, the date should be be formatted outside of the
1385         # loop.
1386         my @datearr = localtime(time());
1387         my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]
1388         +1)).sprintf ("%0.2d", $datearr[3]);
1389         my $datedue=$data->{'date_due'};
1390         $datedue=~s/-//g;
1391         if ($datedue < $todaysdate) {
1392             $data->{'overdue'}=1;
1393         }
1394         my $itemnumber=$data->{'itemnumber'};
1395         # FIXME - Consecutive integers as hash keys? You have GOT to
1396         # be kidding me! Use an array, fercrissakes!
1397         $currentissues{$counter}=$data;
1398         $counter++;
1399     }
1400     $sth->finish;
1401     return(\%currentissues);
1402 }
1403
1404 =item getissues
1405
1406   $issues = &getissues($borrowernumber);
1407
1408 Returns the set of books currently on loan to a patron.
1409
1410 C<$borrowernumber> is the patron's borrower number.
1411
1412 C<&getissues> returns a PHP-style array: C<$issues> is a
1413 reference-to-hash whose keys are integers in the range 0..I<n>-1,
1414 where I<n> is the number of books the patron currently has on loan.
1415
1416 The values of C<$issues> are references-to-hash whose keys are
1417 selected fields from the issues, items, biblio, and biblioitems tables
1418 of the Koha database.
1419
1420 =cut
1421 #'
1422 sub getissues {
1423 # New subroutine for Circ2.pm
1424     my ($borrower) = @_;
1425     my $dbh = C4::Context->dbh;
1426     my $borrowernumber = $borrower->{'borrowernumber'};
1427     my %currentissues;
1428     my $select = "SELECT issues.timestamp      AS timestamp,
1429                          issues.date_due       AS date_due,
1430                          items.biblionumber    AS biblionumber,
1431                          items.itemnumber    AS itemnumber,
1432                          items.barcode         AS barcode,
1433                          biblio.title          AS title,
1434                          biblio.author         AS author,
1435                          biblioitems.dewey     AS dewey,
1436                          itemtypes.description AS itemtype,
1437                          biblioitems.subclass  AS subclass
1438                     FROM issues,items,biblioitems,biblio, itemtypes
1439                    WHERE issues.borrowernumber  = ?
1440                      AND issues.itemnumber      = items.itemnumber
1441                      AND items.biblionumber     = biblio.biblionumber
1442                      AND items.biblioitemnumber = biblioitems.biblioitemnumber
1443                      AND itemtypes.itemtype     = biblioitems.itemtype
1444                      AND issues.returndate      IS NULL
1445                 ORDER BY issues.date_due";
1446 #    print $select;
1447     my $sth=$dbh->prepare($select);
1448     $sth->execute($borrowernumber);
1449     my $counter = 0;
1450     while (my $data = $sth->fetchrow_hashref) {
1451         $data->{'dewey'} =~ s/0*$//;
1452         ($data->{'dewey'} == 0) && ($data->{'dewey'} = '');
1453                 # FIXME - The Dewey code is a string, not a number.
1454         # FIXME - Use POSIX::strftime to get a text version of today's
1455         # date. That's what it's for.
1456         # FIXME - Move the date calculation outside of the loop.
1457         my @datearr = localtime(time());
1458         my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]);
1459
1460         # FIXME - Instead of converting the due date to YYYYMMDD, just
1461         # use
1462         #       $todaysdate = POSIX::strftime("%Y-%m-%d", localtime);
1463         #       ...
1464         #       if ($date->{date_due} lt $todaysdate)
1465         my $datedue = $data->{'date_due'};
1466         $datedue =~ s/-//g;
1467         if ($datedue < $todaysdate) {
1468             $data->{'overdue'} = 1;
1469         }
1470         $currentissues{$counter} = $data;
1471         $counter++;
1472                 # FIXME - This is ludicrous. If you want to return an
1473                 # array of values, just use an array. That's what
1474                 # they're there for.
1475     }
1476     $sth->finish;
1477     return(\%currentissues);
1478 }
1479
1480 # Not exported
1481 sub checkwaiting {
1482 #Stolen from Main.pm
1483   # check for reserves waiting
1484   my ($env,$dbh,$bornum)=@_;
1485   my @itemswaiting;
1486   my $query = "select * from reserves
1487     where (borrowernumber = '$bornum')
1488     and (reserves.found='W') and cancellationdate is NULL";
1489   my $sth = $dbh->prepare($query);
1490   $sth->execute();
1491   my $cnt=0;
1492   if (my $data=$sth->fetchrow_hashref) {
1493     $itemswaiting[$cnt] =$data;
1494     $cnt ++
1495   }
1496   $sth->finish;
1497   return ($cnt,\@itemswaiting);
1498 }
1499
1500 # Not exported
1501 # FIXME - This is nearly-identical to &C4::Accounts::checkaccount
1502 sub checkaccount  {
1503 # Stolen from Accounts.pm
1504   #take borrower number
1505   #check accounts and list amounts owing
1506   my ($env,$bornumber,$dbh,$date)=@_;
1507   my $select="SELECT SUM(amountoutstanding) AS total
1508                 FROM accountlines
1509                WHERE borrowernumber = $bornumber
1510                  AND amountoutstanding<>0";
1511   if ($date ne ''){
1512     $select.=" AND date < '$date'";
1513   }
1514 #  print $select;
1515   my $sth=$dbh->prepare($select);
1516   $sth->execute;
1517   my $data=$sth->fetchrow_hashref;
1518   my $total = $data->{'total'};
1519   $sth->finish;
1520   # output(1,2,"borrower owes $total");
1521   #if ($total > 0){
1522   #  # output(1,2,"borrower owes $total");
1523   #  if ($total > 5){
1524   #    reconcileaccount($env,$dbh,$bornumber,$total);
1525   #  }
1526   #}
1527   #  pause();
1528   return($total);
1529 }
1530
1531 # FIXME - This is identical to &C4::Circulation::Renewals::renewstatus.
1532 # Pick one and stick with it.
1533 sub renewstatus {
1534 # Stolen from Renewals.pm
1535   # check renewal status
1536   my ($env,$dbh,$bornum,$itemno)=@_;
1537   my $renews = 1;
1538   my $renewokay = 0;
1539   my $q1 = "select * from issues
1540     where (borrowernumber = '$bornum')
1541     and (itemnumber = '$itemno')
1542     and returndate is null";
1543   my $sth1 = $dbh->prepare($q1);
1544   $sth1->execute;
1545   if (my $data1 = $sth1->fetchrow_hashref) {
1546     my $q2 = "select renewalsallowed from items,biblioitems,itemtypes
1547        where (items.itemnumber = '$itemno')
1548        and (items.biblioitemnumber = biblioitems.biblioitemnumber)
1549        and (biblioitems.itemtype = itemtypes.itemtype)";
1550     my $sth2 = $dbh->prepare($q2);
1551     $sth2->execute;
1552     if (my $data2=$sth2->fetchrow_hashref) {
1553       $renews = $data2->{'renewalsallowed'};
1554     }
1555     if ($renews > $data1->{'renewals'}) {
1556       $renewokay = 1;
1557     }
1558     $sth2->finish;
1559   }
1560   $sth1->finish;
1561   return($renewokay);
1562 }
1563
1564 sub renewbook {
1565 # Stolen from Renewals.pm
1566   # mark book as renewed
1567   my ($env,$dbh,$bornum,$itemno,$datedue)=@_;
1568   $datedue=$env->{'datedue'};
1569   if ($datedue eq "" ) {
1570     my $loanlength=21;
1571     my $query= "Select * from biblioitems,items,itemtypes
1572        where (items.itemnumber = '$itemno')
1573        and (biblioitems.biblioitemnumber = items.biblioitemnumber)
1574        and (biblioitems.itemtype = itemtypes.itemtype)";
1575     my $sth=$dbh->prepare($query);
1576     $sth->execute;
1577     if (my $data=$sth->fetchrow_hashref) {
1578       $loanlength = $data->{'loanlength'}
1579     }
1580     $sth->finish;
1581     my $ti = time;
1582     my $datedu = time + ($loanlength * 86400);
1583     my @datearr = localtime($datedu);
1584     $datedue = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
1585   }
1586   my @date = split("-",$datedue);
1587   my $odatedue = ($date[2]+0)."-".($date[1]+0)."-".$date[0];
1588   my $issquery = "select * from issues where borrowernumber='$bornum' and
1589     itemnumber='$itemno' and returndate is null";
1590   my $sth=$dbh->prepare($issquery);
1591   $sth->execute;
1592   my $issuedata=$sth->fetchrow_hashref;
1593   $sth->finish;
1594   my $renews = $issuedata->{'renewals'} +1;
1595   my $updquery = "update issues
1596     set date_due = '$datedue', renewals = '$renews'
1597     where borrowernumber='$bornum' and
1598     itemnumber='$itemno' and returndate is null";
1599   $sth=$dbh->prepare($updquery);
1600
1601   $sth->execute;
1602   $sth->finish;
1603   return($odatedue);
1604 }
1605
1606 # FIXME - This is almost, but not quite, identical to
1607 # &C4::Circulation::Issues::calc_charges and
1608 # &C4::Circulation::Renewals2::calc_charges.
1609 # Pick one and stick with it.
1610 sub calc_charges {
1611 # Stolen from Issues.pm
1612 # calculate charges due
1613     my ($env, $dbh, $itemno, $bornum)=@_;
1614 #    if (!$dbh){
1615 #      $dbh=C4Connect();
1616 #    }
1617     my $charge=0;
1618 #    open (FILE,">>/tmp/charges");
1619     my $item_type;
1620     my $q1 = "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes
1621     where (items.itemnumber ='$itemno')
1622     and (biblioitems.biblioitemnumber = items.biblioitemnumber)
1623     and (biblioitems.itemtype = itemtypes.itemtype)";
1624     my $sth1= $dbh->prepare($q1);
1625 #    print FILE "$q1\n";
1626     $sth1->execute;
1627     if (my $data1=$sth1->fetchrow_hashref) {
1628         $item_type = $data1->{'itemtype'};
1629         $charge = $data1->{'rentalcharge'};
1630 #       print FILE "charge is $charge\n";
1631         my $q2 = "select rentaldiscount from borrowers,categoryitem
1632         where (borrowers.borrowernumber = '$bornum')
1633         and (borrowers.categorycode = categoryitem.categorycode)
1634         and (categoryitem.itemtype = '$item_type')";
1635         my $sth2=$dbh->prepare($q2);
1636 #       warn $q2;
1637         $sth2->execute;
1638         if (my $data2=$sth2->fetchrow_hashref) {
1639             my $discount = $data2->{'rentaldiscount'};
1640 #           print FILE "discount is $discount";
1641             if ($discount eq 'NULL') {
1642               $discount=0;
1643             }
1644             $charge = ($charge *(100 - $discount)) / 100;
1645         }
1646         $sth2->finish;
1647     }
1648     $sth1->finish;
1649 #    close FILE;
1650     return ($charge, $item_type);
1651 }
1652
1653 # FIXME - A virtually identical function appears in
1654 # C4::Circulation::Issues. Pick one and stick with it.
1655 sub createcharge {
1656 #Stolen from Issues.pm
1657     my ($env,$dbh,$itemno,$bornum,$charge) = @_;
1658     my $nextaccntno = getnextacctno($env,$bornum,$dbh);
1659     my $sth = $dbh->prepare(<<EOT);
1660         INSERT INTO     accountlines
1661                         (borrowernumber, itemnumber, accountno,
1662                          date, amount, description, accounttype,
1663                          amountoutstanding)
1664         VALUES          (?, ?, ?,
1665                          now(), ?, 'Rental', 'Rent',
1666                          ?)
1667 EOT
1668     $sth->execute($bornum, $itemno, $nextaccntno, $charge, $charge);
1669     $sth->finish;
1670 }
1671
1672
1673 sub getnextacctno {
1674 # Stolen from Accounts.pm
1675     my ($env,$bornumber,$dbh)=@_;
1676     my $nextaccntno = 1;
1677     my $query = "select * from accountlines where (borrowernumber = '$bornumber') order by accountno desc";
1678     my $sth = $dbh->prepare($query);
1679     $sth->execute;
1680     if (my $accdata=$sth->fetchrow_hashref){
1681         $nextaccntno = $accdata->{'accountno'} + 1;
1682     }
1683     $sth->finish;
1684     return($nextaccntno);
1685 }
1686
1687 =item find_reserves
1688
1689   ($status, $record) = &find_reserves($itemnumber);
1690
1691 Looks up an item in the reserves.
1692
1693 C<$itemnumber> is the itemnumber to look up.
1694
1695 C<$status> is true iff the search was successful.
1696
1697 C<$record> is a reference-to-hash describing the reserve. Its keys are
1698 the fields from the reserves table of the Koha database.
1699
1700 =cut
1701 #'
1702 # FIXME - This API is bogus: just return the record, or undef if none
1703 # was found.
1704 # FIXME - There's also a &C4::Circulation::Returns::find_reserves, but
1705 # that one looks rather different.
1706 sub find_reserves {
1707 # Stolen from Returns.pm
1708     my ($itemno) = @_;
1709     my %env;
1710     my $dbh = C4::Context->dbh;
1711     my ($itemdata) = getiteminformation(\%env, $itemno,0);
1712     my $bibno = $dbh->quote($itemdata->{'biblionumber'});
1713     my $bibitm = $dbh->quote($itemdata->{'biblioitemnumber'});
1714     my $query = "select * from reserves where ((found = 'W') or (found is null))
1715                        and biblionumber = $bibno and cancellationdate is NULL
1716                        order by priority, reservedate ";
1717     my $sth = $dbh->prepare($query);
1718     $sth->execute;
1719     my $resfound = 0;
1720     my $resrec;
1721     my $lastrec;
1722 # print $query;
1723
1724     # FIXME - I'm not really sure what's going on here, but since we
1725     # only want one result, wouldn't it be possible (and far more
1726     # efficient) to do something clever in SQL that only returns one
1727     # set of values?
1728     while (($resrec = $sth->fetchrow_hashref) && (not $resfound)) {
1729                 # FIXME - Unlike Pascal, Perl allows you to exit loops
1730                 # early. Take out the "&& (not $resfound)" and just
1731                 # use "last" at the appropriate point in the loop.
1732                 # (Oh, and just in passing: if you'd used "!" instead
1733                 # of "not", you wouldn't have needed the parentheses.)
1734         $lastrec = $resrec;
1735         my $brn = $dbh->quote($resrec->{'borrowernumber'});
1736         my $rdate = $dbh->quote($resrec->{'reservedate'});
1737         my $bibno = $dbh->quote($resrec->{'biblionumber'});
1738         if ($resrec->{'found'} eq "W") {
1739             if ($resrec->{'itemnumber'} eq $itemno) {
1740                 $resfound = 1;
1741             }
1742         } else {
1743             # FIXME - Use 'elsif' to avoid unnecessary indentation.
1744             if ($resrec->{'constrainttype'} eq "a") {
1745                 $resfound = 1;
1746             } else {
1747                 my $conquery = "select * from reserveconstraints where borrowernumber = $brn
1748                      and reservedate = $rdate and biblionumber = $bibno and biblioitemnumber = $bibitm";
1749                 my $consth = $dbh->prepare($conquery);
1750                 $consth->execute;
1751                 if (my $conrec = $consth->fetchrow_hashref) {
1752                     if ($resrec->{'constrainttype'} eq "o") {
1753                         $resfound = 1;
1754                     }
1755                 }
1756                 $consth->finish;
1757             }
1758         }
1759         if ($resfound) {
1760             my $updquery = "update reserves set found = 'W', itemnumber = '$itemno'
1761                   where borrowernumber = $brn and reservedate = $rdate and biblionumber = $bibno";
1762             my $updsth = $dbh->prepare($updquery);
1763             $updsth->execute;
1764             $updsth->finish;
1765             # FIXME - "last;" here to break out of the loop early.
1766         }
1767     }
1768     $sth->finish;
1769     return ($resfound,$lastrec);
1770 }
1771
1772 1;
1773 __END__
1774
1775 =back
1776
1777 =head1 AUTHOR
1778
1779 Koha Developement team <info@koha.org>
1780
1781 =cut