C4/Circulation/Circ2.pm

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