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