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