- my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
- 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;
+ 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, $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;