+# -*- tab-width: 8 -*-
+# Please use 8-character tabs for this file (indents are every 4 characters)
+
package C4::Circulation::Circ2;
+# $Id$
+
#package to deal with Returns
#written 3/11/99 by olwen@katipo.co.nz
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
use strict;
+# use warnings;
require Exporter;
use DBI;
-use C4::Database;
-#use C4::Accounts;
-#use C4::InterfaceCDK;
-#use C4::Circulation::Main;
-#use C4::Format;
-#use C4::Circulation::Renewals;
-#use C4::Scan;
+use C4::Context;
use C4::Stats;
-#use C4::Search;
-#use C4::Print;
+use C4::Reserves2;
+use C4::Koha;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-
+
# set the version for version checking
$VERSION = 0.01;
-
+
+=head1 NAME
+
+C4::Circulation::Circ2 - Koha circulation module
+
+=head1 SYNOPSIS
+
+ use C4::Circulation::Circ2;
+
+=head1 DESCRIPTION
+
+The functions in this module deal with circulation, issues, and
+returns, as well as general information about the library.
+
+=head1 FUNCTIONS
+
+=over 2
+
+=cut
+
@ISA = qw(Exporter);
-@EXPORT = qw(&getpatroninformation ¤tissues &getiteminformation &findborrower &issuebook &returnbook);
-%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
-
-# your exported package globals go here,
-# as well as any optionally exported functions
-
-@EXPORT_OK = qw($Var1 %Hashit);
-
-
-# non-exported package globals go here
-#use vars qw(@more $stuff);
-
-# initalize package globals, first exported ones
-
-my $Var1 = '';
-my %Hashit = ();
-
-# then the others (which are still accessible as $Some::Module::stuff)
-my $stuff = '';
-my @more = ();
-
-# all file-scoped lexicals must be created before
-# the functions below that use them.
-
-# file-private lexicals go here
-my $priv_var = '';
-my %secret_hash = ();
-
-# here's a file-private function as a closure,
-# callable as &$priv_func; it cannot be prototyped.
-my $priv_func = sub {
- # stuff goes here.
-};
-
-# make all your functions, whether exported or not;
-
-
-sub getbranches {
- my ($env) = @_;
- my %branches;
- my $dbh=&C4Connect;
- my $sth=$dbh->prepare("select * from branches");
- $sth->execute;
- while (my $branch=$sth->fetchrow_hashref) {
- $branches{$branch->{'branchcode'}}=$branch;
- }
- return (\%branches);
-}
+@EXPORT = qw(&getpatroninformation
+ ¤tissues &getissues &getiteminformation
+ &issuebook &returnbook &find_reserves &transferbook &decode
+ &calc_charges);
+# &getbranches &getprinters &getbranch &getprinter => moved to C4::Koha.pm
-sub getprinters {
- my ($env) = @_;
- my %printers;
- my $dbh=&C4Connect;
- my $sth=$dbh->prepare("select * from printers");
- $sth->execute;
- while (my $printer=$sth->fetchrow_hashref) {
- $printers{$printer->{'printername'}}=$printer;
- }
- return (\%printers);
-}
+=item getpatroninformation
+
+ ($borrower, $flags) = &getpatroninformation($env, $borrowernumber,
+ $cardnumber);
+
+Looks up a patron and returns information about him or her. If
+C<$borrowernumber> is true (nonzero), C<&getpatroninformation> looks
+up the borrower by number; otherwise, it looks up the borrower by card
+number.
+
+C<$env> is effectively ignored, but should be a reference-to-hash.
+
+C<$borrower> is a reference-to-hash whose keys are the fields of the
+borrowers table in the Koha database. In addition,
+C<$borrower-E<gt>{flags}> is the same as C<$flags>.
+
+C<$flags> is a reference-to-hash giving more detailed information
+about the patron. Its keys act as flags: if they are set, then the key
+is a reference-to-hash that gives further details:
+
+ if (exists($flags->{LOST}))
+ {
+ # Patron's card was reported lost
+ print $flags->{LOST}{message}, "\n";
+ }
+
+Each flag has a C<message> key, giving a human-readable explanation of
+the flag. If the state of a flag means that the patron should not be
+allowed to borrow any more books, then it will have a C<noissues> key
+with a true value.
+
+The possible flags are:
+
+=over 4
+
+=item CHARGES
+
+Shows the patron's credit or debt, if any.
+
+=item GNA
+
+(Gone, no address.) Set if the patron has left without giving a
+forwarding address.
+
+=item LOST
+
+Set if the patron's card has been reported as lost.
+
+=item DBARRED
+
+Set if the patron has been debarred.
+
+=item NOTES
+
+Any additional notes about the patron.
+
+=item ODUES
+
+Set if the patron has overdue items. This flag has several keys:
+
+C<$flags-E<gt>{ODUES}{itemlist}> is a reference-to-array listing the
+overdue items. Its elements are references-to-hash, each describing an
+overdue item. The keys are selected fields from the issues, biblio,
+biblioitems, and items tables of the Koha database.
+
+C<$flags-E<gt>{ODUES}{itemlist}> is a string giving a text listing of
+the overdue items, one per line.
+=item WAITING
+Set if any items that the patron has reserved are available.
+C<$flags-E<gt>{WAITING}{itemlist}> is a reference-to-array listing the
+available items. Each element is a reference-to-hash whose keys are
+fields from the reserves table of the Koha database.
+
+=back
+
+=cut
+#'
sub getpatroninformation {
-# returns
- my ($env, $borrowernumber,$cardnumber) = @_;
- my $dbh=&C4Connect;
- my $sth;
- open O, ">>/root/tkcirc.out";
- print O "Looking up patron $borrowernumber / $cardnumber\n";
- if ($borrowernumber) {
- $sth=$dbh->prepare("select * from borrowers where borrowernumber=$borrowernumber");
- } elsif ($cardnumber) {
- $sth=$dbh->prepare("select * from borrowers where cardnumber=$cardnumber");
- } else {
- # error condition. This subroutine must be called with either a
- # borrowernumber or a card number.
- $env->{'apierror'}="invalid borrower information passed to getpatroninformation subroutine";
- return();
- }
- $sth->execute;
- my $borrower=$sth->fetchrow_hashref;
- my $flags=patronflags($env, $borrower, $dbh);
- $sth->finish;
- $dbh->disconnect;
- print O "$borrower->{'surname'} <---\n";
- close O;
- $borrower->{'flags'}=$flags;
- return($borrower, $flags);
+# returns
+ my ($env, $borrowernumber,$cardnumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query;
+ my $sth;
+ if ($borrowernumber) {
+ $query = "select * from borrowers where borrowernumber=$borrowernumber";
+ } elsif ($cardnumber) {
+ $query = "select * from borrowers where cardnumber=$cardnumber";
+ } else {
+ $env->{'apierror'} = "invalid borrower information passed to getpatroninformation subroutine";
+ return();
+ }
+ $env->{'mess'} = $query;
+ $sth = $dbh->prepare($query);
+ $sth->execute;
+ my $borrower = $sth->fetchrow_hashref;
+ my $amount = checkaccount($env, $borrowernumber, $dbh);
+ $borrower->{'amountoutstanding'} = $amount;
+ my $flags = patronflags($env, $borrower, $dbh);
+ my $accessflagshash;
+
+ $sth=$dbh->prepare("select bit,flag from userflags");
+ $sth->execute;
+ while (my ($bit, $flag) = $sth->fetchrow) {
+ if ($borrower->{'flags'} & 2**$bit) {
+ $accessflagshash->{$flag}=1;
+ }
+ }
+ $sth->finish;
+ $borrower->{'flags'}=$flags;
+ return ($borrower, $flags, $accessflagshash);
}
+=item decode
+
+ $str = &decode($chunk);
+
+Decodes a segment of a string emitted by a CueCat barcode scanner and
+returns it.
+
+=cut
+#'
+# FIXME - At least, I'm pretty sure this is for decoding CueCat stuff.
+sub decode {
+ my ($encoded) = @_;
+ my $seq = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
+ my @s = map { index($seq,$_); } split(//,$encoded);
+ my $l = ($#s+1) % 4;
+ if ($l)
+ {
+ if ($l == 1)
+ {
+ print "Error!";
+ return;
+ }
+ $l = 4-$l;
+ $#s += $l;
+ }
+ my $r = '';
+ while ($#s >= 0)
+ {
+ my $n = (($s[0] << 6 | $s[1]) << 6 | $s[2]) << 6 | $s[3];
+ $r .=chr(($n >> 16) ^ 67) .
+ chr(($n >> 8 & 255) ^ 67) .
+ chr(($n & 255) ^ 67);
+ @s = @s[4..$#s];
+ }
+ $r = substr($r,0,length($r)-$l);
+ return $r;
+}
+
+=item getiteminformation
+
+ $item = &getiteminformation($env, $itemnumber, $barcode);
+
+Looks up information about an item, given either its item number or
+its barcode. If C<$itemnumber> is a nonzero value, it is used;
+otherwise, C<$barcode> is used.
+
+C<$env> is effectively ignored, but should be a reference-to-hash.
+C<$item> is a reference-to-hash whose keys are fields from the biblio,
+items, and biblioitems tables of the Koha database. It may also
+contain the following keys:
+=over 4
+=item C<date_due>
+The due date on this item, if it has been borrowed and not returned
+yet. The date is in YYYY-MM-DD format.
+
+=item C<loanlength>
+
+The length of time for which the item can be borrowed, in days.
+
+=item C<notforloan>
+
+True if the item may not be borrowed.
+
+=back
+
+=cut
+#'
sub getiteminformation {
# returns a hash of item information given either the itemnumber or the barcode
- my ($env, $itemnumber, $barcode) = @_;
- my $dbh=&C4Connect;
- my $sth;
- if ($itemnumber) {
- $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.itemnumber=$itemnumber and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
- } elsif ($barcode) {
- my $q_barcode=$dbh->quote($barcode);
- $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.barcode=$q_barcode and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
- } else {
- $env->{'apierror'}="getiteminformation() subroutine must be called with either an itemnumber or a barcode";
- # Error condition.
- return();
- }
- $sth->execute;
- my $iteminformation=$sth->fetchrow_hashref;
- $sth->finish;
- $dbh->disconnect;
- $iteminformation->{'dewey'}=~s/0*$//;
- return($iteminformation);
+ my ($env, $itemnumber, $barcode) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth;
+ if ($itemnumber) {
+ $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.itemnumber=$itemnumber and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
+ } elsif ($barcode) {
+ my $q_barcode=$dbh->quote($barcode);
+ $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.barcode=$q_barcode and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
+ } else {
+ $env->{'apierror'}="getiteminformation() subroutine must be called with either an itemnumber or a barcode";
+ # Error condition.
+ return();
+ }
+ $sth->execute;
+ my $iteminformation=$sth->fetchrow_hashref;
+ $sth->finish;
+ # FIXME - Style: instead of putting the entire rest of the
+ # function in a block, just say
+ # return undef unless $iteminformation;
+ # That way, the rest of the function needn't be indented as much.
+ if ($iteminformation) {
+ $sth=$dbh->prepare("select date_due from issues where itemnumber=$iteminformation->{'itemnumber'} and isnull(returndate)");
+ $sth->execute;
+ my ($date_due) = $sth->fetchrow;
+ $iteminformation->{'date_due'}=$date_due;
+ $sth->finish;
+ # FIXME - The Dewey code is a string, not a number. Besides,
+ # "000" is a perfectly valid Dewey code.
+ #$iteminformation->{'dewey'}=~s/0*$//;
+ ($iteminformation->{'dewey'} == 0) && ($iteminformation->{'dewey'}='');
+ # FIXME - fetchrow_hashref is documented as being inefficient.
+ # Perhaps this should be rewritten as
+ # $sth = $dbh->prepare("select loanlength, notforloan ...");
+ # $sth->execute;
+ # ($iteminformation->{loanlength},
+ # $iteminformation->{notforloan}) = fetchrow_array;
+ $sth=$dbh->prepare("select * from itemtypes where itemtype='$iteminformation->{'itemtype'}'");
+ $sth->execute;
+ my $itemtype=$sth->fetchrow_hashref;
+ $iteminformation->{'loanlength'}=$itemtype->{'loanlength'};
+ $iteminformation->{'notforloan'}=$itemtype->{'notforloan'};
+ $sth->finish;
+ }
+ return($iteminformation);
}
-sub findborrower {
-# returns an array of borrower hash references, given a cardnumber or a partial
-# surname
- my ($env, $key) = @_;
- my $dbh=&C4Connect;
- my @borrowers;
- my $q_key=$dbh->quote($key);
- my $sth=$dbh->prepare("select * from borrowers where cardnumber=$q_key");
- $sth->execute;
- if ($sth->rows) {
- my ($borrower)=$sth->fetchrow_hashref;
- push (@borrowers, $borrower);
- } else {
- $q_key=$dbh->quote("$key%");
- $sth->finish;
- $sth=$dbh->prepare("select * from borrowers where surname like $q_key");
- $sth->execute;
- while (my $borrower = $sth->fetchrow_hashref) {
- push (@borrowers, $borrower);
+=item transferbook
+
+ ($dotransfer, $messages, $iteminformation) =
+ &transferbook($newbranch, $barcode, $ignore_reserves);
+
+Transfers an item to a new branch. If the item is currently on loan,
+it is automatically returned before the actual transfer.
+
+C<$newbranch> is the code for the branch to which the item should be
+transferred.
+
+C<$barcode> is the barcode of the item to be transferred.
+
+If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
+Otherwise, if an item is reserved, the transfer fails.
+
+Returns three values:
+
+C<$dotransfer> is true iff the transfer was successful.
+
+C<$messages> is a reference-to-hash which may have any of the
+following keys:
+
+=over 4
+
+=item C<BadBarcode>
+
+There is no item in the catalog with the given barcode. The value is
+C<$barcode>.
+
+=item C<IsPermanent>
+
+The item's home branch is permanent. This doesn't prevent the item
+from being transferred, though. The value is the code of the item's
+home branch.
+
+=item C<DestinationEqualsHolding>
+
+The item is already at the branch to which it is being transferred.
+The transfer is nonetheless considered to have failed. The value
+should be ignored.
+
+=item C<WasReturned>
+
+The item was on loan, and C<&transferbook> automatically returned it
+before transferring it. The value is the borrower number of the patron
+who had the item.
+
+=item C<ResFound>
+
+The item was reserved. The value is a reference-to-hash whose keys are
+fields from the reserves table of the Koha database, and
+C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
+either C<Waiting> or C<Reserved>.
+
+=item C<WasTransferred>
+
+The item was eligible to be transferred. Barring problems
+communicating with the database, the transfer should indeed have
+succeeded. The value should be ignored.
+
+=back
+
+=cut
+#'
+# FIXME - This function tries to do too much, and its API is clumsy.
+# If it didn't also return books, it could be used to change the home
+# branch of a book while the book is on loan.
+#
+# Is there any point in returning the item information? The caller can
+# look that up elsewhere if ve cares.
+#
+# This leaves the ($dotransfer, $messages) tuple. This seems clumsy.
+# If the transfer succeeds, that's all the caller should need to know.
+# Thus, this function could simply return 1 or 0 to indicate success
+# or failure, and set $C4::Circulation::Circ2::errmsg in case of
+# failure. Or this function could return undef if successful, and an
+# error message in case of failure (this would feel more like C than
+# Perl, though).
+sub transferbook {
+# transfer book code....
+ my ($tbr, $barcode, $ignoreRs) = @_;
+ my $messages;
+ my %env;
+ my $dotransfer = 1;
+ my $branches = getbranches();
+ my $iteminformation = getiteminformation(\%env, 0, $barcode);
+ # bad barcode..
+ if (not $iteminformation) {
+ $messages->{'BadBarcode'} = $barcode;
+ $dotransfer = 0;
}
- }
- $sth->finish;
- $dbh->disconnect;
- return(\@borrowers);
+ # get branches of book...
+ my $hbr = $iteminformation->{'homebranch'};
+ my $fbr = $iteminformation->{'holdingbranch'};
+ # if is permanent...
+ if ($branches->{$hbr}->{'PE'}) {
+ $messages->{'IsPermanent'} = $hbr;
+ }
+ # can't transfer book if is already there....
+ # FIXME - Why not? Shouldn't it trivially succeed?
+ if ($fbr eq $tbr) {
+ $messages->{'DestinationEqualsHolding'} = 1;
+ $dotransfer = 0;
+ }
+ # check if it is still issued to someone, return it...
+ my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
+ if ($currentborrower) {
+ returnbook($barcode, $fbr);
+ $messages->{'WasReturned'} = $currentborrower;
+ }
+ # find reserves.....
+ # FIXME - Don't call &CheckReserves unless $ignoreRs is true.
+ # That'll save a database query.
+ my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
+ if ($resfound and not $ignoreRs) {
+ $resrec->{'ResFound'} = $resfound;
+ $messages->{'ResFound'} = $resrec;
+ $dotransfer = 0;
+ }
+ #actually do the transfer....
+ if ($dotransfer) {
+ dotransfer($iteminformation->{'itemnumber'}, $fbr, $tbr);
+ $messages->{'WasTransfered'} = 1;
+ }
+ return ($dotransfer, $messages, $iteminformation);
+}
+
+# Not exported
+# FIXME - This is only used in &transferbook. Why bother making it a
+# separate function?
+sub dotransfer {
+ my ($itm, $fbr, $tbr) = @_;
+ my $dbh = C4::Context->dbh;
+ $itm = $dbh->quote($itm);
+ $fbr = $dbh->quote($fbr);
+ $tbr = $dbh->quote($tbr);
+ #new entry in branchtransfers....
+ $dbh->do("INSERT INTO branchtransfers (itemnumber, frombranch, datearrived, tobranch)
+ VALUES ($itm, $fbr, now(), $tbr)");
+ #update holdingbranch in items .....
+ $dbh->do("UPDATE items SET datelastseen = now(), holdingbranch = $tbr WHERE items.itemnumber = $itm");
+ return;
}
+=item issuebook
+
+ ($iteminformation, $datedue, $rejected, $question, $questionnumber,
+ $defaultanswer, $message) =
+ &issuebook($env, $patroninformation, $barcode, $responses, $date);
+
+Issue a book to a patron.
+
+C<$env-E<gt>{usercode}> will be used in the usercode field of the
+statistics table of the Koha database when this transaction is
+recorded.
+
+C<$env-E<gt>{datedue}>, if given, specifies the date on which the book
+is due back. This should be a string of the form "YYYY-MM-DD".
+
+C<$env-E<gt>{branchcode}> is the code of the branch where this
+transaction is taking place.
+
+C<$patroninformation> is a reference-to-hash giving information about
+the person borrowing the book. This is the first value returned by
+C<&getpatroninformation>.
+
+C<$barcode> is the bar code of the book being issued.
+
+C<$responses> is a reference-to-hash. It represents the answers to the
+questions asked by the C<$question>, C<$questionnumber>, and
+C<$defaultanswer> return values (see below). The keys are numbers, and
+the values can be "Y" or "N".
+
+C<$date> is an optional date in the form "YYYY-MM-DD". If specified,
+then only fines and charges up to that date will be considered when
+checking to see whether the patron owes too much money to be lent a
+book.
+
+C<&issuebook> returns an array of seven values:
+
+C<$iteminformation> is a reference-to-hash describing the item just
+issued. This in a form similar to that returned by
+C<&getiteminformation>.
+
+C<$datedue> is a string giving the date when the book is due, in the
+form "YYYY-MM-DD".
+
+C<$rejected> is either a string, or -1. If it is defined and is a
+string, then the book may not be issued, and C<$rejected> gives the
+reason for this. If C<$rejected> is -1, then the book may not be
+issued, but no reason is given.
+
+If there is a problem or question (e.g., the book is reserved for
+another patron), then C<$question>, C<$questionnumber>, and
+C<$defaultanswer> will be set. C<$questionnumber> indicates the
+problem. C<$question> is a text string asking how to resolve the
+problem, as a yes-or-no question, and C<$defaultanswer> is either "Y"
+or "N", giving the default answer. The questions, their numbers, and
+default answers are:
+
+=over 4
+
+=item 1: "Issued to <name>. Mark as returned?" (Y)
+
+=item 2: "Waiting for <patron> at <branch>. Allow issue?" (N)
+
+=item 3: "Cancel reserve for <patron>?" (N)
+=item 4: "Book is issued to this borrower. Renew?" (Y)
+
+=item 5: "Reserved for <patron> at <branch> since <date>. Allow issue?" (N)
+
+=item 6: "Set reserve for <patron> to waiting and transfer to <branch>?" (Y)
+
+This is asked if the answer to question 5 was "N".
+
+=item 7: "Cancel reserve for <patron>?" (N)
+
+=back
+
+C<$message>, if defined, is an additional information message, e.g., a
+rental fee notice.
+
+=cut
+#'
+# FIXME - The business with $responses is absurd. For one thing, these
+# questions should have names, not numbers. For another, it'd be
+# better to have the last argument be %extras. Then scripts can call
+# this function with
+# &issuebook(...,
+# -renew => 1,
+# -mark_returned => 0,
+# -cancel_reserve => 1,
+# ...
+# );
+# and the script can use
+# if (defined($extras{"-mark_returned"}) && $extras{"-mark_returned"})
+# Heck, the $date argument should go in there as well.
+#
+# Also, there might be several reasons why a book can't be issued, but
+# this API only supports asking one question at a time. Perhaps it'd
+# be better to return a ref-to-list of problem IDs. Then the calling
+# script can display a list of all of the problems at once.
+#
+# Is it this function's place to decide the default answer to the
+# various questions? Why not document the various problems and allow
+# the caller to decide?
sub issuebook {
- my ($env, $patroninformation, $barcode, $responses) = @_;
- my $dbh=&C4Connect;
- my $iteminformation=getiteminformation($env, 0, $barcode);
- my ($datedue);
- my ($rejected,$question,$defaultanswer,$questionnumber, $noissue);
- SWITCH: {
- if ($patroninformation->{'gonenoaddress'}) {
- $rejected="Patron is gone, with no known address.";
- last SWITCH;
- }
- if ($patroninformation->{'lost'}) {
- $rejected="Patron's card has been reported lost.";
- last SWITCH;
- }
- if ($iteminformation->{'notforloan'} == 1) {
- $rejected="Item not for loan.";
- last SWITCH;
- }
- if ($iteminformation->{'wthdrawn'} == 1) {
- $rejected="Item withdrawn.";
- last SWITCH;
- }
- if ($iteminformation->{'restricted'} == 1) {
- $rejected="Restricted item.";
- last SWITCH;
- }
- if ($iteminformation->{'itemtype'} eq 'REF') {
- $rejected="Reference item: Not for loan.";
- last SWITCH;
- }
- my ($currentborrower) = currentborrower($env, $iteminformation->{'itemnumber'}, $dbh);
- if ($currentborrower eq $patroninformation->{'borrowernumber'}) {
-# Already issued to current borrower
- my ($renewstatus) = renewstatus($env,$dbh,$patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
- if ($renewstatus == 0) {
- $rejected="No more renewals allowed for this item.";
- last SWITCH;
- } else {
- if ($responses->{4} eq '') {
- $questionnumber=4;
- $question="Book is issued to this borrower.\nRenew?";
- $defaultanswer='Y';
- last SWITCH;
- } elsif ($responses->{4} eq 'Y') {
- renewbook($env,$dbh, $patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
- $noissue=1;
- } else {
- $rejected=-1;
- last SWITCH;
+ my ($env, $patroninformation, $barcode, $responses, $date) = @_;
+ my $dbh = C4::Context->dbh;
+ my $iteminformation = getiteminformation($env, 0, $barcode);
+ my ($datedue);
+ my ($rejected,$question,$defaultanswer,$questionnumber, $noissue);
+ my $message;
+
+ # See if there's any reason this book shouldn't be issued to this
+ # patron.
+ SWITCH: { # FIXME - Yes, we know it's a switch. Tell us what it's for.
+ if ($patroninformation->{'gonenoaddress'}) {
+ $rejected="Patron is gone, with no known address.";
+ last SWITCH;
}
- }
- } elsif ($currentborrower ne '') {
- my ($currborrower, $cbflags)=getpatroninformation($env,$currentborrower,0);
- if ($responses->{1} eq '') {
- $questionnumber=1;
- $question="Issued to $currborrower->{'firstname'} $currborrower->{'surname'} ($currborrower->{'cardnumber'}).\nMark as returned?";
- $defaultanswer='Y';
- last SWITCH;
- } elsif ($responses->{1} eq 'Y') {
- returnbook($env,$iteminformation->{'barcode'});
- } else {
- $rejected=-1;
+ if ($patroninformation->{'lost'}) {
+ $rejected="Patron's card has been reported lost.";
+ last SWITCH;
+ }
+ if ($patroninformation->{'debarred'}) {
+ $rejected="Patron is Debarred";
+ last SWITCH;
+ }
+ my $amount = checkaccount($env,$patroninformation->{'borrowernumber'}, $dbh,$date);
+ # FIXME - "5" shouldn't be hardcoded. An Italian library might
+ # be generous enough to lend a book to a patron even if he
+ # does still owe them 5 lire.
+ if ($amount > 5 && $patroninformation->{'categorycode'} ne 'L' &&
+ $patroninformation->{'categorycode'} ne 'W' &&
+ $patroninformation->{'categorycode'} ne 'I' &&
+ $patroninformation->{'categorycode'} ne 'B' &&
+ $patroninformation->{'categorycode'} ne 'P') {
+ # FIXME - What do these category codes mean?
+ $rejected = sprintf "Patron owes \$%.02f.", $amount;
last SWITCH;
- }
- }
+ }
+ # FIXME - This sort of error-checking should be placed closer
+ # to the test; in this case, this error-checking should be
+ # done immediately after the call to &getiteminformation.
+ unless ($iteminformation) {
+ $rejected = "$barcode is not a valid barcode.";
+ last SWITCH;
+ }
+ if ($iteminformation->{'notforloan'} == 1) {
+ $rejected="Item not for loan.";
+ last SWITCH;
+ }
+ if ($iteminformation->{'wthdrawn'} == 1) {
+ $rejected="Item withdrawn.";
+ last SWITCH;
+ }
+ if ($iteminformation->{'restricted'} == 1) {
+ $rejected="Restricted item.";
+ last SWITCH;
+ }
+ if ($iteminformation->{'itemtype'} eq 'REF') {
+ $rejected="Reference item: Not for loan.";
+ last SWITCH;
+ }
+ my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
+ if ($currentborrower eq $patroninformation->{'borrowernumber'}) {
+ # Already issued to current borrower. Ask whether the loan should
+ # be renewed.
+ my ($renewstatus) = renewstatus($env,$dbh,$patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
+ if ($renewstatus == 0) {
+ $rejected="No more renewals allowed for this item.";
+ last SWITCH;
+ } else {
+ if ($responses->{4} eq '') {
+ $questionnumber = 4;
+ $question = "Book is issued to this borrower.\nRenew?";
+ $defaultanswer = 'Y';
+ last SWITCH;
+ } elsif ($responses->{4} eq 'Y') {
+ my ($charge,$itemtype) = calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'});
+ if ($charge > 0) {
+ createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'}, $charge);
+ $iteminformation->{'charge'} = $charge;
+ }
+ &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$patroninformation->{'borrowernumber'});
+ renewbook($env,$dbh, $patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
+ $noissue=1;
+ } else {
+ $rejected=-1;
+ last SWITCH;
+ }
+ }
+ } elsif ($currentborrower ne '') {
+ # This book is currently on loan, but not to the person
+ # who wants to borrow it now.
+ my ($currborrower, $cbflags) = getpatroninformation($env,$currentborrower,0);
+ if ($responses->{1} eq '') {
+ $questionnumber=1;
+ $question = "Issued to $currborrower->{'firstname'} $currborrower->{'surname'} ($currborrower->{'cardnumber'}).\nMark as returned?";
+ $defaultanswer='Y';
+ last SWITCH;
+ } elsif ($responses->{1} eq 'Y') {
+ returnbook($iteminformation->{'barcode'}, $env->{'branchcode'});
+ } else {
+ $rejected=-1;
+ last SWITCH;
+ }
+ }
- my ($resbor, $resrec) = checkreserve($env, $dbh, $iteminformation->{'itemnumber'});
+ # See if the item is on reserve.
+ my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'});
+ if ($restype) {
+ my $resbor = $res->{'borrowernumber'};
+ if ($resbor eq $patroninformation->{'borrowernumber'}) {
+ # The item is on reserve to the current patron
+ FillReserve($res);
+ } elsif ($restype eq "Waiting") {
+ # The item is on reserve and waiting, but has been
+ # reserved by some other patron.
+ my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
+ my $branches = getbranches();
+ my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
+ if ($responses->{2} eq '') {
+ $questionnumber=2;
+ # FIXME - Assumes HTML
+ $question="<font color=red>Waiting</font> for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) at $branchname \nAllow issue?";
+ $defaultanswer='N';
+ last SWITCH;
+ } elsif ($responses->{2} eq 'N') {
+ $rejected=-1;
+ last SWITCH;
+ } else {
+ if ($responses->{3} eq '') {
+ $questionnumber=3;
+ $question="Cancel reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})?";
+ $defaultanswer='N';
+ last SWITCH;
+ } elsif ($responses->{3} eq 'Y') {
+ CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
+ }
- if ($resbor eq $patroninformation->{'borrowernumber'}) {
- my $rquery = "update reserves set found = 'F' where reservedate = '$resrec->{'reservedate'}' and borrowernumber = '$resrec->{'borrowernumber'}' and biblionumber = '$resrec->{'biblionumber'}'";
- my $rsth = $dbh->prepare($rquery);
- $rsth->execute;
- $rsth->finish;
- } elsif ($resbor ne "") {
- my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
- if ($responses->{2} eq '') {
- $questionnumber=2;
- $question="Reserved for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) since $resrec->{'reservedate'}\nAllow issue?";
- $defaultanswer='N';
- last SWITCH;
- } elsif ($responses->{2} eq 'N') {
- #printreserve($env, $resrec, $resborrower, $iteminformation);
- $rejected=-1;
- last SWITCH;
- } else {
- if ($responses->{3} eq '') {
- $questionnumber=3;
- $question="Cancel reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})?";
- $defaultanswer='N';
- last SWITCH;
- } elsif ($responses->{3} eq 'Y') {
- my $rquery = "update reserves set found = 'F' where reservedate = '$resrec->{'reservedate'}' and borrowernumber = '$resrec->{'borrowernumber'}' and biblionumber = '$resrec->{'biblionumber'}'";
- my $rsth = $dbh->prepare($rquery);
- $rsth->execute;
- $rsth->finish;
+}
+ } elsif ($restype eq "Reserved") {
+ # The item is on reserve for someone else.
+ my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
+ my $branches = getbranches();
+ my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
+ if ($responses->{5} eq '') {
+ $questionnumber=5;
+ $question="Reserved for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) since $res->{'reservedate'} \nAllow issue?";
+ $defaultanswer='N';
+ if ($responses->{6} eq 'Y') {
+ my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'});
+ transferbook($tobrcd,$barcode, 1);
+ $message = "Item should now be waiting at $branchname";
+ }
+ last SWITCH;
+ } elsif ($responses->{5} eq 'N') {
+ if ($responses->{6} eq '') {
+ $questionnumber=6;
+ $question="Set reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) to waiting and transfer to $branchname?";
+ $defaultanswer='N';
+ } elsif ($responses->{6} eq 'Y') {
+ my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'});
+ transferbook($tobrcd, $barcode, 1);
+ $message = "Item should now be waiting at $branchname";
+ }
+ $rejected=-1;
+ last SWITCH;
+ } else {
+ if ($responses->{7} eq '') {
+ $questionnumber=7;
+ $question="Cancel reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})?";
+ $defaultanswer='N';
+ last SWITCH;
+ } elsif ($responses->{7} eq 'Y') {
+ CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
+ }
+ }
+ }
}
- }
}
- }
my $dateduef;
unless (($question) || ($rejected) || ($noissue)) {
- my $loanlength=21;
- if ($iteminformation->{'loanlength'}) {
- $loanlength=$iteminformation->{'loanlength'};
- }
- my $ti=time;
- my $datedue=time+($loanlength)*86400;
- my @datearr = localtime($datedue);
- $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
- my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode) values ($patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'}, '$dateduef', '$env->{'branchcode'}')");
+ # There's no reason why the item can't be issued.
+ # FIXME - my $loanlength = $iteminformation->{loanlength} || 21;
+ my $loanlength=21;
+ if ($iteminformation->{'loanlength'}) {
+ $loanlength=$iteminformation->{'loanlength'};
+ }
+ my $ti=time; # FIXME - Never used
+ my $datedue=time+($loanlength)*86400;
+ # FIXME - Could just use POSIX::strftime("%Y-%m-%d", localtime);
+ # That's what it's for. Or, in this case:
+ # $dateduef = $env->{datedue} ||
+ # strftime("%Y-%m-%d", localtime(time +
+ # $loanlength * 86400));
+ my @datearr = localtime($datedue);
+ $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
+ if ($env->{'datedue'}) {
+ $dateduef=$env->{'datedue'};
+ }
+ $dateduef=~ s/2001\-4\-25/2001\-4\-26/;
+ # FIXME - What's this for? Leftover from debugging?
+
+ # Record in the database the fact that the book was issued.
+ # FIXME - Use $dbh->do();
+ my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode) values ($patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'}, '$dateduef', '$env->{'branchcode'}')");
+ $sth->execute;
+ $sth->finish;
+ $iteminformation->{'issues'}++;
+ # FIXME - Use $dbh->do();
+ $sth=$dbh->prepare("update items set issues=$iteminformation->{'issues'},datelastseen=now() where itemnumber=$iteminformation->{'itemnumber'}");
+ $sth->execute;
+ $sth->finish;
+ # If it costs to borrow this book, charge it to the patron's account.
+ my ($charge,$itemtype)=calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'});
+ if ($charge > 0) {
+ createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'}, $charge);
+ $iteminformation->{'charge'}=$charge;
+ }
+ # Record the fact that this book was issued.
+ &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$patroninformation->{'borrowernumber'});
+ }
+
+ if ($iteminformation->{'charge'}) {
+ $message=sprintf "Rental charge of \$%.02f applies.", $iteminformation->{'charge'};
+ }
+ return ($iteminformation, $dateduef, $rejected, $question, $questionnumber, $defaultanswer, $message);
+}
+
+
+
+=item returnbook
+
+ ($doreturn, $messages, $iteminformation, $borrower) =
+ &returnbook($barcode, $branch);
+
+Returns a book.
+
+C<$barcode> is the bar code of the book being returned. C<$branch> is
+the code of the branch where the book is being returned.
+
+C<&returnbook> returns a list of four items:
+
+C<$doreturn> is true iff the return succeeded.
+
+C<$messages> is a reference-to-hash giving the reason for failure:
+
+=over 4
+
+=item C<BadBarcode>
+
+No item with this barcode exists. The value is C<$barcode>.
+
+=item C<NotIssued>
+
+The book is not currently on loan. The value is C<$barcode>.
+
+=item C<IsPermanent>
+
+The book's home branch is a permanent collection. If you have borrowed
+this book, you are not allowed to return it. The value is the code for
+the book's home branch.
+
+=item C<wthdrawn>
+
+This book has been withdrawn/cancelled. The value should be ignored.
+
+=item C<ResFound>
+
+The item was reserved. The value is a reference-to-hash whose keys are
+fields from the reserves table of the Koha database, and
+C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
+either C<Waiting>, C<Reserved>, or 0.
+
+=back
+
+C<$borrower> is a reference-to-hash, giving information about the
+patron who last borrowed the book.
+
+=cut
+#'
+# FIXME - This API is bogus. There's no need to return $borrower and
+# $iteminformation; the caller can ask about those separately, if it
+# cares (it'd be inefficient to make two database calls instead of
+# one, but &getpatroninformation and &getiteminformation can be
+# memoized if this is an issue).
+#
+# The ($doreturn, $messages) tuple is redundant: if the return
+# succeeded, that's all the caller needs to know. So &returnbook can
+# return 1 and 0 on success and failure, and set
+# $C4::Circulation::Circ2::errmsg to indicate the error. Or it can
+# return undef for success, and an error message on error (though this
+# is more C-ish than Perl-ish).
+sub returnbook {
+ my ($barcode, $branch) = @_;
+ my %env;
+ my $messages;
+ my $doreturn = 1;
+ die '$branch not defined' unless defined $branch; # just in case (bug 170)
+ # get information on item
+ my ($iteminformation) = getiteminformation(\%env, 0, $barcode);
+ if (not $iteminformation) {
+ $messages->{'BadBarcode'} = $barcode;
+ $doreturn = 0;
+ }
+ # find the borrower
+ my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
+ if ((not $currentborrower) && $doreturn) {
+ $messages->{'NotIssued'} = $barcode;
+ $doreturn = 0;
+ }
+ # check if the book is in a permanent collection....
+ my $hbr = $iteminformation->{'homebranch'};
+ my $branches = getbranches();
+ if ($branches->{$hbr}->{'PE'}) {
+ $messages->{'IsPermanent'} = $hbr;
+ }
+ # check that the book has been cancelled
+ if ($iteminformation->{'wthdrawn'}) {
+ $messages->{'wthdrawn'} = 1;
+ $doreturn = 0;
+ }
+ # update issues, thereby returning book (should push this out into another subroutine
+ my ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
+ if ($doreturn) {
+ doreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
+ $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
+ }
+ ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
+ # transfer book to the current branch
+ my ($transfered, $mess, $item) = transferbook($branch, $barcode, 1);
+ if ($transfered) {
+ $messages->{'WasTransfered'} = 1; # FIXME is the "= 1" right?
+ }
+ # fix up the accounts.....
+ if ($iteminformation->{'itemlost'}) {
+ # Mark the item as not being lost.
+ updateitemlost($iteminformation->{'itemnumber'});
+ fixaccountforlostandreturned($iteminformation, $borrower);
+ $messages->{'WasLost'} = 1; # FIXME is the "= 1" right?
+ }
+ # fix up the overdues in accounts...
+ fixoverduesonreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
+ # find reserves.....
+ my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
+ if ($resfound) {
+ # my $tobrcd = ReserveWaiting($resrec->{'itemnumber'}, $resrec->{'borrowernumber'});
+ $resrec->{'ResFound'} = $resfound;
+ # $messages->{'ResFound'} = $resrec;
+ }
+ # update stats?
+ # Record the fact that this book was returned.
+ UpdateStats(\%env, $branch ,'return','0','',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'});
+ return ($doreturn, $messages, $iteminformation, $borrower);
+}
+
+# doreturn
+# Takes a borrowernumber and an itemnuber.
+# Updates the 'issues' table to mark the item as returned (assuming
+# that it's currently on loan to the given borrower. Otherwise, the
+# item remains on loan.
+# Updates items.datelastseen for the item.
+# Not exported
+# FIXME - This is only used in &returnbook. Why make it into a
+# separate function? (is this a recognizable step in the return process? - acli)
+sub doreturn {
+ my ($brn, $itm) = @_;
+ my $dbh = C4::Context->dbh;
+ $brn = $dbh->quote($brn);
+ $itm = $dbh->quote($itm);
+ my $query = "update issues set returndate = now() where (borrowernumber = $brn)
+ and (itemnumber = $itm) and (returndate is null)";
+ my $sth = $dbh->prepare($query);
$sth->execute;
$sth->finish;
- $iteminformation->{'issues'}++;
- $sth=$dbh->prepare("update items set issues=$iteminformation->{'issues'} where itemnumber=$iteminformation->{'itemnumber'}");
+ $query="update items set datelastseen=now() where itemnumber=$itm";
+ $sth=$dbh->prepare($query);
$sth->execute;
$sth->finish;
- }
- $dbh->disconnect;
- return ($iteminformation, $dateduef, $rejected, $question, $questionnumber, $defaultanswer);
+ return;
}
+# updateitemlost
+# Marks an item as not being lost.
+# Not exported
+sub updateitemlost{
+ my ($itemno)=@_;
+ my $dbh = C4::Context->dbh;
-sub returnbook {
- my ($env, $barcode) = @_;
- my ($messages, $overduecharge);
- my $dbh=&C4Connect;
- my ($iteminformation) = getiteminformation($env, 0, $barcode);
- my $borrower;
- if ($iteminformation) {
- my $sth=$dbh->prepare("select * from issues where (itemnumber='$iteminformation->{'itemnumber'}') and (returndate is null)");
+ $dbh->do("UPDATE items SET itemlost = 0 WHERE itemnumber = $itemno");
+}
+
+# Not exported
+sub fixaccountforlostandreturned {
+ my ($iteminfo, $borrower) = @_;
+ my %env;
+ my $dbh = C4::Context->dbh;
+ my $itm = $dbh->quote($iteminfo->{'itemnumber'});
+ # check for charge made for lost book
+ my $query = "select * from accountlines where (itemnumber = $itm)
+ and (accounttype='L' or accounttype='Rep') order by date desc";
+ my $sth = $dbh->prepare($query);
$sth->execute;
- my ($currentborrower) = currentborrower($env, $iteminformation->{'itemnumber'}, $dbh);
- updatelastseen($env,$dbh,$iteminformation->{'itemnumber'});
- if ($currentborrower) {
- ($borrower)=getpatroninformation($env,$currentborrower,0);
- my @datearr = localtime(time);
- my $dateret = (1900+$datearr[5])."-".$datearr[4]."-".$datearr[3];
- my $query = "update issues set returndate = now(), branchcode ='$env->{'branchcode'}' where (borrowernumber = $borrower->{'borrowernumber'}) and (itemnumber = $iteminformation->{'itemnumber'}) and (returndate is null)";
- my $sth = $dbh->prepare($query);
- $sth->execute;
- $sth->finish;
-
-
- # check for overdue fine
-
- $overduecharge;
- $sth=$dbh->prepare("select * from accountlines where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber = $iteminformation->{'itemnumber'}) and (accounttype='FU' or accounttype='O')");
- $sth->execute;
- # alter fine to show that the book has been returned
- if (my $data = $sth->fetchrow_hashref) {
- my $usth=$dbh->prepare("update accountlines set accounttype='F' where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber=$iteminformation->{'itemnumber'}) and (acccountno='$data->{'accountno'}')");
- $usth->execute();
- $usth->finish();
- $overduecharge=$data->{'amountoutstanding'};
- }
- $sth->finish;
- # check for charge made for lost book
- $sth=$dbh->prepare("select * from accountlines where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber = $iteminformation->{'itemnumber'}) and (accounttype='L')");
- $sth->execute;
- if (my $data = $sth->fetchrow_hashref) {
- # writeoff this amount
+ if (my $data = $sth->fetchrow_hashref) {
+ # writeoff this amount
my $offset;
my $amount = $data->{'amount'};
my $acctno = $data->{'accountno'};
my $amountleft;
if ($data->{'amountoutstanding'} == $amount) {
- $offset = $data->{'amount'};
- $amountleft = 0;
+ $offset = $data->{'amount'};
+ $amountleft = 0;
} else {
- $offset = $amount - $data->{'amountoutstanding'};
- $amountleft = $data->{'amountoutstanding'} - $amount;
+ $offset = $amount - $data->{'amountoutstanding'};
+ $amountleft = $data->{'amountoutstanding'} - $amount;
}
- my $uquery = "update accountlines
- set accounttype = 'LR',amountoutstanding='0'
- where (borrowernumber = $borrower->{'borrowernumber'})
- and (itemnumber = $iteminformation->{'itemnumber'})
- and (accountno = '$acctno') ";
+ my $uquery = "update accountlines set accounttype = 'LR',amountoutstanding='0'
+ where (borrowernumber = '$data->{'borrowernumber'}')
+ and (itemnumber = $itm) and (accountno = '$acctno') ";
my $usth = $dbh->prepare($uquery);
- $usth->execute();
+ $usth->execute;
$usth->finish;
- my $nextaccntno = C4::Accounts::getnextacctno($env,$borrower->{'borrowernumber'},$dbh);
+ #check if any credit is left if so writeoff other accounts
+ my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
+ if ($amountleft < 0){
+ $amountleft*=-1;
+ }
+ if ($amountleft > 0){
+ my $query = "select * from accountlines where (borrowernumber = '$data->{'borrowernumber'}')
+ and (amountoutstanding >0) order by date";
+ my $msth = $dbh->prepare($query);
+ $msth->execute;
+ # offset transactions
+ my $newamtos;
+ my $accdata;
+ while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
+ if ($accdata->{'amountoutstanding'} < $amountleft) {
+ $newamtos = 0;
+ $amountleft -= $accdata->{'amountoutstanding'};
+ } else {
+ $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
+ $amountleft = 0;
+ }
+ my $thisacct = $accdata->{'accountno'};
+ my $updquery = "update accountlines set amountoutstanding= '$newamtos'
+ where (borrowernumber = '$data->{'borrowernumber'}')
+ and (accountno='$thisacct')";
+ my $usth = $dbh->prepare($updquery);
+ $usth->execute;
+ $usth->finish;
+ $updquery = "insert into accountoffsets
+ (borrowernumber, accountno, offsetaccount, offsetamount)
+ values
+ ('$data->{'borrowernumber'}','$accdata->{'accountno'}','$nextaccntno','$newamtos')";
+ $usth = $dbh->prepare($updquery);
+ $usth->execute;
+ $usth->finish;
+ }
+ $msth->finish;
+ }
+ if ($amountleft > 0){
+ $amountleft*=-1;
+ }
+ my $desc="Book Returned ".$iteminfo->{'barcode'};
$uquery = "insert into accountlines
- (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
- values ($borrower->{'borrowernumber'},$nextaccntno,now(),0-$amount,'Book Returned',
- 'CR',$amountleft)";
+ (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
+ values ('$data->{'borrowernumber'}','$nextaccntno',now(),0-$amount,'$desc',
+ 'CR',$amountleft)";
$usth = $dbh->prepare($uquery);
$usth->execute;
$usth->finish;
$uquery = "insert into accountoffsets
- (borrowernumber, accountno, offsetaccount, offsetamount)
- values ($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset)";
+ (borrowernumber, accountno, offsetaccount, offsetamount)
+ values ($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset)";
+ $usth = $dbh->prepare($uquery);
+ $usth->execute;
+ $usth->finish;
+ $uquery = "update items set paidfor='' where itemnumber=$itm";
$usth = $dbh->prepare($uquery);
$usth->execute;
$usth->finish;
- }
- $sth->finish;
}
- UpdateStats($env,'branch','return','0','',$iteminformation->{'itemnumber'});
- }
- $dbh->disconnect;
- return ($iteminformation, $borrower, $messages, $overduecharge);
+ $sth->finish;
+ return;
}
+# Not exported
+sub fixoverduesonreturn {
+ my ($brn, $itm) = @_;
+ my $dbh = C4::Context->dbh;
+ $itm = $dbh->quote($itm);
+ $brn = $dbh->quote($brn);
+ # check for overdue fine
+ my $query = "select * from accountlines where (borrowernumber=$brn)
+ and (itemnumber = $itm) and (accounttype='FU' or accounttype='O')";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ # alter fine to show that the book has been returned
+ if (my $data = $sth->fetchrow_hashref) {
+ my $query = "update accountlines set accounttype='F' where (borrowernumber = $brn)
+ and (itemnumber = $itm) and (acccountno='$data->{'accountno'}')";
+ my $usth=$dbh->prepare($query);
+ $usth->execute();
+ $usth->finish();
+ }
+ $sth->finish;
+ return;
+}
+# Not exported
+#
+# NOTE!: If you change this function, be sure to update the POD for
+# &getpatroninformation.
+#
+# $flags = &patronflags($env, $patron, $dbh);
+#
+# $flags->{CHARGES}
+# {message} Message showing patron's credit or debt
+# {noissues} Set if patron owes >$5.00
+# {GNA} Set if patron gone w/o address
+# {message} "Borrower has no valid address"
+# {noissues} Set.
+# {LOST} Set if patron's card reported lost
+# {message} Message to this effect
+# {noissues} Set.
+# {DBARRED} Set is patron is debarred
+# {message} Message to this effect
+# {noissues} Set.
+# {NOTES} Set if patron has notes
+# {message} Notes about patron
+# {ODUES} Set if patron has overdue books
+# {message} "Yes"
+# {itemlist} ref-to-array: list of overdue books
+# {itemlisttext} Text list of overdue items
+# {WAITING} Set if there are items available that the
+# patron reserved
+# {message} Message to this effect
+# {itemlist} ref-to-array: list of available items
sub patronflags {
# Original subroutine for Circ2.pm
- my %flags;
- my ($env,$patroninformation,$dbh) = @_;
- my $amount = checkaccount($env,$patroninformation->{'borrowernumber'}, $dbh);
- if ($amount>0) {
+ my %flags;
+ my ($env, $patroninformation, $dbh) = @_;
+ my $amount = checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh);
+ if ($amount > 0) {
+ my %flaginfo;
+ my $noissuescharge = C4::Context->preference("noissuescharge");
+ $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount;
+ if ($amount > $noissuescharge) {
+ $flaginfo{'noissues'} = 1;
+ }
+ $flags{'CHARGES'} = \%flaginfo;
+ } elsif ($amount < 0){
my %flaginfo;
- $flaginfo{'message'}='Patron owes $amount';
- if ($amount>5) {
- $flaginfo{'noissues'}=1;
+ $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
+ $flags{'CHARGES'} = \%flaginfo;
}
- $flags{'CHARGES'}=\%flaginfo;
- }
- if ($patroninformation->{'gonenoaddress'} == 1) {
- my %flaginfo;
- $flaginfo{'message'}='Borrower has no valid address.';
- $flaginfo{'noissues'}=1;
- $flags{'GNA'}=\%flaginfo;
- }
- if ($patroninformation->{'lost'} == 1) {
- my %flaginfo;
- $flaginfo{'message'}='Borrower\'s card reported lost.';
- $flaginfo{'noissues'}=1;
- $flags{'LOST'}=\%flaginfo;
- }
- if ($patroninformation->{'borrowernotes'}) {
- my %flaginfo;
- $flaginfo{'message'}="Note: $patroninformation->{'borrowernotes'}";
- $flags{'NOTES'}=\%flaginfo;
- }
- my ($odues, $itemsoverdue) = checkoverdues($env,$patroninformation->{'borrowernumber'},$dbh);
- if ($odues > 0) {
- my %flaginfo;
- $flaginfo{'message'}="Overdue Items\n";
- foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) {
- $flaginfo{'message'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
+ if ($patroninformation->{'gonenoaddress'} == 1) {
+ my %flaginfo;
+ $flaginfo{'message'} = 'Borrower has no valid address.';
+ $flaginfo{'noissues'} = 1;
+ $flags{'GNA'} = \%flaginfo;
}
- $flags{'ODUES'}=\%flaginfo;
- }
- my ($nowaiting,$itemswaiting) = checkwaiting($env,$dbh,$patroninformation->{'borrowernumber'});
- if ($nowaiting>0) {
- my %flaginfo;
- $flaginfo{'message'}="Reserved items available";
- $flaginfo{'itemlist'}=$itemswaiting;
- $flaginfo{'itemfields'}=['barcode', 'title', 'author', 'dewey', 'subclass', 'holdingbranch'];
- $flags{'WAITING'}=\%flaginfo;
- }
- my $flag;
- my $key;
- return(\%flags);
+ if ($patroninformation->{'lost'} == 1) {
+ my %flaginfo;
+ $flaginfo{'message'} = 'Borrower\'s card reported lost.';
+ $flaginfo{'noissues'} = 1;
+ $flags{'LOST'} = \%flaginfo;
+ }
+ if ($patroninformation->{'debarred'} == 1) {
+ my %flaginfo;
+ $flaginfo{'message'} = 'Borrower is Debarred.';
+ $flaginfo{'noissues'} = 1;
+ $flags{'DBARRED'} = \%flaginfo;
+ }
+ if ($patroninformation->{'borrowernotes'}) {
+ my %flaginfo;
+ $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
+ $flags{'NOTES'} = \%flaginfo;
+ }
+ my ($odues, $itemsoverdue)
+ = checkoverdues($env, $patroninformation->{'borrowernumber'}, $dbh);
+ if ($odues > 0) {
+ my %flaginfo;
+ $flaginfo{'message'} = "Yes";
+ $flaginfo{'itemlist'} = $itemsoverdue;
+ foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) {
+ $flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
+ }
+ $flags{'ODUES'} = \%flaginfo;
+ }
+ my ($nowaiting, $itemswaiting)
+ = CheckWaiting($patroninformation->{'borrowernumber'});
+ if ($nowaiting > 0) {
+ my %flaginfo;
+ $flaginfo{'message'} = "Reserved items available";
+ $flaginfo{'itemlist'} = $itemswaiting;
+ $flags{'WAITING'} = \%flaginfo;
+ }
+ return(\%flags);
}
+# Not exported
sub checkoverdues {
# From Main.pm, modified to return a list of overdueitems, in addition to a count
#checks whether a borrower has overdue items
- my ($env,$bornum,$dbh)=@_;
- my @datearr = localtime;
- my $today = ($datearr[5] + 1900)."-".($datearr[4]+1)."-".$datearr[3];
- my @overdueitems;
- my $count=0;
- 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'";
- my $sth=$dbh->prepare($query);
- $sth->execute;
- while (my $data = $sth->fetchrow_hashref) {
- push (@overdueitems, $data);
- $count++;
- }
- $sth->finish;
- return ($count, \@overdueitems);
+ my ($env, $bornum, $dbh)=@_;
+ my @datearr = localtime;
+ my $today = ($datearr[5] + 1900)."-".($datearr[4]+1)."-".$datearr[3];
+ my @overdueitems;
+ my $count = 0;
+ my $query = "SELECT * FROM issues,biblio,biblioitems,items
+ WHERE items.biblioitemnumber = biblioitems.biblioitemnumber
+ AND items.biblionumber = biblio.biblionumber
+ AND issues.itemnumber = items.itemnumber
+ AND issues.borrowernumber = $bornum
+ AND issues.returndate is NULL
+ AND issues.date_due < '$today'";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ while (my $data = $sth->fetchrow_hashref) {
+ push (@overdueitems, $data);
+ $count++;
+ }
+ $sth->finish;
+ return ($count, \@overdueitems);
}
-sub updatelastseen {
-# Stolen from Returns.pm
- my ($env,$dbh,$itemnumber)= @_;
- my $br = $env->{'branchcode'};
- my $query = "update items
- set datelastseen = now(), holdingbranch = '$br'
- where (itemnumber = '$itemnumber')";
- my $sth = $dbh->prepare($query);
- $sth->execute;
- $sth->finish;
-}
-
+# Not exported
sub currentborrower {
# Original subroutine for Circ2.pm
- my ($env, $itemnumber, $dbh) = @_;
- my $q_itemnumber=$dbh->quote($itemnumber);
- my $sth=$dbh->prepare("select borrowers.borrowernumber from
- issues,borrowers where issues.itemnumber=$q_itemnumber and
- issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
- NULL");
- $sth->execute;
- my ($previousborrower)=$sth->fetchrow;
- return($previousborrower);
+ my ($itemnumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $q_itemnumber = $dbh->quote($itemnumber);
+ my $sth=$dbh->prepare("select borrowers.borrowernumber from
+ issues,borrowers where issues.itemnumber=$q_itemnumber and
+ issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
+ NULL");
+ $sth->execute;
+ my ($borrower) = $sth->fetchrow;
+ return($borrower);
}
+# FIXME - Not exported, but used in 'updateitem.pl' anyway.
sub checkreserve {
# Stolen from Main.pm
- # Check for reserves for biblio
- my ($env,$dbh,$itemnum)=@_;
- my $resbor = "";
- my $query = "select * from reserves,items
- where (items.itemnumber = '$itemnum')
- and (reserves.cancellationdate is NULL)
- and (items.biblionumber = reserves.biblionumber)
- and ((reserves.found = 'W')
- or (reserves.found is null))
- order by priority";
- my $sth = $dbh->prepare($query);
- $sth->execute();
- my $resrec;
- if (my $data=$sth->fetchrow_hashref) {
- $resrec=$data;
- my $const = $data->{'constrainttype'};
- if ($const eq "a") {
- $resbor = $data->{'borrowernumber'};
- } else {
- my $found = 0;
- my $cquery = "select * from reserveconstraints,items
- where (borrowernumber='$data->{'borrowernumber'}')
- and reservedate='$data->{'reservedate'}'
- and reserveconstraints.biblionumber='$data->{'biblionumber'}'
- and (items.itemnumber=$itemnum and
- items.biblioitemnumber = reserveconstraints.biblioitemnumber)";
- my $csth = $dbh->prepare($cquery);
- $csth->execute;
- if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
- if ($const eq 'o') {
- if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
- } else {
- if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
- }
- $csth->finish();
- }
- }
- $sth->finish;
- return ($resbor,$resrec);
+# Check for reserves for biblio
+ my ($env,$dbh,$itemnum)=@_;
+ my $resbor = "";
+ my $query = "select * from reserves,items
+ where (items.itemnumber = '$itemnum')
+ and (reserves.cancellationdate is NULL)
+ and (items.biblionumber = reserves.biblionumber)
+ and ((reserves.found = 'W')
+ or (reserves.found is null))
+ order by priority";
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ my $resrec;
+ my $data=$sth->fetchrow_hashref;
+ while ($data && $resbor eq '') {
+ $resrec=$data;
+ my $const = $data->{'constrainttype'};
+ if ($const eq "a") {
+ $resbor = $data->{'borrowernumber'};
+ } else {
+ my $found = 0;
+ my $cquery = "select * from reserveconstraints,items
+ where (borrowernumber='$data->{'borrowernumber'}')
+ and reservedate='$data->{'reservedate'}'
+ and reserveconstraints.biblionumber='$data->{'biblionumber'}'
+ and (items.itemnumber=$itemnum and
+ items.biblioitemnumber = reserveconstraints.biblioitemnumber)";
+ my $csth = $dbh->prepare($cquery);
+ $csth->execute;
+ if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
+ if ($const eq 'o') {
+ if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
+ } else {
+ if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
+ }
+ $csth->finish();
+ }
+ $data=$sth->fetchrow_hashref;
+ }
+ $sth->finish;
+ return ($resbor,$resrec);
}
+=item currentissues
+
+ $issues = ¤tissues($env, $borrower);
+
+Returns a list of books currently on loan to a patron.
+
+If C<$env-E<gt>{todaysissues}> is set and true, C<¤tissues> only
+returns information about books issued today. If
+C<$env-E<gt>{nottodaysissues}> is set and true, C<¤tissues> only
+returns information about books issued before today. If both are
+specified, C<$env-E<gt>{todaysissues}> is ignored. If neither is
+specified, C<¤tissues> returns all of the patron's issues.
+
+C<$borrower->{borrowernumber}> is the borrower number of the patron
+whose issues we want to list.
+
+C<¤tissues> returns a PHP-style array: C<$issues> is a
+reference-to-hash whose keys are integers in the range 1...I<n>, where
+I<n> is the number of items on issue (either today or before today).
+C<$issues-E<gt>{I<n>}> is a reference-to-hash whose keys are all of
+the fields of the biblio, biblioitems, items, and issues fields of the
+Koha database for that particular item.
+
+=cut
+#'
sub currentissues {
# New subroutine for Circ2.pm
- my ($env, $borrower) = @_;
- my $dbh=&C4Connect;
- my %currentissues;
- my $counter=1;
- my $borrowernumber=$borrower->{'borrowernumber'};
- my $crit='';
- if ($env->{'todaysissues'}) {
- my @datearr = localtime(time());
- my $today = (1900+$datearr[5]).sprintf "0%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
- $crit=" and issues.timestamp like '$today%' ";
- }
- if ($env->{'nottodaysissues'}) {
- my @datearr = localtime(time());
- my $today = (1900+$datearr[5]).sprintf "0%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
- $crit=" and !(issues.timestamp like '$today%') ";
- }
- my $sth=$dbh->prepare("select * from issues,items,biblioitems,biblio where borrowernumber=$borrowernumber and issues.itemnumber=items.itemnumber and items.biblionumber=biblio.biblionumber and items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is null $crit order by date_due");
- $sth->execute;
- while (my $data = $sth->fetchrow_hashref) {
- $data->{'dewey'}=~s/0*$//;
- my $datedue=$data->{'date_due'};
- my $itemnumber=$data->{'itemnumber'};
- $currentissues{$counter}=$data;
- $counter++;
- }
- $sth->finish;
- $dbh->disconnect;
- return(\%currentissues);
+ my ($env, $borrower) = @_;
+ my $dbh = C4::Context->dbh;
+ my %currentissues;
+ my $counter=1;
+ my $borrowernumber = $borrower->{'borrowernumber'};
+ my $crit='';
+
+ # Figure out whether to get the books issued today, or earlier.
+ # FIXME - $env->{todaysissues} and $env->{nottodaysissues} can
+ # both be specified, but are mutually-exclusive. This is bogus.
+ # Make this a flag. Or better yet, return everything in (reverse)
+ # chronological order and let the caller figure out which books
+ # were issued today.
+ if ($env->{'todaysissues'}) {
+ # FIXME - Could use
+ # $today = POSIX::strftime("%Y%m%d", localtime);
+ # FIXME - Since $today will be used in either case, move it
+ # out of the two if-blocks.
+ my @datearr = localtime(time());
+ my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
+ # FIXME - MySQL knows about dates. Just use
+ # and issues.timestamp = curdate();
+ $crit=" and issues.timestamp like '$today%' ";
+ }
+ if ($env->{'nottodaysissues'}) {
+ # FIXME - Could use
+ # $today = POSIX::strftime("%Y%m%d", localtime);
+ # FIXME - Since $today will be used in either case, move it
+ # out of the two if-blocks.
+ my @datearr = localtime(time());
+ my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
+ # FIXME - MySQL knows about dates. Just use
+ # and issues.timestamp < curdate();
+ $crit=" and !(issues.timestamp like '$today%') ";
+ }
+
+ # FIXME - Does the caller really need every single field from all
+ # four tables?
+ my $select="select * from issues,items,biblioitems,biblio where
+ borrowernumber='$borrowernumber' and issues.itemnumber=items.itemnumber and
+ items.biblionumber=biblio.biblionumber and
+ items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is null
+ $crit order by issues.date_due";
+ # warn $select;
+ my $sth=$dbh->prepare($select);
+ $sth->execute;
+ while (my $data = $sth->fetchrow_hashref) {
+ # FIXME - The Dewey code is a string, not a number.
+ $data->{'dewey'}=~s/0*$//;
+ ($data->{'dewey'} == 0) && ($data->{'dewey'}='');
+ # FIXME - Could use
+ # $todaysdate = POSIX::strftime("%Y%m%d", localtime)
+ # or better yet, just reuse $today which was calculated above.
+ # This function isn't going to run until midnight, is it?
+ # Alternately, use
+ # $todaysdate = POSIX::strftime("%Y-%m-%d", localtime)
+ # if ($data->{'date_due'} lt $todaysdate)
+ # ...
+ # Either way, the date should be be formatted outside of the
+ # loop.
+ my @datearr = localtime(time());
+ my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]);
+ my $datedue=$data->{'date_due'};
+ $datedue=~s/-//g;
+ if ($datedue < $todaysdate) {
+ $data->{'overdue'}=1;
+ }
+ my $itemnumber=$data->{'itemnumber'};
+ # FIXME - Consecutive integers as hash keys? You have GOT to
+ # be kidding me! Use an array, fercrissakes!
+ $currentissues{$counter}=$data;
+ $counter++;
+ }
+ $sth->finish;
+ return(\%currentissues);
}
+=item getissues
+
+ $issues = &getissues($borrowernumber);
+
+Returns the set of books currently on loan to a patron.
+
+C<$borrowernumber> is the patron's borrower number.
+
+C<&getissues> returns a PHP-style array: C<$issues> is a
+reference-to-hash whose keys are integers in the range 0..I<n>-1,
+where I<n> is the number of books the patron currently has on loan.
+
+The values of C<$issues> are references-to-hash whose keys are
+selected fields from the issues, items, biblio, and biblioitems tables
+of the Koha database.
+
+=cut
+#'
+sub getissues {
+# New subroutine for Circ2.pm
+ my ($borrower) = @_;
+ my $dbh = C4::Context->dbh;
+ my $borrowernumber = $borrower->{'borrowernumber'};
+ my %currentissues;
+ my $select = "SELECT issues.timestamp AS timestamp,
+ issues.date_due AS date_due,
+ items.biblionumber AS biblionumber,
+ items.itemnumber AS itemnumber,
+ items.barcode AS barcode,
+ biblio.title AS title,
+ biblio.author AS author,
+ biblioitems.dewey AS dewey,
+ itemtypes.description AS itemtype,
+ biblioitems.subclass AS subclass
+ FROM issues,items,biblioitems,biblio, itemtypes
+ WHERE issues.borrowernumber = ?
+ AND issues.itemnumber = items.itemnumber
+ AND items.biblionumber = biblio.biblionumber
+ AND items.biblioitemnumber = biblioitems.biblioitemnumber
+ AND itemtypes.itemtype = biblioitems.itemtype
+ AND issues.returndate IS NULL
+ ORDER BY issues.date_due";
+ # print $select;
+ my $sth=$dbh->prepare($select);
+ $sth->execute($borrowernumber);
+ my $counter = 0;
+ while (my $data = $sth->fetchrow_hashref) {
+ $data->{'dewey'} =~ s/0*$//;
+ ($data->{'dewey'} == 0) && ($data->{'dewey'} = '');
+ # FIXME - The Dewey code is a string, not a number.
+ # FIXME - Use POSIX::strftime to get a text version of today's
+ # date. That's what it's for.
+ # FIXME - Move the date calculation outside of the loop.
+ my @datearr = localtime(time());
+ my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]);
+
+ # FIXME - Instead of converting the due date to YYYYMMDD, just
+ # use
+ # $todaysdate = POSIX::strftime("%Y-%m-%d", localtime);
+ # ...
+ # if ($date->{date_due} lt $todaysdate)
+ my $datedue = $data->{'date_due'};
+ $datedue =~ s/-//g;
+ if ($datedue < $todaysdate) {
+ $data->{'overdue'} = 1;
+ }
+ $currentissues{$counter} = $data;
+ $counter++;
+ # FIXME - This is ludicrous. If you want to return an
+ # array of values, just use an array. That's what
+ # they're there for.
+ }
+ $sth->finish;
+ return(\%currentissues);
+}
+
+# Not exported
sub checkwaiting {
#Stolen from Main.pm
- # check for reserves waiting
- my ($env,$dbh,$bornum)=@_;
- my @itemswaiting;
- my $query = "select * from reserves
- where (borrowernumber = '$bornum')
- and (reserves.found='W') and cancellationdate is NULL";
- my $sth = $dbh->prepare($query);
- $sth->execute();
- my $cnt=0;
- if (my $data=$sth->fetchrow_hashref) {
- @itemswaiting[$cnt] =$data;
- $cnt ++
- }
- $sth->finish;
- return ($cnt,\@itemswaiting);
+# check for reserves waiting
+ my ($env,$dbh,$bornum)=@_;
+ my @itemswaiting;
+ my $query = "select * from reserves where (borrowernumber = '$bornum') and (reserves.found='W') and cancellationdate is NULL";
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ my $cnt=0;
+ if (my $data=$sth->fetchrow_hashref) {
+ $itemswaiting[$cnt] =$data;
+ $cnt ++
+ }
+ $sth->finish;
+ return ($cnt,\@itemswaiting);
}
-
+# Not exported
+# FIXME - This is nearly-identical to &C4::Accounts::checkaccount
sub checkaccount {
# Stolen from Accounts.pm
#take borrower number
#check accounts and list amounts owing
- my ($env,$bornumber,$dbh)=@_;
- my $sth=$dbh->prepare("Select sum(amountoutstanding) from accountlines where
- borrowernumber=$bornumber and amountoutstanding<>0");
- $sth->execute;
- my $total=0;
- while (my $data=$sth->fetchrow_hashref){
- $total=$total+$data->{'sum(amountoutstanding)'};
- }
- $sth->finish;
- # output(1,2,"borrower owes $total");
- #if ($total > 0){
- # # output(1,2,"borrower owes $total");
- # if ($total > 5){
- # reconcileaccount($env,$dbh,$bornumber,$total);
- # }
- #}
- # pause();
- return($total);
-}
+ my ($env,$bornumber,$dbh,$date)=@_;
+ my $select="SELECT SUM(amountoutstanding) AS total
+ FROM accountlines
+ WHERE borrowernumber = $bornumber
+ AND amountoutstanding<>0";
+ if ($date ne ''){
+ $select.=" AND date < '$date'";
+ }
+ # print $select;
+ my $sth=$dbh->prepare($select);
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ my $total = $data->{'total'};
+ $sth->finish;
+ # output(1,2,"borrower owes $total");
+ #if ($total > 0){
+ # # output(1,2,"borrower owes $total");
+ # if ($total > 5){
+ # reconcileaccount($env,$dbh,$bornumber,$total);
+ # }
+ #}
+ # pause();
+ return($total);
+}
+# FIXME - This is identical to &C4::Circulation::Renewals::renewstatus.
+# Pick one and stick with it.
sub renewstatus {
# Stolen from Renewals.pm
# check renewal status
my ($env,$dbh,$bornum,$itemno)=@_;
my $renews = 1;
my $renewokay = 0;
- my $q1 = "select * from issues
+ my $q1 = "select * from issues
where (borrowernumber = '$bornum')
- and (itemnumber = '$itemno')
+ and (itemnumber = '$itemno')
and returndate is null";
my $sth1 = $dbh->prepare($q1);
$sth1->execute;
if (my $data1 = $sth1->fetchrow_hashref) {
my $q2 = "select renewalsallowed from items,biblioitems,itemtypes
where (items.itemnumber = '$itemno')
- and (items.biblioitemnumber = biblioitems.biblioitemnumber)
+ and (items.biblioitemnumber = biblioitems.biblioitemnumber)
and (biblioitems.itemtype = itemtypes.itemtype)";
my $sth2 = $dbh->prepare($q2);
- $sth2->execute;
+ $sth2->execute;
if (my $data2=$sth2->fetchrow_hashref) {
$renews = $data2->{'renewalsallowed'};
}
$renewokay = 1;
}
$sth2->finish;
- }
+ }
$sth1->finish;
- return($renewokay);
+ return($renewokay);
}
sub renewbook {
# Stolen from Renewals.pm
# mark book as renewed
my ($env,$dbh,$bornum,$itemno,$datedue)=@_;
- if ($datedue eq "" ) {
+ $datedue=$env->{'datedue'};
+ if ($datedue eq "" ) {
my $loanlength=21;
my $query= "Select * from biblioitems,items,itemtypes
where (items.itemnumber = '$itemno')
$datedue = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
}
my @date = split("-",$datedue);
- my $odatedue = (@date[2]+0)."-".(@date[1]+0)."-".@date[0];
+ my $odatedue = ($date[2]+0)."-".($date[1]+0)."-".$date[0];
my $issquery = "select * from issues where borrowernumber='$bornum' and
itemnumber='$itemno' and returndate is null";
my $sth=$dbh->prepare($issquery);
my $issuedata=$sth->fetchrow_hashref;
$sth->finish;
my $renews = $issuedata->{'renewals'} +1;
- my $updquery = "update issues
+ my $updquery = "update issues
set date_due = '$datedue', renewals = '$renews'
where borrowernumber='$bornum' and
itemnumber='$itemno' and returndate is null";
- my $sth=$dbh->prepare($updquery);
-
+ $sth=$dbh->prepare($updquery);
+
$sth->execute;
$sth->finish;
return($odatedue);
}
+# FIXME - This is almost, but not quite, identical to
+# &C4::Circulation::Issues::calc_charges and
+# &C4::Circulation::Renewals2::calc_charges.
+# Pick one and stick with it.
+sub calc_charges {
+# Stolen from Issues.pm
+# calculate charges due
+ my ($env, $dbh, $itemno, $bornum)=@_;
+# if (!$dbh){
+# $dbh=C4Connect();
+# }
+ my $charge=0;
+# open (FILE,">>/tmp/charges");
+ my $item_type;
+ my $q1 = "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes
+ where (items.itemnumber ='$itemno')
+ and (biblioitems.biblioitemnumber = items.biblioitemnumber)
+ and (biblioitems.itemtype = itemtypes.itemtype)";
+ my $sth1= $dbh->prepare($q1);
+# print FILE "$q1\n";
+ $sth1->execute;
+ if (my $data1=$sth1->fetchrow_hashref) {
+ $item_type = $data1->{'itemtype'};
+ $charge = $data1->{'rentalcharge'};
+# print FILE "charge is $charge\n";
+ my $q2 = "select rentaldiscount from borrowers,categoryitem
+ where (borrowers.borrowernumber = '$bornum')
+ and (borrowers.categorycode = categoryitem.categorycode)
+ and (categoryitem.itemtype = '$item_type')";
+ my $sth2=$dbh->prepare($q2);
+# warn $q2;
+ $sth2->execute;
+ if (my $data2=$sth2->fetchrow_hashref) {
+ my $discount = $data2->{'rentaldiscount'};
+# print FILE "discount is $discount";
+ if ($discount eq 'NULL') {
+ $discount=0;
+ }
+ $charge = ($charge *(100 - $discount)) / 100;
+ }
+ $sth2->finish;
+ }
+ $sth1->finish;
+# close FILE;
+ return ($charge, $item_type);
+}
+
+# FIXME - A virtually identical function appears in
+# C4::Circulation::Issues. Pick one and stick with it.
+sub createcharge {
+#Stolen from Issues.pm
+ my ($env,$dbh,$itemno,$bornum,$charge) = @_;
+ my $nextaccntno = getnextacctno($env,$bornum,$dbh);
+ my $sth = $dbh->prepare(<<EOT);
+ INSERT INTO accountlines
+ (borrowernumber, itemnumber, accountno,
+ date, amount, description, accounttype,
+ amountoutstanding)
+ VALUES (?, ?, ?,
+ now(), ?, 'Rental', 'Rent',
+ ?)
+EOT
+ $sth->execute($bornum, $itemno, $nextaccntno, $charge, $charge);
+ $sth->finish;
+}
+
+
+sub getnextacctno {
+# Stolen from Accounts.pm
+ my ($env,$bornumber,$dbh)=@_;
+ my $nextaccntno = 1;
+ my $query = "select * from accountlines where (borrowernumber = '$bornumber') order by accountno desc";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ if (my $accdata=$sth->fetchrow_hashref){
+ $nextaccntno = $accdata->{'accountno'} + 1;
+ }
+ $sth->finish;
+ return($nextaccntno);
+}
+
+=item find_reserves
+
+ ($status, $record) = &find_reserves($itemnumber);
+
+Looks up an item in the reserves.
+
+C<$itemnumber> is the itemnumber to look up.
+
+C<$status> is true iff the search was successful.
+
+C<$record> is a reference-to-hash describing the reserve. Its keys are
+the fields from the reserves table of the Koha database.
+
+=cut
+#'
+# FIXME - This API is bogus: just return the record, or undef if none
+# was found.
+# FIXME - There's also a &C4::Circulation::Returns::find_reserves, but
+# that one looks rather different.
+sub find_reserves {
+# Stolen from Returns.pm
+ my ($itemno) = @_;
+ my %env;
+ my $dbh = C4::Context->dbh;
+ my ($itemdata) = getiteminformation(\%env, $itemno,0);
+ my $bibno = $dbh->quote($itemdata->{'biblionumber'});
+ my $bibitm = $dbh->quote($itemdata->{'biblioitemnumber'});
+ my $query = "select * from reserves where ((found = 'W') or (found is null))
+ and biblionumber = $bibno and cancellationdate is NULL
+ order by priority, reservedate ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ my $resfound = 0;
+ my $resrec;
+ my $lastrec;
+# print $query;
+
+ # FIXME - I'm not really sure what's going on here, but since we
+ # only want one result, wouldn't it be possible (and far more
+ # efficient) to do something clever in SQL that only returns one
+ # set of values?
+ while (($resrec = $sth->fetchrow_hashref) && (not $resfound)) {
+ # FIXME - Unlike Pascal, Perl allows you to exit loops
+ # early. Take out the "&& (not $resfound)" and just
+ # use "last" at the appropriate point in the loop.
+ # (Oh, and just in passing: if you'd used "!" instead
+ # of "not", you wouldn't have needed the parentheses.)
+ $lastrec = $resrec;
+ my $brn = $dbh->quote($resrec->{'borrowernumber'});
+ my $rdate = $dbh->quote($resrec->{'reservedate'});
+ my $bibno = $dbh->quote($resrec->{'biblionumber'});
+ if ($resrec->{'found'} eq "W") {
+ if ($resrec->{'itemnumber'} eq $itemno) {
+ $resfound = 1;
+ }
+ } else {
+ # FIXME - Use 'elsif' to avoid unnecessary indentation.
+ if ($resrec->{'constrainttype'} eq "a") {
+ $resfound = 1;
+ } else {
+ my $conquery = "select * from reserveconstraints where borrowernumber = $brn
+ and reservedate = $rdate and biblionumber = $bibno and biblioitemnumber = $bibitm";
+ my $consth = $dbh->prepare($conquery);
+ $consth->execute;
+ if (my $conrec = $consth->fetchrow_hashref) {
+ if ($resrec->{'constrainttype'} eq "o") {
+ $resfound = 1;
+ }
+ }
+ $consth->finish;
+ }
+ }
+ if ($resfound) {
+ my $updquery = "update reserves set found = 'W', itemnumber = '$itemno'
+ where borrowernumber = $brn and reservedate = $rdate and biblionumber = $bibno";
+ my $updsth = $dbh->prepare($updquery);
+ $updsth->execute;
+ $updsth->finish;
+ # FIXME - "last;" here to break out of the loop early.
+ }
+ }
+ $sth->finish;
+ return ($resfound,$lastrec);
+}
+
+1;
+__END__
+
+=back
+
+=head1 AUTHOR
+
+Koha Developement team <info@koha.org>
-END { } # module clean-up code here (global destructor)
+=cut
projects / koha_fer / blobdiff