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 %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
  28
  29 # your exported package globals go here,
  30 # as well as any optionally exported functions
  31
  32 @EXPORT_OK   = qw($Var1 %Hashit);
  33
  34
  35 # non-exported package globals go here
  36 #use vars qw(@more $stuff);
  37
  38 # initalize package globals, first exported ones
  39
  40 my $Var1   = '';
  41 my %Hashit = ();
  42
  43 # then the others (which are still accessible as $Some::Module::stuff)
  44 my $stuff  = '';
  45 my @more   = ();
  46
  47 # all file-scoped lexicals must be created before
  48 # the functions below that use them.
  49
  50 # file-private lexicals go here
  51 my $priv_var    = '';
  52 my %secret_hash = ();
  53
  54 # here's a file-private function as a closure,
  55 # callable as &$priv_func;  it cannot be prototyped.
  56 my $priv_func = sub {
  57   # stuff goes here.
  58 };
  59
  60 # make all your functions, whether exported or not;
  61
  62
  63 sub getbranches {
  64     my ($env) = @_;
  65     my %branches;
  66     my $dbh=&C4Connect;
  67     my $sth=$dbh->prepare("select * from branches");
  68     $sth->execute;
  69     while (my $branch=$sth->fetchrow_hashref) {
  70         $branches{$branch->{'branchcode'}}=$branch;
  71     }
  72     return (\%branches);
  73 }
  74
  75
  76 sub getprinters {
  77     my ($env) = @_;
  78     my %printers;
  79     my $dbh=&C4Connect;
  80     my $sth=$dbh->prepare("select * from printers");
  81     $sth->execute;
  82     while (my $printer=$sth->fetchrow_hashref) {
  83         $printers{$printer->{'printqueue'}}=$printer;
  84     }
  85     return (\%printers);
  86 }
  87
  88
  89
  90 sub getpatroninformation {
  91 # returns
  92     my ($env, $borrowernumber,$cardnumber) = @_;
  93     my $dbh=&C4Connect;
  94     my $sth;
  95     open O, ">>/root/tkcirc.out";
  96     print O "Looking up patron $borrowernumber / $cardnumber\n";
  97     if ($borrowernumber) {
  98         $sth=$dbh->prepare("select * from borrowers where borrowernumber=$borrowernumber");
  99     } elsif ($cardnumber) {
 100         $sth=$dbh->prepare("select * from borrowers where cardnumber=$cardnumber");
 101     } else {
 102          # error condition.  This subroutine must be called with either a
 103          # borrowernumber or a card number.
 104         $env->{'apierror'}="invalid borrower information passed to getpatroninformation subroutine";
 105          return();
 106     }
 107     $sth->execute;
 108     my $borrower=$sth->fetchrow_hashref;
 109     my $flags=patronflags($env, $borrower, $dbh);
 110     $sth->finish;
 111     $dbh->disconnect;
 112     print O "$borrower->{'surname'} <---\n";
 113     close O;
 114     $borrower->{'flags'}=$flags;
 115     return($borrower, $flags);
 116 }
 117
 118
 119
 120
 121
 122 sub getiteminformation {
 123 # returns a hash of item information given either the itemnumber or the barcode
 124     my ($env, $itemnumber, $barcode) = @_;
 125     my $dbh=&C4Connect;
 126     my $sth;
 127     if ($itemnumber) {
 128         $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.itemnumber=$itemnumber and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
 129     } elsif ($barcode) {
 130         my $q_barcode=$dbh->quote($barcode);
 131         $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.barcode=$q_barcode and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
 132     } else {
 133         $env->{'apierror'}="getiteminformation() subroutine must be called with either an itemnumber or a barcode";
 134         # Error condition.
 135         return();
 136     }
 137     $sth->execute;
 138     my $iteminformation=$sth->fetchrow_hashref;
 139     $sth->finish;
 140     $dbh->disconnect;
 141     $iteminformation->{'dewey'}=~s/0*$//;
 142     return($iteminformation);
 143 }
 144
 145 sub findborrower {
 146 # returns an array of borrower hash references, given a cardnumber or a partial
 147 # surname
 148     my ($env, $key) = @_;
 149     my $dbh=&C4Connect;
 150     my @borrowers;
 151     my $q_key=$dbh->quote($key);
 152     my $sth=$dbh->prepare("select * from borrowers where cardnumber=$q_key");
 153     $sth->execute;
 154     if ($sth->rows) {
 155         my ($borrower)=$sth->fetchrow_hashref;
 156         push (@borrowers, $borrower);
 157     } else {
 158         $q_key=$dbh->quote("$key%");
 159         $sth->finish;
 160         $sth=$dbh->prepare("select * from borrowers where surname like $q_key");
 161         $sth->execute;
 162         while (my $borrower = $sth->fetchrow_hashref) {
 163             push (@borrowers, $borrower);
 164         }
 165     }
 166     $sth->finish;
 167     $dbh->disconnect;
 168     return(\@borrowers);
 169 }
 170
 171
 172 sub issuebook {
 173     my ($env, $patroninformation, $barcode, $responses) = @_;
 174     my $dbh=&C4Connect;
 175     my $iteminformation=getiteminformation($env, 0, $barcode);
 176     my ($datedue);
 177     my ($rejected,$question,$defaultanswer,$questionnumber, $noissue);
 178     SWITCH: {
 179         if ($patroninformation->{'gonenoaddress'}) {
 180             $rejected="Patron is gone, with no known address.";
 181             last SWITCH;
 182         }
 183         if ($patroninformation->{'lost'}) {
 184             $rejected="Patron's card has been reported lost.";
 185             last SWITCH;
 186         }
 187         my $amount = checkaccount($env,$patroninformation->{'borrowernumber'}, $dbh);
 188         if ($amount>5) {
 189             $rejected=sprintf "Patron owes \$%.02f.", $amount;
 190             last SWITCH;
 191         }
 192         if ($iteminformation->{'notforloan'} == 1) {
 193             $rejected="Item not for loan.";
 194             last SWITCH;
 195         }
 196         if ($iteminformation->{'wthdrawn'} == 1) {
 197             $rejected="Item withdrawn.";
 198             last SWITCH;
 199         }
 200         if ($iteminformation->{'restricted'} == 1) {
 201             $rejected="Restricted item.";
 202             last SWITCH;
 203         }
 204         if ($iteminformation->{'itemtype'} eq 'REF') {
 205             $rejected="Reference item:  Not for loan.";
 206             last SWITCH;
 207         }
 208         my ($currentborrower) = currentborrower($env, $iteminformation->{'itemnumber'}, $dbh);
 209         if ($currentborrower eq $patroninformation->{'borrowernumber'}) {
 210 # Already issued to current borrower
 211             my ($renewstatus) = renewstatus($env,$dbh,$patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
 212             if ($renewstatus == 0) {
 213                 $rejected="No more renewals allowed for this item.";
 214                 last SWITCH;
 215             } else {
 216                 if ($responses->{4} eq '') {
 217                     $questionnumber=4;
 218                     $question="Book is issued to this borrower.\nRenew?";
 219                     $defaultanswer='Y';
 220                     last SWITCH;
 221                 } elsif ($responses->{4} eq 'Y') {
 222                     my $charge=calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'});
 223                     if ($charge > 0) {
 224                         createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'}, $charge);
 225                         $iteminformation->{'charge'}=$charge;
 226                     }
 227                     &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'});
 228                     renewbook($env,$dbh, $patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
 229                     $noissue=1;
 230                 } else {
 231                     $rejected=-1;
 232                     last SWITCH;
 233                 }
 234             }
 235         } elsif ($currentborrower ne '') {
 236             my ($currborrower, $cbflags)=getpatroninformation($env,$currentborrower,0);
 237             if ($responses->{1} eq '') {
 238                 $questionnumber=1;
 239                 $question="Issued to $currborrower->{'firstname'} $currborrower->{'surname'} ($currborrower->{'cardnumber'}).\nMark as returned?";
 240                 $defaultanswer='Y';
 241                 last SWITCH;
 242             } elsif ($responses->{1} eq 'Y') {
 243                 returnbook($env,$iteminformation->{'barcode'});
 244             } else {
 245                 $rejected=-1;
 246                 last SWITCH;
 247             }
 248         }
 249
 250         my ($resbor, $resrec) = checkreserve($env, $dbh, $iteminformation->{'itemnumber'});
 251
 252         if ($resbor eq $patroninformation->{'borrowernumber'}) {
 253              my $rquery = "update reserves set found = 'F' where reservedate = '$resrec->{'reservedate'}' and borrowernumber = '$resrec->{'borrowernumber'}' and biblionumber = '$resrec->{'biblionumber'}'";
 254              my $rsth = $dbh->prepare($rquery);
 255              $rsth->execute;
 256              $rsth->finish;
 257         } elsif ($resbor ne "") {
 258             my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
 259             if ($responses->{2} eq '') {
 260                 $questionnumber=2;
 261                 $question="Reserved for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) since $resrec->{'reservedate'}\nAllow issue?";
 262                 $defaultanswer='N';
 263                 last SWITCH;
 264             } elsif ($responses->{2} eq 'N') {
 265                 #printreserve($env, $resrec, $resborrower, $iteminformation);
 266                 $rejected=-1;
 267                 last SWITCH;
 268             } else {
 269                 if ($responses->{3} eq '') {
 270                     $questionnumber=3;
 271                     $question="Cancel reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})?";
 272                     $defaultanswer='N';
 273                     last SWITCH;
 274                 } elsif ($responses->{3} eq 'Y') {
 275                     my $rquery = "update reserves set found = 'F' where reservedate = '$resrec->{'reservedate'}' and borrowernumber = '$resrec->{'borrowernumber'}' and biblionumber = '$resrec->{'biblionumber'}'";
 276                     my $rsth = $dbh->prepare($rquery);
 277                     $rsth->execute;
 278                     $rsth->finish;
 279                 }
 280             }
 281         }
 282     }
 283     my $dateduef;
 284     unless (($question) || ($rejected) || ($noissue)) {
 285         my $loanlength=21;
 286         if ($iteminformation->{'loanlength'}) {
 287             $loanlength=$iteminformation->{'loanlength'};
 288         }
 289         my $ti=time;
 290         my $datedue=time+($loanlength)*86400;
 291         my @datearr = localtime($datedue);
 292         $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
 293         if ($env->{'datedue'}) {
 294             $dateduef=$env->{'datedue'};
 295         }
 296         my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode) values ($patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'}, '$dateduef', '$env->{'branchcode'}')");
 297         $sth->execute;
 298         $sth->finish;
 299         $iteminformation->{'issues'}++;
 300         $sth=$dbh->prepare("update items set issues=$iteminformation->{'issues'} where itemnumber=$iteminformation->{'itemnumber'}");
 301         $sth->execute;
 302         $sth->finish;
 303         my $charge=calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'});
 304         if ($charge > 0) {
 305             createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'}, $charge);
 306             $iteminformation->{'charge'}=$charge;
 307         }
 308         &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'});
 309     }
 310     my $message='';
 311     if ($iteminformation->{'charge'}) {
 312         $message=sprintf "Rental charge of \$%.02f applies.", $iteminformation->{'charge'};
 313     }
 314     $dbh->disconnect;
 315     return ($iteminformation, $dateduef, $rejected, $question, $questionnumber, $defaultanswer, $message);
 316 }
 317
 318
 319 sub returnbook {
 320     my ($env, $barcode) = @_;
 321     my ($messages, $overduecharge);
 322     my $dbh=&C4Connect;
 323     my ($iteminformation) = getiteminformation($env, 0, $barcode);
 324     my $borrower;
 325     if ($iteminformation) {
 326         my $sth=$dbh->prepare("select * from issues where (itemnumber='$iteminformation->{'itemnumber'}') and (returndate is null)");
 327         $sth->execute;
 328         my ($currentborrower) = currentborrower($env, $iteminformation->{'itemnumber'}, $dbh);
 329         updatelastseen($env,$dbh,$iteminformation->{'itemnumber'});
 330         if ($currentborrower) {
 331             ($borrower)=getpatroninformation($env,$currentborrower,0);
 332             my @datearr = localtime(time);
 333             my $dateret = (1900+$datearr[5])."-".$datearr[4]."-".$datearr[3];
 334             my $query = "update issues set returndate = now(), branchcode ='$env->{'branchcode'}' where (borrowernumber = $borrower->{'borrowernumber'}) and (itemnumber = $iteminformation->{'itemnumber'}) and (returndate is null)";
 335             my $sth = $dbh->prepare($query);
 336             $sth->execute;
 337             $sth->finish;
 338
 339
 340             # check for overdue fine
 341
 342             $overduecharge;
 343             $sth=$dbh->prepare("select * from accountlines where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber = $iteminformation->{'itemnumber'}) and (accounttype='FU' or accounttype='O')");
 344             $sth->execute;
 345             # alter fine to show that the book has been returned
 346             if (my $data = $sth->fetchrow_hashref) {
 347                 my $usth=$dbh->prepare("update accountlines set accounttype='F' where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber=$iteminformation->{'itemnumber'}) and (acccountno='$data->{'accountno'}')");
 348                 $usth->execute();
 349                 $usth->finish();
 350                 $overduecharge=$data->{'amountoutstanding'};
 351             }
 352             $sth->finish;
 353             # check for charge made for lost book
 354             $sth=$dbh->prepare("select * from accountlines where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber = $iteminformation->{'itemnumber'}) and (accounttype='L')");
 355             $sth->execute;
 356             if (my $data = $sth->fetchrow_hashref) {
 357                 # writeoff this amount
 358                 my $offset;
 359                 my $amount = $data->{'amount'};
 360                 my $acctno = $data->{'accountno'};
 361                 my $amountleft;
 362                 if ($data->{'amountoutstanding'} == $amount) {
 363                     $offset = $data->{'amount'};
 364                     $amountleft = 0;
 365                 } else {
 366                     $offset = $amount - $data->{'amountoutstanding'};
 367                     $amountleft = $data->{'amountoutstanding'} - $amount;
 368                 }
 369                 my $uquery = "update accountlines
 370                   set accounttype = 'LR',amountoutstanding='0'
 371                   where (borrowernumber = $borrower->{'borrowernumber'})
 372                   and (itemnumber = $iteminformation->{'itemnumber'})
 373                   and (accountno = '$acctno') ";
 374                 my $usth = $dbh->prepare($uquery);
 375                 $usth->execute();
 376                 $usth->finish;
 377                 my $nextaccntno = C4::Accounts::getnextacctno($env,$borrower->{'borrowernumber'},$dbh);
 378                 $uquery = "insert into accountlines
 379                   (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
 380                   values ($borrower->{'borrowernumber'},$nextaccntno,now(),0-$amount,'Book Returned',
 381                   'CR',$amountleft)";
 382                 $usth = $dbh->prepare($uquery);
 383                 $usth->execute;
 384                 $usth->finish;
 385                 $uquery = "insert into accountoffsets
 386                   (borrowernumber, accountno, offsetaccount,  offsetamount)
 387                   values ($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset)";
 388                 $usth = $dbh->prepare($uquery);
 389                 $usth->execute;
 390                 $usth->finish;
 391             }
 392             $sth->finish;
 393         }
 394         UpdateStats($env,'branch','return','0','',$iteminformation->{'itemnumber'});
 395     }
 396     $dbh->disconnect;
 397     return ($iteminformation, $borrower, $messages, $overduecharge);
 398 }
 399
 400
 401 sub patronflags {
 402 # Original subroutine for Circ2.pm
 403     my %flags;
 404     my ($env,$patroninformation,$dbh) = @_;
 405     my $amount = checkaccount($env,$patroninformation->{'borrowernumber'}, $dbh);
 406     if ($amount>0) {
 407         my %flaginfo;
 408         $flaginfo{'message'}=sprintf "Patron owes \$%.02f", $amount;
 409         if ($amount>5) {
 410             $flaginfo{'noissues'}=1;
 411         }
 412         $flags{'CHARGES'}=\%flaginfo;
 413     }
 414     if ($patroninformation->{'gonenoaddress'} == 1) {
 415         my %flaginfo;
 416         $flaginfo{'message'}='Borrower has no valid address.';
 417         $flaginfo{'noissues'}=1;
 418         $flags{'GNA'}=\%flaginfo;
 419     }
 420     if ($patroninformation->{'lost'} == 1) {
 421         my %flaginfo;
 422         $flaginfo{'message'}='Borrower\'s card reported lost.';
 423         $flaginfo{'noissues'}=1;
 424         $flags{'LOST'}=\%flaginfo;
 425     }
 426     if ($patroninformation->{'borrowernotes'}) {
 427         my %flaginfo;
 428         $flaginfo{'message'}="$patroninformation->{'borrowernotes'}";
 429         $flags{'NOTES'}=\%flaginfo;
 430     }
 431     my ($odues, $itemsoverdue) = checkoverdues($env,$patroninformation->{'borrowernumber'},$dbh);
 432     if ($odues > 0) {
 433         my %flaginfo;
 434         $flaginfo{'message'}="Overdue Items\n";
 435         foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) {
 436             $flaginfo{'message'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
 437         }
 438         $flags{'ODUES'}=\%flaginfo;
 439     }
 440     my ($nowaiting,$itemswaiting) = checkwaiting($env,$dbh,$patroninformation->{'borrowernumber'});
 441     if ($nowaiting>0) {
 442         my %flaginfo;
 443         $flaginfo{'message'}="Reserved items available";
 444         $flaginfo{'itemlist'}=$itemswaiting;
 445         $flaginfo{'itemfields'}=['barcode', 'title', 'author', 'dewey', 'subclass', 'holdingbranch'];
 446         $flags{'WAITING'}=\%flaginfo;
 447     }
 448     my $flag;
 449     my $key;
 450     return(\%flags);
 451 }
 452
 453
 454 sub checkoverdues {
 455 # From Main.pm, modified to return a list of overdueitems, in addition to a count
 456   #checks whether a borrower has overdue items
 457   my ($env,$bornum,$dbh)=@_;
 458   my @datearr = localtime;
 459   my $today = ($datearr[5] + 1900)."-".($datearr[4]+1)."-".$datearr[3];
 460   my @overdueitems;
 461   my $count=0;
 462   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'";
 463   my $sth=$dbh->prepare($query);
 464   $sth->execute;
 465   while (my $data = $sth->fetchrow_hashref) {
 466       push (@overdueitems, $data);
 467       $count++;
 468   }
 469   $sth->finish;
 470   return ($count, \@overdueitems);
 471 }
 472
 473 sub updatelastseen {
 474 # Stolen from Returns.pm
 475     my ($env,$dbh,$itemnumber)= @_;
 476     my $br = $env->{'branchcode'};
 477     my $query = "update items
 478     set datelastseen = now(), holdingbranch = '$br'
 479     where (itemnumber = '$itemnumber')";
 480     my $sth = $dbh->prepare($query);
 481     $sth->execute;
 482     $sth->finish;
 483 }
 484
 485 sub currentborrower {
 486 # Original subroutine for Circ2.pm
 487     my ($env, $itemnumber, $dbh) = @_;
 488     my $q_itemnumber=$dbh->quote($itemnumber);
 489     my $sth=$dbh->prepare("select borrowers.borrowernumber from
 490     issues,borrowers where issues.itemnumber=$q_itemnumber and
 491     issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
 492     NULL");
 493     $sth->execute;
 494     my ($previousborrower)=$sth->fetchrow;
 495     return($previousborrower);
 496 }
 497
 498 sub checkreserve {
 499 # Stolen from Main.pm
 500   # Check for reserves for biblio
 501   my ($env,$dbh,$itemnum)=@_;
 502   my $resbor = "";
 503   my $query = "select * from reserves,items
 504     where (items.itemnumber = '$itemnum')
 505     and (reserves.cancellationdate is NULL)
 506     and (items.biblionumber = reserves.biblionumber)
 507     and ((reserves.found = 'W')
 508     or (reserves.found is null))
 509     order by priority";
 510   my $sth = $dbh->prepare($query);
 511   $sth->execute();
 512   my $resrec;
 513   if (my $data=$sth->fetchrow_hashref) {
 514     $resrec=$data;
 515     my $const = $data->{'constrainttype'};
 516     if ($const eq "a") {
 517       $resbor = $data->{'borrowernumber'};
 518     } else {
 519       my $found = 0;
 520       my $cquery = "select * from reserveconstraints,items
 521          where (borrowernumber='$data->{'borrowernumber'}')
 522          and reservedate='$data->{'reservedate'}'
 523          and reserveconstraints.biblionumber='$data->{'biblionumber'}'
 524          and (items.itemnumber=$itemnum and
 525          items.biblioitemnumber = reserveconstraints.biblioitemnumber)";
 526       my $csth = $dbh->prepare($cquery);
 527       $csth->execute;
 528       if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
 529       if ($const eq 'o') {
 530         if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
 531       } else {
 532         if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
 533       }
 534       $csth->finish();
 535     }
 536   }
 537   $sth->finish;
 538   return ($resbor,$resrec);
 539 }
 540
 541 sub currentissues {
 542 # New subroutine for Circ2.pm
 543     my ($env, $borrower) = @_;
 544     my $dbh=&C4Connect;
 545     my %currentissues;
 546     my $counter=1;
 547     my $borrowernumber=$borrower->{'borrowernumber'};
 548     my $crit='';
 549     if ($env->{'todaysissues'}) {
 550         my @datearr = localtime(time());
 551         my $today = (1900+$datearr[5]).sprintf "0%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
 552         $crit=" and issues.timestamp like '$today%' ";
 553     }
 554     if ($env->{'nottodaysissues'}) {
 555         my @datearr = localtime(time());
 556         my $today = (1900+$datearr[5]).sprintf "0%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
 557         $crit=" and !(issues.timestamp like '$today%') ";
 558     }
 559     my $sth=$dbh->prepare("select * from issues,items,biblioitems,biblio where borrowernumber=$borrowernumber and issues.itemnumber=items.itemnumber and items.biblionumber=biblio.biblionumber and items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is null $crit order by date_due");
 560     $sth->execute;
 561     while (my $data = $sth->fetchrow_hashref) {
 562         $data->{'dewey'}=~s/0*$//;
 563         my $datedue=$data->{'date_due'};
 564         my $itemnumber=$data->{'itemnumber'};
 565         $currentissues{$counter}=$data;
 566         $counter++;
 567     }
 568     $sth->finish;
 569     $dbh->disconnect;
 570     return(\%currentissues);
 571 }
 572
 573 sub checkwaiting {
 574 #Stolen from Main.pm
 575   # check for reserves waiting
 576   my ($env,$dbh,$bornum)=@_;
 577   my @itemswaiting;
 578   my $query = "select * from reserves
 579     where (borrowernumber = '$bornum')
 580     and (reserves.found='W') and cancellationdate is NULL";
 581   my $sth = $dbh->prepare($query);
 582   $sth->execute();
 583   my $cnt=0;
 584   if (my $data=$sth->fetchrow_hashref) {
 585     @itemswaiting[$cnt] =$data;
 586     $cnt ++
 587   }
 588   $sth->finish;
 589   return ($cnt,\@itemswaiting);
 590 }
 591
 592
 593 sub checkaccount  {
 594 # Stolen from Accounts.pm
 595   #take borrower number
 596   #check accounts and list amounts owing
 597   my ($env,$bornumber,$dbh)=@_;
 598   my $sth=$dbh->prepare("Select sum(amountoutstanding) from accountlines where
 599   borrowernumber=$bornumber and amountoutstanding<>0");
 600   $sth->execute;
 601   my $total=0;
 602   while (my $data=$sth->fetchrow_hashref){
 603     $total=$total+$data->{'sum(amountoutstanding)'};
 604   }
 605   $sth->finish;
 606   # output(1,2,"borrower owes $total");
 607   #if ($total > 0){
 608   #  # output(1,2,"borrower owes $total");
 609   #  if ($total > 5){
 610   #    reconcileaccount($env,$dbh,$bornumber,$total);
 611   #  }
 612   #}
 613   #  pause();
 614   return($total);
 615 }
 616
 617 sub renewstatus {
 618 # Stolen from Renewals.pm
 619   # check renewal status
 620   my ($env,$dbh,$bornum,$itemno)=@_;
 621   my $renews = 1;
 622   my $renewokay = 0;
 623   my $q1 = "select * from issues
 624     where (borrowernumber = '$bornum')
 625     and (itemnumber = '$itemno')
 626     and returndate is null";
 627   my $sth1 = $dbh->prepare($q1);
 628   $sth1->execute;
 629   if (my $data1 = $sth1->fetchrow_hashref) {
 630     my $q2 = "select renewalsallowed from items,biblioitems,itemtypes
 631        where (items.itemnumber = '$itemno')
 632        and (items.biblioitemnumber = biblioitems.biblioitemnumber)
 633        and (biblioitems.itemtype = itemtypes.itemtype)";
 634     my $sth2 = $dbh->prepare($q2);
 635     $sth2->execute;
 636     if (my $data2=$sth2->fetchrow_hashref) {
 637       $renews = $data2->{'renewalsallowed'};
 638     }
 639     if ($renews > $data1->{'renewals'}) {
 640       $renewokay = 1;
 641     }
 642     $sth2->finish;
 643   }
 644   $sth1->finish;
 645   return($renewokay);
 646 }
 647
 648 sub renewbook {
 649 # Stolen from Renewals.pm
 650   # mark book as renewed
 651   my ($env,$dbh,$bornum,$itemno,$datedue)=@_;
 652   $datedue=$env->{'datedue'};
 653   if ($datedue eq "" ) {
 654     my $loanlength=21;
 655     my $query= "Select * from biblioitems,items,itemtypes
 656        where (items.itemnumber = '$itemno')
 657        and (biblioitems.biblioitemnumber = items.biblioitemnumber)
 658        and (biblioitems.itemtype = itemtypes.itemtype)";
 659     my $sth=$dbh->prepare($query);
 660     $sth->execute;
 661     if (my $data=$sth->fetchrow_hashref) {
 662       $loanlength = $data->{'loanlength'}
 663     }
 664     $sth->finish;
 665     my $ti = time;
 666     my $datedu = time + ($loanlength * 86400);
 667     my @datearr = localtime($datedu);
 668     $datedue = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
 669   }
 670   my @date = split("-",$datedue);
 671   my $odatedue = (@date[2]+0)."-".(@date[1]+0)."-".@date[0];
 672   my $issquery = "select * from issues where borrowernumber='$bornum' and
 673     itemnumber='$itemno' and returndate is null";
 674   my $sth=$dbh->prepare($issquery);
 675   $sth->execute;
 676   my $issuedata=$sth->fetchrow_hashref;
 677   $sth->finish;
 678   my $renews = $issuedata->{'renewals'} +1;
 679   my $updquery = "update issues
 680     set date_due = '$datedue', renewals = '$renews'
 681     where borrowernumber='$bornum' and
 682     itemnumber='$itemno' and returndate is null";
 683   my $sth=$dbh->prepare($updquery);
 684
 685   $sth->execute;
 686   $sth->finish;
 687   return($odatedue);
 688 }
 689
 690 sub calc_charges {
 691 # Stolen from Issues.pm
 692 # calculate charges due
 693     my ($env, $dbh, $itemno, $bornum)=@_;
 694     my $charge=0;
 695     my $item_type;
 696     my $q1 = "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes where (items.itemnumber ='$itemno') and (biblioitems.biblioitemnumber = items.biblioitemnumber) and (biblioitems.itemtype = itemtypes.itemtype)";
 697     my $sth1= $dbh->prepare($q1);
 698     $sth1->execute;
 699     if (my $data1=$sth1->fetchrow_hashref) {
 700         $item_type = $data1->{'itemtype'};
 701         $charge = $data1->{'rentalcharge'};
 702         my $q2 = "select rentaldiscount from borrowers,categoryitem
 703         where (borrowers.borrowernumber = '$bornum')
 704         and (borrowers.categorycode = categoryitem.categorycode)
 705         and (categoryitem.itemtype = '$item_type')";
 706         my $sth2=$dbh->prepare($q2);
 707         $sth2->execute;
 708         if (my $data2=$sth2->fetchrow_hashref) {
 709             my $discount = $data2->{'rentaldiscount'};
 710             $charge = ($charge *(100 - $discount)) / 100;
 711         }
 712         $sth2->{'finish'};
 713     }
 714     $sth1->finish;
 715     return ($charge);
 716 }
 717
 718 sub createcharge {
 719 #Stolen from Issues.pm
 720     my ($env,$dbh,$itemno,$bornum,$charge) = @_;
 721     my $nextaccntno = getnextacctno($env,$bornum,$dbh);
 722     my $query = "insert into accountlines (borrowernumber,itemnumber,accountno,date,amount, description,accounttype,amountoutstanding) values ($bornum,$itemno,$nextaccntno,now(),$charge,'Rental','Rent',$charge)";
 723     my $sth = $dbh->prepare($query);
 724     $sth->execute;
 725     $sth->finish;
 726 }
 727
 728
 729 sub getnextacctno {
 730 # Stolen from Accounts.pm
 731     my ($env,$bornumber,$dbh)=@_;
 732     my $nextaccntno = 1;
 733     my $query = "select * from accountlines where (borrowernumber = '$bornumber') order by accountno desc";
 734     my $sth = $dbh->prepare($query);
 735     $sth->execute;
 736     if (my $accdata=$sth->fetchrow_hashref){
 737         $nextaccntno = $accdata->{'accountno'} + 1;
 738     }
 739     $sth->finish;
 740     return($nextaccntno);
 741 }
 742
 743
 744 END { }       # module clean-up code here (global destructor)