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