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