2 # Please use 8-character tabs for this file (indents are every 4 characters)
4 package C4::Circulation::Circ2;
8 #package to deal with Returns
9 #written 3/11/99 by olwen@katipo.co.nz
12 # Copyright 2000-2002 Katipo Communications
14 # This file is part of Koha.
16 # Koha is free software; you can redistribute it and/or modify it under the
17 # terms of the GNU General Public License as published by the Free Software
18 # Foundation; either version 2 of the License, or (at your option) any later
21 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
22 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
23 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
25 # You should have received a copy of the GNU General Public License along with
26 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
27 # Suite 330, Boston, MA 02111-1307 USA
38 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
40 # set the version for version checking
45 C4::Circulation::Circ2 - Koha circulation module
49 use C4::Circulation::Circ2;
53 The functions in this module deal with circulation, issues, and
54 returns, as well as general information about the library.
55 Also deals with stocktaking.
64 @EXPORT = qw(&getpatroninformation
65 ¤tissues &getissues &getiteminformation
66 &issuebook &returnbook &find_reserves &transferbook &decode
67 &calc_charges &listitemsforinventory &itemseen);
69 # &getbranches &getprinters &getbranch &getprinter => moved to C4::Koha.pm
73 Mark item as seen. Is called when an item is issued, returned or manually marked during inventory/stocktaking
74 C<$itemnum> is the item number
81 my $dbh = C4::Context->dbh;
82 my $sth = $dbh->prepare("update items set datelastseen = now() where items.itemnumber = ?");
83 $sth->execute($itemnum);
87 sub listitemsforinventory {
88 my ($minlocation,$maxlocation,$datelastseen,$offset,$size) = @_;
89 my $dbh = C4::Context->dbh;
90 my $sth = $dbh->prepare("select itemnumber,barcode,itemcallnumber,title,author from items,biblio where items.biblionumber=biblio.biblionumber and itemcallnumber>= ? and itemcallnumber <=? and (datelastseen< ? or datelastseen is null) order by itemcallnumber,title");
91 $sth->execute($minlocation,$maxlocation,$datelastseen);
93 while (my $row = $sth->fetchrow_hashref) {
94 $offset-- if ($offset);
95 if ((!$offset) && $size) {
102 =item getpatroninformation
104 ($borrower, $flags) = &getpatroninformation($env, $borrowernumber,
107 Looks up a patron and returns information about him or her. If
108 C<$borrowernumber> is true (nonzero), C<&getpatroninformation> looks
109 up the borrower by number; otherwise, it looks up the borrower by card
112 C<$env> is effectively ignored, but should be a reference-to-hash.
114 C<$borrower> is a reference-to-hash whose keys are the fields of the
115 borrowers table in the Koha database. In addition,
116 C<$borrower-E<gt>{flags}> is the same as C<$flags>.
118 C<$flags> is a reference-to-hash giving more detailed information
119 about the patron. Its keys act as flags: if they are set, then the key
120 is a reference-to-hash that gives further details:
122 if (exists($flags->{LOST}))
124 # Patron's card was reported lost
125 print $flags->{LOST}{message}, "\n";
128 Each flag has a C<message> key, giving a human-readable explanation of
129 the flag. If the state of a flag means that the patron should not be
130 allowed to borrow any more books, then it will have a C<noissues> key
133 The possible flags are:
139 Shows the patron's credit or debt, if any.
143 (Gone, no address.) Set if the patron has left without giving a
148 Set if the patron's card has been reported as lost.
152 Set if the patron has been debarred.
156 Any additional notes about the patron.
160 Set if the patron has overdue items. This flag has several keys:
162 C<$flags-E<gt>{ODUES}{itemlist}> is a reference-to-array listing the
163 overdue items. Its elements are references-to-hash, each describing an
164 overdue item. The keys are selected fields from the issues, biblio,
165 biblioitems, and items tables of the Koha database.
167 C<$flags-E<gt>{ODUES}{itemlist}> is a string giving a text listing of
168 the overdue items, one per line.
172 Set if any items that the patron has reserved are available.
174 C<$flags-E<gt>{WAITING}{itemlist}> is a reference-to-array listing the
175 available items. Each element is a reference-to-hash whose keys are
176 fields from the reserves table of the Koha database.
182 sub getpatroninformation {
184 my ($env, $borrowernumber,$cardnumber) = @_;
185 my $dbh = C4::Context->dbh;
188 if ($borrowernumber) {
189 $sth = $dbh->prepare("select * from borrowers where borrowernumber=?");
190 $sth->execute($borrowernumber);
191 } elsif ($cardnumber) {
192 $sth = $dbh->prepare("select * from borrowers where cardnumber=?");
193 $sth->execute($cardnumber);
195 $env->{'apierror'} = "invalid borrower information passed to getpatroninformation subroutine";
198 $env->{'mess'} = $query;
199 my $borrower = $sth->fetchrow_hashref;
200 my $amount = checkaccount($env, $borrowernumber, $dbh);
201 $borrower->{'amountoutstanding'} = $amount;
202 my $flags = patronflags($env, $borrower, $dbh);
205 $sth=$dbh->prepare("select bit,flag from userflags");
207 while (my ($bit, $flag) = $sth->fetchrow) {
208 if ($borrower->{'flags'} & 2**$bit) {
209 $accessflagshash->{$flag}=1;
213 $borrower->{'flags'}=$flags;
214 return ($borrower, $flags, $accessflagshash);
219 $str = &decode($chunk);
221 Decodes a segment of a string emitted by a CueCat barcode scanner and
226 # FIXME - At least, I'm pretty sure this is for decoding CueCat stuff.
229 my $seq = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
230 my @s = map { index($seq,$_); } split(//,$encoded);
245 my $n = (($s[0] << 6 | $s[1]) << 6 | $s[2]) << 6 | $s[3];
246 $r .=chr(($n >> 16) ^ 67) .
247 chr(($n >> 8 & 255) ^ 67) .
248 chr(($n & 255) ^ 67);
251 $r = substr($r,0,length($r)-$l);
255 =item getiteminformation
257 $item = &getiteminformation($env, $itemnumber, $barcode);
259 Looks up information about an item, given either its item number or
260 its barcode. If C<$itemnumber> is a nonzero value, it is used;
261 otherwise, C<$barcode> is used.
263 C<$env> is effectively ignored, but should be a reference-to-hash.
265 C<$item> is a reference-to-hash whose keys are fields from the biblio,
266 items, and biblioitems tables of the Koha database. It may also
267 contain the following keys:
273 The due date on this item, if it has been borrowed and not returned
274 yet. The date is in YYYY-MM-DD format.
278 The length of time for which the item can be borrowed, in days.
282 True if the item may not be borrowed.
288 sub getiteminformation {
289 # returns a hash of item information given either the itemnumber or the barcode
290 my ($env, $itemnumber, $barcode) = @_;
291 my $dbh = C4::Context->dbh;
294 $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.itemnumber=? and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
295 $sth->execute($itemnumber);
297 $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.barcode=? and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
298 $sth->execute($barcode);
300 $env->{'apierror'}="getiteminformation() subroutine must be called with either an itemnumber or a barcode";
304 my $iteminformation=$sth->fetchrow_hashref;
306 # FIXME - Style: instead of putting the entire rest of the
307 # function in a block, just say
308 # return undef unless $iteminformation;
309 # That way, the rest of the function needn't be indented as much.
310 if ($iteminformation) {
311 $sth=$dbh->prepare("select date_due from issues where itemnumber=? and isnull(returndate)");
312 $sth->execute($iteminformation->{'itemnumber'});
313 my ($date_due) = $sth->fetchrow;
314 $iteminformation->{'date_due'}=$date_due;
316 # FIXME - The Dewey code is a string, not a number. Besides,
317 # "000" is a perfectly valid Dewey code.
318 #$iteminformation->{'dewey'}=~s/0*$//;
319 ($iteminformation->{'dewey'} == 0) && ($iteminformation->{'dewey'}='');
320 # FIXME - fetchrow_hashref is documented as being inefficient.
321 # Perhaps this should be rewritten as
322 # $sth = $dbh->prepare("select loanlength, notforloan ...");
324 # ($iteminformation->{loanlength},
325 # $iteminformation->{notforloan}) = fetchrow_array;
326 $sth=$dbh->prepare("select * from itemtypes where itemtype=?");
327 $sth->execute($iteminformation->{'itemtype'});
328 my $itemtype=$sth->fetchrow_hashref;
329 $iteminformation->{'loanlength'}=$itemtype->{'loanlength'};
330 # if specific item notforloan, don't use itemtype notforloan field.
331 # otherwise, use itemtype notforloan value to see if item can be issued.
332 $iteminformation->{'notforloan'}=$itemtype->{'notforloan'} unless $iteminformation->{'notforloan'};
335 return($iteminformation);
340 ($dotransfer, $messages, $iteminformation) =
341 &transferbook($newbranch, $barcode, $ignore_reserves);
343 Transfers an item to a new branch. If the item is currently on loan,
344 it is automatically returned before the actual transfer.
346 C<$newbranch> is the code for the branch to which the item should be
349 C<$barcode> is the barcode of the item to be transferred.
351 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
352 Otherwise, if an item is reserved, the transfer fails.
354 Returns three values:
356 C<$dotransfer> is true iff the transfer was successful.
358 C<$messages> is a reference-to-hash which may have any of the
365 There is no item in the catalog with the given barcode. The value is
370 The item's home branch is permanent. This doesn't prevent the item
371 from being transferred, though. The value is the code of the item's
374 =item C<DestinationEqualsHolding>
376 The item is already at the branch to which it is being transferred.
377 The transfer is nonetheless considered to have failed. The value
382 The item was on loan, and C<&transferbook> automatically returned it
383 before transferring it. The value is the borrower number of the patron
388 The item was reserved. The value is a reference-to-hash whose keys are
389 fields from the reserves table of the Koha database, and
390 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
391 either C<Waiting> or C<Reserved>.
393 =item C<WasTransferred>
395 The item was eligible to be transferred. Barring problems
396 communicating with the database, the transfer should indeed have
397 succeeded. The value should be ignored.
403 # FIXME - This function tries to do too much, and its API is clumsy.
404 # If it didn't also return books, it could be used to change the home
405 # branch of a book while the book is on loan.
407 # Is there any point in returning the item information? The caller can
408 # look that up elsewhere if ve cares.
410 # This leaves the ($dotransfer, $messages) tuple. This seems clumsy.
411 # If the transfer succeeds, that's all the caller should need to know.
412 # Thus, this function could simply return 1 or 0 to indicate success
413 # or failure, and set $C4::Circulation::Circ2::errmsg in case of
414 # failure. Or this function could return undef if successful, and an
415 # error message in case of failure (this would feel more like C than
418 # transfer book code....
419 my ($tbr, $barcode, $ignoreRs) = @_;
423 my $branches = getbranches();
424 my $iteminformation = getiteminformation(\%env, 0, $barcode);
426 if (not $iteminformation) {
427 $messages->{'BadBarcode'} = $barcode;
430 # get branches of book...
431 my $hbr = $iteminformation->{'homebranch'};
432 my $fbr = $iteminformation->{'holdingbranch'};
434 if ($branches->{$hbr}->{'PE'}) {
435 $messages->{'IsPermanent'} = $hbr;
437 # can't transfer book if is already there....
438 # FIXME - Why not? Shouldn't it trivially succeed?
440 $messages->{'DestinationEqualsHolding'} = 1;
443 # check if it is still issued to someone, return it...
444 my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
445 if ($currentborrower) {
446 returnbook($barcode, $fbr);
447 $messages->{'WasReturned'} = $currentborrower;
450 # FIXME - Don't call &CheckReserves unless $ignoreRs is true.
451 # That'll save a database query.
452 my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
453 if ($resfound and not $ignoreRs) {
454 $resrec->{'ResFound'} = $resfound;
455 $messages->{'ResFound'} = $resrec;
458 #actually do the transfer....
460 dotransfer($iteminformation->{'itemnumber'}, $fbr, $tbr);
461 $messages->{'WasTransfered'} = 1;
463 return ($dotransfer, $messages, $iteminformation);
467 # FIXME - This is only used in &transferbook. Why bother making it a
470 my ($itm, $fbr, $tbr) = @_;
471 my $dbh = C4::Context->dbh;
472 $itm = $dbh->quote($itm);
473 $fbr = $dbh->quote($fbr);
474 $tbr = $dbh->quote($tbr);
475 #new entry in branchtransfers....
476 $dbh->do("INSERT INTO branchtransfers (itemnumber, frombranch, datearrived, tobranch)
477 VALUES ($itm, $fbr, now(), $tbr)");
478 #update holdingbranch in items .....
479 $dbh->do("UPDATE items set holdingbranch = $tbr WHERE items.itemnumber = $itm");
486 ($iteminformation, $datedue, $rejected, $question, $questionnumber,
487 $defaultanswer, $message) =
488 &issuebook($env, $patroninformation, $barcode, $responses, $date);
490 Issue a book to a patron.
492 C<$env-E<gt>{usercode}> will be used in the usercode field of the
493 statistics table of the Koha database when this transaction is
496 C<$env-E<gt>{datedue}>, if given, specifies the date on which the book
497 is due back. This should be a string of the form "YYYY-MM-DD".
499 C<$env-E<gt>{branchcode}> is the code of the branch where this
500 transaction is taking place.
502 C<$patroninformation> is a reference-to-hash giving information about
503 the person borrowing the book. This is the first value returned by
504 C<&getpatroninformation>.
506 C<$barcode> is the bar code of the book being issued.
508 C<$responses> is a reference-to-hash. It represents the answers to the
509 questions asked by the C<$question>, C<$questionnumber>, and
510 C<$defaultanswer> return values (see below). The keys are numbers, and
511 the values can be "Y" or "N".
513 C<$date> is an optional date in the form "YYYY-MM-DD". If specified,
514 then only fines and charges up to that date will be considered when
515 checking to see whether the patron owes too much money to be lent a
518 C<&issuebook> returns an array of seven values:
520 C<$iteminformation> is a reference-to-hash describing the item just
521 issued. This in a form similar to that returned by
522 C<&getiteminformation>.
524 C<$datedue> is a string giving the date when the book is due, in the
527 C<$rejected> is either a string, or -1. If it is defined and is a
528 string, then the book may not be issued, and C<$rejected> gives the
529 reason for this. If C<$rejected> is -1, then the book may not be
530 issued, but no reason is given.
532 If there is a problem or question (e.g., the book is reserved for
533 another patron), then C<$question>, C<$questionnumber>, and
534 C<$defaultanswer> will be set. C<$questionnumber> indicates the
535 problem. C<$question> is a text string asking how to resolve the
536 problem, as a yes-or-no question, and C<$defaultanswer> is either "Y"
537 or "N", giving the default answer. The questions, their numbers, and
542 =item 1: "Issued to <name>. Mark as returned?" (Y)
544 =item 2: "Waiting for <patron> at <branch>. Allow issue?" (N)
546 =item 3: "Cancel reserve for <patron>?" (N)
548 =item 4: "Book is issued to this borrower. Renew?" (Y)
550 =item 5: "Reserved for <patron> at <branch> since <date>. Allow issue?" (N)
552 =item 6: "Set reserve for <patron> to waiting and transfer to <branch>?" (Y)
554 This is asked if the answer to question 5 was "N".
556 =item 7: "Cancel reserve for <patron>?" (N)
560 C<$message>, if defined, is an additional information message, e.g., a
565 # FIXME - The business with $responses is absurd. For one thing, these
566 # questions should have names, not numbers. For another, it'd be
567 # better to have the last argument be %extras. Then scripts can call
571 # -mark_returned => 0,
572 # -cancel_reserve => 1,
575 # and the script can use
576 # if (defined($extras{"-mark_returned"}) && $extras{"-mark_returned"})
577 # Heck, the $date argument should go in there as well.
579 # Also, there might be several reasons why a book can't be issued, but
580 # this API only supports asking one question at a time. Perhaps it'd
581 # be better to return a ref-to-list of problem IDs. Then the calling
582 # script can display a list of all of the problems at once.
584 # Is it this function's place to decide the default answer to the
585 # various questions? Why not document the various problems and allow
586 # the caller to decide?
588 my ($env, $patroninformation, $barcode, $responses, $date) = @_;
589 my $dbh = C4::Context->dbh;
590 my $iteminformation = getiteminformation($env, 0, $barcode);
592 my ($rejected,$question,$defaultanswer,$questionnumber, $noissue);
595 # See if there's any reason this book shouldn't be issued to this
597 SWITCH: { # FIXME - Yes, we know it's a switch. Tell us what it's for.
598 if ($patroninformation->{'gonenoaddress'}) {
599 $rejected="Patron is gone, with no known address.";
602 if ($patroninformation->{'lost'}) {
603 $rejected="Patron's card has been reported lost.";
606 if ($patroninformation->{'debarred'}) {
607 $rejected="Patron is Debarred";
610 my $amount = checkaccount($env,$patroninformation->{'borrowernumber'}, $dbh,$date);
611 # FIXME - "5" shouldn't be hardcoded. An Italian library might
612 # be generous enough to lend a book to a patron even if he
613 # does still owe them 5 lire.
614 if ($amount > 5 && $patroninformation->{'categorycode'} ne 'L' &&
615 $patroninformation->{'categorycode'} ne 'W' &&
616 $patroninformation->{'categorycode'} ne 'I' &&
617 $patroninformation->{'categorycode'} ne 'B' &&
618 $patroninformation->{'categorycode'} ne 'P') {
619 # FIXME - What do these category codes mean?
620 $rejected = sprintf "Patron owes \$%.02f.", $amount;
623 # FIXME - This sort of error-checking should be placed closer
624 # to the test; in this case, this error-checking should be
625 # done immediately after the call to &getiteminformation.
626 unless ($iteminformation) {
627 $rejected = "$barcode is not a valid barcode.";
630 if ($iteminformation->{'notforloan'} == 1) {
631 $rejected="Item not for loan.";
634 if ($iteminformation->{'wthdrawn'} == 1) {
635 $rejected="Item withdrawn.";
638 if ($iteminformation->{'restricted'} == 1) {
639 $rejected="Restricted item.";
642 if ($iteminformation->{'itemtype'} eq 'REF') {
643 $rejected="Reference item: Not for loan.";
646 my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
647 if ($currentborrower eq $patroninformation->{'borrowernumber'}) {
648 # Already issued to current borrower. Ask whether the loan should
650 my ($renewstatus) = renewstatus($env,$dbh,$patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
651 if ($renewstatus == 0) {
652 $rejected="No more renewals allowed for this item.";
655 if ($responses->{4} eq '') {
657 $question = "Book is issued to this borrower.\nRenew?";
658 $defaultanswer = 'Y';
660 } elsif ($responses->{4} eq 'Y') {
661 my ($charge,$itemtype) = calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'});
663 createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'}, $charge);
664 $iteminformation->{'charge'} = $charge;
666 &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$patroninformation->{'borrowernumber'});
667 renewbook($env,$dbh, $patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
670 $rejected="Item on issue to this borrower, and you have chosen not to renew";
674 } elsif ($currentborrower ne '') {
675 # This book is currently on loan, but not to the person
676 # who wants to borrow it now.
677 my ($currborrower, $cbflags) = getpatroninformation($env,$currentborrower,0);
678 if ($responses->{1} eq '') {
680 $question = "Issued to $currborrower->{'firstname'} $currborrower->{'surname'} ($currborrower->{'cardnumber'}).\nMark as returned?";
683 } elsif ($responses->{1} eq 'Y') {
684 returnbook($iteminformation->{'barcode'}, $env->{'branchcode'});
686 $rejected="Item on issue to another borrower, and you have chosen not to return it";
691 # See if the item is on reserve.
692 my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'});
694 my $resbor = $res->{'borrowernumber'};
695 if ($resbor eq $patroninformation->{'borrowernumber'}) {
696 # The item is on reserve to the current patron
698 } elsif ($restype eq "Waiting") {
699 # The item is on reserve and waiting, but has been
700 # reserved by some other patron.
701 my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
702 my $branches = getbranches();
703 my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
704 if ($responses->{2} eq '' && $responses->{3} eq '') {
706 # FIXME - Assumes HTML
707 $question="<font color=red>Waiting</font> for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) at $branchname \nAllow issue?";
710 } elsif ($responses->{2} eq 'N') {
711 $rejected="Issue cancelled";
714 if ($responses->{3} eq '') {
716 $question="Cancel reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})?";
719 } elsif ($responses->{3} eq 'Y') {
720 CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
724 } elsif ($restype eq "Reserved") {
725 # The item is on reserve for someone else.
726 my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
727 my $branches = getbranches();
728 my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
729 if ($responses->{5} eq '' && $responses->{7} eq '') {
731 $question="Reserved for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) since $res->{'reservedate'} \nAllow issue?";
733 if ($responses->{6} eq 'Y') {
734 my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'});
735 transferbook($tobrcd,$barcode, 1);
736 $message = "Item should now be waiting at $branchname";
739 } elsif ($responses->{5} eq 'N') {
740 if ($responses->{6} eq '') {
742 $question="Set reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) to waiting and transfer to $branchname?";
744 } elsif ($responses->{6} eq 'Y') {
745 my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'});
746 transferbook($tobrcd, $barcode, 1);
747 $message = "Item should now be waiting at $branchname";
752 if ($responses->{7} eq '') {
754 $question="Cancel reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})?";
757 } elsif ($responses->{7} eq 'Y') {
758 CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
765 unless (($question) || ($rejected) || ($noissue)) {
766 # There's no reason why the item can't be issued.
767 # FIXME - my $loanlength = $iteminformation->{loanlength} || 21;
769 if ($iteminformation->{'loanlength'}) {
770 $loanlength=$iteminformation->{'loanlength'};
772 my $ti=time; # FIXME - Never used
773 my $datedue=time+($loanlength)*86400;
774 # FIXME - Could just use POSIX::strftime("%Y-%m-%d", localtime);
775 # That's what it's for. Or, in this case:
776 # $dateduef = $env->{datedue} ||
777 # strftime("%Y-%m-%d", localtime(time +
778 # $loanlength * 86400));
779 my @datearr = localtime($datedue);
780 $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
781 if ($env->{'datedue'}) {
782 $dateduef=$env->{'datedue'};
784 $dateduef=~ s/2001\-4\-25/2001\-4\-26/;
785 # FIXME - What's this for? Leftover from debugging?
787 # Record in the database the fact that the book was issued.
788 my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode) values (?,?,?,?)");
789 $sth->execute($patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'}, $dateduef, $env->{'branchcode'});
791 $iteminformation->{'issues'}++;
792 $sth=$dbh->prepare("update items set issues=? where itemnumber=?");
793 $sth->execute($iteminformation->{'issues'},$iteminformation->{'itemnumber'});
795 &itemseen($iteminformation->{'itemnumber'});
796 # If it costs to borrow this book, charge it to the patron's account.
797 my ($charge,$itemtype)=calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'});
799 createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'}, $charge);
800 $iteminformation->{'charge'}=$charge;
802 # Record the fact that this book was issued.
803 &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$patroninformation->{'borrowernumber'});
806 if ($iteminformation->{'charge'}) {
807 $message=sprintf "Rental charge of \$%.02f applies.", $iteminformation->{'charge'};
809 return ($iteminformation, $dateduef, $rejected, $question, $questionnumber, $defaultanswer, $message);
816 ($doreturn, $messages, $iteminformation, $borrower) =
817 &returnbook($barcode, $branch);
821 C<$barcode> is the bar code of the book being returned. C<$branch> is
822 the code of the branch where the book is being returned.
824 C<&returnbook> returns a list of four items:
826 C<$doreturn> is true iff the return succeeded.
828 C<$messages> is a reference-to-hash giving the reason for failure:
834 No item with this barcode exists. The value is C<$barcode>.
838 The book is not currently on loan. The value is C<$barcode>.
842 The book's home branch is a permanent collection. If you have borrowed
843 this book, you are not allowed to return it. The value is the code for
844 the book's home branch.
848 This book has been withdrawn/cancelled. The value should be ignored.
852 The item was reserved. The value is a reference-to-hash whose keys are
853 fields from the reserves table of the Koha database, and
854 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
855 either C<Waiting>, C<Reserved>, or 0.
859 C<$borrower> is a reference-to-hash, giving information about the
860 patron who last borrowed the book.
864 # FIXME - This API is bogus. There's no need to return $borrower and
865 # $iteminformation; the caller can ask about those separately, if it
866 # cares (it'd be inefficient to make two database calls instead of
867 # one, but &getpatroninformation and &getiteminformation can be
868 # memoized if this is an issue).
870 # The ($doreturn, $messages) tuple is redundant: if the return
871 # succeeded, that's all the caller needs to know. So &returnbook can
872 # return 1 and 0 on success and failure, and set
873 # $C4::Circulation::Circ2::errmsg to indicate the error. Or it can
874 # return undef for success, and an error message on error (though this
875 # is more C-ish than Perl-ish).
877 my ($barcode, $branch) = @_;
881 die '$branch not defined' unless defined $branch; # just in case (bug 170)
882 # get information on item
883 my ($iteminformation) = getiteminformation(\%env, 0, $barcode);
884 if (not $iteminformation) {
885 $messages->{'BadBarcode'} = $barcode;
889 my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
890 if ((not $currentborrower) && $doreturn) {
891 $messages->{'NotIssued'} = $barcode;
894 # check if the book is in a permanent collection....
895 my $hbr = $iteminformation->{'homebranch'};
896 my $branches = getbranches();
897 if ($branches->{$hbr}->{'PE'}) {
898 $messages->{'IsPermanent'} = $hbr;
900 # check that the book has been cancelled
901 if ($iteminformation->{'wthdrawn'}) {
902 $messages->{'wthdrawn'} = 1;
905 # update issues, thereby returning book (should push this out into another subroutine
906 my ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
908 doreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
909 $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
911 ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
912 # transfer book to the current branch
913 my ($transfered, $mess, $item) = transferbook($branch, $barcode, 1);
915 $messages->{'WasTransfered'} = 1; # FIXME is the "= 1" right?
917 # fix up the accounts.....
918 if ($iteminformation->{'itemlost'}) {
919 # Mark the item as not being lost.
920 updateitemlost($iteminformation->{'itemnumber'});
921 fixaccountforlostandreturned($iteminformation, $borrower);
922 $messages->{'WasLost'} = 1; # FIXME is the "= 1" right?
924 # fix up the overdues in accounts...
925 fixoverduesonreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
927 my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
929 # my $tobrcd = ReserveWaiting($resrec->{'itemnumber'}, $resrec->{'borrowernumber'});
930 $resrec->{'ResFound'} = $resfound;
931 $messages->{'ResFound'} = $resrec;
934 # Record the fact that this book was returned.
935 UpdateStats(\%env, $branch ,'return','0','',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'});
936 return ($doreturn, $messages, $iteminformation, $borrower);
940 # Takes a borrowernumber and an itemnuber.
941 # Updates the 'issues' table to mark the item as returned (assuming
942 # that it's currently on loan to the given borrower. Otherwise, the
943 # item remains on loan.
944 # Updates items.datelastseen for the item.
946 # FIXME - This is only used in &returnbook. Why make it into a
947 # separate function? (is this a recognizable step in the return process? - acli)
949 my ($brn, $itm) = @_;
950 my $dbh = C4::Context->dbh;
951 my $sth = $dbh->prepare("update issues set returndate = now() where (borrowernumber = ?)
952 and (itemnumber = ?) and (returndate is null)");
953 $sth->execute($brn,$itm);
960 # Marks an item as not being lost.
964 my $dbh = C4::Context->dbh;
966 my $sth = $dbh->prepare("UPDATE items SET itemlost = 0 WHERE itemnumber =?");
967 $sth->execute($itemno);
972 sub fixaccountforlostandreturned {
973 my ($iteminfo, $borrower) = @_;
975 my $dbh = C4::Context->dbh;
976 my $itm = $iteminfo->{'itemnumber'};
977 # check for charge made for lost book
978 my $sth = $dbh->prepare("select * from accountlines where (itemnumber = ?)
979 and (accounttype='L' or accounttype='Rep') order by date desc");
981 if (my $data = $sth->fetchrow_hashref) {
982 # writeoff this amount
984 my $amount = $data->{'amount'};
985 my $acctno = $data->{'accountno'};
987 if ($data->{'amountoutstanding'} == $amount) {
988 $offset = $data->{'amount'};
991 $offset = $amount - $data->{'amountoutstanding'};
992 $amountleft = $data->{'amountoutstanding'} - $amount;
994 my $usth = $dbh->prepare("update accountlines set accounttype = 'LR',amountoutstanding='0'
995 where (borrowernumber = ?)
996 and (itemnumber = ?) and (accountno = ?) ");
997 $usth->execute($data->{'borrowernumber'},$itm,$acctno);
999 #check if any credit is left if so writeoff other accounts
1000 my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
1001 if ($amountleft < 0){
1004 if ($amountleft > 0){
1005 my $msth = $dbh->prepare("select * from accountlines where (borrowernumber = ?)
1006 and (amountoutstanding >0) order by date");
1007 $msth->execute($data->{'borrowernumber'});
1008 # offset transactions
1011 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1012 if ($accdata->{'amountoutstanding'} < $amountleft) {
1014 $amountleft -= $accdata->{'amountoutstanding'};
1016 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1019 my $thisacct = $accdata->{'accountno'};
1020 my $usth = $dbh->prepare("update accountlines set amountoutstanding= ?
1021 where (borrowernumber = ?)
1022 and (accountno=?)");
1023 $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
1025 $usth = $dbh->prepare("insert into accountoffsets
1026 (borrowernumber, accountno, offsetaccount, offsetamount)
1029 $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1034 if ($amountleft > 0){
1037 my $desc="Book Returned ".$iteminfo->{'barcode'};
1038 $usth = $dbh->prepare("insert into accountlines
1039 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1040 values (?,?,now(),?,?,'CR',?)");
1041 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1043 $usth = $dbh->prepare("insert into accountoffsets
1044 (borrowernumber, accountno, offsetaccount, offsetamount)
1046 $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
1048 $usth = $dbh->prepare("update items set paidfor='' where itemnumber=?");
1049 $usth->execute($itm);
1057 sub fixoverduesonreturn {
1058 my ($brn, $itm) = @_;
1059 my $dbh = C4::Context->dbh;
1060 # check for overdue fine
1061 my $sth = $dbh->prepare("select * from accountlines where (borrowernumber = ?) and (itemnumber = ?) and (accounttype='FU' or accounttype='O')");
1062 $sth->execute($brn,$itm);
1063 # alter fine to show that the book has been returned
1064 if (my $data = $sth->fetchrow_hashref) {
1065 my $usth=$dbh->prepare("update accountlines set accounttype='F' where (borrowernumber = ?) and (itemnumber = ?) and (acccountno = ?)");
1066 $usth->execute($brn,$itm,$data->{'accountno'});
1075 # NOTE!: If you change this function, be sure to update the POD for
1076 # &getpatroninformation.
1078 # $flags = &patronflags($env, $patron, $dbh);
1081 # {message} Message showing patron's credit or debt
1082 # {noissues} Set if patron owes >$5.00
1083 # {GNA} Set if patron gone w/o address
1084 # {message} "Borrower has no valid address"
1086 # {LOST} Set if patron's card reported lost
1087 # {message} Message to this effect
1089 # {DBARRED} Set is patron is debarred
1090 # {message} Message to this effect
1092 # {NOTES} Set if patron has notes
1093 # {message} Notes about patron
1094 # {ODUES} Set if patron has overdue books
1096 # {itemlist} ref-to-array: list of overdue books
1097 # {itemlisttext} Text list of overdue items
1098 # {WAITING} Set if there are items available that the
1100 # {message} Message to this effect
1101 # {itemlist} ref-to-array: list of available items
1103 # Original subroutine for Circ2.pm
1105 my ($env, $patroninformation, $dbh) = @_;
1106 my $amount = checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh);
1109 my $noissuescharge = C4::Context->preference("noissuescharge");
1110 $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount;
1111 if ($amount > $noissuescharge) {
1112 $flaginfo{'noissues'} = 1;
1114 $flags{'CHARGES'} = \%flaginfo;
1115 } elsif ($amount < 0){
1117 $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
1118 $flags{'CHARGES'} = \%flaginfo;
1120 if ($patroninformation->{'gonenoaddress'} == 1) {
1122 $flaginfo{'message'} = 'Borrower has no valid address.';
1123 $flaginfo{'noissues'} = 1;
1124 $flags{'GNA'} = \%flaginfo;
1126 if ($patroninformation->{'lost'} == 1) {
1128 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
1129 $flaginfo{'noissues'} = 1;
1130 $flags{'LOST'} = \%flaginfo;
1132 if ($patroninformation->{'debarred'} == 1) {
1134 $flaginfo{'message'} = 'Borrower is Debarred.';
1135 $flaginfo{'noissues'} = 1;
1136 $flags{'DBARRED'} = \%flaginfo;
1138 if ($patroninformation->{'borrowernotes'}) {
1140 $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
1141 $flags{'NOTES'} = \%flaginfo;
1143 my ($odues, $itemsoverdue)
1144 = checkoverdues($env, $patroninformation->{'borrowernumber'}, $dbh);
1147 $flaginfo{'message'} = "Yes";
1148 $flaginfo{'itemlist'} = $itemsoverdue;
1149 foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) {
1150 $flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
1152 $flags{'ODUES'} = \%flaginfo;
1154 my ($nowaiting, $itemswaiting)
1155 = CheckWaiting($patroninformation->{'borrowernumber'});
1156 if ($nowaiting > 0) {
1158 $flaginfo{'message'} = "Reserved items available";
1159 $flaginfo{'itemlist'} = $itemswaiting;
1160 $flags{'WAITING'} = \%flaginfo;
1168 # From Main.pm, modified to return a list of overdueitems, in addition to a count
1169 #checks whether a borrower has overdue items
1170 my ($env, $bornum, $dbh)=@_;
1171 my @datearr = localtime;
1172 my $today = ($datearr[5] + 1900)."-".($datearr[4]+1)."-".$datearr[3];
1175 my $sth = $dbh->prepare("SELECT * FROM issues,biblio,biblioitems,items
1176 WHERE items.biblioitemnumber = biblioitems.biblioitemnumber
1177 AND items.biblionumber = biblio.biblionumber
1178 AND issues.itemnumber = items.itemnumber
1179 AND issues.borrowernumber = ?
1180 AND issues.returndate is NULL
1181 AND issues.date_due < ?");
1182 $sth->execute($bornum,$today);
1183 while (my $data = $sth->fetchrow_hashref) {
1184 push (@overdueitems, $data);
1188 return ($count, \@overdueitems);
1192 sub currentborrower {
1193 # Original subroutine for Circ2.pm
1194 my ($itemnumber) = @_;
1195 my $dbh = C4::Context->dbh;
1196 my $q_itemnumber = $dbh->quote($itemnumber);
1197 my $sth=$dbh->prepare("select borrowers.borrowernumber from
1198 issues,borrowers where issues.itemnumber=$q_itemnumber and
1199 issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
1202 my ($borrower) = $sth->fetchrow;
1206 # FIXME - Not exported, but used in 'updateitem.pl' anyway.
1208 # Stolen from Main.pm
1209 # Check for reserves for biblio
1210 my ($env,$dbh,$itemnum)=@_;
1212 my $sth = $dbh->prepare("select * from reserves,items
1213 where (items.itemnumber = ?)
1214 and (reserves.cancellationdate is NULL)
1215 and (items.biblionumber = reserves.biblionumber)
1216 and ((reserves.found = 'W')
1217 or (reserves.found is null))
1218 order by priority");
1219 $sth->execute($itemnum);
1221 my $data=$sth->fetchrow_hashref;
1222 while ($data && $resbor eq '') {
1224 my $const = $data->{'constrainttype'};
1225 if ($const eq "a") {
1226 $resbor = $data->{'borrowernumber'};
1229 my $csth = $dbh->prepare("select * from reserveconstraints,items
1230 where (borrowernumber=?)
1232 and reserveconstraints.biblionumber=?
1233 and (items.itemnumber=? and
1234 items.biblioitemnumber = reserveconstraints.biblioitemnumber)");
1235 $csth->execute($data->{'borrowernumber'},$data->{'biblionumber'},$data->{'reservedate'},$itemnum);
1236 if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
1237 if ($const eq 'o') {
1238 if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
1240 if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
1244 $data=$sth->fetchrow_hashref;
1247 return ($resbor,$resrec);
1252 $issues = ¤tissues($env, $borrower);
1254 Returns a list of books currently on loan to a patron.
1256 If C<$env-E<gt>{todaysissues}> is set and true, C<¤tissues> only
1257 returns information about books issued today. If
1258 C<$env-E<gt>{nottodaysissues}> is set and true, C<¤tissues> only
1259 returns information about books issued before today. If both are
1260 specified, C<$env-E<gt>{todaysissues}> is ignored. If neither is
1261 specified, C<¤tissues> returns all of the patron's issues.
1263 C<$borrower->{borrowernumber}> is the borrower number of the patron
1264 whose issues we want to list.
1266 C<¤tissues> returns a PHP-style array: C<$issues> is a
1267 reference-to-hash whose keys are integers in the range 1...I<n>, where
1268 I<n> is the number of items on issue (either today or before today).
1269 C<$issues-E<gt>{I<n>}> is a reference-to-hash whose keys are all of
1270 the fields of the biblio, biblioitems, items, and issues fields of the
1271 Koha database for that particular item.
1276 # New subroutine for Circ2.pm
1277 my ($env, $borrower) = @_;
1278 my $dbh = C4::Context->dbh;
1281 my $borrowernumber = $borrower->{'borrowernumber'};
1284 # Figure out whether to get the books issued today, or earlier.
1285 # FIXME - $env->{todaysissues} and $env->{nottodaysissues} can
1286 # both be specified, but are mutually-exclusive. This is bogus.
1287 # Make this a flag. Or better yet, return everything in (reverse)
1288 # chronological order and let the caller figure out which books
1289 # were issued today.
1290 if ($env->{'todaysissues'}) {
1292 # $today = POSIX::strftime("%Y%m%d", localtime);
1293 # FIXME - Since $today will be used in either case, move it
1294 # out of the two if-blocks.
1295 my @datearr = localtime(time());
1296 my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
1297 # FIXME - MySQL knows about dates. Just use
1298 # and issues.timestamp = curdate();
1299 $crit=" and issues.timestamp like '$today%' ";
1301 if ($env->{'nottodaysissues'}) {
1303 # $today = POSIX::strftime("%Y%m%d", localtime);
1304 # FIXME - Since $today will be used in either case, move it
1305 # out of the two if-blocks.
1306 my @datearr = localtime(time());
1307 my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
1308 # FIXME - MySQL knows about dates. Just use
1309 # and issues.timestamp < curdate();
1310 $crit=" and !(issues.timestamp like '$today%') ";
1313 # FIXME - Does the caller really need every single field from all
1315 my $sth=$dbh->prepare("select * from issues,items,biblioitems,biblio where
1316 borrowernumber=? and issues.itemnumber=items.itemnumber and
1317 items.biblionumber=biblio.biblionumber and
1318 items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is null
1319 $crit order by issues.date_due");
1320 $sth->execute($borrowernumber);
1321 while (my $data = $sth->fetchrow_hashref) {
1322 # FIXME - The Dewey code is a string, not a number.
1323 $data->{'dewey'}=~s/0*$//;
1324 ($data->{'dewey'} == 0) && ($data->{'dewey'}='');
1326 # $todaysdate = POSIX::strftime("%Y%m%d", localtime)
1327 # or better yet, just reuse $today which was calculated above.
1328 # This function isn't going to run until midnight, is it?
1330 # $todaysdate = POSIX::strftime("%Y-%m-%d", localtime)
1331 # if ($data->{'date_due'} lt $todaysdate)
1333 # Either way, the date should be be formatted outside of the
1335 my @datearr = localtime(time());
1336 my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]);
1337 my $datedue=$data->{'date_due'};
1339 if ($datedue < $todaysdate) {
1340 $data->{'overdue'}=1;
1342 my $itemnumber=$data->{'itemnumber'};
1343 # FIXME - Consecutive integers as hash keys? You have GOT to
1344 # be kidding me! Use an array, fercrissakes!
1345 $currentissues{$counter}=$data;
1349 return(\%currentissues);
1354 $issues = &getissues($borrowernumber);
1356 Returns the set of books currently on loan to a patron.
1358 C<$borrowernumber> is the patron's borrower number.
1360 C<&getissues> returns a PHP-style array: C<$issues> is a
1361 reference-to-hash whose keys are integers in the range 0..I<n>-1,
1362 where I<n> is the number of books the patron currently has on loan.
1364 The values of C<$issues> are references-to-hash whose keys are
1365 selected fields from the issues, items, biblio, and biblioitems tables
1366 of the Koha database.
1371 # New subroutine for Circ2.pm
1372 my ($borrower) = @_;
1373 my $dbh = C4::Context->dbh;
1374 my $borrowernumber = $borrower->{'borrowernumber'};
1376 my $select = "SELECT issues.timestamp AS timestamp,
1377 issues.date_due AS date_due,
1378 items.biblionumber AS biblionumber,
1379 items.itemnumber AS itemnumber,
1380 items.barcode AS barcode,
1381 biblio.title AS title,
1382 biblio.author AS author,
1383 biblioitems.dewey AS dewey,
1384 itemtypes.description AS itemtype,
1385 biblioitems.subclass AS subclass,
1386 biblioitems.classification AS classification
1387 FROM issues,items,biblioitems,biblio, itemtypes
1388 WHERE issues.borrowernumber = ?
1389 AND issues.itemnumber = items.itemnumber
1390 AND items.biblionumber = biblio.biblionumber
1391 AND items.biblioitemnumber = biblioitems.biblioitemnumber
1392 AND itemtypes.itemtype = biblioitems.itemtype
1393 AND issues.returndate IS NULL
1394 ORDER BY issues.date_due";
1396 my $sth=$dbh->prepare($select);
1397 $sth->execute($borrowernumber);
1399 while (my $data = $sth->fetchrow_hashref) {
1400 $data->{'dewey'} =~ s/0*$//;
1401 ($data->{'dewey'} == 0) && ($data->{'dewey'} = '');
1402 # FIXME - The Dewey code is a string, not a number.
1403 # FIXME - Use POSIX::strftime to get a text version of today's
1404 # date. That's what it's for.
1405 # FIXME - Move the date calculation outside of the loop.
1406 my @datearr = localtime(time());
1407 my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]);
1409 # FIXME - Instead of converting the due date to YYYYMMDD, just
1411 # $todaysdate = POSIX::strftime("%Y-%m-%d", localtime);
1413 # if ($date->{date_due} lt $todaysdate)
1414 my $datedue = $data->{'date_due'};
1416 if ($datedue < $todaysdate) {
1417 $data->{'overdue'} = 1;
1419 $currentissues{$counter} = $data;
1421 # FIXME - This is ludicrous. If you want to return an
1422 # array of values, just use an array. That's what
1423 # they're there for.
1426 return(\%currentissues);
1431 #Stolen from Main.pm
1432 # check for reserves waiting
1433 my ($env,$dbh,$bornum)=@_;
1435 my $sth = $dbh->prepare("select * from reserves where (borrowernumber = ?) and (reserves.found='W') and cancellationdate is NULL");
1436 $sth->execute($bornum);
1438 if (my $data=$sth->fetchrow_hashref) {
1439 $itemswaiting[$cnt] =$data;
1443 return ($cnt,\@itemswaiting);
1447 # FIXME - This is nearly-identical to &C4::Accounts::checkaccount
1449 # Stolen from Accounts.pm
1450 #take borrower number
1451 #check accounts and list amounts owing
1452 my ($env,$bornumber,$dbh,$date)=@_;
1453 my $select="SELECT SUM(amountoutstanding) AS total
1455 WHERE borrowernumber = ?
1456 AND amountoutstanding<>0";
1457 my @bind = ($bornumber);
1459 $select.=" AND date < ?";
1463 my $sth=$dbh->prepare($select);
1464 $sth->execute(@bind);
1465 my $data=$sth->fetchrow_hashref;
1466 my $total = $data->{'total'};
1468 # output(1,2,"borrower owes $total");
1470 # # output(1,2,"borrower owes $total");
1472 # reconcileaccount($env,$dbh,$bornumber,$total);
1479 # FIXME - This is identical to &C4::Circulation::Renewals::renewstatus.
1480 # Pick one and stick with it.
1482 # Stolen from Renewals.pm
1483 # check renewal status
1484 my ($env,$dbh,$bornum,$itemno)=@_;
1487 my $sth1 = $dbh->prepare("select * from issues
1488 where (borrowernumber = ?)
1489 and (itemnumber = ?)
1490 and returndate is null");
1491 $sth1->execute($bornum,$itemno);
1492 if (my $data1 = $sth1->fetchrow_hashref) {
1493 my $sth2 = $dbh->prepare("select renewalsallowed from items,biblioitems,itemtypes
1494 where (items.itemnumber = ?)
1495 and (items.biblioitemnumber = biblioitems.biblioitemnumber)
1496 and (biblioitems.itemtype = itemtypes.itemtype)");
1497 $sth2->execute($itemno);
1498 if (my $data2=$sth2->fetchrow_hashref) {
1499 $renews = $data2->{'renewalsallowed'};
1501 if ($renews > $data1->{'renewals'}) {
1511 # Stolen from Renewals.pm
1512 # mark book as renewed
1513 my ($env,$dbh,$bornum,$itemno,$datedue)=@_;
1514 $datedue=$env->{'datedue'};
1515 if ($datedue eq "" ) {
1517 my $sth=$dbh->prepare("Select * from biblioitems,items,itemtypes
1518 where (items.itemnumber = ?)
1519 and (biblioitems.biblioitemnumber = items.biblioitemnumber)
1520 and (biblioitems.itemtype = itemtypes.itemtype)");
1521 $sth->execute($itemno);
1522 if (my $data=$sth->fetchrow_hashref) {
1523 $loanlength = $data->{'loanlength'}
1527 my $datedu = time + ($loanlength * 86400);
1528 my @datearr = localtime($datedu);
1529 $datedue = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
1531 my @date = split("-",$datedue);
1532 my $odatedue = ($date[2]+0)."-".($date[1]+0)."-".$date[0];
1533 my $sth=$dbh->prepare("select * from issues where borrowernumber=? and
1534 itemnumber=? and returndate is null");
1535 $sth->execute($bornum,$itemno);
1536 my $issuedata=$sth->fetchrow_hashref;
1538 my $renews = $issuedata->{'renewals'} +1;
1539 $sth=$dbh->prepare("update issues
1540 set date_due = ?, renewals = ?
1541 where borrowernumber=? and
1542 itemnumber=? and returndate is null");
1544 $sth->execute($datedue,$renews,$bornum,$itemno);
1549 # FIXME - This is almost, but not quite, identical to
1550 # &C4::Circulation::Issues::calc_charges and
1551 # &C4::Circulation::Renewals2::calc_charges.
1552 # Pick one and stick with it.
1554 # Stolen from Issues.pm
1555 # calculate charges due
1556 my ($env, $dbh, $itemno, $bornum)=@_;
1561 # open (FILE,">>/tmp/charges");
1563 my $sth1= $dbh->prepare("select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes
1564 where (items.itemnumber =?)
1565 and (biblioitems.biblioitemnumber = items.biblioitemnumber)
1566 and (biblioitems.itemtype = itemtypes.itemtype)");
1567 # print FILE "$q1\n";
1568 $sth1->execute($itemno);
1569 if (my $data1=$sth1->fetchrow_hashref) {
1570 $item_type = $data1->{'itemtype'};
1571 $charge = $data1->{'rentalcharge'};
1572 # print FILE "charge is $charge\n";
1573 my $sth2=$dbh->prepare("select rentaldiscount from borrowers,categoryitem
1574 where (borrowers.borrowernumber = ?)
1575 and (borrowers.categorycode = categoryitem.categorycode)
1576 and (categoryitem.itemtype = ?)");
1578 $sth2->execute($bornum,$item_type);
1579 if (my $data2=$sth2->fetchrow_hashref) {
1580 my $discount = $data2->{'rentaldiscount'};
1581 # print FILE "discount is $discount";
1582 if ($discount eq 'NULL') {
1585 $charge = ($charge *(100 - $discount)) / 100;
1591 return ($charge, $item_type);
1594 # FIXME - A virtually identical function appears in
1595 # C4::Circulation::Issues. Pick one and stick with it.
1597 #Stolen from Issues.pm
1598 my ($env,$dbh,$itemno,$bornum,$charge) = @_;
1599 my $nextaccntno = getnextacctno($env,$bornum,$dbh);
1600 my $sth = $dbh->prepare(<<EOT);
1601 INSERT INTO accountlines
1602 (borrowernumber, itemnumber, accountno,
1603 date, amount, description, accounttype,
1606 now(), ?, 'Rental', 'Rent',
1609 $sth->execute($bornum, $itemno, $nextaccntno, $charge, $charge);
1615 # Stolen from Accounts.pm
1616 my ($env,$bornumber,$dbh)=@_;
1617 my $nextaccntno = 1;
1618 my $sth = $dbh->prepare("select * from accountlines where (borrowernumber = ?) order by accountno desc");
1619 $sth->execute($bornumber);
1620 if (my $accdata=$sth->fetchrow_hashref){
1621 $nextaccntno = $accdata->{'accountno'} + 1;
1624 return($nextaccntno);
1629 ($status, $record) = &find_reserves($itemnumber);
1631 Looks up an item in the reserves.
1633 C<$itemnumber> is the itemnumber to look up.
1635 C<$status> is true iff the search was successful.
1637 C<$record> is a reference-to-hash describing the reserve. Its keys are
1638 the fields from the reserves table of the Koha database.
1642 # FIXME - This API is bogus: just return the record, or undef if none
1644 # FIXME - There's also a &C4::Circulation::Returns::find_reserves, but
1645 # that one looks rather different.
1647 # Stolen from Returns.pm
1650 my $dbh = C4::Context->dbh;
1651 my ($itemdata) = getiteminformation(\%env, $itemno,0);
1652 my $bibno = $dbh->quote($itemdata->{'biblionumber'});
1653 my $bibitm = $dbh->quote($itemdata->{'biblioitemnumber'});
1654 my $sth = $dbh->prepare("select * from reserves where ((found = 'W') or (found is null)) and biblionumber = ? and cancellationdate is NULL order by priority, reservedate");
1655 $sth->execute($bibno);
1661 # FIXME - I'm not really sure what's going on here, but since we
1662 # only want one result, wouldn't it be possible (and far more
1663 # efficient) to do something clever in SQL that only returns one
1665 while (($resrec = $sth->fetchrow_hashref) && (not $resfound)) {
1666 # FIXME - Unlike Pascal, Perl allows you to exit loops
1667 # early. Take out the "&& (not $resfound)" and just
1668 # use "last" at the appropriate point in the loop.
1669 # (Oh, and just in passing: if you'd used "!" instead
1670 # of "not", you wouldn't have needed the parentheses.)
1672 my $brn = $dbh->quote($resrec->{'borrowernumber'});
1673 my $rdate = $dbh->quote($resrec->{'reservedate'});
1674 my $bibno = $dbh->quote($resrec->{'biblionumber'});
1675 if ($resrec->{'found'} eq "W") {
1676 if ($resrec->{'itemnumber'} eq $itemno) {
1680 # FIXME - Use 'elsif' to avoid unnecessary indentation.
1681 if ($resrec->{'constrainttype'} eq "a") {
1684 my $consth = $dbh->prepare("select * from reserveconstraints where borrowernumber = ? and reservedate = ? and biblionumber = ? and biblioitemnumber = ?");
1685 $consth->execute($brn,$rdate,$bibno,$bibitm);
1686 if (my $conrec = $consth->fetchrow_hashref) {
1687 if ($resrec->{'constrainttype'} eq "o") {
1695 my $updsth = $dbh->prepare("update reserves set found = 'W', itemnumber = ? where borrowernumber = ? and reservedate = ? and biblionumber = ?");
1696 $updsth->execute($itemno,$brn,$rdate,$bibno);
1698 # FIXME - "last;" here to break out of the loop early.
1702 return ($resfound,$lastrec);
1712 Koha Developement team <info@koha.org>