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