C4/Circulation/Circ2.pm

   1 package C4::Circulation::Circ2;
   2
   3 #package to deal with Returns
   4 #written 3/11/99 by olwen@katipo.co.nz
   5
   6
   7 # Copyright 2000-2002 Katipo Communications
   8 #
   9 # This file is part of Koha.
  10 #
  11 # Koha is free software; you can redistribute it and/or modify it under the
  12 # terms of the GNU General Public License as published by the Free Software
  13 # Foundation; either version 2 of the License, or (at your option) any later
  14 # version.
  15 #
  16 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  17 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  18 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU General Public License along with
  21 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  22 # Suite 330, Boston, MA  02111-1307 USA
  23
  24 use strict;
  25 # use warnings;
  26 require Exporter;
  27 use DBI;
  28 use C4::Database;
  29 #use C4::Accounts;
  30 #use C4::InterfaceCDK;
  31 #use C4::Circulation::Main;
  32 #use C4::Format;
  33 #use C4::Circulation::Renewals;
  34 #use C4::Scan;
  35 use C4::Stats;
  36 use C4::Reserves2;
  37 #use C4::Search;
  38 #use C4::Print;
  39
  40 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  41
  42 # set the version for version checking
  43 $VERSION = 0.01;
  44
  45 @ISA = qw(Exporter);
  46 @EXPORT = qw(&getbranches &getprinters &getpatroninformation &currentissues &getissues &getiteminformation &findborrower &issuebook &returnbook &find_reserves &transferbook &decode
  47 calc_charges);
  48 %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
  49
  50 # your exported package globals go here,
  51 # as well as any optionally exported functions
  52
  53 @EXPORT_OK   = qw($Var1 %Hashit);
  54
  55
  56 # non-exported package globals go here
  57 #use vars qw(@more $stuff);
  58
  59 # initalize package globals, first exported ones
  60
  61 my $Var1   = '';
  62 my %Hashit = ();
  63
  64 # then the others (which are still accessible as $Some::Module::stuff)
  65 my $stuff  = '';
  66 my @more   = ();
  67
  68 # all file-scoped lexicals must be created before
  69 # the functions below that use them.
  70
  71 # file-private lexicals go here
  72 my $priv_var    = '';
  73 my %secret_hash = ();
  74
  75 # here's a file-private function as a closure,
  76 # callable as &$priv_func;  it cannot be prototyped.
  77 my $priv_func = sub {
  78   # stuff goes here.
  79 };
  80
  81 # make all your functions, whether exported or not;
  82
  83
  84 sub getbranches {
  85 # returns a reference to a hash of references to branches...
  86     my %branches;
  87     my $dbh=&C4Connect;
  88     my $sth=$dbh->prepare("select * from branches");
  89     $sth->execute;
  90     while (my $branch=$sth->fetchrow_hashref) {
  91         my $tmp = $branch->{'branchcode'}; my $brc = $dbh->quote($tmp);
  92         my $query = "select categorycode from branchrelations where branchcode = $brc";
  93         my $nsth = $dbh->prepare($query);
  94         $nsth->execute;
  95         while (my ($cat) = $nsth->fetchrow_array) {
  96             $branch->{$cat} = 1;
  97         }
  98         $nsth->finish;
  99         $branches{$branch->{'branchcode'}}=$branch;
 100     }
 101     $dbh->disconnect;
 102     return (\%branches);
 103 }
 104
 105
 106 sub getprinters {
 107     my ($env) = @_;
 108     my %printers;
 109     my $dbh=&C4Connect;
 110     my $sth=$dbh->prepare("select * from printers");
 111     $sth->execute;
 112     while (my $printer=$sth->fetchrow_hashref) {
 113         $printers{$printer->{'printqueue'}}=$printer;
 114     }
 115     $dbh->disconnect;
 116     return (\%printers);
 117 }
 118
 119
 120
 121 sub getpatroninformation {
 122 # returns
 123     my ($env, $borrowernumber,$cardnumber) = @_;
 124     my $dbh=&C4Connect;
 125     my $query;
 126     my $sth;
 127     if ($borrowernumber) {
 128         $query = "select * from borrowers where borrowernumber=$borrowernumber";
 129     } elsif ($cardnumber) {
 130         $query = "select * from borrowers where cardnumber=$cardnumber";
 131     } else {
 132         $env->{'apierror'} = "invalid borrower information passed to getpatroninformation subroutine";
 133         return();
 134     }
 135     $env->{'mess'} = $query;
 136     $sth = $dbh->prepare($query);
 137     $sth->execute;
 138     my $borrower = $sth->fetchrow_hashref;
 139     my $flags = patronflags($env, $borrower, $dbh);
 140     $sth->finish;
 141     $dbh->disconnect;
 142     $borrower->{'flags'}=$flags;
 143     return($borrower, $flags);
 144 }
 145
 146 sub decode {
 147     my ($encoded) = @_;
 148     my $seq = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
 149     my @s = map { index($seq,$_); } split(//,$encoded);
 150     my $l = ($#s+1) % 4;
 151     if ($l)
 152     {
 153         if ($l == 1)
 154         {
 155             print "Error!";
 156             return;
 157         }
 158         $l = 4-$l;
 159         $#s += $l;
 160     }
 161     my $r = '';
 162     while ($#s >= 0)
 163     {
 164         my $n = (($s[0] << 6 | $s[1]) << 6 | $s[2]) << 6 | $s[3];
 165         $r .=chr(($n >> 16) ^ 67) .
 166              chr(($n >> 8 & 255) ^ 67) .
 167              chr(($n & 255) ^ 67);
 168         @s = @s[4..$#s];
 169     }
 170     $r = substr($r,0,length($r)-$l);
 171     return $r;
 172 }
 173
 174
 175
 176
 177 sub getiteminformation {
 178 # returns a hash of item information given either the itemnumber or the barcode
 179     my ($env, $itemnumber, $barcode) = @_;
 180     my $dbh=&C4Connect;
 181     my $sth;
 182     if ($itemnumber) {
 183         $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.itemnumber=$itemnumber and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
 184     } elsif ($barcode) {
 185         my $q_barcode=$dbh->quote($barcode);
 186         $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.barcode=$q_barcode and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
 187     } else {
 188         $env->{'apierror'}="getiteminformation() subroutine must be called with either an itemnumber or a barcode";
 189         # Error condition.
 190         return();
 191     }
 192     $sth->execute;
 193     my $iteminformation=$sth->fetchrow_hashref;
 194     $sth->finish;
 195     if ($iteminformation) {
 196         $sth=$dbh->prepare("select date_due from issues where itemnumber=$iteminformation->{'itemnumber'} and isnull(returndate)");
 197         $sth->execute;
 198         my ($date_due) = $sth->fetchrow;
 199         $iteminformation->{'date_due'}=$date_due;
 200         $sth->finish;
 201         #$iteminformation->{'dewey'}=~s/0*$//;
 202         ($iteminformation->{'dewey'} == 0) && ($iteminformation->{'dewey'}='');
 203         $sth=$dbh->prepare("select * from itemtypes where itemtype='$iteminformation->{'itemtype'}'");
 204         $sth->execute;
 205         my $itemtype=$sth->fetchrow_hashref;
 206         $iteminformation->{'loanlength'}=$itemtype->{'loanlength'};
 207         $sth->finish;
 208     }
 209     $dbh->disconnect;
 210     return($iteminformation);
 211 }
 212
 213 sub findborrower {
 214 # returns an array of borrower hash references, given a cardnumber or a partial
 215 # surname
 216     my ($env, $key) = @_;
 217     my $dbh=&C4Connect;
 218     my @borrowers;
 219     my $q_key=$dbh->quote($key);
 220     my $sth=$dbh->prepare("select * from borrowers where cardnumber=$q_key");
 221     $sth->execute;
 222     if ($sth->rows) {
 223         my ($borrower)=$sth->fetchrow_hashref;
 224         push (@borrowers, $borrower);
 225     } else {
 226         $q_key=$dbh->quote("$key%");
 227         $sth->finish;
 228         $sth=$dbh->prepare("select * from borrowers where surname like $q_key");
 229         $sth->execute;
 230         while (my $borrower = $sth->fetchrow_hashref) {
 231             push (@borrowers, $borrower);
 232         }
 233     }
 234     $sth->finish;
 235     $dbh->disconnect;
 236     return(\@borrowers);
 237 }
 238
 239
 240 sub transferbook {
 241 # transfer book code....
 242     my ($tbr, $barcode, $ignoreRs) = @_;
 243     my $messages;
 244     my %env;
 245     my $dotransfer = 1;
 246     my $branches = getbranches();
 247     my $iteminformation = getiteminformation(\%env, 0, $barcode);
 248 # bad barcode..
 249     if (not $iteminformation) {
 250         $messages->{'BadBarcode'} = $barcode;
 251         $dotransfer = 0;
 252     }
 253 # get branches of book...
 254     my $hbr = $iteminformation->{'homebranch'};
 255     my $fbr = $iteminformation->{'holdingbranch'};
 256 # if is permanent...
 257     if ($branches->{$hbr}->{'PE'}) {
 258         $messages->{'IsPermanent'} = $hbr;
 259     }
 260 # cant transfer book if is already there....
 261     if ($fbr eq $tbr) {
 262         $messages->{'DestinationEqualsHolding'} = 1;
 263         $dotransfer = 0;
 264     }
 265 # check if it is still issued to someone, return it...
 266     my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
 267     if ($currentborrower) {
 268         returnbook($barcode, $fbr);
 269         $messages->{'WasReturned'} = $currentborrower;
 270     }
 271 # find reserves.....
 272     my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
 273     if ($resfound and not $ignoreRs) {
 274         $resrec->{'ResFound'} = $resfound;
 275         $messages->{'ResFound'} = $resrec;
 276         $dotransfer = 0;
 277     }
 278 #actually do the transfer....
 279     if ($dotransfer) {
 280         dotransfer($iteminformation->{'itemnumber'}, $fbr, $tbr);
 281         $messages->{'WasTransfered'} = 1;
 282     }
 283     return ($dotransfer, $messages, $iteminformation);
 284 }
 285
 286 sub dotransfer {
 287     my ($itm, $fbr, $tbr) = @_;
 288     my $dbh = &C4Connect;
 289     $itm = $dbh->quote($itm);
 290     $fbr = $dbh->quote($fbr);
 291     $tbr = $dbh->quote($tbr);
 292     #new entry in branchtransfers....
 293     my $query = "insert into branchtransfers (itemnumber, frombranch, datearrived, tobranch)
 294                                       values($itm, $fbr, now(), $tbr)";
 295     my $sth = $dbh->prepare($query);
 296     $sth->execute;
 297     $sth->finish;
 298     #update holdingbranch in items .....
 299     $query = "update items set datelastseen = now(), holdingbranch=$tbr where items.itemnumber=$itm";
 300     $sth = $dbh->prepare($query);
 301     $sth->execute;
 302     $sth->finish;
 303     $dbh->disconnect;
 304     return;
 305 }
 306
 307
 308 sub issuebook {
 309     my ($env, $patroninformation, $barcode, $responses, $date) = @_;
 310     my $dbh=&C4Connect;
 311     my $iteminformation = getiteminformation($env, 0, $barcode);
 312     my ($datedue);
 313     my ($rejected,$question,$defaultanswer,$questionnumber, $noissue);
 314     my $message;
 315     SWITCH: {
 316         if ($patroninformation->{'gonenoaddress'}) {
 317             $rejected="Patron is gone, with no known address.";
 318             last SWITCH;
 319         }
 320         if ($patroninformation->{'lost'}) {
 321             $rejected="Patron's card has been reported lost.";
 322             last SWITCH;
 323         }
 324         if ($patroninformation->{'debarred'}) {
 325             $rejected="Patron is Debarred";
 326             last SWITCH;
 327         }
 328         my $amount = checkaccount($env,$patroninformation->{'borrowernumber'}, $dbh,$date);
 329         if ($amount > 5 && $patroninformation->{'categorycode'} ne 'L' &&
 330                          $patroninformation->{'categorycode'} ne 'W' &&
 331                          $patroninformation->{'categorycode'} ne 'I' &&
 332                          $patroninformation->{'categorycode'} ne 'B' &&
 333                          $patroninformation->{'categorycode'} ne 'P') {
 334             $rejected = sprintf "Patron owes \$%.02f.", $amount;
 335             last SWITCH;
 336         }
 337         unless ($iteminformation) {
 338             $rejected = "$barcode is not a valid barcode.";
 339             last SWITCH;
 340         }
 341         if ($iteminformation->{'notforloan'} == 1) {
 342             $rejected="Item not for loan.";
 343             last SWITCH;
 344         }
 345         if ($iteminformation->{'wthdrawn'} == 1) {
 346             $rejected="Item withdrawn.";
 347             last SWITCH;
 348         }
 349         if ($iteminformation->{'restricted'} == 1) {
 350             $rejected="Restricted item.";
 351             last SWITCH;
 352         }
 353         if ($iteminformation->{'itemtype'} eq 'REF') {
 354             $rejected="Reference item:  Not for loan.";
 355             last SWITCH;
 356         }
 357         my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
 358         if ($currentborrower eq $patroninformation->{'borrowernumber'}) {
 359 # Already issued to current borrower
 360             my ($renewstatus) = renewstatus($env,$dbh,$patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
 361             if ($renewstatus == 0) {
 362                 $rejected="No more renewals allowed for this item.";
 363                 last SWITCH;
 364             } else {
 365                 if ($responses->{4} eq '') {
 366                     $questionnumber = 4;
 367                     $question = "Book is issued to this borrower.\nRenew?";
 368                     $defaultanswer = 'Y';
 369                     last SWITCH;
 370                 } elsif ($responses->{4} eq 'Y') {
 371                     my $charge = calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'});
 372                     if ($charge > 0) {
 373                         createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'}, $charge);
 374                         $iteminformation->{'charge'} = $charge;
 375                     }
 376                     &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'});
 377                     renewbook($env,$dbh, $patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
 378                     $noissue=1;
 379                 } else {
 380                     $rejected=-1;
 381                     last SWITCH;
 382                 }
 383             }
 384         } elsif ($currentborrower ne '') {
 385             my ($currborrower, $cbflags) = getpatroninformation($env,$currentborrower,0);
 386             if ($responses->{1} eq '') {
 387                 $questionnumber=1;
 388                 $question = "Issued to $currborrower->{'firstname'} $currborrower->{'surname'} ($currborrower->{'cardnumber'}).\nMark as returned?";
 389                 $defaultanswer='Y';
 390                 last SWITCH;
 391             } elsif ($responses->{1} eq 'Y') {
 392                 returnbook($iteminformation->{'barcode'}, $env->{'branch'});
 393             } else {
 394                 $rejected=-1;
 395                 last SWITCH;
 396             }
 397         }
 398
 399         my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'});
 400         if ($restype) {
 401             my $resbor = $res->{'borrowernumber'};
 402             if ($resbor eq $patroninformation->{'borrowernumber'}) {
 403                 FillReserve($res);
 404             } elsif ($restype eq "Waiting") {
 405                 my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
 406                 my $branches = getbranches();
 407                 my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
 408                 if ($responses->{2} eq '') {
 409                     $questionnumber=2;
 410                     $question="Waiting for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) at $branchname \nAllow issue?";
 411                     $defaultanswer='N';
 412                     last SWITCH;
 413                 } elsif ($responses->{2} eq 'N') {
 414                     $rejected=-1;
 415                     last SWITCH;
 416                 } else {
 417                     if ($responses->{3} eq '') {
 418                         $questionnumber=3;
 419                         $question="Cancel reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})?";
 420                         $defaultanswer='N';
 421                         last SWITCH;
 422                     } elsif ($responses->{3} eq 'Y') {
 423                         CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
 424                     }
 425                 }
 426             } elsif ($restype eq "Reserved") {
 427                 my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
 428                 my $branches = getbranches();
 429                 my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
 430                 if ($responses->{5} eq '') {
 431                     $questionnumber=5;
 432                     $question="Reserved for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) since $res->{'reservedate'} \nAllow issue?";
 433                     $defaultanswer='N';
 434                     last SWITCH;
 435                 } elsif ($responses->{5} eq 'N') {
 436                     if ($responses->{6} eq '') {
 437                         $questionnumber=6;
 438                         $question="Set reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) to waiting and transfer to $branchname?";
 439                         $defaultanswer='N';
 440                     } elsif ($responses->{6} eq 'Y') {
 441                         my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'});
 442                         transferbook($tobrcd, $barcode, 1);
 443                         $message = "Item should now be waiting at $branchname";
 444                     }
 445                     $rejected=-1;
 446                     last SWITCH;
 447                 } else {
 448                     if ($responses->{7} eq '') {
 449                         $questionnumber=7;
 450                         $question="Cancel reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})?";
 451                         $defaultanswer='N';
 452                         last SWITCH;
 453                     } elsif ($responses->{7} eq 'Y') {
 454                         CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
 455                     }
 456                 }
 457             }
 458         }
 459     }
 460     my $dateduef;
 461     unless (($question) || ($rejected) || ($noissue)) {
 462         my $loanlength=21;
 463         if ($iteminformation->{'loanlength'}) {
 464             $loanlength=$iteminformation->{'loanlength'};
 465         }
 466         my $ti=time;
 467         my $datedue=time+($loanlength)*86400;
 468         my @datearr = localtime($datedue);
 469         $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
 470         if ($env->{'datedue'}) {
 471             $dateduef=$env->{'datedue'};
 472         }
 473         $dateduef=~ s/2001\-4\-25/2001\-4\-26/;
 474         my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode) values ($patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'}, '$dateduef', '$env->{'branchcode'}')");
 475         $sth->execute;
 476         $sth->finish;
 477         $iteminformation->{'issues'}++;
 478         $sth=$dbh->prepare("update items set issues=$iteminformation->{'issues'},datelastseen=now() where itemnumber=$iteminformation->{'itemnumber'}");
 479         $sth->execute;
 480         $sth->finish;
 481         my $charge=calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'});
 482         if ($charge > 0) {
 483             createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'}, $charge);
 484             $iteminformation->{'charge'}=$charge;
 485         }
 486         &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'});
 487     }
 488     if ($iteminformation->{'charge'}) {
 489         $message=sprintf "Rental charge of \$%.02f applies.", $iteminformation->{'charge'};
 490     }
 491     $dbh->disconnect;
 492     return ($iteminformation, $dateduef, $rejected, $question, $questionnumber, $defaultanswer, $message);
 493 }
 494
 495
 496
 497 sub returnbook {
 498     my ($barcode, $branch) = @_;
 499     my %env;
 500     my $messages;
 501     my $doreturn = 1;
 502 # get information on item
 503     my ($iteminformation) = getiteminformation(\%env, 0, $barcode);
 504     if (not $iteminformation) {
 505         $messages->{'BadBarcode'} = $barcode;
 506         $doreturn = 0;
 507     }
 508 # find the borrower
 509     my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
 510     if ((not $currentborrower) && $doreturn) {
 511         $messages->{'NotIssued'} = $barcode;
 512         $doreturn = 0;
 513     }
 514 # check if the book is in a permanent collection....
 515     my $hbr = $iteminformation->{'homebranch'};
 516     my $branches = getbranches();
 517     if ($branches->{$hbr}->{'PE'}) {
 518         $messages->{'IsPermanent'} = $hbr;
 519     }
 520 # check that the book has been cancelled
 521     if ($iteminformation->{'wthdrawn'}) {
 522         $messages->{'wthdrawn'} = 1;
 523         $doreturn = 0;
 524     }
 525 # update issues, thereby returning book (should push this out into another subroutine
 526     my ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
 527     if ($doreturn) {
 528         doreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
 529         $messages->{'WasReturned'};
 530     }
 531     ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
 532 # transfer book
 533     my ($transfered, $mess, $item) = transferbook($branch, $barcode);
 534     if ($transfered) {
 535         $messages->{'WasTransfered'};
 536     }
 537 # fix up the accounts.....
 538     if ($iteminformation->{'itemlost'}) {
 539         updateitemlost($iteminformation->{'itemnumber'});
 540         fixaccountforlostandreturned($iteminformation, $borrower);
 541         $messages->{'WasLost'};
 542     }
 543 # fix up the overdues in accounts...
 544     fixoverduesonreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
 545 # find reserves.....
 546     my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
 547     if ($resfound) {
 548         $resrec->{'ResFound'} = $resfound;
 549         $messages->{'ResFound'} = $resrec;
 550     }
 551 # update stats?
 552     UpdateStats(\%env, $branch ,'return','0','',$iteminformation->{'itemnumber'});
 553     return ($doreturn, $messages, $iteminformation, $borrower);
 554 }
 555
 556
 557 sub doreturn {
 558     my ($brn, $itm) = @_;
 559     my $dbh=&C4Connect;
 560     $brn = $dbh->quote($brn);
 561     $itm = $dbh->quote($itm);
 562     my $query = "update issues set returndate = now() where (borrowernumber = $brn)
 563         and (itemnumber = $itm) and (returndate is null)";
 564     my $sth = $dbh->prepare($query);
 565     $sth->execute;
 566     $sth->finish;
 567     $query="update items set datelastseen=now() where itemnumber=$itm";
 568     $sth=$dbh->prepare($query);
 569     $sth->execute;
 570     $sth->finish;
 571     $dbh->disconnect;
 572     return;
 573 }
 574
 575 sub updateitemlost{
 576   my ($itemno)=@_;
 577   my $dbh=&C4Connect;
 578   my $query="update items set itemlost=0 where itemnumber=$itemno";
 579   my $sth=$dbh->prepare($query);
 580   $sth->execute;
 581   $sth->finish;
 582 }
 583
 584 sub fixaccountforlostandreturned {
 585     my ($iteminfo, $borrower) = @_;
 586     my %env;
 587     my $dbh=&C4Connect;
 588     my $itm = $dbh->quote($iteminfo->{'itemnumber'});
 589 # check for charge made for lost book
 590     my $query = "select * from accountlines where (itemnumber = $itm)
 591                           and (accounttype='L' or accounttype='Rep') order by date desc";
 592     my $sth = $dbh->prepare($query);
 593     $sth->execute;
 594     if (my $data = $sth->fetchrow_hashref) {
 595 # writeoff this amount
 596         my $offset;
 597         my $amount = $data->{'amount'};
 598         my $acctno = $data->{'accountno'};
 599         my $amountleft;
 600         if ($data->{'amountoutstanding'} == $amount) {
 601             $offset = $data->{'amount'};
 602             $amountleft = 0;
 603         } else {
 604             $offset = $amount - $data->{'amountoutstanding'};
 605             $amountleft = $data->{'amountoutstanding'} - $amount;
 606         }
 607         my $uquery = "update accountlines set accounttype = 'LR',amountoutstanding='0'
 608                   where (borrowernumber = '$data->{'borrowernumber'}')
 609                   and (itemnumber = $itm) and (accountno = '$acctno') ";
 610         my $usth = $dbh->prepare($uquery);
 611         $usth->execute;
 612         $usth->finish;
 613 #check if any credit is left if so writeoff other accounts
 614         my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
 615         if ($amountleft < 0){
 616             $amountleft*=-1;
 617         }
 618         if ($amountleft > 0){
 619             my $query = "select * from accountlines where (borrowernumber = '$data->{'borrowernumber'}')
 620                                                       and (amountoutstanding >0) order by date";
 621             my $msth = $dbh->prepare($query);
 622             $msth->execute;
 623       # offset transactions
 624             my $newamtos;
 625             my $accdata;
 626             while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
 627                 if ($accdata->{'amountoutstanding'} < $amountleft) {
 628                     $newamtos = 0;
 629                     $amountleft = $amountleft - $accdata->{'amountoutstanding'};
 630                 }  else {
 631                     $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
 632                     $amountleft = 0;
 633                 }
 634                 my $thisacct = $accdata->{'accountno'};
 635                 my $updquery = "update accountlines set amountoutstanding= '$newamtos'
 636                                  where (borrowernumber = '$data->{'borrowernumber'}')
 637                                    and (accountno='$thisacct')";
 638                 my $usth = $dbh->prepare($updquery);
 639                 $usth->execute;
 640                 $usth->finish;
 641                 $updquery = "insert into accountoffsets
 642                           (borrowernumber, accountno, offsetaccount,  offsetamount)
 643                           values
 644                           ('$data->{'borrowernumber'}','$accdata->{'accountno'}','$nextaccntno','$newamtos')";
 645                 $usth = $dbh->prepare($updquery);
 646                 $usth->execute;
 647                 $usth->finish;
 648             }
 649             $msth->finish;
 650         }
 651         if ($amountleft > 0){
 652             $amountleft*=-1;
 653         }
 654         my $desc="Book Returned ".$iteminfo->{'barcode'};
 655         $uquery = "insert into accountlines
 656                   (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
 657                   values ('$data->{'borrowernumber'}','$nextaccntno',now(),0-$amount,'$desc',
 658                   'CR',$amountleft)";
 659         $usth = $dbh->prepare($uquery);
 660         $usth->execute;
 661         $usth->finish;
 662         $uquery = "insert into accountoffsets
 663                   (borrowernumber, accountno, offsetaccount,  offsetamount)
 664                   values ($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset)";
 665         $usth = $dbh->prepare($uquery);
 666         $usth->execute;
 667         $usth->finish;
 668         $uquery = "update items set paidfor='' where itemnumber=$itm";
 669         $usth = $dbh->prepare($uquery);
 670         $usth->execute;
 671         $usth->finish;
 672     }
 673     $sth->finish;
 674     return;
 675 }
 676
 677 sub fixoverduesonreturn {
 678     my ($brn, $itm) = @_;
 679     my $dbh=&C4Connect;
 680     $itm = $dbh->quote($itm);
 681     $brn = $dbh->quote($brn);
 682 # check for overdue fine
 683     my $query = "select * from accountlines where (borrowernumber=$brn)
 684                            and (itemnumber = $itm) and (accounttype='FU' or accounttype='O')";
 685     my $sth = $dbh->prepare($query);
 686     $sth->execute;
 687 # alter fine to show that the book has been returned
 688     if (my $data = $sth->fetchrow_hashref) {
 689         my $query = "update accountlines set accounttype='F' where (borrowernumber = $brn)
 690                            and (itemnumber = $itm) and (acccountno='$data->{'accountno'}')";
 691         my $usth=$dbh->prepare($query);
 692         $usth->execute();
 693         $usth->finish();
 694     }
 695     $sth->finish;
 696     return;
 697 }
 698
 699 sub patronflags {
 700 # Original subroutine for Circ2.pm
 701     my %flags;
 702     my ($env, $patroninformation, $dbh) = @_;
 703     my $amount = checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh);
 704     if ($amount > 0) {
 705         my %flaginfo;
 706         $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount;
 707         if ($amount > 5) {
 708             $flaginfo{'noissues'} = 1;
 709         }
 710         $flags{'CHARGES'} = \%flaginfo;
 711     } elsif ($amount < 0){
 712        my %flaginfo;
 713        $amount = $amount*-1;
 714        $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", $amount;
 715         $flags{'CHARGES'} = \%flaginfo;
 716     }
 717     if ($patroninformation->{'gonenoaddress'} == 1) {
 718         my %flaginfo;
 719         $flaginfo{'message'} = 'Borrower has no valid address.';
 720         $flaginfo{'noissues'} = 1;
 721         $flags{'GNA'} = \%flaginfo;
 722     }
 723     if ($patroninformation->{'lost'} == 1) {
 724         my %flaginfo;
 725         $flaginfo{'message'} = 'Borrower\'s card reported lost.';
 726         $flaginfo{'noissues'} = 1;
 727         $flags{'LOST'} = \%flaginfo;
 728     }
 729     if ($patroninformation->{'debarred'} == 1) {
 730         my %flaginfo;
 731         $flaginfo{'message'} = 'Borrower is Debarred.';
 732         $flaginfo{'noissues'} = 1;
 733         $flags{'DBARRED'} = \%flaginfo;
 734     }
 735     if ($patroninformation->{'borrowernotes'}) {
 736         my %flaginfo;
 737         $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
 738         $flags{'NOTES'} = \%flaginfo;
 739     }
 740     my ($odues, $itemsoverdue)
 741                   = checkoverdues($env, $patroninformation->{'borrowernumber'}, $dbh);
 742     if ($odues > 0) {
 743         my %flaginfo;
 744         $flaginfo{'message'} = "Yes";
 745         $flaginfo{'itemlist'} = $itemsoverdue;
 746         foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) {
 747             $flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
 748         }
 749         $flags{'ODUES'} = \%flaginfo;
 750     }
 751     my ($nowaiting, $itemswaiting)
 752                   = CheckWaiting($patroninformation->{'borrowernumber'});
 753     if ($nowaiting > 0) {
 754         my %flaginfo;
 755         $flaginfo{'message'} = "Reserved items available";
 756         $flaginfo{'itemlist'} = $itemswaiting;
 757         $flags{'WAITING'} = \%flaginfo;
 758     }
 759     return(\%flags);
 760 }
 761
 762
 763 sub checkoverdues {
 764 # From Main.pm, modified to return a list of overdueitems, in addition to a count
 765   #checks whether a borrower has overdue items
 766   my ($env, $bornum, $dbh)=@_;
 767   my @datearr = localtime;
 768   my $today = ($datearr[5] + 1900)."-".($datearr[4]+1)."-".$datearr[3];
 769   my @overdueitems;
 770   my $count = 0;
 771   my $query = "SELECT * FROM issues,biblio,biblioitems,items
 772                        WHERE items.biblioitemnumber = biblioitems.biblioitemnumber
 773                          AND items.biblionumber     = biblio.biblionumber
 774                          AND issues.itemnumber      = items.itemnumber
 775                          AND issues.borrowernumber  = $bornum
 776                          AND issues.returndate is NULL
 777                          AND issues.date_due < '$today'";
 778   my $sth = $dbh->prepare($query);
 779   $sth->execute;
 780   while (my $data = $sth->fetchrow_hashref) {
 781       push (@overdueitems, $data);
 782       $count++;
 783   }
 784   $sth->finish;
 785   return ($count, \@overdueitems);
 786 }
 787
 788 sub currentborrower {
 789 # Original subroutine for Circ2.pm
 790     my ($itemnumber) = @_;
 791     my $dbh = &C4Connect;
 792     my $q_itemnumber = $dbh->quote($itemnumber);
 793     my $sth=$dbh->prepare("select borrowers.borrowernumber from
 794     issues,borrowers where issues.itemnumber=$q_itemnumber and
 795     issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
 796     NULL");
 797     $sth->execute;
 798     my ($borrower) = $sth->fetchrow;
 799     return($borrower);
 800 }
 801
 802 sub checkreserve {
 803 # Stolen from Main.pm
 804   # Check for reserves for biblio
 805   my ($env,$dbh,$itemnum)=@_;
 806   my $resbor = "";
 807   my $query = "select * from reserves,items
 808     where (items.itemnumber = '$itemnum')
 809     and (reserves.cancellationdate is NULL)
 810     and (items.biblionumber = reserves.biblionumber)
 811     and ((reserves.found = 'W')
 812     or (reserves.found is null))
 813     order by priority";
 814   my $sth = $dbh->prepare($query);
 815   $sth->execute();
 816   my $resrec;
 817   my $data=$sth->fetchrow_hashref;
 818   while ($data && $resbor eq '') {
 819     $resrec=$data;
 820     my $const = $data->{'constrainttype'};
 821     if ($const eq "a") {
 822       $resbor = $data->{'borrowernumber'};
 823     } else {
 824       my $found = 0;
 825       my $cquery = "select * from reserveconstraints,items
 826          where (borrowernumber='$data->{'borrowernumber'}')
 827          and reservedate='$data->{'reservedate'}'
 828          and reserveconstraints.biblionumber='$data->{'biblionumber'}'
 829          and (items.itemnumber=$itemnum and
 830          items.biblioitemnumber = reserveconstraints.biblioitemnumber)";
 831       my $csth = $dbh->prepare($cquery);
 832       $csth->execute;
 833       if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
 834       if ($const eq 'o') {
 835         if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
 836       } else {
 837         if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
 838       }
 839       $csth->finish();
 840     }
 841     $data=$sth->fetchrow_hashref;
 842   }
 843   $sth->finish;
 844   return ($resbor,$resrec);
 845 }
 846
 847 sub currentissues {
 848 # New subroutine for Circ2.pm
 849     my ($env, $borrower) = @_;
 850     my $dbh=&C4Connect;
 851     my %currentissues;
 852     my $counter=1;
 853     my $borrowernumber = $borrower->{'borrowernumber'};
 854     my $crit='';
 855     if ($env->{'todaysissues'}) {
 856         my @datearr = localtime(time());
 857         my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
 858         $crit=" and issues.timestamp like '$today%' ";
 859     }
 860     if ($env->{'nottodaysissues'}) {
 861         my @datearr = localtime(time());
 862         my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
 863         $crit=" and !(issues.timestamp like '$today%') ";
 864     }
 865     my $select="select * from issues,items,biblioitems,biblio where
 866        borrowernumber='$borrowernumber' and issues.itemnumber=items.itemnumber and
 867        items.biblionumber=biblio.biblionumber and
 868        items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is null
 869        $crit order by issues.timestamp desc";
 870 #    print $select;
 871     my $sth=$dbh->prepare($select);
 872     $sth->execute;
 873     while (my $data = $sth->fetchrow_hashref) {
 874         $data->{'dewey'}=~s/0*$//;
 875         ($data->{'dewey'} == 0) && ($data->{'dewey'}='');
 876         my @datearr = localtime(time());
 877         my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]
 878         +1)).sprintf ("%0.2d", $datearr[3]);
 879         my $datedue=$data->{'date_due'};
 880         $datedue=~s/-//g;
 881         if ($datedue < $todaysdate) {
 882             $data->{'overdue'}=1;
 883         }
 884         my $itemnumber=$data->{'itemnumber'};
 885         $currentissues{$counter}=$data;
 886         $counter++;
 887     }
 888     $sth->finish;
 889     $dbh->disconnect;
 890     return(\%currentissues);
 891 }
 892 sub getissues {
 893 # New subroutine for Circ2.pm
 894     my ($borrower) = @_;
 895     my $dbh=&C4Connect;
 896     my $borrowernumber = $borrower->{'borrowernumber'};
 897     my $brn =$dbh->quote($borrowernumber);
 898     my %currentissues;
 899     my $select = "select issues.timestamp, issues.date_due, items.biblionumber,
 900                          items.barcode, biblio.title, biblio.author, biblioitems.dewey,
 901                          biblioitems.subclass
 902                     from issues,items,biblioitems,biblio
 903                    where issues.borrowernumber = $brn
 904                      and issues.itemnumber = items.itemnumber
 905                      and items.biblionumber = biblio.biblionumber
 906                      and items.biblioitemnumber = biblioitems.biblioitemnumber
 907                      and issues.returndate is null
 908                          order by issues.date_due";
 909 #    print $select;
 910     my $sth=$dbh->prepare($select);
 911     $sth->execute;
 912     my $counter = 0;
 913     while (my $data = $sth->fetchrow_hashref) {
 914         $data->{'dewey'} =~ s/0*$//;
 915         ($data->{'dewey'} == 0) && ($data->{'dewey'} = '');
 916         my @datearr = localtime(time());
 917         my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]);
 918         my $datedue = $data->{'date_due'};
 919         $datedue =~ s/-//g;
 920         if ($datedue < $todaysdate) {
 921             $data->{'overdue'} = 1;
 922         }
 923         $currentissues{$counter} = $data;
 924         $counter++;
 925     }
 926     $sth->finish;
 927     $dbh->disconnect;
 928     return(\%currentissues);
 929 }
 930
 931 sub checkwaiting {
 932 #Stolen from Main.pm
 933   # check for reserves waiting
 934   my ($env,$dbh,$bornum)=@_;
 935   my @itemswaiting;
 936   my $query = "select * from reserves
 937     where (borrowernumber = '$bornum')
 938     and (reserves.found='W') and cancellationdate is NULL";
 939   my $sth = $dbh->prepare($query);
 940   $sth->execute();
 941   my $cnt=0;
 942   if (my $data=$sth->fetchrow_hashref) {
 943     $itemswaiting[$cnt] =$data;
 944     $cnt ++
 945   }
 946   $sth->finish;
 947   return ($cnt,\@itemswaiting);
 948 }
 949
 950
 951 sub checkaccount  {
 952 # Stolen from Accounts.pm
 953   #take borrower number
 954   #check accounts and list amounts owing
 955   my ($env,$bornumber,$dbh,$date)=@_;
 956   my $select="Select sum(amountoutstanding) from accountlines where
 957   borrowernumber=$bornumber and amountoutstanding<>0";
 958   if ($date ne ''){
 959     $select.=" and date < '$date'";
 960   }
 961 #  print $select;
 962   my $sth=$dbh->prepare($select);
 963   $sth->execute;
 964   my $total=0;
 965   while (my $data=$sth->fetchrow_hashref){
 966     $total=$total+$data->{'sum(amountoutstanding)'};
 967   }
 968   $sth->finish;
 969   # output(1,2,"borrower owes $total");
 970   #if ($total > 0){
 971   #  # output(1,2,"borrower owes $total");
 972   #  if ($total > 5){
 973   #    reconcileaccount($env,$dbh,$bornumber,$total);
 974   #  }
 975   #}
 976   #  pause();
 977   return($total);
 978 }
 979
 980 sub renewstatus {
 981 # Stolen from Renewals.pm
 982   # check renewal status
 983   my ($env,$dbh,$bornum,$itemno)=@_;
 984   my $renews = 1;
 985   my $renewokay = 0;
 986   my $q1 = "select * from issues
 987     where (borrowernumber = '$bornum')
 988     and (itemnumber = '$itemno')
 989     and returndate is null";
 990   my $sth1 = $dbh->prepare($q1);
 991   $sth1->execute;
 992   if (my $data1 = $sth1->fetchrow_hashref) {
 993     my $q2 = "select renewalsallowed from items,biblioitems,itemtypes
 994        where (items.itemnumber = '$itemno')
 995        and (items.biblioitemnumber = biblioitems.biblioitemnumber)
 996        and (biblioitems.itemtype = itemtypes.itemtype)";
 997     my $sth2 = $dbh->prepare($q2);
 998     $sth2->execute;
 999     if (my $data2=$sth2->fetchrow_hashref) {
1000       $renews = $data2->{'renewalsallowed'};
1001     }
1002     if ($renews > $data1->{'renewals'}) {
1003       $renewokay = 1;
1004     }
1005     $sth2->finish;
1006   }
1007   $sth1->finish;
1008   return($renewokay);
1009 }
1010
1011 sub renewbook {
1012 # Stolen from Renewals.pm
1013   # mark book as renewed
1014   my ($env,$dbh,$bornum,$itemno,$datedue)=@_;
1015   $datedue=$env->{'datedue'};
1016   if ($datedue eq "" ) {
1017     my $loanlength=21;
1018     my $query= "Select * from biblioitems,items,itemtypes
1019        where (items.itemnumber = '$itemno')
1020        and (biblioitems.biblioitemnumber = items.biblioitemnumber)
1021        and (biblioitems.itemtype = itemtypes.itemtype)";
1022     my $sth=$dbh->prepare($query);
1023     $sth->execute;
1024     if (my $data=$sth->fetchrow_hashref) {
1025       $loanlength = $data->{'loanlength'}
1026     }
1027     $sth->finish;
1028     my $ti = time;
1029     my $datedu = time + ($loanlength * 86400);
1030     my @datearr = localtime($datedu);
1031     $datedue = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
1032   }
1033   my @date = split("-",$datedue);
1034   my $odatedue = ($date[2]+0)."-".($date[1]+0)."-".$date[0];
1035   my $issquery = "select * from issues where borrowernumber='$bornum' and
1036     itemnumber='$itemno' and returndate is null";
1037   my $sth=$dbh->prepare($issquery);
1038   $sth->execute;
1039   my $issuedata=$sth->fetchrow_hashref;
1040   $sth->finish;
1041   my $renews = $issuedata->{'renewals'} +1;
1042   my $updquery = "update issues
1043     set date_due = '$datedue', renewals = '$renews'
1044     where borrowernumber='$bornum' and
1045     itemnumber='$itemno' and returndate is null";
1046   $sth=$dbh->prepare($updquery);
1047
1048   $sth->execute;
1049   $sth->finish;
1050   return($odatedue);
1051 }
1052
1053 sub calc_charges {
1054 # Stolen from Issues.pm
1055 # calculate charges due
1056     my ($env, $dbh, $itemno, $bornum)=@_;
1057 #    if (!$dbh){
1058 #      $dbh=C4Connect();
1059 #    }
1060     my $charge=0;
1061 #    open (FILE,">>/tmp/charges");
1062     my $item_type;
1063     my $q1 = "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes
1064     where (items.itemnumber ='$itemno')
1065     and (biblioitems.biblioitemnumber = items.biblioitemnumber)
1066     and (biblioitems.itemtype = itemtypes.itemtype)";
1067     my $sth1= $dbh->prepare($q1);
1068 #    print FILE "$q1\n";
1069     $sth1->execute;
1070     if (my $data1=$sth1->fetchrow_hashref) {
1071         $item_type = $data1->{'itemtype'};
1072         $charge = $data1->{'rentalcharge'};
1073 #       print FILE "charge is $charge\n";
1074         my $q2 = "select rentaldiscount from borrowers,categoryitem
1075         where (borrowers.borrowernumber = '$bornum')
1076         and (borrowers.categorycode = categoryitem.categorycode)
1077         and (categoryitem.itemtype = '$item_type')";
1078         my $sth2=$dbh->prepare($q2);
1079 #       warn $q2;
1080         $sth2->execute;
1081         if (my $data2=$sth2->fetchrow_hashref) {
1082             my $discount = $data2->{'rentaldiscount'};
1083 #           print FILE "discount is $discount";
1084             if ($discount eq 'NULL') {
1085               $discount=0;
1086             }
1087             $charge = ($charge *(100 - $discount)) / 100;
1088         }
1089         $sth2->finish;
1090     }
1091     $sth1->finish;
1092 #    close FILE;
1093     return ($charge);
1094 }
1095
1096 sub createcharge {
1097 #Stolen from Issues.pm
1098     my ($env,$dbh,$itemno,$bornum,$charge) = @_;
1099     my $nextaccntno = getnextacctno($env,$bornum,$dbh);
1100     my $query = "insert into accountlines (borrowernumber,itemnumber,accountno,date,amount, description,accounttype,amountoutstanding) values ($bornum,$itemno,$nextaccntno,now(),$charge,'Rental','Rent',$charge)";
1101     my $sth = $dbh->prepare($query);
1102     $sth->execute;
1103     $sth->finish;
1104 }
1105
1106
1107 sub getnextacctno {
1108 # Stolen from Accounts.pm
1109     my ($env,$bornumber,$dbh)=@_;
1110     my $nextaccntno = 1;
1111     my $query = "select * from accountlines where (borrowernumber = '$bornumber') order by accountno desc";
1112     my $sth = $dbh->prepare($query);
1113     $sth->execute;
1114     if (my $accdata=$sth->fetchrow_hashref){
1115         $nextaccntno = $accdata->{'accountno'} + 1;
1116     }
1117     $sth->finish;
1118     return($nextaccntno);
1119 }
1120
1121 sub find_reserves {
1122 # Stolen from Returns.pm
1123     my ($itemno) = @_;
1124     my %env;
1125     my $dbh=&C4Connect;
1126     my ($itemdata) = getiteminformation(\%env, $itemno,0);
1127     my $bibno = $dbh->quote($itemdata->{'biblionumber'});
1128     my $bibitm = $dbh->quote($itemdata->{'biblioitemnumber'});
1129     my $query = "select * from reserves where ((found = 'W') or (found is null))
1130                        and biblionumber = $bibno and cancellationdate is NULL
1131                        order by priority, reservedate ";
1132     my $sth = $dbh->prepare($query);
1133     $sth->execute;
1134     my $resfound = 0;
1135     my $resrec;
1136     my $lastrec;
1137 # print $query;
1138     while (($resrec = $sth->fetchrow_hashref) && (not $resfound)) {
1139         $lastrec = $resrec;
1140         my $brn = $dbh->quote($resrec->{'borrowernumber'});
1141         my $rdate = $dbh->quote($resrec->{'reservedate'});
1142         my $bibno = $dbh->quote($resrec->{'biblionumber'});
1143         if ($resrec->{'found'} eq "W") {
1144             if ($resrec->{'itemnumber'} eq $itemno) {
1145                 $resfound = 1;
1146             }
1147         } else {
1148             if ($resrec->{'constrainttype'} eq "a") {
1149                 $resfound = 1;
1150             } else {
1151                 my $conquery = "select * from reserveconstraints where borrowernumber = $brn
1152                      and reservedate = $rdate and biblionumber = $bibno and biblioitemnumber = $bibitm";
1153                 my $consth = $dbh->prepare($conquery);
1154                 $consth->execute;
1155                 if (my $conrec = $consth->fetchrow_hashref) {
1156                     if ($resrec->{'constrainttype'} eq "o") {
1157                         $resfound = 1;
1158                     }
1159                 }
1160                 $consth->finish;
1161             }
1162         }
1163         if ($resfound) {
1164             my $updquery = "update reserves set found = 'W', itemnumber = '$itemno'
1165                   where borrowernumber = $brn and reservedate = $rdate and biblionumber = $bibno";
1166             my $updsth = $dbh->prepare($updquery);
1167             $updsth->execute;
1168             $updsth->finish;
1169         }
1170     }
1171     $sth->finish;
1172     return ($resfound,$lastrec);
1173 }
1174
1175 END { }       # module clean-up code here (global destructor)