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) = FindReserves($iteminformation->{'biblionumber'}, 0);
 494     if ($resfound) {
 495         $messages->{'ResFound'} = $resrec;
 496     }
 497 # update stats?
 498     UpdateStats(\%env, $branch ,'return','0','',$iteminformation->{'itemnumber'});
 499     return ($doreturn, $messages, $iteminformation, $borrower);
 500 }
 501
 502
 503 sub doreturn {
 504     my ($brn, $itm) = @_;
 505     my $dbh=&C4Connect;
 506     $brn = $dbh->quote($brn);
 507     $itm = $dbh->quote($itm);
 508     my $query = "update issues set returndate = now() where (borrowernumber = $brn)
 509         and (itemnumber = $itm) and (returndate is null)";
 510     my $sth = $dbh->prepare($query);
 511     $sth->execute;
 512     $sth->finish;
 513     return;
 514 }
 515
 516 sub updateitemlost{
 517   my ($itemno)=@_;
 518   my $dbh=&C4Connect;
 519   my $query="update items set itemlost=0 where itemnumber=$itemno";
 520   my $sth=$dbh->prepare($query);
 521   $sth->execute;
 522   $sth->finish;
 523 }
 524
 525 sub fixaccountforlostandreturned {
 526     my ($iteminfo, $borrower) = @_;
 527     my %env;
 528     my $dbh=&C4Connect;
 529     my $itm = $dbh->quote($iteminfo->{'itemnumber'});
 530 # check for charge made for lost book
 531     my $query = "select * from accountlines where (itemnumber = $itm)
 532                           and (accounttype='L' or accounttype='Rep') order by date desc";
 533     my $sth = $dbh->prepare($query);
 534     $sth->execute;
 535     if (my $data = $sth->fetchrow_hashref) {
 536 # writeoff this amount
 537         my $offset;
 538         my $amount = $data->{'amount'};
 539         my $acctno = $data->{'accountno'};
 540         my $amountleft;
 541         if ($data->{'amountoutstanding'} == $amount) {
 542             $offset = $data->{'amount'};
 543             $amountleft = 0;
 544         } else {
 545             $offset = $amount - $data->{'amountoutstanding'};
 546             $amountleft = $data->{'amountoutstanding'} - $amount;
 547         }
 548         my $uquery = "update accountlines set accounttype = 'LR',amountoutstanding='0'
 549                   where (borrowernumber = '$data->{'borrowernumber'}')
 550                   and (itemnumber = $itm) and (accountno = '$acctno') ";
 551         my $usth = $dbh->prepare($uquery);
 552         $usth->execute;
 553         $usth->finish;
 554 #check if any credit is left if so writeoff other accounts
 555         my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
 556         if ($amountleft < 0){
 557             $amountleft*=-1;
 558         }
 559         if ($amountleft > 0){
 560             my $query = "select * from accountlines where (borrowernumber = '$data->{'borrowernumber'}')
 561                                                       and (amountoutstanding >0) order by date";
 562             my $msth = $dbh->prepare($query);
 563             $msth->execute;
 564       # offset transactions
 565             my $newamtos;
 566             my $accdata;
 567             while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
 568                 if ($accdata->{'amountoutstanding'} < $amountleft) {
 569                     $newamtos = 0;
 570                     $amountleft = $amountleft - $accdata->{'amountoutstanding'};
 571                 }  else {
 572                     $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
 573                     $amountleft = 0;
 574                 }
 575                 my $thisacct = $accdata->{'accountno'};
 576                 my $updquery = "update accountlines set amountoutstanding= '$newamtos'
 577                                  where (borrowernumber = '$data->{'borrowernumber'}')
 578                                    and (accountno='$thisacct')";
 579                 my $usth = $dbh->prepare($updquery);
 580                 $usth->execute;
 581                 $usth->finish;
 582                 $updquery = "insert into accountoffsets
 583                           (borrowernumber, accountno, offsetaccount,  offsetamount)
 584                           values
 585                           ('$data->{'borrowernumber'}','$accdata->{'accountno'}','$nextaccntno','$newamtos')";
 586                 my $usth = $dbh->prepare($updquery);
 587                 $usth->execute;
 588                 $usth->finish;
 589             }
 590             $msth->finish;
 591         }
 592         if ($amountleft > 0){
 593             $amountleft*=-1;
 594         }
 595         my $desc="Book Returned ".$iteminfo->{'barcode'};
 596         $uquery = "insert into accountlines
 597                   (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
 598                   values ('$data->{'borrowernumber'}','$nextaccntno',now(),0-$amount,'$desc',
 599                   'CR',$amountleft)";
 600         $usth = $dbh->prepare($uquery);
 601         $usth->execute;
 602         $usth->finish;
 603         $uquery = "insert into accountoffsets
 604                   (borrowernumber, accountno, offsetaccount,  offsetamount)
 605                   values ($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset)";
 606         $usth = $dbh->prepare($uquery);
 607         $usth->execute;
 608         $usth->finish;
 609         $uquery = "update items set paidfor='' where itemnumber=$itm";
 610         $usth = $dbh->prepare($uquery);
 611         $usth->execute;
 612         $usth->finish;
 613     }
 614     $sth->finish;
 615     return;
 616 }
 617
 618 sub fixoverduesonreturn {
 619     my ($brn, $itm) = @_;
 620     my $dbh=&C4Connect;
 621     $itm = $dbh->quote($itm);
 622     $brn = $dbh->quote($brn);
 623 # check for overdue fine
 624     my $query = "select * from accountlines where (borrowernumber=$brn)
 625                            and (itemnumber = $itm) and (accounttype='FU' or accounttype='O')";
 626     my $sth = $dbh->prepare($query);
 627     $sth->execute;
 628 # alter fine to show that the book has been returned
 629     if (my $data = $sth->fetchrow_hashref) {
 630         my $query = "update accountlines set accounttype='F' where (borrowernumber = $brn)
 631                            and (itemnumber = $itm) and (acccountno='$data->{'accountno'}')";
 632         my $usth=$dbh->prepare($query);
 633         $usth->execute();
 634         $usth->finish();
 635     }
 636     $sth->finish;
 637     return;
 638 }
 639
 640 sub patronflags {
 641 # Original subroutine for Circ2.pm
 642     my %flags;
 643     my ($env, $patroninformation, $dbh) = @_;
 644     my $amount = checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh);
 645     if ($amount > 0) {
 646         my %flaginfo;
 647         $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount;
 648         if ($amount > 5) {
 649             $flaginfo{'noissues'} = 1;
 650         }
 651         $flags{'CHARGES'} = \%flaginfo;
 652     } elsif ($amount < 0){
 653        my %flaginfo;
 654        $amount = $amount*-1;
 655        $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", $amount;
 656         $flags{'CHARGES'} = \%flaginfo;
 657     }
 658     if ($patroninformation->{'gonenoaddress'} == 1) {
 659         my %flaginfo;
 660         $flaginfo{'message'} = 'Borrower has no valid address.';
 661         $flaginfo{'noissues'} = 1;
 662         $flags{'GNA'} = \%flaginfo;
 663     }
 664     if ($patroninformation->{'lost'} == 1) {
 665         my %flaginfo;
 666         $flaginfo{'message'} = 'Borrower\'s card reported lost.';
 667         $flaginfo{'noissues'} = 1;
 668         $flags{'LOST'} = \%flaginfo;
 669     }
 670     if ($patroninformation->{'debarred'} == 1) {
 671         my %flaginfo;
 672         $flaginfo{'message'} = 'Borrower is Debarred.';
 673         $flaginfo{'noissues'} = 1;
 674         $flags{'DBARRED'} = \%flaginfo;
 675     }
 676     if ($patroninformation->{'borrowernotes'}) {
 677         my %flaginfo;
 678         $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
 679         $flags{'NOTES'} = \%flaginfo;
 680     }
 681     my ($odues, $itemsoverdue) = checkoverdues($env, $patroninformation->{'borrowernumber'}, $dbh);
 682     if ($odues > 0) {
 683         my %flaginfo;
 684         $flaginfo{'message'} = "Yes";
 685         $flaginfo{'itemlist'} = $itemsoverdue;
 686         foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) {
 687             $flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
 688         }
 689         $flags{'ODUES'} = \%flaginfo;
 690     }
 691     my ($nowaiting, $itemswaiting) = checkwaiting($env, $dbh, $patroninformation->{'borrowernumber'});
 692     if ($nowaiting > 0) {
 693         my %flaginfo;
 694         $flaginfo{'message'} = "Reserved items available";
 695         $flaginfo{'itemlist'} = $itemswaiting;
 696         $flaginfo{'itemfields'} = ['barcode', 'title', 'author', 'dewey', 'subclass', 'holdingbranch'];
 697         $flags{'WAITING'} = \%flaginfo;
 698     }
 699     return(\%flags);
 700 }
 701
 702
 703 sub checkoverdues {
 704 # From Main.pm, modified to return a list of overdueitems, in addition to a count
 705   #checks whether a borrower has overdue items
 706   my ($env,$bornum,$dbh)=@_;
 707   my @datearr = localtime;
 708   my $today = ($datearr[5] + 1900)."-".($datearr[4]+1)."-".$datearr[3];
 709   my @overdueitems;
 710   my $count=0;
 711   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'";
 712   my $sth=$dbh->prepare($query);
 713   $sth->execute;
 714   while (my $data = $sth->fetchrow_hashref) {
 715       push (@overdueitems, $data);
 716       $count++;
 717   }
 718   $sth->finish;
 719   return ($count, \@overdueitems);
 720 }
 721
 722 sub currentborrower {
 723 # Original subroutine for Circ2.pm
 724     my ($itemnumber) = @_;
 725     my $dbh = &C4Connect;
 726     my $q_itemnumber = $dbh->quote($itemnumber);
 727     my $sth=$dbh->prepare("select borrowers.borrowernumber from
 728     issues,borrowers where issues.itemnumber=$q_itemnumber and
 729     issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
 730     NULL");
 731     $sth->execute;
 732     my ($borrower) = $sth->fetchrow;
 733     return($borrower);
 734 }
 735
 736 sub checkreserve {
 737 # Stolen from Main.pm
 738   # Check for reserves for biblio
 739   my ($env,$dbh,$itemnum)=@_;
 740   my $resbor = "";
 741   my $query = "select * from reserves,items
 742     where (items.itemnumber = '$itemnum')
 743     and (reserves.cancellationdate is NULL)
 744     and (items.biblionumber = reserves.biblionumber)
 745     and ((reserves.found = 'W')
 746     or (reserves.found is null))
 747     order by priority";
 748   my $sth = $dbh->prepare($query);
 749   $sth->execute();
 750   my $resrec;
 751   my $data=$sth->fetchrow_hashref;
 752   while ($data && $resbor eq '') {
 753     $resrec=$data;
 754     my $const = $data->{'constrainttype'};
 755     if ($const eq "a") {
 756       $resbor = $data->{'borrowernumber'};
 757     } else {
 758       my $found = 0;
 759       my $cquery = "select * from reserveconstraints,items
 760          where (borrowernumber='$data->{'borrowernumber'}')
 761          and reservedate='$data->{'reservedate'}'
 762          and reserveconstraints.biblionumber='$data->{'biblionumber'}'
 763          and (items.itemnumber=$itemnum and
 764          items.biblioitemnumber = reserveconstraints.biblioitemnumber)";
 765       my $csth = $dbh->prepare($cquery);
 766       $csth->execute;
 767       if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
 768       if ($const eq 'o') {
 769         if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
 770       } else {
 771         if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
 772       }
 773       $csth->finish();
 774     }
 775     $data=$sth->fetchrow_hashref;
 776   }
 777   $sth->finish;
 778   return ($resbor,$resrec);
 779 }
 780
 781 sub currentissues {
 782 # New subroutine for Circ2.pm
 783     my ($env, $borrower) = @_;
 784     my $dbh=&C4Connect;
 785     my %currentissues;
 786     my $counter=1;
 787     my $borrowernumber = $borrower->{'borrowernumber'};
 788     my $crit='';
 789     if ($env->{'todaysissues'}) {
 790         my @datearr = localtime(time());
 791         my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
 792         $crit=" and issues.timestamp like '$today%' ";
 793     }
 794     if ($env->{'nottodaysissues'}) {
 795         my @datearr = localtime(time());
 796         my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
 797         $crit=" and !(issues.timestamp like '$today%') ";
 798     }
 799     my $select="select * from issues,items,biblioitems,biblio where
 800        borrowernumber='$borrowernumber' and issues.itemnumber=items.itemnumber and
 801        items.biblionumber=biblio.biblionumber and
 802        items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is null
 803        $crit order by issues.timestamp desc";
 804 #    print $select;
 805     my $sth=$dbh->prepare($select);
 806     $sth->execute;
 807     while (my $data = $sth->fetchrow_hashref) {
 808         $data->{'dewey'}=~s/0*$//;
 809         ($data->{'dewey'} == 0) && ($data->{'dewey'}='');
 810         my @datearr = localtime(time());
 811         my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]
 812         +1)).sprintf ("%0.2d", $datearr[3]);
 813         my $datedue=$data->{'date_due'};
 814         $datedue=~s/-//g;
 815         if ($datedue < $todaysdate) {
 816             $data->{'overdue'}=1;
 817         }
 818         my $itemnumber=$data->{'itemnumber'};
 819         $currentissues{$counter}=$data;
 820         $counter++;
 821     }
 822     $sth->finish;
 823     $dbh->disconnect;
 824     return(\%currentissues);
 825 }
 826 sub getissues {
 827 # New subroutine for Circ2.pm
 828     my ($borrower) = @_;
 829     my $dbh=&C4Connect;
 830     my $borrowernumber = $borrower->{'borrowernumber'};
 831     my $brn =$dbh->quote($borrowernumber);
 832     my %currentissues;
 833     my $select = "select issues.timestamp, issues.date_due, items.biblionumber,
 834                          items.barcode, biblio.title, biblio.author, biblioitems.dewey,
 835                          biblioitems.subclass
 836                     from issues,items,biblioitems,biblio
 837                    where issues.borrowernumber = $brn
 838                      and issues.itemnumber = items.itemnumber
 839                      and items.biblionumber = biblio.biblionumber
 840                      and items.biblioitemnumber = biblioitems.biblioitemnumber
 841                      and issues.returndate is null
 842                          order by issues.timestamp desc";
 843 #    print $select;
 844     my $sth=$dbh->prepare($select);
 845     $sth->execute;
 846     my $counter = 0;
 847     while (my $data = $sth->fetchrow_hashref) {
 848         $data->{'dewey'} =~ s/0*$//;
 849         ($data->{'dewey'} == 0) && ($data->{'dewey'} = '');
 850         my @datearr = localtime(time());
 851         my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]);
 852         my $datedue = $data->{'date_due'};
 853         $datedue =~ s/-//g;
 854         if ($datedue < $todaysdate) {
 855             $data->{'overdue'} = 1;
 856         }
 857         $currentissues{$counter} = $data;
 858         $counter++;
 859     }
 860     $sth->finish;
 861     $dbh->disconnect;
 862     return(\%currentissues);
 863 }
 864
 865 sub checkwaiting {
 866 #Stolen from Main.pm
 867   # check for reserves waiting
 868   my ($env,$dbh,$bornum)=@_;
 869   my @itemswaiting;
 870   my $query = "select * from reserves
 871     where (borrowernumber = '$bornum')
 872     and (reserves.found='W') and cancellationdate is NULL";
 873   my $sth = $dbh->prepare($query);
 874   $sth->execute();
 875   my $cnt=0;
 876   if (my $data=$sth->fetchrow_hashref) {
 877     @itemswaiting[$cnt] =$data;
 878     $cnt ++
 879   }
 880   $sth->finish;
 881   return ($cnt,\@itemswaiting);
 882 }
 883
 884
 885 sub checkaccount  {
 886 # Stolen from Accounts.pm
 887   #take borrower number
 888   #check accounts and list amounts owing
 889   my ($env,$bornumber,$dbh,$date)=@_;
 890   my $select="Select sum(amountoutstanding) from accountlines where
 891   borrowernumber=$bornumber and amountoutstanding<>0";
 892   if ($date ne ''){
 893     $select.=" and date < '$date'";
 894   }
 895 #  print $select;
 896   my $sth=$dbh->prepare($select);
 897   $sth->execute;
 898   my $total=0;
 899   while (my $data=$sth->fetchrow_hashref){
 900     $total=$total+$data->{'sum(amountoutstanding)'};
 901   }
 902   $sth->finish;
 903   # output(1,2,"borrower owes $total");
 904   #if ($total > 0){
 905   #  # output(1,2,"borrower owes $total");
 906   #  if ($total > 5){
 907   #    reconcileaccount($env,$dbh,$bornumber,$total);
 908   #  }
 909   #}
 910   #  pause();
 911   return($total);
 912 }
 913
 914 sub renewstatus {
 915 # Stolen from Renewals.pm
 916   # check renewal status
 917   my ($env,$dbh,$bornum,$itemno)=@_;
 918   my $renews = 1;
 919   my $renewokay = 0;
 920   my $q1 = "select * from issues
 921     where (borrowernumber = '$bornum')
 922     and (itemnumber = '$itemno')
 923     and returndate is null";
 924   my $sth1 = $dbh->prepare($q1);
 925   $sth1->execute;
 926   if (my $data1 = $sth1->fetchrow_hashref) {
 927     my $q2 = "select renewalsallowed from items,biblioitems,itemtypes
 928        where (items.itemnumber = '$itemno')
 929        and (items.biblioitemnumber = biblioitems.biblioitemnumber)
 930        and (biblioitems.itemtype = itemtypes.itemtype)";
 931     my $sth2 = $dbh->prepare($q2);
 932     $sth2->execute;
 933     if (my $data2=$sth2->fetchrow_hashref) {
 934       $renews = $data2->{'renewalsallowed'};
 935     }
 936     if ($renews > $data1->{'renewals'}) {
 937       $renewokay = 1;
 938     }
 939     $sth2->finish;
 940   }
 941   $sth1->finish;
 942   return($renewokay);
 943 }
 944
 945 sub renewbook {
 946 # Stolen from Renewals.pm
 947   # mark book as renewed
 948   my ($env,$dbh,$bornum,$itemno,$datedue)=@_;
 949   $datedue=$env->{'datedue'};
 950   if ($datedue eq "" ) {
 951     my $loanlength=21;
 952     my $query= "Select * from biblioitems,items,itemtypes
 953        where (items.itemnumber = '$itemno')
 954        and (biblioitems.biblioitemnumber = items.biblioitemnumber)
 955        and (biblioitems.itemtype = itemtypes.itemtype)";
 956     my $sth=$dbh->prepare($query);
 957     $sth->execute;
 958     if (my $data=$sth->fetchrow_hashref) {
 959       $loanlength = $data->{'loanlength'}
 960     }
 961     $sth->finish;
 962     my $ti = time;
 963     my $datedu = time + ($loanlength * 86400);
 964     my @datearr = localtime($datedu);
 965     $datedue = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
 966   }
 967   my @date = split("-",$datedue);
 968   my $odatedue = (@date[2]+0)."-".(@date[1]+0)."-".@date[0];
 969   my $issquery = "select * from issues where borrowernumber='$bornum' and
 970     itemnumber='$itemno' and returndate is null";
 971   my $sth=$dbh->prepare($issquery);
 972   $sth->execute;
 973   my $issuedata=$sth->fetchrow_hashref;
 974   $sth->finish;
 975   my $renews = $issuedata->{'renewals'} +1;
 976   my $updquery = "update issues
 977     set date_due = '$datedue', renewals = '$renews'
 978     where borrowernumber='$bornum' and
 979     itemnumber='$itemno' and returndate is null";
 980   my $sth=$dbh->prepare($updquery);
 981
 982   $sth->execute;
 983   $sth->finish;
 984   return($odatedue);
 985 }
 986
 987 sub calc_charges {
 988 # Stolen from Issues.pm
 989 # calculate charges due
 990     my ($env, $dbh, $itemno, $bornum)=@_;
 991     my $charge=0;
 992     my $item_type;
 993     my $q1 = "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes where (items.itemnumber ='$itemno') and (biblioitems.biblioitemnumber = items.biblioitemnumber) and (biblioitems.itemtype = itemtypes.itemtype)";
 994     my $sth1= $dbh->prepare($q1);
 995     $sth1->execute;
 996     if (my $data1=$sth1->fetchrow_hashref) {
 997         $item_type = $data1->{'itemtype'};
 998         $charge = $data1->{'rentalcharge'};
 999         my $q2 = "select rentaldiscount from borrowers,categoryitem
1000         where (borrowers.borrowernumber = '$bornum')
1001         and (borrowers.categorycode = categoryitem.categorycode)
1002         and (categoryitem.itemtype = '$item_type')";
1003         my $sth2=$dbh->prepare($q2);
1004         $sth2->execute;
1005         if (my $data2=$sth2->fetchrow_hashref) {
1006             my $discount = $data2->{'rentaldiscount'};
1007             $charge = ($charge *(100 - $discount)) / 100;
1008         }
1009         $sth2->{'finish'};
1010     }
1011     $sth1->finish;
1012     return ($charge);
1013 }
1014
1015 sub createcharge {
1016 #Stolen from Issues.pm
1017     my ($env,$dbh,$itemno,$bornum,$charge) = @_;
1018     my $nextaccntno = getnextacctno($env,$bornum,$dbh);
1019     my $query = "insert into accountlines (borrowernumber,itemnumber,accountno,date,amount, description,accounttype,amountoutstanding) values ($bornum,$itemno,$nextaccntno,now(),$charge,'Rental','Rent',$charge)";
1020     my $sth = $dbh->prepare($query);
1021     $sth->execute;
1022     $sth->finish;
1023 }
1024
1025
1026 sub getnextacctno {
1027 # Stolen from Accounts.pm
1028     my ($env,$bornumber,$dbh)=@_;
1029     my $nextaccntno = 1;
1030     my $query = "select * from accountlines where (borrowernumber = '$bornumber') order by accountno desc";
1031     my $sth = $dbh->prepare($query);
1032     $sth->execute;
1033     if (my $accdata=$sth->fetchrow_hashref){
1034         $nextaccntno = $accdata->{'accountno'} + 1;
1035     }
1036     $sth->finish;
1037     return($nextaccntno);
1038 }
1039
1040 sub find_reserves {
1041 # Stolen from Returns.pm
1042     my ($itemno) = @_;
1043     my %env;
1044     my $dbh=&C4Connect;
1045     my ($itemdata) = getiteminformation(\%env, $itemno,0);
1046     my $bibno = $dbh->quote($itemdata->{'biblionumber'});
1047     my $bibitm = $dbh->quote($itemdata->{'biblioitemnumber'});
1048     my $query = "select * from reserves where ((found = 'W') or (found is null))
1049                        and biblionumber = $bibno and cancellationdate is NULL
1050                        order by priority, reservedate ";
1051     my $sth = $dbh->prepare($query);
1052     $sth->execute;
1053     my $resfound = 0;
1054     my $resrec;
1055     my $lastrec;
1056 # print $query;
1057     while (($resrec = $sth->fetchrow_hashref) && (not $resfound)) {
1058         $lastrec = $resrec;
1059         my $brn = $dbh->quote($resrec->{'borrowernumber'});
1060         my $rdate = $dbh->quote($resrec->{'reservedate'});
1061         my $bibno = $dbh->quote($resrec->{'biblionumber'});
1062         if ($resrec->{'found'} eq "W") {
1063             if ($resrec->{'itemnumber'} eq $itemno) {
1064                 $resfound = 1;
1065             }
1066         } else {
1067             if ($resrec->{'constrainttype'} eq "a") {
1068                 $resfound = 1;
1069             } else {
1070                 my $conquery = "select * from reserveconstraints where borrowernumber = $brn
1071                      and reservedate = $rdate and biblionumber = $bibno and biblioitemnumber = $bibitm";
1072                 my $consth = $dbh->prepare($conquery);
1073                 $consth->execute;
1074                 if (my $conrec = $consth->fetchrow_hashref) {
1075                     if ($resrec->{'constrainttype'} eq "o") {
1076                         $resfound = 1;
1077                     }
1078                 }
1079                 $consth->finish;
1080             }
1081         }
1082         if ($resfound) {
1083             my $updquery = "update reserves set found = 'W', itemnumber = '$itemno'
1084                   where borrowernumber = $brn and reservedate = $rdate and biblionumber = $bibno";
1085             my $updsth = $dbh->prepare($updquery);
1086             $updsth->execute;
1087             $updsth->finish;
1088         }
1089     }
1090     $sth->finish;
1091     return ($resfound,$lastrec);
1092 }
1093
1094 END { }       # module clean-up code here (global destructor)