From 3344f22bb7357fd3c680c0d4b1c35b492407ae09 Mon Sep 17 00:00:00 2001 From: arensb Date: Wed, 9 Oct 2002 14:17:49 +0000 Subject: [PATCH] Added POD. Added a bunch of FIXMEs. Trimmed trailing whitespace. --- C4/Circulation/Circ2.pm | 843 ++++++++++++++++++++++++++++++++++++---- 1 file changed, 762 insertions(+), 81 deletions(-) diff --git a/C4/Circulation/Circ2.pm b/C4/Circulation/Circ2.pm index 6fbb33aef0..06bb19ffc5 100755 --- a/C4/Circulation/Circ2.pm +++ b/C4/Circulation/Circ2.pm @@ -3,6 +3,7 @@ package C4::Circulation::Circ2; #package to deal with Returns #written 3/11/99 by olwen@katipo.co.nz +# $Id$ # Copyright 2000-2002 Katipo Communications # @@ -37,49 +38,92 @@ use C4::Reserves2; #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 &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 { # returns a reference to a hash of references to branches... my %branches; @@ -88,10 +132,20 @@ sub getbranches { $sth->execute; while (my $branch=$sth->fetchrow_hashref) { 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; @@ -100,7 +154,22 @@ sub getbranches { 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; @@ -113,10 +182,88 @@ sub getprinters { 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{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 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 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{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{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{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 = C4::Context->dbh; my $query; @@ -139,6 +286,16 @@ sub getpatroninformation { 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+-'; @@ -167,9 +324,39 @@ sub decode { 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 + +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 + +The length of time for which the item can be borrowed, in days. + +=item C + +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) = @_; @@ -182,20 +369,32 @@ sub getiteminformation { $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; @@ -206,9 +405,33 @@ sub getiteminformation { 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 = C4::Context->dbh; my @borrowers; @@ -232,6 +455,85 @@ sub findborrower { } +=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 + +There is no item in the catalog with the given barcode. The value is +C<$barcode>. + +=item C + +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 + +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 + +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 + +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. It also has the key C, whose value is +either C or C. + +=item C + +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) = @_; @@ -252,7 +554,8 @@ sub transferbook { if ($branches->{$hbr}->{'PE'}) { $messages->{'IsPermanent'} = $hbr; } -# cant transfer book if is already there.... +# 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; @@ -264,6 +567,8 @@ sub transferbook { $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; @@ -274,10 +579,13 @@ sub transferbook { 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; @@ -287,7 +595,7 @@ sub dotransfer { #new entry in branchtransfers.... $dbh->do(<{usercode}> will be used in the usercode field of the +statistics table of the Koha database when this transaction is +recorded. + +C<$env-E{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{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 . Mark as returned?" (Y) + +=item 2: "Waiting for at . Allow issue?" (N) + +=item 3: "Cancel reserve for ?" (N) + +=item 4: "Book is issued to this borrower. Renew?" (Y) + +=item 5: "Reserved for at since . Allow issue?" (N) + +=item 6: "Set reserve for to waiting and transfer to ?" (Y) + +This is asked if the answer to question 5 was "N". + +=item 7: "Cancel reserve for ?" (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; @@ -309,7 +719,10 @@ sub issuebook { my ($datedue); my ($rejected,$question,$defaultanswer,$questionnumber, $noissue); my $message; - SWITCH: { + + # 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; @@ -323,14 +736,21 @@ sub issuebook { 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 '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; @@ -347,9 +767,12 @@ sub issuebook { $rejected="Restricted item."; last SWITCH; } + + # 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."; @@ -375,6 +798,8 @@ sub issuebook { } } } 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; @@ -389,17 +814,22 @@ sub issuebook { } } + # 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="Waiting for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) at $branchname \nAllow issue?"; $defaultanswer='N'; last SWITCH; @@ -417,6 +847,7 @@ sub issuebook { } } } 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'}; @@ -452,30 +883,44 @@ sub issuebook { } 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'}++; + # 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'}); } if ($iteminformation->{'charge'}) { @@ -486,6 +931,68 @@ sub issuebook { +=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 + +No item with this barcode exists. The value is C<$barcode>. + +=item C + +The book is not currently on loan. The value is C<$barcode>. + +=item C + +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 + +This book has been withdrawn/cancelled. The value should be ignored. + +=item C + +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. It also has the key C, whose value is +either C, C, 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; @@ -516,21 +1023,22 @@ sub returnbook { } # update issues, thereby returning book (should push this out into another subroutine my ($borrower) = getpatroninformation(\%env, $currentborrower, 0); - if ($doreturn) { # FIXME - perl -wc complains about this line. + if ($doreturn) { doreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}); - $messages->{'WasReturned'}; + $messages->{'WasReturned'}; # FIXME - This does nothing } ($borrower) = getpatroninformation(\%env, $currentborrower, 0); -# transfer book +# 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'}; + $messages->{'WasTransfered'}; # FIXME - This does nothing } # fix up the accounts..... - if ($iteminformation->{'itemlost'}) { # FIXME - perl -wc complains about this line. + if ($iteminformation->{'itemlost'}) { + # Mark the item as not being lost. updateitemlost($iteminformation->{'itemnumber'}); fixaccountforlostandreturned($iteminformation, $borrower); - $messages->{'WasLost'}; + $messages->{'WasLost'}; # FIXME - This does nothing } # fix up the overdues in accounts... fixoverduesonreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}); @@ -541,17 +1049,26 @@ sub returnbook { $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) + my $query = "update issues set returndate = now() where (borrowernumber = $brn) and (itemnumber = $itm) and (returndate is null)"; my $sth = $dbh->prepare($query); $sth->execute; @@ -563,6 +1080,9 @@ sub doreturn { return; } +# updateitemlost +# Marks an item as not being lost. +# Not exported sub updateitemlost{ my ($itemno)=@_; my $dbh = C4::Context->dbh; @@ -574,18 +1094,19 @@ sub updateitemlost{ 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) + 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 +# writeoff this amount my $offset; my $amount = $data->{'amount'}; my $acctno = $data->{'accountno'}; @@ -609,7 +1130,7 @@ sub fixaccountforlostandreturned { $amountleft*=-1; } if ($amountleft > 0){ - my $query = "select * from accountlines where (borrowernumber = '$data->{'borrowernumber'}') + my $query = "select * from accountlines where (borrowernumber = '$data->{'borrowernumber'}') and (amountoutstanding >0) order by date"; my $msth = $dbh->prepare($query); $msth->execute; @@ -626,12 +1147,12 @@ sub fixaccountforlostandreturned { } my $thisacct = $accdata->{'accountno'}; my $updquery = "update accountlines set amountoutstanding= '$newamtos' - where (borrowernumber = '$data->{'borrowernumber'}') + where (borrowernumber = '$data->{'borrowernumber'}') and (accountno='$thisacct')"; my $usth = $dbh->prepare($updquery); $usth->execute; $usth->finish; - $updquery = "insert into accountoffsets + $updquery = "insert into accountoffsets (borrowernumber, accountno, offsetaccount, offsetamount) values ('$data->{'borrowernumber'}','$accdata->{'accountno'}','$nextaccntno','$newamtos')"; @@ -650,7 +1171,7 @@ sub fixaccountforlostandreturned { values ('$data->{'borrowernumber'}','$nextaccntno',now(),0-$amount,'$desc', 'CR',$amountleft)"; $usth = $dbh->prepare($uquery); - $usth->execute; + $usth->execute; $usth->finish; $uquery = "insert into accountoffsets (borrowernumber, accountno, offsetaccount, offsetamount) @@ -667,19 +1188,20 @@ sub fixaccountforlostandreturned { 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) + 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) + my $query = "update accountlines set accounttype='F' where (borrowernumber = $brn) and (itemnumber = $itm) and (acccountno='$data->{'accountno'}')"; my $usth=$dbh->prepare($query); $usth->execute(); @@ -689,39 +1211,67 @@ sub fixoverduesonreturn { 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) { + if ($amount > 0) { my %flaginfo; - $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount; + $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount; if ($amount > 5) { $flaginfo{'noissues'} = 1; } $flags{'CHARGES'} = \%flaginfo; } elsif ($amount < 0){ my %flaginfo; - $amount = $amount*-1; - $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", $amount; + $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{'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{'message'} = 'Borrower\'s card reported lost.'; $flaginfo{'noissues'} = 1; $flags{'LOST'} = \%flaginfo; } if ($patroninformation->{'debarred'} == 1) { my %flaginfo; - $flaginfo{'message'} = 'Borrower is Debarred.'; + $flaginfo{'message'} = 'Borrower is Debarred.'; $flaginfo{'noissues'} = 1; $flags{'DBARRED'} = \%flaginfo; } @@ -730,7 +1280,7 @@ sub patronflags { $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}"; $flags{'NOTES'} = \%flaginfo; } - my ($odues, $itemsoverdue) + my ($odues, $itemsoverdue) = checkoverdues($env, $patroninformation->{'borrowernumber'}, $dbh); if ($odues > 0) { my %flaginfo; @@ -741,7 +1291,7 @@ sub patronflags { } $flags{'ODUES'} = \%flaginfo; } - my ($nowaiting, $itemswaiting) + my ($nowaiting, $itemswaiting) = CheckWaiting($patroninformation->{'borrowernumber'}); if ($nowaiting > 0) { my %flaginfo; @@ -753,6 +1303,7 @@ sub patronflags { } +# 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 @@ -761,12 +1312,12 @@ sub checkoverdues { 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 + 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; @@ -778,6 +1329,7 @@ sub checkoverdues { return ($count, \@overdueitems); } +# Not exported sub currentborrower { # Original subroutine for Circ2.pm my ($itemnumber) = @_; @@ -792,17 +1344,18 @@ sub currentborrower { 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(); @@ -815,11 +1368,11 @@ sub checkreserve { $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; @@ -837,6 +1390,31 @@ sub checkreserve { return ($resbor,$resrec); } +=item currentissues + + $issues = ¤tissues($env, $borrower); + +Returns a list of books currently on loan to a patron. + +If C<$env-E{todaysissues}> is set and true, C<¤tissues> only +returns information about books issued today. If +C<$env-E{nottodaysissues}> is set and true, C<¤tissues> only +returns information about books issued before today. If both are +specified, C<$env-E{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, where +I is the number of items on issue (either today or before today). +C<$issues-E{I}> 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) = @_; @@ -845,16 +1423,38 @@ sub 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 @@ -864,8 +1464,19 @@ sub currentissues { 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]); @@ -875,6 +1486,8 @@ sub currentissues { $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++; } @@ -882,6 +1495,24 @@ sub currentissues { 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-1, +where I 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) = @_; @@ -890,13 +1521,13 @@ sub getissues { 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 + 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 + 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; @@ -906,8 +1537,18 @@ sub getissues { 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) { @@ -915,11 +1556,15 @@ sub getissues { } $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 @@ -939,6 +1584,7 @@ sub checkwaiting { return ($cnt,\@itemswaiting); } +# Not exported # FIXME - This is nearly-identical to &C4::Accounts::checkaccount sub checkaccount { # Stolen from Accounts.pm @@ -967,7 +1613,7 @@ sub checkaccount { #} # pause(); return($total); -} +} sub renewstatus { # Stolen from Renewals.pm @@ -975,19 +1621,19 @@ sub renewstatus { 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'}; } @@ -995,9 +1641,9 @@ sub renewstatus { $renewokay = 1; } $sth2->finish; - } + } $sth1->finish; - return($renewokay); + return($renewokay); } sub renewbook { @@ -1005,7 +1651,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') @@ -1031,12 +1677,12 @@ 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"; $sth=$dbh->prepare($updquery); - + $sth->execute; $sth->finish; return($odatedue); @@ -1056,9 +1702,9 @@ sub calc_charges { my $charge=0; # open (FILE,">>/tmp/charges"); my $item_type; - my $q1 = "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes + my $q1 = "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes where (items.itemnumber ='$itemno') - and (biblioitems.biblioitemnumber = items.biblioitemnumber) + and (biblioitems.biblioitemnumber = items.biblioitemnumber) and (biblioitems.itemtype = itemtypes.itemtype)"; my $sth1= $dbh->prepare($q1); # print FILE "$q1\n"; @@ -1067,8 +1713,8 @@ sub calc_charges { $item_type = $data1->{'itemtype'}; $charge = $data1->{'rentalcharge'}; # print FILE "charge is $charge\n"; - my $q2 = "select rentaldiscount from borrowers,categoryitem - where (borrowers.borrowernumber = '$bornum') + 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); @@ -1083,7 +1729,7 @@ sub calc_charges { $charge = ($charge *(100 - $discount)) / 100; } $sth2->finish; - } + } $sth1->finish; # close FILE; return ($charge); @@ -1114,6 +1760,23 @@ 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. sub find_reserves { # Stolen from Returns.pm my ($itemno) = @_; @@ -1122,7 +1785,7 @@ sub find_reserves { 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)) + 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); @@ -1131,7 +1794,17 @@ sub find_reserves { 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'}); @@ -1141,10 +1814,11 @@ sub find_reserves { $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 + my $conquery = "select * from reserveconstraints where borrowernumber = $brn and reservedate = $rdate and biblionumber = $bibno and biblioitemnumber = $bibitm"; my $consth = $dbh->prepare($conquery); $consth->execute; @@ -1162,6 +1836,7 @@ sub find_reserves { my $updsth = $dbh->prepare($updquery); $updsth->execute; $updsth->finish; + # FIXME - "last;" here to break out of the loop early. } } $sth->finish; @@ -1169,3 +1844,9 @@ sub find_reserves { } END { } # module clean-up code here (global destructor) + +1; +__END__ +=back + +=cut -- 2.39.5