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