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