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