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     my $message;
 296     SWITCH: {
 297         if ($patroninformation->{'gonenoaddress'}) {
 298             $rejected="Patron is gone, with no known address.";
 299             last SWITCH;
 300         }
 301         if ($patroninformation->{'lost'}) {
 302             $rejected="Patron's card has been reported lost.";
 303             last SWITCH;
 304         }
 305         if ($patroninformation->{'debarred'}) {
 306             $rejected="Patron is Debarred";
 307             last SWITCH;
 308         }
 309         my $amount = checkaccount($env,$patroninformation->{'borrowernumber'}, $dbh,$date);
 310         if ($amount > 5 && $patroninformation->{'categorycode'} ne 'L' &&
 311                          $patroninformation->{'categorycode'} ne 'W' &&
 312                          $patroninformation->{'categorycode'} ne 'I' &&
 313                          $patroninformation->{'categorycode'} ne 'B' &&
 314                          $patroninformation->{'categorycode'} ne 'P') {
 315             $rejected = sprintf "Patron owes \$%.02f.", $amount;
 316             last SWITCH;
 317         }
 318         unless ($iteminformation) {
 319             $rejected = "$barcode is not a valid barcode.";
 320             last SWITCH;
 321         }
 322         if ($iteminformation->{'notforloan'} == 1) {
 323             $rejected="Item not for loan.";
 324             last SWITCH;
 325         }
 326         if ($iteminformation->{'wthdrawn'} == 1) {
 327             $rejected="Item withdrawn.";
 328             last SWITCH;
 329         }
 330         if ($iteminformation->{'restricted'} == 1) {
 331             $rejected="Restricted item.";
 332             last SWITCH;
 333         }
 334         if ($iteminformation->{'itemtype'} eq 'REF') {
 335             $rejected="Reference item:  Not for loan.";
 336             last SWITCH;
 337         }
 338         my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
 339         if ($currentborrower eq $patroninformation->{'borrowernumber'}) {
 340 # Already issued to current borrower
 341             my ($renewstatus) = renewstatus($env,$dbh,$patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
 342             if ($renewstatus == 0) {
 343                 $rejected="No more renewals allowed for this item.";
 344                 last SWITCH;
 345             } else {
 346                 if ($responses->{4} eq '') {
 347                     $questionnumber = 4;
 348                     $question = "Book is issued to this borrower.\nRenew?";
 349                     $defaultanswer = 'Y';
 350                     last SWITCH;
 351                 } elsif ($responses->{4} eq 'Y') {
 352                     my $charge = calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'});
 353                     if ($charge > 0) {
 354                         createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'}, $charge);
 355                         $iteminformation->{'charge'} = $charge;
 356                     }
 357                     &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'});
 358                     renewbook($env,$dbh, $patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
 359                     $noissue=1;
 360                 } else {
 361                     $rejected=-1;
 362                     last SWITCH;
 363                 }
 364             }
 365         } elsif ($currentborrower ne '') {
 366             my ($currborrower, $cbflags) = getpatroninformation($env,$currentborrower,0);
 367             if ($responses->{1} eq '') {
 368                 $questionnumber=1;
 369                 $question = "Issued to $currborrower->{'firstname'} $currborrower->{'surname'} ($currborrower->{'cardnumber'}).\nMark as returned?";
 370                 $defaultanswer='Y';
 371                 last SWITCH;
 372             } elsif ($responses->{1} eq 'Y') {
 373                 returnbook($iteminformation->{'barcode'}, $env->{'branch'});
 374             } else {
 375                 $rejected=-1;
 376                 last SWITCH;
 377             }
 378         }
 379
 380         my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'});
 381         if ($restype) {
 382             my $resbor = $res->{'borrowernumber'};
 383             if ($resbor eq $patroninformation->{'borrowernumber'}) {
 384                 FillReserve($res);
 385             } elsif ($restype eq "Waiting") {
 386                 my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
 387                 my $branches = getbranches();
 388                 my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
 389                 if ($responses->{2} eq '') {
 390                     $questionnumber=2;
 391                     $question="Waiting for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) at $branchname \nAllow issue?";
 392                     $defaultanswer='N';
 393                     last SWITCH;
 394                 } elsif ($responses->{2} eq 'N') {
 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                         CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
 405                     }
 406                 }
 407             } elsif ($restype eq "Reserved") {
 408                 my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
 409                 my $branches = getbranches();
 410                 my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
 411                 if ($responses->{5} eq '') {
 412                     $questionnumber=5;
 413                     $question="Reserved for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) since $res->{'reservedate'} \nAllow issue?";
 414                     $defaultanswer='N';
 415                     last SWITCH;
 416                 } elsif ($responses->{5} eq 'N') {
 417                     if ($responses->{6} eq '') {
 418                         $questionnumber=6;
 419                         $question="Set reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) to waiting and transfer to $branchname?";
 420                         $defaultanswer='N';
 421                     } elsif ($responses->{6} eq 'Y') {
 422                         my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'});
 423                         transferbook($tobrcd, $barcode, 1);
 424                         $message = "Item should now be waiting at $branchname";
 425                     }
 426                     $rejected=-1;
 427                     last SWITCH;
 428                 } else {
 429                     if ($responses->{7} eq '') {
 430                         $questionnumber=7;
 431                         $question="Cancel reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})?";
 432                         $defaultanswer='N';
 433                         last SWITCH;
 434                     } elsif ($responses->{7} eq 'Y') {
 435                         CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
 436                     }
 437                 }
 438             }
 439         }
 440     }
 441     my $dateduef;
 442     unless (($question) || ($rejected) || ($noissue)) {
 443         my $loanlength=21;
 444         if ($iteminformation->{'loanlength'}) {
 445             $loanlength=$iteminformation->{'loanlength'};
 446         }
 447         my $ti=time;
 448         my $datedue=time+($loanlength)*86400;
 449         my @datearr = localtime($datedue);
 450         $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
 451         if ($env->{'datedue'}) {
 452             $dateduef=$env->{'datedue'};
 453         }
 454         $dateduef=~ s/2001\-4\-25/2001\-4\-26/;
 455         my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode) values ($patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'}, '$dateduef', '$env->{'branchcode'}')");
 456         $sth->execute;
 457         $sth->finish;
 458         $iteminformation->{'issues'}++;
 459         $sth=$dbh->prepare("update items set issues=$iteminformation->{'issues'} where itemnumber=$iteminformation->{'itemnumber'}");
 460         $sth->execute;
 461         $sth->finish;
 462         my $charge=calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'});
 463         if ($charge > 0) {
 464             createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'}, $charge);
 465             $iteminformation->{'charge'}=$charge;
 466         }
 467         &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'});
 468     }
 469     if ($iteminformation->{'charge'}) {
 470         $message=sprintf "Rental charge of \$%.02f applies.", $iteminformation->{'charge'};
 471     }
 472     $dbh->disconnect;
 473     return ($iteminformation, $dateduef, $rejected, $question, $questionnumber, $defaultanswer, $message);
 474 }
 475
 476
 477
 478 sub returnbook {
 479     my ($barcode, $branch) = @_;
 480     my %env;
 481     my $messages;
 482     my $doreturn = 1;
 483 # get information on item
 484     my ($iteminformation) = getiteminformation(\%env, 0, $barcode);
 485     if (not $iteminformation) {
 486         $messages->{'BadBarcode'} = $barcode;
 487         $doreturn = 0;
 488     }
 489 # find the borrower
 490     my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
 491     if ((not $currentborrower) && $doreturn) {
 492         $messages->{'NotIssued'} = $barcode;
 493         $doreturn = 0;
 494     }
 495 # check if the book is in a permanent collection....
 496     my $hbr = $iteminformation->{'homebranch'};
 497     my $branches = getbranches();
 498     if ($branches->{$hbr}->{'PE'}) {
 499         $messages->{'IsPermanent'} = $hbr;
 500     }
 501 # update issues, thereby returning book (should push this out into another subroutine
 502     my ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
 503     if ($doreturn) {
 504         doreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
 505         $messages->{'WasReturned'};
 506     }
 507     ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
 508 # transfer book
 509     my ($transfered, $mess, $item) = transferbook($branch, $barcode);
 510     if ($transfered) {
 511         $messages->{'WasTransfered'};
 512     }
 513 # fix up the accounts.....
 514     if ($iteminformation->{'itemlost'}) {
 515         updateitemlost($iteminformation->{'itemnumber'});
 516         fixaccountforlostandreturned($iteminformation, $borrower);
 517         $messages->{'WasLost'};
 518     }
 519 # fix up the overdues in accounts...
 520     fixoverduesonreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
 521 # find reserves.....
 522     my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
 523     if ($resfound) {
 524         $resrec->{'ResFound'} = $resfound;
 525         $messages->{'ResFound'} = $resrec;
 526     }
 527 # update stats?
 528     UpdateStats(\%env, $branch ,'return','0','',$iteminformation->{'itemnumber'});
 529     return ($doreturn, $messages, $iteminformation, $borrower);
 530 }
 531
 532
 533 sub doreturn {
 534     my ($brn, $itm) = @_;
 535     my $dbh=&C4Connect;
 536     $brn = $dbh->quote($brn);
 537     $itm = $dbh->quote($itm);
 538     my $query = "update issues set returndate = now() where (borrowernumber = $brn)
 539         and (itemnumber = $itm) and (returndate is null)";
 540     my $sth = $dbh->prepare($query);
 541     $sth->execute;
 542     $sth->finish;
 543     return;
 544 }
 545
 546 sub updateitemlost{
 547   my ($itemno)=@_;
 548   my $dbh=&C4Connect;
 549   my $query="update items set itemlost=0 where itemnumber=$itemno";
 550   my $sth=$dbh->prepare($query);
 551   $sth->execute;
 552   $sth->finish;
 553 }
 554
 555 sub fixaccountforlostandreturned {
 556     my ($iteminfo, $borrower) = @_;
 557     my %env;
 558     my $dbh=&C4Connect;
 559     my $itm = $dbh->quote($iteminfo->{'itemnumber'});
 560 # check for charge made for lost book
 561     my $query = "select * from accountlines where (itemnumber = $itm)
 562                           and (accounttype='L' or accounttype='Rep') order by date desc";
 563     my $sth = $dbh->prepare($query);
 564     $sth->execute;
 565     if (my $data = $sth->fetchrow_hashref) {
 566 # writeoff this amount
 567         my $offset;
 568         my $amount = $data->{'amount'};
 569         my $acctno = $data->{'accountno'};
 570         my $amountleft;
 571         if ($data->{'amountoutstanding'} == $amount) {
 572             $offset = $data->{'amount'};
 573             $amountleft = 0;
 574         } else {
 575             $offset = $amount - $data->{'amountoutstanding'};
 576             $amountleft = $data->{'amountoutstanding'} - $amount;
 577         }
 578         my $uquery = "update accountlines set accounttype = 'LR',amountoutstanding='0'
 579                   where (borrowernumber = '$data->{'borrowernumber'}')
 580                   and (itemnumber = $itm) and (accountno = '$acctno') ";
 581         my $usth = $dbh->prepare($uquery);
 582         $usth->execute;
 583         $usth->finish;
 584 #check if any credit is left if so writeoff other accounts
 585         my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
 586         if ($amountleft < 0){
 587             $amountleft*=-1;
 588         }
 589         if ($amountleft > 0){
 590             my $query = "select * from accountlines where (borrowernumber = '$data->{'borrowernumber'}')
 591                                                       and (amountoutstanding >0) order by date";
 592             my $msth = $dbh->prepare($query);
 593             $msth->execute;
 594       # offset transactions
 595             my $newamtos;
 596             my $accdata;
 597             while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
 598                 if ($accdata->{'amountoutstanding'} < $amountleft) {
 599                     $newamtos = 0;
 600                     $amountleft = $amountleft - $accdata->{'amountoutstanding'};
 601                 }  else {
 602                     $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
 603                     $amountleft = 0;
 604                 }
 605                 my $thisacct = $accdata->{'accountno'};
 606                 my $updquery = "update accountlines set amountoutstanding= '$newamtos'
 607                                  where (borrowernumber = '$data->{'borrowernumber'}')
 608                                    and (accountno='$thisacct')";
 609                 my $usth = $dbh->prepare($updquery);
 610                 $usth->execute;
 611                 $usth->finish;
 612                 $updquery = "insert into accountoffsets
 613                           (borrowernumber, accountno, offsetaccount,  offsetamount)
 614                           values
 615                           ('$data->{'borrowernumber'}','$accdata->{'accountno'}','$nextaccntno','$newamtos')";
 616                 my $usth = $dbh->prepare($updquery);
 617                 $usth->execute;
 618                 $usth->finish;
 619             }
 620             $msth->finish;
 621         }
 622         if ($amountleft > 0){
 623             $amountleft*=-1;
 624         }
 625         my $desc="Book Returned ".$iteminfo->{'barcode'};
 626         $uquery = "insert into accountlines
 627                   (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
 628                   values ('$data->{'borrowernumber'}','$nextaccntno',now(),0-$amount,'$desc',
 629                   'CR',$amountleft)";
 630         $usth = $dbh->prepare($uquery);
 631         $usth->execute;
 632         $usth->finish;
 633         $uquery = "insert into accountoffsets
 634                   (borrowernumber, accountno, offsetaccount,  offsetamount)
 635                   values ($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset)";
 636         $usth = $dbh->prepare($uquery);
 637         $usth->execute;
 638         $usth->finish;
 639         $uquery = "update items set paidfor='' where itemnumber=$itm";
 640         $usth = $dbh->prepare($uquery);
 641         $usth->execute;
 642         $usth->finish;
 643     }
 644     $sth->finish;
 645     return;
 646 }
 647
 648 sub fixoverduesonreturn {
 649     my ($brn, $itm) = @_;
 650     my $dbh=&C4Connect;
 651     $itm = $dbh->quote($itm);
 652     $brn = $dbh->quote($brn);
 653 # check for overdue fine
 654     my $query = "select * from accountlines where (borrowernumber=$brn)
 655                            and (itemnumber = $itm) and (accounttype='FU' or accounttype='O')";
 656     my $sth = $dbh->prepare($query);
 657     $sth->execute;
 658 # alter fine to show that the book has been returned
 659     if (my $data = $sth->fetchrow_hashref) {
 660         my $query = "update accountlines set accounttype='F' where (borrowernumber = $brn)
 661                            and (itemnumber = $itm) and (acccountno='$data->{'accountno'}')";
 662         my $usth=$dbh->prepare($query);
 663         $usth->execute();
 664         $usth->finish();
 665     }
 666     $sth->finish;
 667     return;
 668 }
 669
 670 sub patronflags {
 671 # Original subroutine for Circ2.pm
 672     my %flags;
 673     my ($env, $patroninformation, $dbh) = @_;
 674     my $amount = checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh);
 675     if ($amount > 0) {
 676         my %flaginfo;
 677         $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount;
 678         if ($amount > 5) {
 679             $flaginfo{'noissues'} = 1;
 680         }
 681         $flags{'CHARGES'} = \%flaginfo;
 682     } elsif ($amount < 0){
 683        my %flaginfo;
 684        $amount = $amount*-1;
 685        $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", $amount;
 686         $flags{'CHARGES'} = \%flaginfo;
 687     }
 688     if ($patroninformation->{'gonenoaddress'} == 1) {
 689         my %flaginfo;
 690         $flaginfo{'message'} = 'Borrower has no valid address.';
 691         $flaginfo{'noissues'} = 1;
 692         $flags{'GNA'} = \%flaginfo;
 693     }
 694     if ($patroninformation->{'lost'} == 1) {
 695         my %flaginfo;
 696         $flaginfo{'message'} = 'Borrower\'s card reported lost.';
 697         $flaginfo{'noissues'} = 1;
 698         $flags{'LOST'} = \%flaginfo;
 699     }
 700     if ($patroninformation->{'debarred'} == 1) {
 701         my %flaginfo;
 702         $flaginfo{'message'} = 'Borrower is Debarred.';
 703         $flaginfo{'noissues'} = 1;
 704         $flags{'DBARRED'} = \%flaginfo;
 705     }
 706     if ($patroninformation->{'borrowernotes'}) {
 707         my %flaginfo;
 708         $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
 709         $flags{'NOTES'} = \%flaginfo;
 710     }
 711     my ($odues, $itemsoverdue)
 712                   = checkoverdues($env, $patroninformation->{'borrowernumber'}, $dbh);
 713     if ($odues > 0) {
 714         my %flaginfo;
 715         $flaginfo{'message'} = "Yes";
 716         $flaginfo{'itemlist'} = $itemsoverdue;
 717         foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) {
 718             $flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
 719         }
 720         $flags{'ODUES'} = \%flaginfo;
 721     }
 722     my ($nowaiting, $itemswaiting)
 723                   = CheckWaiting($patroninformation->{'borrowernumber'});
 724     if ($nowaiting > 0) {
 725         my %flaginfo;
 726         $flaginfo{'message'} = "Reserved items available";
 727         $flaginfo{'itemlist'} = $itemswaiting;
 728         $flags{'WAITING'} = \%flaginfo;
 729     }
 730     return(\%flags);
 731 }
 732
 733
 734 sub checkoverdues {
 735 # From Main.pm, modified to return a list of overdueitems, in addition to a count
 736   #checks whether a borrower has overdue items
 737   my ($env, $bornum, $dbh)=@_;
 738   my @datearr = localtime;
 739   my $today = ($datearr[5] + 1900)."-".($datearr[4]+1)."-".$datearr[3];
 740   my @overdueitems;
 741   my $count = 0;
 742   my $query = "SELECT * FROM issues,biblio,biblioitems,items
 743                        WHERE items.biblioitemnumber = biblioitems.biblioitemnumber
 744                          AND items.biblionumber     = biblio.biblionumber
 745                          AND issues.itemnumber      = items.itemnumber
 746                          AND issues.borrowernumber  = $bornum
 747                          AND issues.returndate is NULL
 748                          AND issues.date_due < '$today'";
 749   my $sth = $dbh->prepare($query);
 750   $sth->execute;
 751   while (my $data = $sth->fetchrow_hashref) {
 752       push (@overdueitems, $data);
 753       $count++;
 754   }
 755   $sth->finish;
 756   return ($count, \@overdueitems);
 757 }
 758
 759 sub currentborrower {
 760 # Original subroutine for Circ2.pm
 761     my ($itemnumber) = @_;
 762     my $dbh = &C4Connect;
 763     my $q_itemnumber = $dbh->quote($itemnumber);
 764     my $sth=$dbh->prepare("select borrowers.borrowernumber from
 765     issues,borrowers where issues.itemnumber=$q_itemnumber and
 766     issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
 767     NULL");
 768     $sth->execute;
 769     my ($borrower) = $sth->fetchrow;
 770     return($borrower);
 771 }
 772
 773 sub checkreserve {
 774 # Stolen from Main.pm
 775   # Check for reserves for biblio
 776   my ($env,$dbh,$itemnum)=@_;
 777   my $resbor = "";
 778   my $query = "select * from reserves,items
 779     where (items.itemnumber = '$itemnum')
 780     and (reserves.cancellationdate is NULL)
 781     and (items.biblionumber = reserves.biblionumber)
 782     and ((reserves.found = 'W')
 783     or (reserves.found is null))
 784     order by priority";
 785   my $sth = $dbh->prepare($query);
 786   $sth->execute();
 787   my $resrec;
 788   my $data=$sth->fetchrow_hashref;
 789   while ($data && $resbor eq '') {
 790     $resrec=$data;
 791     my $const = $data->{'constrainttype'};
 792     if ($const eq "a") {
 793       $resbor = $data->{'borrowernumber'};
 794     } else {
 795       my $found = 0;
 796       my $cquery = "select * from reserveconstraints,items
 797          where (borrowernumber='$data->{'borrowernumber'}')
 798          and reservedate='$data->{'reservedate'}'
 799          and reserveconstraints.biblionumber='$data->{'biblionumber'}'
 800          and (items.itemnumber=$itemnum and
 801          items.biblioitemnumber = reserveconstraints.biblioitemnumber)";
 802       my $csth = $dbh->prepare($cquery);
 803       $csth->execute;
 804       if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
 805       if ($const eq 'o') {
 806         if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
 807       } else {
 808         if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
 809       }
 810       $csth->finish();
 811     }
 812     $data=$sth->fetchrow_hashref;
 813   }
 814   $sth->finish;
 815   return ($resbor,$resrec);
 816 }
 817
 818 sub currentissues {
 819 # New subroutine for Circ2.pm
 820     my ($env, $borrower) = @_;
 821     my $dbh=&C4Connect;
 822     my %currentissues;
 823     my $counter=1;
 824     my $borrowernumber = $borrower->{'borrowernumber'};
 825     my $crit='';
 826     if ($env->{'todaysissues'}) {
 827         my @datearr = localtime(time());
 828         my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
 829         $crit=" and issues.timestamp like '$today%' ";
 830     }
 831     if ($env->{'nottodaysissues'}) {
 832         my @datearr = localtime(time());
 833         my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
 834         $crit=" and !(issues.timestamp like '$today%') ";
 835     }
 836     my $select="select * from issues,items,biblioitems,biblio where
 837        borrowernumber='$borrowernumber' and issues.itemnumber=items.itemnumber and
 838        items.biblionumber=biblio.biblionumber and
 839        items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is null
 840        $crit order by issues.timestamp desc";
 841 #    print $select;
 842     my $sth=$dbh->prepare($select);
 843     $sth->execute;
 844     while (my $data = $sth->fetchrow_hashref) {
 845         $data->{'dewey'}=~s/0*$//;
 846         ($data->{'dewey'} == 0) && ($data->{'dewey'}='');
 847         my @datearr = localtime(time());
 848         my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]
 849         +1)).sprintf ("%0.2d", $datearr[3]);
 850         my $datedue=$data->{'date_due'};
 851         $datedue=~s/-//g;
 852         if ($datedue < $todaysdate) {
 853             $data->{'overdue'}=1;
 854         }
 855         my $itemnumber=$data->{'itemnumber'};
 856         $currentissues{$counter}=$data;
 857         $counter++;
 858     }
 859     $sth->finish;
 860     $dbh->disconnect;
 861     return(\%currentissues);
 862 }
 863 sub getissues {
 864 # New subroutine for Circ2.pm
 865     my ($borrower) = @_;
 866     my $dbh=&C4Connect;
 867     my $borrowernumber = $borrower->{'borrowernumber'};
 868     my $brn =$dbh->quote($borrowernumber);
 869     my %currentissues;
 870     my $select = "select issues.timestamp, issues.date_due, items.biblionumber,
 871                          items.barcode, biblio.title, biblio.author, biblioitems.dewey,
 872                          biblioitems.subclass
 873                     from issues,items,biblioitems,biblio
 874                    where issues.borrowernumber = $brn
 875                      and issues.itemnumber = items.itemnumber
 876                      and items.biblionumber = biblio.biblionumber
 877                      and items.biblioitemnumber = biblioitems.biblioitemnumber
 878                      and issues.returndate is null
 879                          order by issues.timestamp desc";
 880 #    print $select;
 881     my $sth=$dbh->prepare($select);
 882     $sth->execute;
 883     my $counter = 0;
 884     while (my $data = $sth->fetchrow_hashref) {
 885         $data->{'dewey'} =~ s/0*$//;
 886         ($data->{'dewey'} == 0) && ($data->{'dewey'} = '');
 887         my @datearr = localtime(time());
 888         my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]);
 889         my $datedue = $data->{'date_due'};
 890         $datedue =~ s/-//g;
 891         if ($datedue < $todaysdate) {
 892             $data->{'overdue'} = 1;
 893         }
 894         $currentissues{$counter} = $data;
 895         $counter++;
 896     }
 897     $sth->finish;
 898     $dbh->disconnect;
 899     return(\%currentissues);
 900 }
 901
 902 sub checkwaiting {
 903 #Stolen from Main.pm
 904   # check for reserves waiting
 905   my ($env,$dbh,$bornum)=@_;
 906   my @itemswaiting;
 907   my $query = "select * from reserves
 908     where (borrowernumber = '$bornum')
 909     and (reserves.found='W') and cancellationdate is NULL";
 910   my $sth = $dbh->prepare($query);
 911   $sth->execute();
 912   my $cnt=0;
 913   if (my $data=$sth->fetchrow_hashref) {
 914     @itemswaiting[$cnt] =$data;
 915     $cnt ++
 916   }
 917   $sth->finish;
 918   return ($cnt,\@itemswaiting);
 919 }
 920
 921
 922 sub checkaccount  {
 923 # Stolen from Accounts.pm
 924   #take borrower number
 925   #check accounts and list amounts owing
 926   my ($env,$bornumber,$dbh,$date)=@_;
 927   my $select="Select sum(amountoutstanding) from accountlines where
 928   borrowernumber=$bornumber and amountoutstanding<>0";
 929   if ($date ne ''){
 930     $select.=" and date < '$date'";
 931   }
 932 #  print $select;
 933   my $sth=$dbh->prepare($select);
 934   $sth->execute;
 935   my $total=0;
 936   while (my $data=$sth->fetchrow_hashref){
 937     $total=$total+$data->{'sum(amountoutstanding)'};
 938   }
 939   $sth->finish;
 940   # output(1,2,"borrower owes $total");
 941   #if ($total > 0){
 942   #  # output(1,2,"borrower owes $total");
 943   #  if ($total > 5){
 944   #    reconcileaccount($env,$dbh,$bornumber,$total);
 945   #  }
 946   #}
 947   #  pause();
 948   return($total);
 949 }
 950
 951 sub renewstatus {
 952 # Stolen from Renewals.pm
 953   # check renewal status
 954   my ($env,$dbh,$bornum,$itemno)=@_;
 955   my $renews = 1;
 956   my $renewokay = 0;
 957   my $q1 = "select * from issues
 958     where (borrowernumber = '$bornum')
 959     and (itemnumber = '$itemno')
 960     and returndate is null";
 961   my $sth1 = $dbh->prepare($q1);
 962   $sth1->execute;
 963   if (my $data1 = $sth1->fetchrow_hashref) {
 964     my $q2 = "select renewalsallowed from items,biblioitems,itemtypes
 965        where (items.itemnumber = '$itemno')
 966        and (items.biblioitemnumber = biblioitems.biblioitemnumber)
 967        and (biblioitems.itemtype = itemtypes.itemtype)";
 968     my $sth2 = $dbh->prepare($q2);
 969     $sth2->execute;
 970     if (my $data2=$sth2->fetchrow_hashref) {
 971       $renews = $data2->{'renewalsallowed'};
 972     }
 973     if ($renews > $data1->{'renewals'}) {
 974       $renewokay = 1;
 975     }
 976     $sth2->finish;
 977   }
 978   $sth1->finish;
 979   return($renewokay);
 980 }
 981
 982 sub renewbook {
 983 # Stolen from Renewals.pm
 984   # mark book as renewed
 985   my ($env,$dbh,$bornum,$itemno,$datedue)=@_;
 986   $datedue=$env->{'datedue'};
 987   if ($datedue eq "" ) {
 988     my $loanlength=21;
 989     my $query= "Select * from biblioitems,items,itemtypes
 990        where (items.itemnumber = '$itemno')
 991        and (biblioitems.biblioitemnumber = items.biblioitemnumber)
 992        and (biblioitems.itemtype = itemtypes.itemtype)";
 993     my $sth=$dbh->prepare($query);
 994     $sth->execute;
 995     if (my $data=$sth->fetchrow_hashref) {
 996       $loanlength = $data->{'loanlength'}
 997     }
 998     $sth->finish;
 999     my $ti = time;
1000     my $datedu = time + ($loanlength * 86400);
1001     my @datearr = localtime($datedu);
1002     $datedue = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
1003   }
1004   my @date = split("-",$datedue);
1005   my $odatedue = (@date[2]+0)."-".(@date[1]+0)."-".@date[0];
1006   my $issquery = "select * from issues where borrowernumber='$bornum' and
1007     itemnumber='$itemno' and returndate is null";
1008   my $sth=$dbh->prepare($issquery);
1009   $sth->execute;
1010   my $issuedata=$sth->fetchrow_hashref;
1011   $sth->finish;
1012   my $renews = $issuedata->{'renewals'} +1;
1013   my $updquery = "update issues
1014     set date_due = '$datedue', renewals = '$renews'
1015     where borrowernumber='$bornum' and
1016     itemnumber='$itemno' and returndate is null";
1017   my $sth=$dbh->prepare($updquery);
1018
1019   $sth->execute;
1020   $sth->finish;
1021   return($odatedue);
1022 }
1023
1024 sub calc_charges {
1025 # Stolen from Issues.pm
1026 # calculate charges due
1027     my ($env, $dbh, $itemno, $bornum)=@_;
1028     my $charge=0;
1029     my $item_type;
1030     my $q1 = "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes where (items.itemnumber ='$itemno') and (biblioitems.biblioitemnumber = items.biblioitemnumber) and (biblioitems.itemtype = itemtypes.itemtype)";
1031     my $sth1= $dbh->prepare($q1);
1032     $sth1->execute;
1033     if (my $data1=$sth1->fetchrow_hashref) {
1034         $item_type = $data1->{'itemtype'};
1035         $charge = $data1->{'rentalcharge'};
1036         my $q2 = "select rentaldiscount from borrowers,categoryitem
1037         where (borrowers.borrowernumber = '$bornum')
1038         and (borrowers.categorycode = categoryitem.categorycode)
1039         and (categoryitem.itemtype = '$item_type')";
1040         my $sth2=$dbh->prepare($q2);
1041         $sth2->execute;
1042         if (my $data2=$sth2->fetchrow_hashref) {
1043             my $discount = $data2->{'rentaldiscount'};
1044             $charge = ($charge *(100 - $discount)) / 100;
1045         }
1046         $sth2->{'finish'};
1047     }
1048     $sth1->finish;
1049     return ($charge);
1050 }
1051
1052 sub createcharge {
1053 #Stolen from Issues.pm
1054     my ($env,$dbh,$itemno,$bornum,$charge) = @_;
1055     my $nextaccntno = getnextacctno($env,$bornum,$dbh);
1056     my $query = "insert into accountlines (borrowernumber,itemnumber,accountno,date,amount, description,accounttype,amountoutstanding) values ($bornum,$itemno,$nextaccntno,now(),$charge,'Rental','Rent',$charge)";
1057     my $sth = $dbh->prepare($query);
1058     $sth->execute;
1059     $sth->finish;
1060 }
1061
1062
1063 sub getnextacctno {
1064 # Stolen from Accounts.pm
1065     my ($env,$bornumber,$dbh)=@_;
1066     my $nextaccntno = 1;
1067     my $query = "select * from accountlines where (borrowernumber = '$bornumber') order by accountno desc";
1068     my $sth = $dbh->prepare($query);
1069     $sth->execute;
1070     if (my $accdata=$sth->fetchrow_hashref){
1071         $nextaccntno = $accdata->{'accountno'} + 1;
1072     }
1073     $sth->finish;
1074     return($nextaccntno);
1075 }
1076
1077 sub find_reserves {
1078 # Stolen from Returns.pm
1079     my ($itemno) = @_;
1080     my %env;
1081     my $dbh=&C4Connect;
1082     my ($itemdata) = getiteminformation(\%env, $itemno,0);
1083     my $bibno = $dbh->quote($itemdata->{'biblionumber'});
1084     my $bibitm = $dbh->quote($itemdata->{'biblioitemnumber'});
1085     my $query = "select * from reserves where ((found = 'W') or (found is null))
1086                        and biblionumber = $bibno and cancellationdate is NULL
1087                        order by priority, reservedate ";
1088     my $sth = $dbh->prepare($query);
1089     $sth->execute;
1090     my $resfound = 0;
1091     my $resrec;
1092     my $lastrec;
1093 # print $query;
1094     while (($resrec = $sth->fetchrow_hashref) && (not $resfound)) {
1095         $lastrec = $resrec;
1096         my $brn = $dbh->quote($resrec->{'borrowernumber'});
1097         my $rdate = $dbh->quote($resrec->{'reservedate'});
1098         my $bibno = $dbh->quote($resrec->{'biblionumber'});
1099         if ($resrec->{'found'} eq "W") {
1100             if ($resrec->{'itemnumber'} eq $itemno) {
1101                 $resfound = 1;
1102             }
1103         } else {
1104             if ($resrec->{'constrainttype'} eq "a") {
1105                 $resfound = 1;
1106             } else {
1107                 my $conquery = "select * from reserveconstraints where borrowernumber = $brn
1108                      and reservedate = $rdate and biblionumber = $bibno and biblioitemnumber = $bibitm";
1109                 my $consth = $dbh->prepare($conquery);
1110                 $consth->execute;
1111                 if (my $conrec = $consth->fetchrow_hashref) {
1112                     if ($resrec->{'constrainttype'} eq "o") {
1113                         $resfound = 1;
1114                     }
1115                 }
1116                 $consth->finish;
1117             }
1118         }
1119         if ($resfound) {
1120             my $updquery = "update reserves set found = 'W', itemnumber = '$itemno'
1121                   where borrowernumber = $brn and reservedate = $rdate and biblionumber = $bibno";
1122             my $updsth = $dbh->prepare($updquery);
1123             $updsth->execute;
1124             $updsth->finish;
1125         }
1126     }
1127     $sth->finish;
1128     return ($resfound,$lastrec);
1129 }
1130
1131 END { }       # module clean-up code here (global destructor)