C4/Circulation/Circ2.pm

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