1 package C4::Circulation::Circ2;
3 #package to deal with Returns
4 #written 3/11/99 by olwen@katipo.co.nz
12 #use C4::InterfaceCDK;
13 #use C4::Circulation::Main;
15 #use C4::Circulation::Renewals;
22 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
24 # set the version for version checking
28 @EXPORT = qw(&getbranches &getprinters &getpatroninformation ¤tissues &getissues &getiteminformation &findborrower &issuebook &returnbook &find_reserves &transferbook &decode);
29 %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
31 # your exported package globals go here,
32 # as well as any optionally exported functions
34 @EXPORT_OK = qw($Var1 %Hashit);
37 # non-exported package globals go here
38 #use vars qw(@more $stuff);
40 # initalize package globals, first exported ones
45 # then the others (which are still accessible as $Some::Module::stuff)
49 # all file-scoped lexicals must be created before
50 # the functions below that use them.
52 # file-private lexicals go here
56 # here's a file-private function as a closure,
57 # callable as &$priv_func; it cannot be prototyped.
62 # make all your functions, whether exported or not;
66 # returns a reference to a hash of references to branches...
69 my $sth=$dbh->prepare("select * from branches");
71 while (my $branch=$sth->fetchrow_hashref) {
72 my $tmp = $branch->{'branchcode'}; my $brc = $dbh->quote($tmp);
73 my $query = "select categorycode from branchrelations where branchcode = $brc";
74 my $nsth = $dbh->prepare($query);
76 while (my ($cat) = $nsth->fetchrow_array) {
80 $branches{$branch->{'branchcode'}}=$branch;
91 my $sth=$dbh->prepare("select * from printers");
93 while (my $printer=$sth->fetchrow_hashref) {
94 $printers{$printer->{'printqueue'}}=$printer;
102 sub getpatroninformation {
104 my ($env, $borrowernumber,$cardnumber) = @_;
108 if ($borrowernumber) {
109 $query = "select * from borrowers where borrowernumber=$borrowernumber";
110 } elsif ($cardnumber) {
111 $query = "select * from borrowers where cardnumber=$cardnumber";
113 $env->{'apierror'} = "invalid borrower information passed to getpatroninformation subroutine";
116 $env->{'mess'} = $query;
117 $sth = $dbh->prepare($query);
119 my $borrower = $sth->fetchrow_hashref;
120 my $flags = patronflags($env, $borrower, $dbh);
123 $borrower->{'flags'}=$flags;
124 return($borrower, $flags);
129 my $seq = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
130 my @s = map { index($seq,$_); } split(//,$encoded);
145 my $n = (($s[0] << 6 | $s[1]) << 6 | $s[2]) << 6 | $s[3];
146 $r .=chr(($n >> 16) ^ 67) .
147 chr(($n >> 8 & 255) ^ 67) .
148 chr(($n & 255) ^ 67);
151 $r = substr($r,0,length($r)-$l);
158 sub getiteminformation {
159 # returns a hash of item information given either the itemnumber or the barcode
160 my ($env, $itemnumber, $barcode) = @_;
164 $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.itemnumber=$itemnumber and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
166 my $q_barcode=$dbh->quote($barcode);
167 $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.barcode=$q_barcode and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
169 $env->{'apierror'}="getiteminformation() subroutine must be called with either an itemnumber or a barcode";
174 my $iteminformation=$sth->fetchrow_hashref;
176 if ($iteminformation) {
177 $sth=$dbh->prepare("select date_due from issues where itemnumber=$iteminformation->{'itemnumber'} and isnull(returndate)");
179 my ($date_due) = $sth->fetchrow;
180 $iteminformation->{'date_due'}=$date_due;
182 #$iteminformation->{'dewey'}=~s/0*$//;
183 ($iteminformation->{'dewey'} == 0) && ($iteminformation->{'dewey'}='');
184 $sth=$dbh->prepare("select * from itemtypes where itemtype='$iteminformation->{'itemtype'}'");
186 my $itemtype=$sth->fetchrow_hashref;
187 $iteminformation->{'loanlength'}=$itemtype->{'loanlength'};
191 return($iteminformation);
195 # returns an array of borrower hash references, given a cardnumber or a partial
197 my ($env, $key) = @_;
200 my $q_key=$dbh->quote($key);
201 my $sth=$dbh->prepare("select * from borrowers where cardnumber=$q_key");
204 my ($borrower)=$sth->fetchrow_hashref;
205 push (@borrowers, $borrower);
207 $q_key=$dbh->quote("$key%");
209 $sth=$dbh->prepare("select * from borrowers where surname like $q_key");
211 while (my $borrower = $sth->fetchrow_hashref) {
212 push (@borrowers, $borrower);
222 # transfer book code....
223 my ($tbr, $barcode, $ignoreRs) = @_;
227 my $branches = getbranches();
228 my $iteminformation = getiteminformation(\%env, 0, $barcode);
230 if (not $iteminformation) {
231 $messages->{'BadBarcode'} = $barcode;
234 # get branches of book...
235 my $hbr = $iteminformation->{'homebranch'};
236 my $fbr = $iteminformation->{'holdingbranch'};
238 if ($branches->{$hbr}->{'PE'}) {
239 $messages->{'IsPermanent'} = $hbr;
241 # cant transfer book if is already there....
243 $messages->{'DestinationEqualsHolding'} = 1;
246 # check if it is still issued to someone, return it...
247 my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
248 if ($currentborrower) {
249 returnbook($barcode, $fbr);
250 $messages->{'WasReturned'} = $currentborrower;
253 my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
254 if ($resfound and not $ignoreRs) {
255 $resrec->{'ResFound'} = $resfound;
256 $messages->{'ResFound'} = $resrec;
259 #actually do the transfer....
261 dotransfer($iteminformation->{'itemnumber'}, $fbr, $tbr);
262 $messages->{'WasTransfered'} = 1;
264 return ($dotransfer, $messages, $iteminformation);
268 my ($itm, $fbr, $tbr) = @_;
269 my $dbh = &C4Connect;
270 $itm = $dbh->quote($itm);
271 $fbr = $dbh->quote($fbr);
272 $tbr = $dbh->quote($tbr);
273 #new entry in branchtransfers....
274 my $query = "insert into branchtransfers (itemnumber, frombranch, datearrived, tobranch)
275 values($itm, $fbr, now(), $tbr)";
276 my $sth = $dbh->prepare($query);
279 #update holdingbranch in items .....
280 $query = "update items set datelastseen = now(), holdingbranch=$tbr where items.itemnumber=$itm";
281 $sth = $dbh->prepare($query);
290 my ($env, $patroninformation, $barcode, $responses, $date) = @_;
292 my $iteminformation=getiteminformation($env, 0, $barcode);
294 my ($rejected,$question,$defaultanswer,$questionnumber, $noissue);
296 if ($patroninformation->{'gonenoaddress'}) {
297 $rejected="Patron is gone, with no known address.";
300 if ($patroninformation->{'lost'}) {
301 $rejected="Patron's card has been reported lost.";
304 if ($patroninformation->{'debarred'}) {
305 $rejected="Patron is Debarred";
308 my $amount = checkaccount($env,$patroninformation->{'borrowernumber'}, $dbh,$date);
309 if ($amount>5 && $patroninformation->{'categorycode'} ne 'L' &&
310 $patroninformation->{'categorycode'} ne 'W' &&
311 $patroninformation->{'categorycode'} ne 'I' &&
312 $patroninformation->{'categorycode'} ne 'B' &&
313 $patroninformation->{'categorycode'} ne 'P') {
314 $rejected=sprintf "Patron owes \$%.02f.", $amount;
317 unless ($iteminformation) {
318 $rejected="$barcode is not a valid barcode.";
321 if ($iteminformation->{'notforloan'} == 1) {
322 $rejected="Item not for loan.";
325 if ($iteminformation->{'wthdrawn'} == 1) {
326 $rejected="Item withdrawn.";
329 if ($iteminformation->{'restricted'} == 1) {
330 $rejected="Restricted item.";
333 if ($iteminformation->{'itemtype'} eq 'REF') {
334 $rejected="Reference item: Not for loan.";
337 my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
338 if ($currentborrower eq $patroninformation->{'borrowernumber'}) {
339 # Already issued to current borrower
340 my ($renewstatus) = renewstatus($env,$dbh,$patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
341 if ($renewstatus == 0) {
342 $rejected="No more renewals allowed for this item.";
345 if ($responses->{4} eq '') {
347 $question="Book is issued to this borrower.\nRenew?";
350 } elsif ($responses->{4} eq 'Y') {
351 my $charge = calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'});
353 createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'}, $charge);
354 $iteminformation->{'charge'}=$charge;
356 &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'});
357 renewbook($env,$dbh, $patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
364 } elsif ($currentborrower ne '') {
365 my ($currborrower, $cbflags) = getpatroninformation($env,$currentborrower,0);
366 if ($responses->{1} eq '') {
368 $question = "Issued to $currborrower->{'firstname'} $currborrower->{'surname'} ($currborrower->{'cardnumber'}).\nMark as returned?";
371 } elsif ($responses->{1} eq 'Y') {
372 returnbook($iteminformation->{'barcode'}, $env->{'branch'});
379 my ($resbor, $resrec) = checkreserve($env, $dbh, $iteminformation->{'itemnumber'});
381 if ($resbor eq $patroninformation->{'borrowernumber'}) {
382 my $rquery = "update reserves set found = 'F' where reservedate = '$resrec->{'reservedate'}' and borrowernumber = '$resrec->{'borrowernumber'}' and biblionumber = '$resrec->{'biblionumber'}'";
383 my $rsth = $dbh->prepare($rquery);
386 } elsif ($resbor ne "") {
387 my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
388 if ($responses->{2} eq '') {
390 $question="Reserved for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) since $resrec->{'reservedate'}\nAllow issue?";
393 } elsif ($responses->{2} eq 'N') {
394 #printreserve($env, $resrec, $resborrower, $iteminformation);
398 if ($responses->{3} eq '') {
400 $question="Cancel reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})?";
403 } elsif ($responses->{3} eq 'Y') {
404 my $rquery = "update reserves set found = 'F' where reservedate = '$resrec->{'reservedate'}' and borrowernumber = '$resrec->{'borrowernumber'}' and biblionumber = '$resrec->{'biblionumber'}'";
405 my $rsth = $dbh->prepare($rquery);
413 unless (($question) || ($rejected) || ($noissue)) {
415 if ($iteminformation->{'loanlength'}) {
416 $loanlength=$iteminformation->{'loanlength'};
419 my $datedue=time+($loanlength)*86400;
420 my @datearr = localtime($datedue);
421 $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
422 if ($env->{'datedue'}) {
423 $dateduef=$env->{'datedue'};
425 $dateduef=~ s/2001\-4\-25/2001\-4\-26/;
426 my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode) values ($patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'}, '$dateduef', '$env->{'branchcode'}')");
429 $iteminformation->{'issues'}++;
430 $sth=$dbh->prepare("update items set issues=$iteminformation->{'issues'} where itemnumber=$iteminformation->{'itemnumber'}");
433 my $charge=calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'});
435 createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'}, $charge);
436 $iteminformation->{'charge'}=$charge;
438 &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'});
441 if ($iteminformation->{'charge'}) {
442 $message=sprintf "Rental charge of \$%.02f applies.", $iteminformation->{'charge'};
445 return ($iteminformation, $dateduef, $rejected, $question, $questionnumber, $defaultanswer, $message);
451 my ($barcode, $branch) = @_;
455 # get information on item
456 my ($iteminformation) = getiteminformation(\%env, 0, $barcode);
457 if (not $iteminformation) {
458 $messages->{'BadBarcode'} = $barcode;
462 my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
463 if ((not $currentborrower) && $doreturn) {
464 $messages->{'NotIssued'} = $barcode;
467 # check if the book is in a permanent collection....
468 my $hbr = $iteminformation->{'homebranch'};
469 my $branches = getbranches();
470 if ($branches->{$hbr}->{'PE'}) {
471 $messages->{'IsPermanent'} = $hbr;
473 # update issues, thereby returning book (should push this out into another subroutine
474 my ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
476 doreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
477 $messages->{'WasReturned'};
480 my ($transfered, $mess, $item) = transferbook($branch, $barcode);
482 $messages->{'WasTransfered'};
484 # fix up the accounts.....
485 if ($iteminformation->{'itemlost'}) {
486 updateitemlost($iteminformation->{'itemnumber'});
487 fixaccountforlostandreturned($iteminformation, $borrower);
488 $messages->{'WasLost'};
490 # fix up the overdues in accounts...
491 fixoverduesonreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
493 my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
495 $resrec->{'ResFound'} = $resfound;
496 $messages->{'ResFound'} = $resrec;
499 UpdateStats(\%env, $branch ,'return','0','',$iteminformation->{'itemnumber'});
500 return ($doreturn, $messages, $iteminformation, $borrower);
505 my ($brn, $itm) = @_;
507 $brn = $dbh->quote($brn);
508 $itm = $dbh->quote($itm);
509 my $query = "update issues set returndate = now() where (borrowernumber = $brn)
510 and (itemnumber = $itm) and (returndate is null)";
511 my $sth = $dbh->prepare($query);
520 my $query="update items set itemlost=0 where itemnumber=$itemno";
521 my $sth=$dbh->prepare($query);
526 sub fixaccountforlostandreturned {
527 my ($iteminfo, $borrower) = @_;
530 my $itm = $dbh->quote($iteminfo->{'itemnumber'});
531 # check for charge made for lost book
532 my $query = "select * from accountlines where (itemnumber = $itm)
533 and (accounttype='L' or accounttype='Rep') order by date desc";
534 my $sth = $dbh->prepare($query);
536 if (my $data = $sth->fetchrow_hashref) {
537 # writeoff this amount
539 my $amount = $data->{'amount'};
540 my $acctno = $data->{'accountno'};
542 if ($data->{'amountoutstanding'} == $amount) {
543 $offset = $data->{'amount'};
546 $offset = $amount - $data->{'amountoutstanding'};
547 $amountleft = $data->{'amountoutstanding'} - $amount;
549 my $uquery = "update accountlines set accounttype = 'LR',amountoutstanding='0'
550 where (borrowernumber = '$data->{'borrowernumber'}')
551 and (itemnumber = $itm) and (accountno = '$acctno') ";
552 my $usth = $dbh->prepare($uquery);
555 #check if any credit is left if so writeoff other accounts
556 my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
557 if ($amountleft < 0){
560 if ($amountleft > 0){
561 my $query = "select * from accountlines where (borrowernumber = '$data->{'borrowernumber'}')
562 and (amountoutstanding >0) order by date";
563 my $msth = $dbh->prepare($query);
565 # offset transactions
568 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
569 if ($accdata->{'amountoutstanding'} < $amountleft) {
571 $amountleft = $amountleft - $accdata->{'amountoutstanding'};
573 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
576 my $thisacct = $accdata->{'accountno'};
577 my $updquery = "update accountlines set amountoutstanding= '$newamtos'
578 where (borrowernumber = '$data->{'borrowernumber'}')
579 and (accountno='$thisacct')";
580 my $usth = $dbh->prepare($updquery);
583 $updquery = "insert into accountoffsets
584 (borrowernumber, accountno, offsetaccount, offsetamount)
586 ('$data->{'borrowernumber'}','$accdata->{'accountno'}','$nextaccntno','$newamtos')";
587 my $usth = $dbh->prepare($updquery);
593 if ($amountleft > 0){
596 my $desc="Book Returned ".$iteminfo->{'barcode'};
597 $uquery = "insert into accountlines
598 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
599 values ('$data->{'borrowernumber'}','$nextaccntno',now(),0-$amount,'$desc',
601 $usth = $dbh->prepare($uquery);
604 $uquery = "insert into accountoffsets
605 (borrowernumber, accountno, offsetaccount, offsetamount)
606 values ($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset)";
607 $usth = $dbh->prepare($uquery);
610 $uquery = "update items set paidfor='' where itemnumber=$itm";
611 $usth = $dbh->prepare($uquery);
619 sub fixoverduesonreturn {
620 my ($brn, $itm) = @_;
622 $itm = $dbh->quote($itm);
623 $brn = $dbh->quote($brn);
624 # check for overdue fine
625 my $query = "select * from accountlines where (borrowernumber=$brn)
626 and (itemnumber = $itm) and (accounttype='FU' or accounttype='O')";
627 my $sth = $dbh->prepare($query);
629 # alter fine to show that the book has been returned
630 if (my $data = $sth->fetchrow_hashref) {
631 my $query = "update accountlines set accounttype='F' where (borrowernumber = $brn)
632 and (itemnumber = $itm) and (acccountno='$data->{'accountno'}')";
633 my $usth=$dbh->prepare($query);
642 # Original subroutine for Circ2.pm
644 my ($env, $patroninformation, $dbh) = @_;
645 my $amount = checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh);
648 $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount;
650 $flaginfo{'noissues'} = 1;
652 $flags{'CHARGES'} = \%flaginfo;
653 } elsif ($amount < 0){
655 $amount = $amount*-1;
656 $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", $amount;
657 $flags{'CHARGES'} = \%flaginfo;
659 if ($patroninformation->{'gonenoaddress'} == 1) {
661 $flaginfo{'message'} = 'Borrower has no valid address.';
662 $flaginfo{'noissues'} = 1;
663 $flags{'GNA'} = \%flaginfo;
665 if ($patroninformation->{'lost'} == 1) {
667 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
668 $flaginfo{'noissues'} = 1;
669 $flags{'LOST'} = \%flaginfo;
671 if ($patroninformation->{'debarred'} == 1) {
673 $flaginfo{'message'} = 'Borrower is Debarred.';
674 $flaginfo{'noissues'} = 1;
675 $flags{'DBARRED'} = \%flaginfo;
677 if ($patroninformation->{'borrowernotes'}) {
679 $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
680 $flags{'NOTES'} = \%flaginfo;
682 my ($odues, $itemsoverdue) = checkoverdues($env, $patroninformation->{'borrowernumber'}, $dbh);
685 $flaginfo{'message'} = "Yes";
686 $flaginfo{'itemlist'} = $itemsoverdue;
687 foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) {
688 $flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
690 $flags{'ODUES'} = \%flaginfo;
692 my ($nowaiting, $itemswaiting) = checkwaiting($env, $dbh, $patroninformation->{'borrowernumber'});
693 if ($nowaiting > 0) {
695 $flaginfo{'message'} = "Reserved items available";
696 $flaginfo{'itemlist'} = $itemswaiting;
697 $flaginfo{'itemfields'} = ['barcode', 'title', 'author', 'dewey', 'subclass', 'holdingbranch'];
698 $flags{'WAITING'} = \%flaginfo;
705 # From Main.pm, modified to return a list of overdueitems, in addition to a count
706 #checks whether a borrower has overdue items
707 my ($env,$bornum,$dbh)=@_;
708 my @datearr = localtime;
709 my $today = ($datearr[5] + 1900)."-".($datearr[4]+1)."-".$datearr[3];
712 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'";
713 my $sth=$dbh->prepare($query);
715 while (my $data = $sth->fetchrow_hashref) {
716 push (@overdueitems, $data);
720 return ($count, \@overdueitems);
723 sub currentborrower {
724 # Original subroutine for Circ2.pm
725 my ($itemnumber) = @_;
726 my $dbh = &C4Connect;
727 my $q_itemnumber = $dbh->quote($itemnumber);
728 my $sth=$dbh->prepare("select borrowers.borrowernumber from
729 issues,borrowers where issues.itemnumber=$q_itemnumber and
730 issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
733 my ($borrower) = $sth->fetchrow;
738 # Stolen from Main.pm
739 # Check for reserves for biblio
740 my ($env,$dbh,$itemnum)=@_;
742 my $query = "select * from reserves,items
743 where (items.itemnumber = '$itemnum')
744 and (reserves.cancellationdate is NULL)
745 and (items.biblionumber = reserves.biblionumber)
746 and ((reserves.found = 'W')
747 or (reserves.found is null))
749 my $sth = $dbh->prepare($query);
752 my $data=$sth->fetchrow_hashref;
753 while ($data && $resbor eq '') {
755 my $const = $data->{'constrainttype'};
757 $resbor = $data->{'borrowernumber'};
760 my $cquery = "select * from reserveconstraints,items
761 where (borrowernumber='$data->{'borrowernumber'}')
762 and reservedate='$data->{'reservedate'}'
763 and reserveconstraints.biblionumber='$data->{'biblionumber'}'
764 and (items.itemnumber=$itemnum and
765 items.biblioitemnumber = reserveconstraints.biblioitemnumber)";
766 my $csth = $dbh->prepare($cquery);
768 if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
770 if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
772 if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
776 $data=$sth->fetchrow_hashref;
779 return ($resbor,$resrec);
783 # New subroutine for Circ2.pm
784 my ($env, $borrower) = @_;
788 my $borrowernumber = $borrower->{'borrowernumber'};
790 if ($env->{'todaysissues'}) {
791 my @datearr = localtime(time());
792 my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
793 $crit=" and issues.timestamp like '$today%' ";
795 if ($env->{'nottodaysissues'}) {
796 my @datearr = localtime(time());
797 my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
798 $crit=" and !(issues.timestamp like '$today%') ";
800 my $select="select * from issues,items,biblioitems,biblio where
801 borrowernumber='$borrowernumber' and issues.itemnumber=items.itemnumber and
802 items.biblionumber=biblio.biblionumber and
803 items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is null
804 $crit order by issues.timestamp desc";
806 my $sth=$dbh->prepare($select);
808 while (my $data = $sth->fetchrow_hashref) {
809 $data->{'dewey'}=~s/0*$//;
810 ($data->{'dewey'} == 0) && ($data->{'dewey'}='');
811 my @datearr = localtime(time());
812 my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]
813 +1)).sprintf ("%0.2d", $datearr[3]);
814 my $datedue=$data->{'date_due'};
816 if ($datedue < $todaysdate) {
817 $data->{'overdue'}=1;
819 my $itemnumber=$data->{'itemnumber'};
820 $currentissues{$counter}=$data;
825 return(\%currentissues);
828 # New subroutine for Circ2.pm
831 my $borrowernumber = $borrower->{'borrowernumber'};
832 my $brn =$dbh->quote($borrowernumber);
834 my $select = "select issues.timestamp, issues.date_due, items.biblionumber,
835 items.barcode, biblio.title, biblio.author, biblioitems.dewey,
837 from issues,items,biblioitems,biblio
838 where issues.borrowernumber = $brn
839 and issues.itemnumber = items.itemnumber
840 and items.biblionumber = biblio.biblionumber
841 and items.biblioitemnumber = biblioitems.biblioitemnumber
842 and issues.returndate is null
843 order by issues.timestamp desc";
845 my $sth=$dbh->prepare($select);
848 while (my $data = $sth->fetchrow_hashref) {
849 $data->{'dewey'} =~ s/0*$//;
850 ($data->{'dewey'} == 0) && ($data->{'dewey'} = '');
851 my @datearr = localtime(time());
852 my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]);
853 my $datedue = $data->{'date_due'};
855 if ($datedue < $todaysdate) {
856 $data->{'overdue'} = 1;
858 $currentissues{$counter} = $data;
863 return(\%currentissues);
868 # check for reserves waiting
869 my ($env,$dbh,$bornum)=@_;
871 my $query = "select * from reserves
872 where (borrowernumber = '$bornum')
873 and (reserves.found='W') and cancellationdate is NULL";
874 my $sth = $dbh->prepare($query);
877 if (my $data=$sth->fetchrow_hashref) {
878 @itemswaiting[$cnt] =$data;
882 return ($cnt,\@itemswaiting);
887 # Stolen from Accounts.pm
888 #take borrower number
889 #check accounts and list amounts owing
890 my ($env,$bornumber,$dbh,$date)=@_;
891 my $select="Select sum(amountoutstanding) from accountlines where
892 borrowernumber=$bornumber and amountoutstanding<>0";
894 $select.=" and date < '$date'";
897 my $sth=$dbh->prepare($select);
900 while (my $data=$sth->fetchrow_hashref){
901 $total=$total+$data->{'sum(amountoutstanding)'};
904 # output(1,2,"borrower owes $total");
906 # # output(1,2,"borrower owes $total");
908 # reconcileaccount($env,$dbh,$bornumber,$total);
916 # Stolen from Renewals.pm
917 # check renewal status
918 my ($env,$dbh,$bornum,$itemno)=@_;
921 my $q1 = "select * from issues
922 where (borrowernumber = '$bornum')
923 and (itemnumber = '$itemno')
924 and returndate is null";
925 my $sth1 = $dbh->prepare($q1);
927 if (my $data1 = $sth1->fetchrow_hashref) {
928 my $q2 = "select renewalsallowed from items,biblioitems,itemtypes
929 where (items.itemnumber = '$itemno')
930 and (items.biblioitemnumber = biblioitems.biblioitemnumber)
931 and (biblioitems.itemtype = itemtypes.itemtype)";
932 my $sth2 = $dbh->prepare($q2);
934 if (my $data2=$sth2->fetchrow_hashref) {
935 $renews = $data2->{'renewalsallowed'};
937 if ($renews > $data1->{'renewals'}) {
947 # Stolen from Renewals.pm
948 # mark book as renewed
949 my ($env,$dbh,$bornum,$itemno,$datedue)=@_;
950 $datedue=$env->{'datedue'};
951 if ($datedue eq "" ) {
953 my $query= "Select * from biblioitems,items,itemtypes
954 where (items.itemnumber = '$itemno')
955 and (biblioitems.biblioitemnumber = items.biblioitemnumber)
956 and (biblioitems.itemtype = itemtypes.itemtype)";
957 my $sth=$dbh->prepare($query);
959 if (my $data=$sth->fetchrow_hashref) {
960 $loanlength = $data->{'loanlength'}
964 my $datedu = time + ($loanlength * 86400);
965 my @datearr = localtime($datedu);
966 $datedue = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
968 my @date = split("-",$datedue);
969 my $odatedue = (@date[2]+0)."-".(@date[1]+0)."-".@date[0];
970 my $issquery = "select * from issues where borrowernumber='$bornum' and
971 itemnumber='$itemno' and returndate is null";
972 my $sth=$dbh->prepare($issquery);
974 my $issuedata=$sth->fetchrow_hashref;
976 my $renews = $issuedata->{'renewals'} +1;
977 my $updquery = "update issues
978 set date_due = '$datedue', renewals = '$renews'
979 where borrowernumber='$bornum' and
980 itemnumber='$itemno' and returndate is null";
981 my $sth=$dbh->prepare($updquery);
989 # Stolen from Issues.pm
990 # calculate charges due
991 my ($env, $dbh, $itemno, $bornum)=@_;
994 my $q1 = "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes where (items.itemnumber ='$itemno') and (biblioitems.biblioitemnumber = items.biblioitemnumber) and (biblioitems.itemtype = itemtypes.itemtype)";
995 my $sth1= $dbh->prepare($q1);
997 if (my $data1=$sth1->fetchrow_hashref) {
998 $item_type = $data1->{'itemtype'};
999 $charge = $data1->{'rentalcharge'};
1000 my $q2 = "select rentaldiscount from borrowers,categoryitem
1001 where (borrowers.borrowernumber = '$bornum')
1002 and (borrowers.categorycode = categoryitem.categorycode)
1003 and (categoryitem.itemtype = '$item_type')";
1004 my $sth2=$dbh->prepare($q2);
1006 if (my $data2=$sth2->fetchrow_hashref) {
1007 my $discount = $data2->{'rentaldiscount'};
1008 $charge = ($charge *(100 - $discount)) / 100;
1017 #Stolen from Issues.pm
1018 my ($env,$dbh,$itemno,$bornum,$charge) = @_;
1019 my $nextaccntno = getnextacctno($env,$bornum,$dbh);
1020 my $query = "insert into accountlines (borrowernumber,itemnumber,accountno,date,amount, description,accounttype,amountoutstanding) values ($bornum,$itemno,$nextaccntno,now(),$charge,'Rental','Rent',$charge)";
1021 my $sth = $dbh->prepare($query);
1028 # Stolen from Accounts.pm
1029 my ($env,$bornumber,$dbh)=@_;
1030 my $nextaccntno = 1;
1031 my $query = "select * from accountlines where (borrowernumber = '$bornumber') order by accountno desc";
1032 my $sth = $dbh->prepare($query);
1034 if (my $accdata=$sth->fetchrow_hashref){
1035 $nextaccntno = $accdata->{'accountno'} + 1;
1038 return($nextaccntno);
1042 # Stolen from Returns.pm
1046 my ($itemdata) = getiteminformation(\%env, $itemno,0);
1047 my $bibno = $dbh->quote($itemdata->{'biblionumber'});
1048 my $bibitm = $dbh->quote($itemdata->{'biblioitemnumber'});
1049 my $query = "select * from reserves where ((found = 'W') or (found is null))
1050 and biblionumber = $bibno and cancellationdate is NULL
1051 order by priority, reservedate ";
1052 my $sth = $dbh->prepare($query);
1058 while (($resrec = $sth->fetchrow_hashref) && (not $resfound)) {
1060 my $brn = $dbh->quote($resrec->{'borrowernumber'});
1061 my $rdate = $dbh->quote($resrec->{'reservedate'});
1062 my $bibno = $dbh->quote($resrec->{'biblionumber'});
1063 if ($resrec->{'found'} eq "W") {
1064 if ($resrec->{'itemnumber'} eq $itemno) {
1068 if ($resrec->{'constrainttype'} eq "a") {
1071 my $conquery = "select * from reserveconstraints where borrowernumber = $brn
1072 and reservedate = $rdate and biblionumber = $bibno and biblioitemnumber = $bibitm";
1073 my $consth = $dbh->prepare($conquery);
1075 if (my $conrec = $consth->fetchrow_hashref) {
1076 if ($resrec->{'constrainttype'} eq "o") {
1084 my $updquery = "update reserves set found = 'W', itemnumber = '$itemno'
1085 where borrowernumber = $brn and reservedate = $rdate and biblionumber = $bibno";
1086 my $updsth = $dbh->prepare($updquery);
1092 return ($resfound,$lastrec);
1095 END { } # module clean-up code here (global destructor)