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