#package to deal with Returns
#written 3/11/99 by olwen@katipo.co.nz
+# $Id$
+
+# 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::Context;
#use C4::Accounts;
#use C4::InterfaceCDK;
#use C4::Circulation::Main;
-#use C4::Format;
#use C4::Circulation::Renewals;
#use C4::Scan;
use C4::Stats;
+use C4::Reserves2;
#use C4::Search;
#use C4::Print;
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(&getbranches &getprinters &getpatroninformation ¤tissues &getiteminformation &findborrower &issuebook &returnbook);
+@EXPORT = qw(&getbranches &getprinters &getpatroninformation ¤tissues &getissues &getiteminformation &findborrower &issuebook &returnbook &find_reserves &transferbook &decode
+calc_charges);
%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);
+@EXPORT_OK = qw($Var1 %Hashit); # FIXME - Unused
# non-exported package globals go here
#use vars qw(@more $stuff);
-
-# initalize package globals, first exported ones
+# initalize package globals, first exported ones
+# FIXME - Unused
my $Var1 = '';
my %Hashit = ();
-
+
# then the others (which are still accessible as $Some::Module::stuff)
+# FIXME - Unused
my $stuff = '';
my @more = ();
-
+
# all file-scoped lexicals must be created before
# the functions below that use them.
-
+
# file-private lexicals go here
+# FIXME - Unused
my $priv_var = '';
my %secret_hash = ();
-
+
# here's a file-private function as a closure,
# callable as &$priv_func; it cannot be prototyped.
+# FIXME - Unused
my $priv_func = sub {
# stuff goes here.
};
-
+
# make all your functions, whether exported or not;
+=item getbranches
+
+ $branches = &getbranches();
+ @branch_codes = keys %$branches;
+ %main_branch_info = %{$branches->{"MAIN"}};
+
+Returns information about existing library branches.
+
+C<$branches> is a reference-to-hash. Its keys are the branch codes for
+all of the existing library branches, and its values are
+references-to-hash describing that particular branch.
+In each branch description (C<%main_branch_info>, above), there is a
+key for each field in the branches table of the Koha database. In
+addition, there is a key for each branch category code to which the
+branch belongs (the category codes are taken from the branchrelations
+table).
+
+=cut
+#'
+# FIXME - This function doesn't feel as if it belongs here. It should
+# go in some generic or administrative module, not in circulation.
sub getbranches {
- my ($env) = @_;
+# returns a reference to a hash of references to branches...
my %branches;
- my $dbh=&C4Connect;
+ my $dbh = C4::Context->dbh;
my $sth=$dbh->prepare("select * from branches");
$sth->execute;
while (my $branch=$sth->fetchrow_hashref) {
-# (next) if ($branch->{'branchcode'} eq 'TR');
+ my $tmp = $branch->{'branchcode'}; my $brc = $dbh->quote($tmp);
+ # FIXME - my $brc = $dbh->quote($branch->{"branchcode"});
+ my $query = "select categorycode from branchrelations where branchcode = $brc";
+ my $nsth = $dbh->prepare($query);
+ $nsth->execute;
+ while (my ($cat) = $nsth->fetchrow_array) {
+ # FIXME - This seems wrong. It ought to be
+ # $branch->{categorycodes}{$cat} = 1;
+ # otherwise, there's a namespace collision if there's a
+ # category with the same name as a field in the 'branches'
+ # table (i.e., don't create a category called "issuing").
+ # In addition, the current structure doesn't really allow
+ # you to list the categories that a branch belongs to:
+ # you'd have to list keys %$branch, and remove those keys
+ # that aren't fields in the "branches" table.
+ $branch->{$cat} = 1;
+ }
+ $nsth->finish;
$branches{$branch->{'branchcode'}}=$branch;
}
- $dbh->disconnect;
return (\%branches);
}
+=item getprinters
+
+ $printers = &getprinters($env);
+ @queues = keys %$printers;
+
+Returns information about existing printer queues.
+C<$env> is ignored.
+
+C<$printers> is a reference-to-hash whose keys are the print queues
+defined in the printers table of the Koha database. The values are
+references-to-hash, whose keys are the fields in the printers table.
+
+=cut
+#'
+# FIXME - Perhaps this really belongs in C4::Print?
sub getprinters {
my ($env) = @_;
my %printers;
- my $dbh=&C4Connect;
+ my $dbh = C4::Context->dbh;
my $sth=$dbh->prepare("select * from printers");
$sth->execute;
while (my $printer=$sth->fetchrow_hashref) {
$printers{$printer->{'printqueue'}}=$printer;
}
- $dbh->disconnect;
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
+# returns
my ($env, $borrowernumber,$cardnumber) = @_;
- my $dbh=&C4Connect;
+ my $dbh = C4::Context->dbh;
+ my $query;
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");
+ $query = "select * from borrowers where borrowernumber=$borrowernumber";
} elsif ($cardnumber) {
- $sth=$dbh->prepare("select * from borrowers where cardnumber=$cardnumber");
+ $query = "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();
+ $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 $flags=patronflags($env, $borrower, $dbh);
+ 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);
}
+=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 $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");
$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.
+ # 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;
}
- $dbh->disconnect;
return($iteminformation);
}
+=item findborrower
+
+ $borrowers = &findborrower($env, $key);
+ print $borrowers->[0]{surname};
+
+Looks up patrons and returns information about them.
+
+C<$env> is ignored.
+
+C<$key> is either a card number or a string. C<&findborrower> tries to
+look it up as a card number first. If that fails, C<&findborrower>
+looks up all patrons whose surname begins with C<$key>.
+
+C<$borrowers> is a reference-to-array. Each element is a
+reference-to-hash whose keys are the fields of the borrowers table in
+the Koha database.
+
+=cut
+#'
+# If you really want to throw a monkey wrench into the works, change
+# your last name to "V10000008" :-)
+
+# FIXME - This is different from &C4::Borrower::findborrower, but I
+# think that one's obsolete.
sub findborrower {
# returns an array of borrower hash references, given a cardnumber or a partial
-# surname
+# surname
my ($env, $key) = @_;
- my $dbh=&C4Connect;
+ my $dbh = C4::Context->dbh;
my @borrowers;
my $q_key=$dbh->quote($key);
my $sth=$dbh->prepare("select * from borrowers where cardnumber=$q_key");
}
}
$sth->finish;
- $dbh->disconnect;
return(\@borrowers);
}
+=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;
+ }
+# 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(<<EOT);
+ INSERT INTO branchtransfers
+ (itemnumber, frombranch, datearrived, tobranch)
+ VALUES ($itm, $fbr, now(), $tbr)
+EOT
+
+ #update holdingbranch in items .....
+ $dbh->do(<<EOT);
+ UPDATE items
+ SET datelastseen = now(),
+ holdingbranch = $tbr
+ WHERE items.itemnumber = $itm
+EOT
+ 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, $date) = @_;
- my $dbh=&C4Connect;
- my $iteminformation=getiteminformation($env, 0, $barcode);
+ my $dbh = C4::Context->dbh;
+ my $iteminformation = getiteminformation($env, 0, $barcode);
my ($datedue);
my ($rejected,$question,$defaultanswer,$questionnumber, $noissue);
- SWITCH: {
+ 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;
last SWITCH;
}
my $amount = checkaccount($env,$patroninformation->{'borrowernumber'}, $dbh,$date);
- if ($amount>5) {
- $rejected=sprintf "Patron owes \$%.02f.", $amount;
+ # 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.";
+ $rejected = "$barcode is not a valid barcode.";
last SWITCH;
}
if ($iteminformation->{'notforloan'} == 1) {
- $rejected="Item not for loan.";
+ $rejected="Reference item: not for loan.";
last SWITCH;
}
if ($iteminformation->{'wthdrawn'} == 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);
+
+ # See who, if anyone, currently has this book.
+ my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
if ($currentborrower eq $patroninformation->{'borrowernumber'}) {
-# Already issued to current borrower
+# 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';
+ $questionnumber = 4;
+ $question = "Book is issued to this borrower.\nRenew?";
+ $defaultanswer = 'Y';
last SWITCH;
} elsif ($responses->{4} eq 'Y') {
- my $charge=calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'});
+ my $charge = calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'});
if ($charge > 0) {
createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $patroninformation->{'borrowernumber'}, $charge);
- $iteminformation->{'charge'}=$charge;
+ $iteminformation->{'charge'} = $charge;
}
&UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'});
renewbook($env,$dbh, $patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
}
}
} elsif ($currentborrower ne '') {
- my ($currborrower, $cbflags)=getpatroninformation($env,$currentborrower,0);
+ # 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?";
+ $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'});
+ returnbook($iteminformation->{'barcode'}, $env->{'branch'});
} else {
$rejected=-1;
last SWITCH;
}
}
- my ($resbor, $resrec) = checkreserve($env, $dbh, $iteminformation->{'itemnumber'});
-
- 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'})?";
+ # 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->{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 ($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'});
+ }
+ }
+ } 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';
+ 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)) {
+ # 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;
+ 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'}++;
- $sth=$dbh->prepare("update items set issues=$iteminformation->{'issues'} where itemnumber=$iteminformation->{'itemnumber'}");
+ # 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=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'});
}
- my $message='';
if ($iteminformation->{'charge'}) {
$message=sprintf "Rental charge of \$%.02f applies.", $iteminformation->{'charge'};
}
- $dbh->disconnect;
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 ($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)");
- $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
- my $offset;
- my $amount = $data->{'amount'};
- my $acctno = $data->{'accountno'};
- my $amountleft;
- if ($data->{'amountoutstanding'} == $amount) {
- $offset = $data->{'amount'};
+ my ($barcode, $branch) = @_;
+ my %env;
+ my $messages;
+ my $doreturn = 1;
+# 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'}; # FIXME - This does nothing
+ }
+ ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
+# transfer book to the current branch
+ my ($transfered, $mess, $item) = transferbook($branch, $barcode, 1);
+ if ($transfered) { # FIXME - perl -wc complains about this line.
+ $messages->{'WasTransfered'}; # FIXME - This does nothing
+ }
+# fix up the accounts.....
+ if ($iteminformation->{'itemlost'}) {
+ # Mark the item as not being lost.
+ updateitemlost($iteminformation->{'itemnumber'});
+ fixaccountforlostandreturned($iteminformation, $borrower);
+ $messages->{'WasLost'}; # FIXME - This does nothing
+ }
+# fix up the overdues in accounts...
+ fixoverduesonreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
+# find reserves.....
+ my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
+ if ($resfound) {
+ $resrec->{'ResFound'} = $resfound;
+ $messages->{'ResFound'} = $resrec;
+ }
+# update stats?
+# Record the fact that this book was returned.
+ UpdateStats(\%env, $branch ,'return','0','',$iteminformation->{'itemnumber'});
+ 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?
+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;
+ $query="update items set datelastseen=now() where itemnumber=$itm";
+ $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ return;
+}
+
+# updateitemlost
+# Marks an item as not being lost.
+# Not exported
+sub updateitemlost{
+ my ($itemno)=@_;
+ my $dbh = C4::Context->dbh;
+
+ $dbh->do(<<EOT);
+ UPDATE items
+ SET itemlost = 0
+ WHERE itemnumber = $itemno
+EOT
+}
+
+# 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;
+ 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;
+ } else {
+ $offset = $amount - $data->{'amountoutstanding'};
+ $amountleft = $data->{'amountoutstanding'} - $amount;
+ }
+ 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->finish;
+#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 = $amountleft - $accdata->{'amountoutstanding'};
+ } else {
+ $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
$amountleft = 0;
- } else {
- $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 $usth = $dbh->prepare($uquery);
- $usth->execute();
- $usth->finish;
- my $nextaccntno = C4::Accounts::getnextacctno($env,$borrower->{'borrowernumber'},$dbh);
- $uquery = "insert into accountlines
- (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
- values ($borrower->{'borrowernumber'},$nextaccntno,now(),0-$amount,'Book Returned',
- 'CR',$amountleft)";
- $usth = $dbh->prepare($uquery);
+ 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;
- $uquery = "insert into accountoffsets
- (borrowernumber, accountno, offsetaccount, offsetamount)
- values ($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset)";
- $usth = $dbh->prepare($uquery);
+ $updquery = "insert into accountoffsets
+ (borrowernumber, accountno, offsetaccount, offsetamount)
+ values
+ ('$data->{'borrowernumber'}','$accdata->{'accountno'}','$nextaccntno','$newamtos')";
+ $usth = $dbh->prepare($updquery);
$usth->execute;
$usth->finish;
}
- $sth->finish;
+ $msth->finish;
}
- my ($resfound,$resrec) = find_reserves($env, $dbh, $iteminformation->{'itemnumber'});
- if ($resfound eq 'y') {
- my ($borrower) = getpatroninformation($env,$resrec->{'borrowernumber'},0);
- #printreserve($env,$resrec,$resborrower,$itemrec);
- my ($branches) = getbranches();
- my $branchname=$branches->{$resrec->{'branchcode'}}->{'branchname'};
- push (@$messages, "<b><font color=red>RESERVED</font></b> for collection by $borrower->{'firstname'} $borrower->{'surname'} ($borrower->{'cardnumber'}) at $branchname");
+ if ($amountleft > 0){
+ $amountleft*=-1;
}
- UpdateStats($env,$env->{'branchcode'},'return','0','',$iteminformation->{'itemnumber'});
+ my $desc="Book Returned ".$iteminfo->{'barcode'};
+ $uquery = "insert into accountlines
+ (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)";
+ $usth = $dbh->prepare($uquery);
+ $usth->execute;
+ $usth->finish;
+ $uquery = "update items set paidfor='' where itemnumber=$itm";
+ $usth = $dbh->prepare($uquery);
+ $usth->execute;
+ $usth->finish;
}
- $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 ($env, $patroninformation, $dbh) = @_;
+ my $amount = checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh);
+ if ($amount > 0) {
my %flaginfo;
- $flaginfo{'message'}=sprintf "Patron owes \$%.02f", $amount;
- if ($amount>5) {
- $flaginfo{'noissues'}=1;
+ $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount;
+ if ($amount > 5) {
+ $flaginfo{'noissues'} = 1;
}
- $flags{'CHARGES'}=\%flaginfo;
+ $flags{'CHARGES'} = \%flaginfo;
+ } elsif ($amount < 0){
+ my %flaginfo;
+ $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
+ $flags{'CHARGES'} = \%flaginfo;
}
if ($patroninformation->{'gonenoaddress'} == 1) {
my %flaginfo;
- $flaginfo{'message'}='Borrower has no valid address.';
- $flaginfo{'noissues'}=1;
- $flags{'GNA'}=\%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;
+ $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;
+ $flaginfo{'message'} = 'Borrower is Debarred.';
+ $flaginfo{'noissues'} = 1;
+ $flags{'DBARRED'} = \%flaginfo;
}
if ($patroninformation->{'borrowernotes'}) {
my %flaginfo;
- $flaginfo{'message'}="$patroninformation->{'borrowernotes'}";
- $flags{'NOTES'}=\%flaginfo;
+ $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
+ $flags{'NOTES'} = \%flaginfo;
}
- my ($odues, $itemsoverdue) = checkoverdues($env,$patroninformation->{'borrowernumber'},$dbh);
+ my ($odues, $itemsoverdue)
+ = checkoverdues($env, $patroninformation->{'borrowernumber'}, $dbh);
if ($odues > 0) {
my %flaginfo;
- $flaginfo{'message'}="Yes";
- $flaginfo{'itemlist'}=$itemsoverdue;
+ $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;
+ $flags{'ODUES'} = \%flaginfo;
}
- my ($nowaiting,$itemswaiting) = checkwaiting($env,$dbh,$patroninformation->{'borrowernumber'});
- if ($nowaiting>0) {
+ my ($nowaiting, $itemswaiting)
+ = CheckWaiting($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;
+ $flaginfo{'message'} = "Reserved items available";
+ $flaginfo{'itemlist'} = $itemswaiting;
+ $flags{'WAITING'} = \%flaginfo;
}
- my $flag;
- my $key;
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 ($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);
+ 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);
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 ($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 ($previousborrower)=$sth->fetchrow;
- return($previousborrower);
+ 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
+ # Check for reserves for biblio
my ($env,$dbh,$itemnum)=@_;
my $resbor = "";
- my $query = "select * from reserves,items
+ 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))
+ or (reserves.found is null))
order by priority";
my $sth = $dbh->prepare($query);
$sth->execute();
$resbor = $data->{'borrowernumber'};
} else {
my $found = 0;
- my $cquery = "select * from reserveconstraints,items
- where (borrowernumber='$data->{'borrowernumber'}')
+ my $cquery = "select * from reserveconstraints,items
+ where (borrowernumber='$data->{'borrowernumber'}')
and reservedate='$data->{'reservedate'}'
and reserveconstraints.biblionumber='$data->{'biblionumber'}'
- and (items.itemnumber=$itemnum and
+ and (items.itemnumber=$itemnum and
items.biblioitemnumber = reserveconstraints.biblioitemnumber)";
my $csth = $dbh->prepare($cquery);
$csth->execute;
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 $dbh = C4::Context->dbh;
my %currentissues;
my $counter=1;
- my $borrowernumber=$borrower->{'borrowernumber'};
+ 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 "0%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
+ 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 "0%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
+ 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.timestamp desc";
-# print $select;
+ 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;
- $dbh->disconnect;
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 $brn =$dbh->quote($borrowernumber);
+ my %currentissues;
+ my $select = "select issues.timestamp, issues.date_due, items.biblionumber,
+ items.barcode, biblio.title, biblio.author, biblioitems.dewey,
+ biblioitems.subclass
+ from issues,items,biblioitems,biblio
+ where issues.borrowernumber = $brn
+ and issues.itemnumber = items.itemnumber
+ and items.biblionumber = biblio.biblionumber
+ and items.biblioitemnumber = biblioitems.biblioitemnumber
+ and issues.returndate is null
+ order by issues.date_due";
+# warn $select;
+ my $sth=$dbh->prepare($select);
+ $sth->execute;
+ 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
$sth->execute();
my $cnt=0;
if (my $data=$sth->fetchrow_hashref) {
- @itemswaiting[$cnt] =$data;
+ $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
#}
# pause();
return($total);
-}
+}
sub renewstatus {
# Stolen from Renewals.pm
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 {
# mark book as renewed
my ($env,$dbh,$bornum,$itemno,$datedue)=@_;
$datedue=$env->{'datedue'};
- if ($datedue eq "" ) {
+ 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 $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'};
- my $q2 = "select rentaldiscount from borrowers,categoryitem
- where (borrowers.borrowernumber = '$bornum')
+# 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'};
- }
+ $sth2->finish;
+ }
$sth1->finish;
+# close FILE;
return ($charge);
}
#Stolen from Issues.pm
my ($env,$dbh,$itemno,$bornum,$charge) = @_;
my $nextaccntno = getnextacctno($env,$bornum,$dbh);
- my $query = "insert into accountlines (borrowernumber,itemnumber,accountno,date,amount, description,accounttype,amountoutstanding) values ($bornum,$itemno,$nextaccntno,now(),$charge,'Rental','Rent',$charge)";
- my $sth = $dbh->prepare($query);
- $sth->execute;
+ 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;
}
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.
sub find_reserves {
# Stolen from Returns.pm
- my ($env,$dbh,$itemno) = @_;
- my ($itemdata) = getiteminformation($env,$itemno,0);
- my $query = "select * from reserves where
- ((reserves.found = 'W')
- or (reserves.found is null))
- and biblionumber = $itemdata->{'biblionumber'} and cancellationdate is NULL
- order by priority,reservedate ";
- my $sth = $dbh->prepare($query);
- $sth->execute;
- my $resfound = "n";
- my $resrec;
- my $lastrec;
- while (($resrec=$sth->fetchrow_hashref) && ($resfound eq "n")) {
- $lastrec=$resrec;
- if ($resrec->{'found'} eq "W") {
- if ($resrec->{'itemnumber'} eq $itemno) {
- $resfound = "y";
- }
- }
- if ($resrec->{'constrainttype'} eq "a") {
- $resfound = "y";
- } else {
- my $conquery = "select * from reserveconstraints where borrowernumber
-= $resrec->{'borrowernumber'} and reservedate = '$resrec->{'reservedate'}' and biblionumber = $resrec->{'biblionumber'} and biblioitemnumber = $itemdata->{'biblioitemnumber'}";
- my $consth = $dbh->prepare($conquery);
- $consth->execute;
- if (my $conrec=$consth->fetchrow_hashref) {
- if ($resrec->{'constrainttype'} eq "o") {
- $resfound = "y";
- }
- } else {
- if ($resrec->{'constrainttype'} eq "e") {
- $resfound = "y";
+ 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.
}
- }
- $consth->finish;
- }
- if ($resfound eq "y") {
- my $updquery = "update reserves
- set found = 'W',itemnumber='$itemno'
- where borrowernumber = $resrec->{'borrowernumber'}
- and reservedate = '$resrec->{'reservedate'}'
- and biblionumber = $resrec->{'biblionumber'}";
- my $updsth = $dbh->prepare($updquery);
- $updsth->execute;
- $updsth->finish;
- my $itbr = $resrec->{'branchcode'};
- if ($resrec->{'branchcode'} ne $env->{'branchcode'}) {
- my $updquery = "update items
- set holdingbranch = 'TR'
- where itemnumber = $itemno";
- my $updsth = $dbh->prepare($updquery);
- $updsth->execute;
- $updsth->finish;
- }
}
- }
- $sth->finish;
- return ($resfound,$lastrec);
+ $sth->finish;
+ return ($resfound,$lastrec);
}
END { } # module clean-up code here (global destructor)
+
+1;
+__END__
+
+=back
+
+=head1 AUTHOR
+
+Koha Developement team <info@koha.org>
+
+=cut