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
30 %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
32 # your exported package globals go here,
33 # as well as any optionally exported functions
35 @EXPORT_OK = qw($Var1 %Hashit);
38 # non-exported package globals go here
39 #use vars qw(@more $stuff);
41 # initalize package globals, first exported ones
46 # then the others (which are still accessible as $Some::Module::stuff)
50 # all file-scoped lexicals must be created before
51 # the functions below that use them.
53 # file-private lexicals go here
57 # here's a file-private function as a closure,
58 # callable as &$priv_func; it cannot be prototyped.
63 # make all your functions, whether exported or not;
67 # returns a reference to a hash of references to branches...
70 my $sth=$dbh->prepare("select * from branches");
72 while (my $branch=$sth->fetchrow_hashref) {
73 my $tmp = $branch->{'branchcode'}; my $brc = $dbh->quote($tmp);
74 my $query = "select categorycode from branchrelations where branchcode = $brc";
75 my $nsth = $dbh->prepare($query);
77 while (my ($cat) = $nsth->fetchrow_array) {
81 $branches{$branch->{'branchcode'}}=$branch;
92 my $sth=$dbh->prepare("select * from printers");
94 while (my $printer=$sth->fetchrow_hashref) {
95 $printers{$printer->{'printqueue'}}=$printer;
103 sub getpatroninformation {
105 my ($env, $borrowernumber,$cardnumber) = @_;
109 if ($borrowernumber) {
110 $query = "select * from borrowers where borrowernumber=$borrowernumber";
111 } elsif ($cardnumber) {
112 $query = "select * from borrowers where cardnumber=$cardnumber";
114 $env->{'apierror'} = "invalid borrower information passed to getpatroninformation subroutine";
117 $env->{'mess'} = $query;
118 $sth = $dbh->prepare($query);
120 my $borrower = $sth->fetchrow_hashref;
121 my $flags = patronflags($env, $borrower, $dbh);
124 $borrower->{'flags'}=$flags;
125 return($borrower, $flags);
130 my $seq = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
131 my @s = map { index($seq,$_); } split(//,$encoded);
146 my $n = (($s[0] << 6 | $s[1]) << 6 | $s[2]) << 6 | $s[3];
147 $r .=chr(($n >> 16) ^ 67) .
148 chr(($n >> 8 & 255) ^ 67) .
149 chr(($n & 255) ^ 67);
152 $r = substr($r,0,length($r)-$l);
159 sub getiteminformation {
160 # returns a hash of item information given either the itemnumber or the barcode
161 my ($env, $itemnumber, $barcode) = @_;
165 $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.itemnumber=$itemnumber and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
167 my $q_barcode=$dbh->quote($barcode);
168 $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.barcode=$q_barcode and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
170 $env->{'apierror'}="getiteminformation() subroutine must be called with either an itemnumber or a barcode";
175 my $iteminformation=$sth->fetchrow_hashref;
177 if ($iteminformation) {
178 $sth=$dbh->prepare("select date_due from issues where itemnumber=$iteminformation->{'itemnumber'} and isnull(returndate)");
180 my ($date_due) = $sth->fetchrow;
181 $iteminformation->{'date_due'}=$date_due;
183 #$iteminformation->{'dewey'}=~s/0*$//;
184 ($iteminformation->{'dewey'} == 0) && ($iteminformation->{'dewey'}='');
185 $sth=$dbh->prepare("select * from itemtypes where itemtype='$iteminformation->{'itemtype'}'");
187 my $itemtype=$sth->fetchrow_hashref;
188 $iteminformation->{'loanlength'}=$itemtype->{'loanlength'};
192 return($iteminformation);
196 # returns an array of borrower hash references, given a cardnumber or a partial
198 my ($env, $key) = @_;
201 my $q_key=$dbh->quote($key);
202 my $sth=$dbh->prepare("select * from borrowers where cardnumber=$q_key");
205 my ($borrower)=$sth->fetchrow_hashref;
206 push (@borrowers, $borrower);
208 $q_key=$dbh->quote("$key%");
210 $sth=$dbh->prepare("select * from borrowers where surname like $q_key");
212 while (my $borrower = $sth->fetchrow_hashref) {
213 push (@borrowers, $borrower);
223 # transfer book code....
224 my ($tbr, $barcode, $ignoreRs) = @_;
228 my $branches = getbranches();
229 my $iteminformation = getiteminformation(\%env, 0, $barcode);
231 if (not $iteminformation) {
232 $messages->{'BadBarcode'} = $barcode;
235 # get branches of book...
236 my $hbr = $iteminformation->{'homebranch'};
237 my $fbr = $iteminformation->{'holdingbranch'};
239 if ($branches->{$hbr}->{'PE'}) {
240 $messages->{'IsPermanent'} = $hbr;
242 # cant transfer book if is already there....
244 $messages->{'DestinationEqualsHolding'} = 1;
247 # check if it is still issued to someone, return it...
248 my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
249 if ($currentborrower) {
250 returnbook($barcode, $fbr);
251 $messages->{'WasReturned'} = $currentborrower;
254 my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
255 if ($resfound and not $ignoreRs) {
256 $resrec->{'ResFound'} = $resfound;
257 $messages->{'ResFound'} = $resrec;
260 #actually do the transfer....
262 dotransfer($iteminformation->{'itemnumber'}, $fbr, $tbr);
263 $messages->{'WasTransfered'} = 1;
265 return ($dotransfer, $messages, $iteminformation);
269 my ($itm, $fbr, $tbr) = @_;
270 my $dbh = &C4Connect;
271 $itm = $dbh->quote($itm);
272 $fbr = $dbh->quote($fbr);
273 $tbr = $dbh->quote($tbr);
274 #new entry in branchtransfers....
275 my $query = "insert into branchtransfers (itemnumber, frombranch, datearrived, tobranch)
276 values($itm, $fbr, now(), $tbr)";
277 my $sth = $dbh->prepare($query);
280 #update holdingbranch in items .....
281 $query = "update items set datelastseen = now(), holdingbranch=$tbr where items.itemnumber=$itm";
282 $sth = $dbh->prepare($query);
291 my ($env, $patroninformation, $barcode, $responses, $date) = @_;
293 my $iteminformation = getiteminformation($env, 0, $barcode);
295 my ($rejected,$question,$defaultanswer,$questionnumber, $noissue);
298 if ($patroninformation->{'gonenoaddress'}) {
299 $rejected="Patron is gone, with no known address.";
302 if ($patroninformation->{'lost'}) {
303 $rejected="Patron's card has been reported lost.";
306 if ($patroninformation->{'debarred'}) {
307 $rejected="Patron is Debarred";
310 my $amount = checkaccount($env,$patroninformation->{'borrowernumber'}, $dbh,$date);
311 if ($amount > 5 && $patroninformation->{'categorycode'} ne 'L' &&
312 $patroninformation->{'categorycode'} ne 'W' &&
313 $patroninformation->{'categorycode'} ne 'I' &&
314 $patroninformation->{'categorycode'} ne 'B' &&
315 $patroninformation->{'categorycode'} ne 'P') {
316 $rejected = sprintf "Patron owes \$%.02f.", $amount;
319 unless ($iteminformation) {
320 $rejected = "$barcode is not a valid barcode.";
323 if ($iteminformation->{'notforloan'} == 1) {
324 $rejected="Item not for loan.";
327 if ($iteminformation->{'wthdrawn'} == 1) {
328 $rejected="Item withdrawn.";
331 if ($iteminformation->{'restricted'} == 1) {
332 $rejected="Restricted item.";
335 if ($iteminformation->{'itemtype'} eq 'REF') {
336 $rejected="Reference item: Not for loan.";
339 my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
340 if ($currentborrower eq $patroninformation->{'borrowernumber'}) {
341 # Already issued to current borrower
342 my ($renewstatus) = renewstatus($env,$dbh,$patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
343 if ($renewstatus == 0) {
344 $rejected="No more renewals allowed for this item.";
347 if ($responses->{4} eq '') {
349 $question = "Book is issued to this borrower.\nRenew?";
350 $defaultanswer = 'Y';
352 } elsif ($responses->{4} eq 'Y') {
353 my $charge = calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'});
355 createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'}, $charge);
356 $iteminformation->{'charge'} = $charge;
358 &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'});
359 renewbook($env,$dbh, $patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
366 } elsif ($currentborrower ne '') {
367 my ($currborrower, $cbflags) = getpatroninformation($env,$currentborrower,0);
368 if ($responses->{1} eq '') {
370 $question = "Issued to $currborrower->{'firstname'} $currborrower->{'surname'} ($currborrower->{'cardnumber'}).\nMark as returned?";
373 } elsif ($responses->{1} eq 'Y') {
374 returnbook($iteminformation->{'barcode'}, $env->{'branch'});
381 my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'});
383 my $resbor = $res->{'borrowernumber'};
384 if ($resbor eq $patroninformation->{'borrowernumber'}) {
386 } elsif ($restype eq "Waiting") {
387 my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
388 my $branches = getbranches();
389 my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
390 if ($responses->{2} eq '') {
392 $question="Waiting for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) at $branchname \nAllow issue?";
395 } elsif ($responses->{2} eq 'N') {
399 if ($responses->{3} eq '') {
401 $question="Cancel reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})?";
404 } elsif ($responses->{3} eq 'Y') {
405 CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
408 } elsif ($restype eq "Reserved") {
409 my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
410 my $branches = getbranches();
411 my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
412 if ($responses->{5} eq '') {
414 $question="Reserved for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) since $res->{'reservedate'} \nAllow issue?";
417 } elsif ($responses->{5} eq 'N') {
418 if ($responses->{6} eq '') {
420 $question="Set reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) to waiting and transfer to $branchname?";
422 } elsif ($responses->{6} eq 'Y') {
423 my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'});
424 transferbook($tobrcd, $barcode, 1);
425 $message = "Item should now be waiting at $branchname";
430 if ($responses->{7} eq '') {
432 $question="Cancel reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})?";
435 } elsif ($responses->{7} eq 'Y') {
436 CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
443 unless (($question) || ($rejected) || ($noissue)) {
445 if ($iteminformation->{'loanlength'}) {
446 $loanlength=$iteminformation->{'loanlength'};
449 my $datedue=time+($loanlength)*86400;
450 my @datearr = localtime($datedue);
451 $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
452 if ($env->{'datedue'}) {
453 $dateduef=$env->{'datedue'};
455 $dateduef=~ s/2001\-4\-25/2001\-4\-26/;
456 my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode) values ($patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'}, '$dateduef', '$env->{'branchcode'}')");
459 $iteminformation->{'issues'}++;
460 $sth=$dbh->prepare("update items set issues=$iteminformation->{'issues'},datelastseen=now() where itemnumber=$iteminformation->{'itemnumber'}");
463 my $charge=calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'});
465 createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'}, $charge);
466 $iteminformation->{'charge'}=$charge;
468 &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'});
470 if ($iteminformation->{'charge'}) {
471 $message=sprintf "Rental charge of \$%.02f applies.", $iteminformation->{'charge'};
474 return ($iteminformation, $dateduef, $rejected, $question, $questionnumber, $defaultanswer, $message);
480 my ($barcode, $branch) = @_;
484 # get information on item
485 my ($iteminformation) = getiteminformation(\%env, 0, $barcode);
486 if (not $iteminformation) {
487 $messages->{'BadBarcode'} = $barcode;
491 my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
492 if ((not $currentborrower) && $doreturn) {
493 $messages->{'NotIssued'} = $barcode;
496 # check if the book is in a permanent collection....
497 my $hbr = $iteminformation->{'homebranch'};
498 my $branches = getbranches();
499 if ($branches->{$hbr}->{'PE'}) {
500 $messages->{'IsPermanent'} = $hbr;
502 # update issues, thereby returning book (should push this out into another subroutine
503 my ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
505 doreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
506 $messages->{'WasReturned'};
508 ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
510 my ($transfered, $mess, $item) = transferbook($branch, $barcode);
512 $messages->{'WasTransfered'};
514 # fix up the accounts.....
515 if ($iteminformation->{'itemlost'}) {
516 updateitemlost($iteminformation->{'itemnumber'});
517 fixaccountforlostandreturned($iteminformation, $borrower);
518 $messages->{'WasLost'};
520 # fix up the overdues in accounts...
521 fixoverduesonreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
523 my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
525 $resrec->{'ResFound'} = $resfound;
526 $messages->{'ResFound'} = $resrec;
529 UpdateStats(\%env, $branch ,'return','0','',$iteminformation->{'itemnumber'});
530 return ($doreturn, $messages, $iteminformation, $borrower);
535 my ($brn, $itm) = @_;
537 $brn = $dbh->quote($brn);
538 $itm = $dbh->quote($itm);
539 my $query = "update issues set returndate = now() where (borrowernumber = $brn)
540 and (itemnumber = $itm) and (returndate is null)";
541 my $sth = $dbh->prepare($query);
544 $query="update items set datelastseen=now() where itemnumber=$itm";
545 $sth=$dbh->prepare($query);
555 my $query="update items set itemlost=0 where itemnumber=$itemno";
556 my $sth=$dbh->prepare($query);
561 sub fixaccountforlostandreturned {
562 my ($iteminfo, $borrower) = @_;
565 my $itm = $dbh->quote($iteminfo->{'itemnumber'});
566 # check for charge made for lost book
567 my $query = "select * from accountlines where (itemnumber = $itm)
568 and (accounttype='L' or accounttype='Rep') order by date desc";
569 my $sth = $dbh->prepare($query);
571 if (my $data = $sth->fetchrow_hashref) {
572 # writeoff this amount
574 my $amount = $data->{'amount'};
575 my $acctno = $data->{'accountno'};
577 if ($data->{'amountoutstanding'} == $amount) {
578 $offset = $data->{'amount'};
581 $offset = $amount - $data->{'amountoutstanding'};
582 $amountleft = $data->{'amountoutstanding'} - $amount;
584 my $uquery = "update accountlines set accounttype = 'LR',amountoutstanding='0'
585 where (borrowernumber = '$data->{'borrowernumber'}')
586 and (itemnumber = $itm) and (accountno = '$acctno') ";
587 my $usth = $dbh->prepare($uquery);
590 #check if any credit is left if so writeoff other accounts
591 my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
592 if ($amountleft < 0){
595 if ($amountleft > 0){
596 my $query = "select * from accountlines where (borrowernumber = '$data->{'borrowernumber'}')
597 and (amountoutstanding >0) order by date";
598 my $msth = $dbh->prepare($query);
600 # offset transactions
603 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
604 if ($accdata->{'amountoutstanding'} < $amountleft) {
606 $amountleft = $amountleft - $accdata->{'amountoutstanding'};
608 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
611 my $thisacct = $accdata->{'accountno'};
612 my $updquery = "update accountlines set amountoutstanding= '$newamtos'
613 where (borrowernumber = '$data->{'borrowernumber'}')
614 and (accountno='$thisacct')";
615 my $usth = $dbh->prepare($updquery);
618 $updquery = "insert into accountoffsets
619 (borrowernumber, accountno, offsetaccount, offsetamount)
621 ('$data->{'borrowernumber'}','$accdata->{'accountno'}','$nextaccntno','$newamtos')";
622 $usth = $dbh->prepare($updquery);
628 if ($amountleft > 0){
631 my $desc="Book Returned ".$iteminfo->{'barcode'};
632 $uquery = "insert into accountlines
633 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
634 values ('$data->{'borrowernumber'}','$nextaccntno',now(),0-$amount,'$desc',
636 $usth = $dbh->prepare($uquery);
639 $uquery = "insert into accountoffsets
640 (borrowernumber, accountno, offsetaccount, offsetamount)
641 values ($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset)";
642 $usth = $dbh->prepare($uquery);
645 $uquery = "update items set paidfor='' where itemnumber=$itm";
646 $usth = $dbh->prepare($uquery);
654 sub fixoverduesonreturn {
655 my ($brn, $itm) = @_;
657 $itm = $dbh->quote($itm);
658 $brn = $dbh->quote($brn);
659 # check for overdue fine
660 my $query = "select * from accountlines where (borrowernumber=$brn)
661 and (itemnumber = $itm) and (accounttype='FU' or accounttype='O')";
662 my $sth = $dbh->prepare($query);
664 # alter fine to show that the book has been returned
665 if (my $data = $sth->fetchrow_hashref) {
666 my $query = "update accountlines set accounttype='F' where (borrowernumber = $brn)
667 and (itemnumber = $itm) and (acccountno='$data->{'accountno'}')";
668 my $usth=$dbh->prepare($query);
677 # Original subroutine for Circ2.pm
679 my ($env, $patroninformation, $dbh) = @_;
680 my $amount = checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh);
683 $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount;
685 $flaginfo{'noissues'} = 1;
687 $flags{'CHARGES'} = \%flaginfo;
688 } elsif ($amount < 0){
690 $amount = $amount*-1;
691 $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", $amount;
692 $flags{'CHARGES'} = \%flaginfo;
694 if ($patroninformation->{'gonenoaddress'} == 1) {
696 $flaginfo{'message'} = 'Borrower has no valid address.';
697 $flaginfo{'noissues'} = 1;
698 $flags{'GNA'} = \%flaginfo;
700 if ($patroninformation->{'lost'} == 1) {
702 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
703 $flaginfo{'noissues'} = 1;
704 $flags{'LOST'} = \%flaginfo;
706 if ($patroninformation->{'debarred'} == 1) {
708 $flaginfo{'message'} = 'Borrower is Debarred.';
709 $flaginfo{'noissues'} = 1;
710 $flags{'DBARRED'} = \%flaginfo;
712 if ($patroninformation->{'borrowernotes'}) {
714 $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
715 $flags{'NOTES'} = \%flaginfo;
717 my ($odues, $itemsoverdue)
718 = checkoverdues($env, $patroninformation->{'borrowernumber'}, $dbh);
721 $flaginfo{'message'} = "Yes";
722 $flaginfo{'itemlist'} = $itemsoverdue;
723 foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) {
724 $flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
726 $flags{'ODUES'} = \%flaginfo;
728 my ($nowaiting, $itemswaiting)
729 = CheckWaiting($patroninformation->{'borrowernumber'});
730 if ($nowaiting > 0) {
732 $flaginfo{'message'} = "Reserved items available";
733 $flaginfo{'itemlist'} = $itemswaiting;
734 $flags{'WAITING'} = \%flaginfo;
741 # From Main.pm, modified to return a list of overdueitems, in addition to a count
742 #checks whether a borrower has overdue items
743 my ($env, $bornum, $dbh)=@_;
744 my @datearr = localtime;
745 my $today = ($datearr[5] + 1900)."-".($datearr[4]+1)."-".$datearr[3];
748 my $query = "SELECT * FROM issues,biblio,biblioitems,items
749 WHERE items.biblioitemnumber = biblioitems.biblioitemnumber
750 AND items.biblionumber = biblio.biblionumber
751 AND issues.itemnumber = items.itemnumber
752 AND issues.borrowernumber = $bornum
753 AND issues.returndate is NULL
754 AND issues.date_due < '$today'";
755 my $sth = $dbh->prepare($query);
757 while (my $data = $sth->fetchrow_hashref) {
758 push (@overdueitems, $data);
762 return ($count, \@overdueitems);
765 sub currentborrower {
766 # Original subroutine for Circ2.pm
767 my ($itemnumber) = @_;
768 my $dbh = &C4Connect;
769 my $q_itemnumber = $dbh->quote($itemnumber);
770 my $sth=$dbh->prepare("select borrowers.borrowernumber from
771 issues,borrowers where issues.itemnumber=$q_itemnumber and
772 issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
775 my ($borrower) = $sth->fetchrow;
780 # Stolen from Main.pm
781 # Check for reserves for biblio
782 my ($env,$dbh,$itemnum)=@_;
784 my $query = "select * from reserves,items
785 where (items.itemnumber = '$itemnum')
786 and (reserves.cancellationdate is NULL)
787 and (items.biblionumber = reserves.biblionumber)
788 and ((reserves.found = 'W')
789 or (reserves.found is null))
791 my $sth = $dbh->prepare($query);
794 my $data=$sth->fetchrow_hashref;
795 while ($data && $resbor eq '') {
797 my $const = $data->{'constrainttype'};
799 $resbor = $data->{'borrowernumber'};
802 my $cquery = "select * from reserveconstraints,items
803 where (borrowernumber='$data->{'borrowernumber'}')
804 and reservedate='$data->{'reservedate'}'
805 and reserveconstraints.biblionumber='$data->{'biblionumber'}'
806 and (items.itemnumber=$itemnum and
807 items.biblioitemnumber = reserveconstraints.biblioitemnumber)";
808 my $csth = $dbh->prepare($cquery);
810 if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
812 if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
814 if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
818 $data=$sth->fetchrow_hashref;
821 return ($resbor,$resrec);
825 # New subroutine for Circ2.pm
826 my ($env, $borrower) = @_;
830 my $borrowernumber = $borrower->{'borrowernumber'};
832 if ($env->{'todaysissues'}) {
833 my @datearr = localtime(time());
834 my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
835 $crit=" and issues.timestamp like '$today%' ";
837 if ($env->{'nottodaysissues'}) {
838 my @datearr = localtime(time());
839 my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
840 $crit=" and !(issues.timestamp like '$today%') ";
842 my $select="select * from issues,items,biblioitems,biblio where
843 borrowernumber='$borrowernumber' and issues.itemnumber=items.itemnumber and
844 items.biblionumber=biblio.biblionumber and
845 items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is null
846 $crit order by issues.timestamp desc";
848 my $sth=$dbh->prepare($select);
850 while (my $data = $sth->fetchrow_hashref) {
851 $data->{'dewey'}=~s/0*$//;
852 ($data->{'dewey'} == 0) && ($data->{'dewey'}='');
853 my @datearr = localtime(time());
854 my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]
855 +1)).sprintf ("%0.2d", $datearr[3]);
856 my $datedue=$data->{'date_due'};
858 if ($datedue < $todaysdate) {
859 $data->{'overdue'}=1;
861 my $itemnumber=$data->{'itemnumber'};
862 $currentissues{$counter}=$data;
867 return(\%currentissues);
870 # New subroutine for Circ2.pm
873 my $borrowernumber = $borrower->{'borrowernumber'};
874 my $brn =$dbh->quote($borrowernumber);
876 my $select = "select issues.timestamp, issues.date_due, items.biblionumber,
877 items.barcode, biblio.title, biblio.author, biblioitems.dewey,
879 from issues,items,biblioitems,biblio
880 where issues.borrowernumber = $brn
881 and issues.itemnumber = items.itemnumber
882 and items.biblionumber = biblio.biblionumber
883 and items.biblioitemnumber = biblioitems.biblioitemnumber
884 and issues.returndate is null
885 order by issues.date_due";
887 my $sth=$dbh->prepare($select);
890 while (my $data = $sth->fetchrow_hashref) {
891 $data->{'dewey'} =~ s/0*$//;
892 ($data->{'dewey'} == 0) && ($data->{'dewey'} = '');
893 my @datearr = localtime(time());
894 my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]);
895 my $datedue = $data->{'date_due'};
897 if ($datedue < $todaysdate) {
898 $data->{'overdue'} = 1;
900 $currentissues{$counter} = $data;
905 return(\%currentissues);
910 # check for reserves waiting
911 my ($env,$dbh,$bornum)=@_;
913 my $query = "select * from reserves
914 where (borrowernumber = '$bornum')
915 and (reserves.found='W') and cancellationdate is NULL";
916 my $sth = $dbh->prepare($query);
919 if (my $data=$sth->fetchrow_hashref) {
920 $itemswaiting[$cnt] =$data;
924 return ($cnt,\@itemswaiting);
929 # Stolen from Accounts.pm
930 #take borrower number
931 #check accounts and list amounts owing
932 my ($env,$bornumber,$dbh,$date)=@_;
933 my $select="Select sum(amountoutstanding) from accountlines where
934 borrowernumber=$bornumber and amountoutstanding<>0";
936 $select.=" and date < '$date'";
939 my $sth=$dbh->prepare($select);
942 while (my $data=$sth->fetchrow_hashref){
943 $total=$total+$data->{'sum(amountoutstanding)'};
946 # output(1,2,"borrower owes $total");
948 # # output(1,2,"borrower owes $total");
950 # reconcileaccount($env,$dbh,$bornumber,$total);
958 # Stolen from Renewals.pm
959 # check renewal status
960 my ($env,$dbh,$bornum,$itemno)=@_;
963 my $q1 = "select * from issues
964 where (borrowernumber = '$bornum')
965 and (itemnumber = '$itemno')
966 and returndate is null";
967 my $sth1 = $dbh->prepare($q1);
969 if (my $data1 = $sth1->fetchrow_hashref) {
970 my $q2 = "select renewalsallowed from items,biblioitems,itemtypes
971 where (items.itemnumber = '$itemno')
972 and (items.biblioitemnumber = biblioitems.biblioitemnumber)
973 and (biblioitems.itemtype = itemtypes.itemtype)";
974 my $sth2 = $dbh->prepare($q2);
976 if (my $data2=$sth2->fetchrow_hashref) {
977 $renews = $data2->{'renewalsallowed'};
979 if ($renews > $data1->{'renewals'}) {
989 # Stolen from Renewals.pm
990 # mark book as renewed
991 my ($env,$dbh,$bornum,$itemno,$datedue)=@_;
992 $datedue=$env->{'datedue'};
993 if ($datedue eq "" ) {
995 my $query= "Select * from biblioitems,items,itemtypes
996 where (items.itemnumber = '$itemno')
997 and (biblioitems.biblioitemnumber = items.biblioitemnumber)
998 and (biblioitems.itemtype = itemtypes.itemtype)";
999 my $sth=$dbh->prepare($query);
1001 if (my $data=$sth->fetchrow_hashref) {
1002 $loanlength = $data->{'loanlength'}
1006 my $datedu = time + ($loanlength * 86400);
1007 my @datearr = localtime($datedu);
1008 $datedue = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
1010 my @date = split("-",$datedue);
1011 my $odatedue = ($date[2]+0)."-".($date[1]+0)."-".$date[0];
1012 my $issquery = "select * from issues where borrowernumber='$bornum' and
1013 itemnumber='$itemno' and returndate is null";
1014 my $sth=$dbh->prepare($issquery);
1016 my $issuedata=$sth->fetchrow_hashref;
1018 my $renews = $issuedata->{'renewals'} +1;
1019 my $updquery = "update issues
1020 set date_due = '$datedue', renewals = '$renews'
1021 where borrowernumber='$bornum' and
1022 itemnumber='$itemno' and returndate is null";
1023 $sth=$dbh->prepare($updquery);
1031 # Stolen from Issues.pm
1032 # calculate charges due
1033 my ($env, $dbh, $itemno, $bornum)=@_;
1038 # open (FILE,">>/tmp/charges");
1040 my $q1 = "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes
1041 where (items.itemnumber ='$itemno')
1042 and (biblioitems.biblioitemnumber = items.biblioitemnumber)
1043 and (biblioitems.itemtype = itemtypes.itemtype)";
1044 my $sth1= $dbh->prepare($q1);
1045 # print FILE "$q1\n";
1047 if (my $data1=$sth1->fetchrow_hashref) {
1048 $item_type = $data1->{'itemtype'};
1049 $charge = $data1->{'rentalcharge'};
1050 # print FILE "charge is $charge\n";
1051 my $q2 = "select rentaldiscount from borrowers,categoryitem
1052 where (borrowers.borrowernumber = '$bornum')
1053 and (borrowers.categorycode = categoryitem.categorycode)
1054 and (categoryitem.itemtype = '$item_type')";
1055 my $sth2=$dbh->prepare($q2);
1058 if (my $data2=$sth2->fetchrow_hashref) {
1059 my $discount = $data2->{'rentaldiscount'};
1060 # print FILE "discount is $discount";
1061 if ($discount eq 'NULL') {
1064 $charge = ($charge *(100 - $discount)) / 100;
1074 #Stolen from Issues.pm
1075 my ($env,$dbh,$itemno,$bornum,$charge) = @_;
1076 my $nextaccntno = getnextacctno($env,$bornum,$dbh);
1077 my $query = "insert into accountlines (borrowernumber,itemnumber,accountno,date,amount, description,accounttype,amountoutstanding) values ($bornum,$itemno,$nextaccntno,now(),$charge,'Rental','Rent',$charge)";
1078 my $sth = $dbh->prepare($query);
1085 # Stolen from Accounts.pm
1086 my ($env,$bornumber,$dbh)=@_;
1087 my $nextaccntno = 1;
1088 my $query = "select * from accountlines where (borrowernumber = '$bornumber') order by accountno desc";
1089 my $sth = $dbh->prepare($query);
1091 if (my $accdata=$sth->fetchrow_hashref){
1092 $nextaccntno = $accdata->{'accountno'} + 1;
1095 return($nextaccntno);
1099 # Stolen from Returns.pm
1103 my ($itemdata) = getiteminformation(\%env, $itemno,0);
1104 my $bibno = $dbh->quote($itemdata->{'biblionumber'});
1105 my $bibitm = $dbh->quote($itemdata->{'biblioitemnumber'});
1106 my $query = "select * from reserves where ((found = 'W') or (found is null))
1107 and biblionumber = $bibno and cancellationdate is NULL
1108 order by priority, reservedate ";
1109 my $sth = $dbh->prepare($query);
1115 while (($resrec = $sth->fetchrow_hashref) && (not $resfound)) {
1117 my $brn = $dbh->quote($resrec->{'borrowernumber'});
1118 my $rdate = $dbh->quote($resrec->{'reservedate'});
1119 my $bibno = $dbh->quote($resrec->{'biblionumber'});
1120 if ($resrec->{'found'} eq "W") {
1121 if ($resrec->{'itemnumber'} eq $itemno) {
1125 if ($resrec->{'constrainttype'} eq "a") {
1128 my $conquery = "select * from reserveconstraints where borrowernumber = $brn
1129 and reservedate = $rdate and biblionumber = $bibno and biblioitemnumber = $bibitm";
1130 my $consth = $dbh->prepare($conquery);
1132 if (my $conrec = $consth->fetchrow_hashref) {
1133 if ($resrec->{'constrainttype'} eq "o") {
1141 my $updquery = "update reserves set found = 'W', itemnumber = '$itemno'
1142 where borrowernumber = $brn and reservedate = $rdate and biblionumber = $bibno";
1143 my $updsth = $dbh->prepare($updquery);
1149 return ($resfound,$lastrec);
1152 END { } # module clean-up code here (global destructor)