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