X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FCirculation%2FCirc2.pm;h=3afcd1cec095ad970bf7d988c8b5f27cb6401af5;hb=e0e3784e8b468b826c3ca63366cfeb3c2ba32696;hp=6ae4a95f940ce1bde5c6abc7342e15ba5370ac5e;hpb=f7953fecf3ba87a9b84bb8bb6fffb53aec86e5c0;p=koha_fer

diff --git a/C4/Circulation/Circ2.pm b/C4/Circulation/Circ2.pm
index 6ae4a95f94..3afcd1cec0 100755
--- a/C4/Circulation/Circ2.pm
+++ b/C4/Circulation/Circ2.pm
@@ -1,661 +1,1490 @@
+# -*- 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(&getbranches &getprinters &getpatroninformation &currentissues &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) {
-#	(next) if ($branch->{'branchcode'} eq 'TR');
-	$branches{$branch->{'branchcode'}}=$branch;
-    }
-    return (\%branches);
-}
+@EXPORT = qw(&getpatroninformation
+	&currentissues &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->{'printqueue'}}=$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;
-    if ($iteminformation) {
-	$sth=$dbh->prepare("select date_due from issues where itemnumber=$iteminformation->{'itemnumber'} and isnull(returndate)");
+	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 ($date_due) = $sth->fetchrow;
-	$iteminformation->{'date_due'}=$date_due;
+	my $iteminformation=$sth->fetchrow_hashref;
 	$sth->finish;
-	#$iteminformation->{'dewey'}=~s/0*$//;
-	($iteminformation->{'dewey'} == 0) && ($iteminformation->{'dewey'}='');
-    }
-    $dbh->disconnect;
-    return($iteminformation);
+	# 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;
-	}
-	my $amount = checkaccount($env,$patroninformation->{'borrowernumber'}, $dbh);
-	if ($amount>5) {
-	    $rejected=sprintf "Patron owes \$%.02f.", $amount;
-	    last SWITCH;
-	}
-	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($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') {
-		    my $charge=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'});
-		    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];
-	if ($env->{'datedue'}) {
-	    $dateduef=$env->{'datedue'};
-	}
-	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;
-	my $charge=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'},'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);
+	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;
-	}
-	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, "Reserved for collection by $borrower->{'firstname'} $borrower->{'surname'} ($borrower->{'cardnumber'}) at $branchname");
 	}
-	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'}=sprintf "Patron owes \$%.02f", $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'}="$patroninformation->{'borrowernotes'}";
-	$flags{'NOTES'}=\%flaginfo;
-    }
-    my ($odues, $itemsoverdue) = checkoverdues($env,$patroninformation->{'borrowernumber'},$dbh);
-    if ($odues > 0) {
-	my %flaginfo;
-	$flaginfo{'message'}="Patron has overdue items";
-	$flaginfo{'itemlist'}=$itemsoverdue;
-	foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) {
-	    $flaginfo{'itemlisttext'}.="$_->{'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 = &currentissues($env, $borrower);
+
+Returns a list of books currently on loan to a patron.
+
+If C<$env-E<gt>{todaysissues}> is set and true, C<&currentissues> only
+returns information about books issued today. If
+C<$env-E<gt>{nottodaysissues}> is set and true, C<&currentissues> only
+returns information about books issued before today. If both are
+specified, C<$env-E<gt>{todaysissues}> is ignored. If neither is
+specified, C<&currentissues> returns all of the patron's issues.
+
+C<$borrower->{borrowernumber}> is the borrower number of the patron
+whose issues we want to list.
+
+C<&currentissues> 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*$//;
-	($data->{'dewey'} == 0) && ($data->{'dewey'}='');
-	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'};
     }
@@ -663,9 +1492,9 @@ sub renewstatus {
       $renewokay = 1;
     }
     $sth2->finish;
-  }   
+  }
   $sth1->finish;
-  return($renewokay);    
+  return($renewokay);
 }
 
 sub renewbook {
@@ -673,7 +1502,7 @@ 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')
@@ -691,7 +1520,7 @@ sub renewbook {
     $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);
@@ -699,52 +1528,80 @@ sub renewbook {
   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;
-    return ($charge);
+#    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 $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;
 }
 
@@ -763,64 +1620,98 @@ sub getnextacctno {
     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 ($env,$dbh,$itemno) = @_;
-  my ($itemdata) = getiteminformation($env,$itemno,0);
-  my $query = "select * from reserves where 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";
-      }
-    } elsif ($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";
-	}
-      }
-      $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;
-      }	
+    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);
+    $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