From 21a379acdaea9819890acc8170932cdafc5a9f7a Mon Sep 17 00:00:00 2001 From: tipaul Date: Mon, 3 May 2004 09:02:12 +0000 Subject: [PATCH] CIRCULATION : the big rewrite... This 1st commit reorders deeply the circulation module. The goal is to : * have something 100% templated/translatable. * have something easy to read & modify, to say to customers/users : you can define your circulation rules as you want if you accept to look in C4/Circ/Circ2.pm The circulation now works : 1=> ask for the borrower barcode (as previously) 2=> ask for the item barcode. 3=> check "canbookbeissued". This new sub returns 2 arrays : - IMPOSSIBLE : if something is here, then the issue is not possible and is not done. - TOBECONFIRMED : if something is here, then the issue can be donc if the user confirms it. 4=> if TOBECONFIRMED is set : ask for confirmation, loop. if neither are set or confirmation flag is set (2nd pass of the loop), then issue. The IMPOSSIBLE & TOBECONFIRMED hashs contains : * the reason of the line. always in capitals, with words separated by _ : BARCODE_UNKNOWN, DEBTS ... as key of the hash * more information, as value of the hash ( TOBECONFIRMED{ALREADY_ISSUED} = "previous_borrower_name", for example) This commit : * compiles * works on certain situations, not on other * does NOT issue (the line is # ) * does not check issuing rules depending of # of books allowed / already issued The next step is : - check issuing rule. - extend issuing rule to have a 3D array : for each branch / itemtype / borrowertype = issuing number and issuing length. --- C4/Circulation/Circ2.pm | 282 ++++++++++--- circ/circulation.pl | 383 ++++++------------ circ/returns.pl | 2 +- .../default/en/circ/circulation.tmpl | 361 +++++++++-------- 4 files changed, 563 insertions(+), 465 deletions(-) diff --git a/C4/Circulation/Circ2.pm b/C4/Circulation/Circ2.pm index 89a774def8..0340957ec1 100755 --- a/C4/Circulation/Circ2.pm +++ b/C4/Circulation/Circ2.pm @@ -34,6 +34,7 @@ use C4::Context; use C4::Stats; use C4::Reserves2; use C4::Koha; +use C4::Accounts; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); @@ -63,19 +64,19 @@ Also deals with stocktaking. @ISA = qw(Exporter); @EXPORT = qw(&getpatroninformation ¤tissues &getissues &getiteminformation - &issuebook &returnbook &find_reserves &transferbook &decode - &calc_charges &listitemsforinventory &itemseen); + &canbookbeissued &issuebook &returnbook &find_reserves &transferbook &decode + &calc_charges &listitemsforinventory &itemseen &fixdate); # &getbranches &getprinters &getbranch &getprinter => moved to C4::Koha.pm =item itemseen + &itemseen($itemnum) Mark item as seen. Is called when an item is issued, returned or manually marked during inventory/stocktaking C<$itemnum> is the item number -=back - =cut + sub itemseen { my ($itemnum) = @_; my $dbh = C4::Context->dbh; @@ -99,10 +100,10 @@ sub listitemsforinventory { } return \@results; } + =item getpatroninformation - ($borrower, $flags) = &getpatroninformation($env, $borrowernumber, - $cardnumber); + ($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 @@ -113,17 +114,12 @@ 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: +C<$borrower-E{flags}> is a hash giving more detailed information +about the patron. Its keys act as flags : - if (exists($flags->{LOST})) - { - # Patron's card was reported lost - print $flags->{LOST}{message}, "\n"; - } + if $borrower->{flags}->{LOST} { + # Patron's card was reported lost + } 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 @@ -178,6 +174,7 @@ fields from the reserves table of the Koha database. =back =cut + #' sub getpatroninformation { # returns @@ -201,7 +198,7 @@ sub getpatroninformation { $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) { @@ -211,7 +208,8 @@ sub getpatroninformation { } $sth->finish; $borrower->{'flags'}=$flags; - return ($borrower, $flags, $accessflagshash); + $borrower->{'authflags'} = $accessflagshash; + return ($borrower); #, $flags, $accessflagshash); } =item decode @@ -222,6 +220,7 @@ 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 { @@ -284,6 +283,7 @@ 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 @@ -399,6 +399,7 @@ 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 @@ -481,6 +482,189 @@ sub dotransfer { return; } +# check if a book can be issued. +# returns an array with errors if any + +sub canbookbeissued { + my ($env,$borrower,$barcode,$year,$month,$day) = @_; + warn "CHECKING CANBEISSUED for $borrower->{'borrowernumber'}, $barcode"; + my %needsconfirmation; # filled with problems that needs confirmations + my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE +# my ($borrower, $flags) = &getpatroninformation($env, $borrowernumber, 0); + my $iteminformation = getiteminformation($env, 0, $barcode); + my $dbh = C4::Context->dbh; +# +# DUE DATE is OK ? +# + my ($duedate, $invalidduedate) = fixdate($year, $month, $day); + $issuingimpossible{INVALID_DATE} = 1 if ($invalidduedate); + +# +# BORROWER STATUS +# + if ($borrower->{flags}->{'gonenoaddress'}) { + $issuingimpossible{GNA} = 1; + } + if ($borrower->{flags}->{'lost'}) { + $issuingimpossible{CARD_LOST} = 1; + } + if ($borrower->{flags}->{'debarred'}) { + $issuingimpossible{DEBARRED} = 1; + } +# +# BORROWER STATUS +# + +# DEBTS + my $amount = checkaccount($env,$borrower->{'borrowernumber'}, $dbh,$duedate); + if ($amount >0) { + $needsconfirmation{DEBT} = $amount; + } + +# +# ITEM CHECKING +# + unless ($iteminformation) { + $issuingimpossible{UNKNOWN_BARCODE} = 1; + } + if ($iteminformation->{'notforloan'} == 1) { + $issuingimpossible{NOT_FOR_LOAN} = 1; + } + if ($iteminformation->{'itemtype'} eq 'REF') { + $issuingimpossible{NOT_FOR_LOAN} = 1; + } + if ($iteminformation->{'wthdrawn'} == 1) { + $issuingimpossible{WTHDRAWN} = 1; + } + if ($iteminformation->{'restricted'} == 1) { + $issuingimpossible{RESTRICTED} = 1; + } + +# +# CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER +# + my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'}); +warn "current borrower for $iteminformation->{'itemnumber'} : $currentborrower"; + if ($currentborrower eq $borrower->{'borrowernumber'}) { +# Already issued to current borrower. Ask whether the loan should +# be renewed. + my ($renewstatus) = renewstatus($env,$dbh,$borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}); + if ($renewstatus == 0) { # no more renewals allowed + $issuingimpossible{NO_MORE_RENEWALS} = 1; + } else { + $needsconfirmation{RENEW_ISSUE} = 1; + } + } elsif ($currentborrower) { +# issued to someone else + $needsconfirmation{ISSUED_TO_ANOTHER} = 1; + } +# See if the item is on reserve. + my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'}); + if ($restype) { + my $resbor = $res->{'borrowernumber'}; + if ($resbor ne $borrower->{'borrowernumber'} && $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'}; + $needsconfirmation{RESERVE_WAITING} = "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)"; + } 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'}; + $needsconfirmation{RESERVED} = "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})"; + } + } + return(\%issuingimpossible,\%needsconfirmation); +} + +# +# issuing book. We already have checked it can be issued, so, just issue it ! +# +sub issuebook { + my ($env,$borrower,$barcode,$date) = @_; +warn "1"; + my $dbh = C4::Context->dbh; +# my ($borrower, $flags) = &getpatroninformation($env, $borrowernumber, 0); + my $iteminformation = getiteminformation($env, 0, $barcode); + warn "B : ".$borrower->{borrowernumber}." / I : ".$iteminformation->{'itemnumber'}; +# +# check if we just renew the issue. +# + my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'}); + if ($currentborrower eq $borrower->{'borrowernumber'}) { +warn "2"; + my ($charge,$itemtype) = calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'}); + if ($charge > 0) { + createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'}, $charge); + $iteminformation->{'charge'} = $charge; + } + &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'}); + renewbook($env,$dbh, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}); + } else { +# +# NOT a renewal +# + if ($currentborrower ne '') { +warn "3"; + # This book is currently on loan, but not to the person + # who wants to borrow it now. mark it returned before issuing to the new borrower + returnbook($iteminformation->{'barcode'}, $env->{'branchcode'}); + } +warn "4"; + # See if the item is on reserve. + my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'}); + if ($restype) { +warn "5"; + my $resbor = $res->{'borrowernumber'}; + if ($resbor eq $borrower->{'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'}; + CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); + } elsif ($restype eq "Reserved") { + # The item is on reserve for someone else. + my ($resborrower, $flags)=getpatroninformation($env, $resbor,0); + my $branches = getbranches(); + my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'}; + my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'}); + transferbook($tobrcd,$barcode, 1); + } + } + # Record in the database the fact that the book was issued. + my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode) values (?,?,?,?)"); + my $loanlength = $iteminformation->{loanlength} || 21; + my $datedue=time+($loanlength)*86400; + my @datearr = localtime($datedue); + my $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3]; + if ($env->{'datedue'}) { + $dateduef=$env->{'datedue'}; + } + $sth->execute($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}, $dateduef, $env->{'branchcode'}); + $sth->finish; + $iteminformation->{'issues'}++; + $sth=$dbh->prepare("update items set issues=? where itemnumber=?"); + $sth->execute($iteminformation->{'issues'},$iteminformation->{'itemnumber'}); + $sth->finish; + &itemseen($iteminformation->{'itemnumber'}); + # If it costs to borrow this book, charge it to the patron's account. + my ($charge,$itemtype)=calc_charges($env, $dbh, $iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'}); + if ($charge > 0) { + createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'}, $charge); + $iteminformation->{'charge'}=$charge; + } + # Record the fact that this book was issued. + &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'}); + } +} + =item issuebook ($iteminformation, $datedue, $rejected, $question, $questionnumber, @@ -561,6 +745,7 @@ 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 @@ -584,7 +769,7 @@ rental fee notice. # 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 { +sub issuebook2 { my ($env, $patroninformation, $barcode, $responses, $date) = @_; my $dbh = C4::Context->dbh; my $iteminformation = getiteminformation($env, 0, $barcode); @@ -860,6 +1045,7 @@ 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 @@ -1271,6 +1457,7 @@ 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 @@ -1443,39 +1630,6 @@ sub checkwaiting { 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,$date)=@_; - my $select="SELECT SUM(amountoutstanding) AS total - FROM accountlines - WHERE borrowernumber = ? - AND amountoutstanding<>0"; - my @bind = ($bornumber); - if ($date ne ''){ - $select.=" AND date < ?"; - push(@bind,$date); - } - # print $select; - my $sth=$dbh->prepare($select); - $sth->execute(@bind); - 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 { @@ -1702,6 +1856,30 @@ sub find_reserves { return ($resfound,$lastrec); } +sub fixdate { + my ($year, $month, $day) = @_; + my $invalidduedate; + my $date; + if (($year eq 0) && ($month eq 0) && ($year eq 0)) { +# $env{'datedue'}=''; + } else { + if (($year eq 0) || ($month eq 0) || ($year eq 0)) { + $invalidduedate=1; + } else { + if (($day>30) && (($month==4) || ($month==6) || ($month==9) || ($month==11))) { + $invalidduedate = 1; + } elsif (($day > 29) && ($month == 2)) { + $invalidduedate=1; + } elsif (($month == 2) && ($day > 28) && (($year%4) && ((!($year%100) || ($year%400))))) { + $invalidduedate=1; + } else { + $date="$year-$month-$day"; + } + } + } + return ($date, $invalidduedate); +} + 1; __END__ diff --git a/circ/circulation.pl b/circ/circulation.pl index bfaa343e06..368d54f489 100755 --- a/circ/circulation.pl +++ b/circ/circulation.pl @@ -35,9 +35,10 @@ use C4::Koha; use HTML::Template; use C4::Date; +# +# PARAMETERS READING +# my $query=new CGI; -#my ($loggedinuser, $sessioncookie, $sessionID) = checkauth -# ($query, 0, { circulate => 1 }); my ($template, $loggedinuser, $cookie) = get_template_and_user ({ @@ -47,18 +48,21 @@ my ($template, $loggedinuser, $cookie) = get_template_and_user authnotrequired => 0, flagsrequired => { circulate => 1 }, }); - - -my %env; -my $linecolor1='#ffffcc'; -my $linecolor2='white'; - my $branches = getbranches(); -my $printers = getprinters(\%env); - +my $printers = getprinters(); my $branch = getbranch($query, $branches); my $printer = getprinter($query, $printers); +my $findborrower = $query->param('findborrower'); +my $borrowernumber = $query->param('borrnumber'); +my $print=$query->param('print'); +my $barcode = $query->param('barcode'); +my $year=$query->param('year'); +my $month=$query->param('month'); +my $day=$query->param('day'); +my $stickyduedate=$query->param('stickyduedate'); +my $issueconfirmed = $query->param('issueconfirmed'); + #set up cookie..... my $branchcookie; @@ -68,6 +72,7 @@ if ($query->param('setcookies')) { $printercookie = $query->cookie(-name=>'printer', -value=>"$printer", -expires=>'+1y'); } +my %env; # env is used as an "environment" variable. Could be dropped probably... $env{'branchcode'}=$branch; $env{'printer'}=$printer; $env{'queue'}=$printer; @@ -75,19 +80,25 @@ $env{'queue'}=$printer; my @datearr = localtime(time()); # FIXME - Could just use POSIX::strftime("%Y%m%d", localtime); my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", ($datearr[3])); -#warn $todaysdate; +# get the borrower information..... +my $borrower; +if ($borrowernumber) { + $borrower = getpatroninformation(\%env,$borrowernumber,0); +} -my $message; -my $borrowerslist; +# my $message; + +# +# STEP 2 : FIND BORROWER # if there is a list of find borrowers.... -my $findborrower = $query->param('findborrower'); +# +my $borrowerslist; if ($findborrower) { my ($count,$borrowers)=BornameSearch(\%env,$findborrower,'web'); my @borrowers=@$borrowers; if ($#borrowers == -1) { $query->param('findborrower', ''); - $message = "'$findborrower'"; } elsif ($#borrowers == 0) { $query->param('borrnumber', $borrowers[0]->{'borrowernumber'}); $query->param('barcode',''); @@ -96,114 +107,56 @@ if ($findborrower) { } } -my $borrowernumber = $query->param('borrnumber'); -my $bornum = $query->param('borrnumber'); -# check and see if we should print -my $print=$query->param('print'); -my $barcode = $query->param('barcode'); -if ($barcode eq '' && $print eq 'maybe'){ - $print = 'yes'; -} -if ($print eq 'yes' && $borrowernumber ne ''){ - printslip(\%env,$borrowernumber); - $query->param('borrnumber',''); - $borrowernumber=''; -} - -# get the borrower information..... -my $borrower; -my $flags; -if ($borrowernumber) { - ($borrower, $flags) = getpatroninformation(\%env,$borrowernumber,0); -} - -# get the responses to any questions..... -my %responses; -foreach (sort $query->param) { - if ($_ =~ /response-(\d*)/) { - $responses{$1} = $query->param($_); - } -} -if (my $qnumber = $query->param('questionnumber')) { - $responses{$qnumber} = $query->param('answer'); -} - -my ($iteminformation, $duedate, $rejected, $question, $questionnumber, $defaultanswer); +# +# STEP 3 : ISSUING +# +# -my $year=$query->param('year'); -my $month=$query->param('month'); -my $day=$query->param('day'); +# check and see if we should print +# if ($barcode eq '' && $print eq 'maybe'){ +# $print = 'yes'; +# } +# if ($print eq 'yes' && $borrowernumber ne ''){ +# printslip(\%env,$borrowernumber); +# $query->param('borrnumber',''); +# $borrowernumber=''; +# } -# if the barcode is set if ($barcode) { $barcode = cuecatbarcodedecode($barcode); my ($datedue, $invalidduedate) = fixdate($year, $month, $day); - unless ($invalidduedate) { - $env{'datedue'}=$datedue; - my @time=localtime(time); - my $date= (1900+$time[5])."-".($time[4]+1)."-".$time[3]; - ($iteminformation, $duedate, $rejected, $question, $questionnumber, $defaultanswer, $message) - = issuebook(\%env, $borrower, $barcode, \%responses, $date); - } +# unless ($invalidduedate) { + my ($error, $question) = canbookbeissued(\%env, $borrower, $barcode, $year, $month, $day); + my $noerror=1; + my $noquestion = 1; + foreach my $impossible (keys %$error) { + warn "Impossible : $impossible : ";#.%$error->{$impossible}; + $template->param($impossible => 1, + IMPOSSIBLE => 1); + $noerror = 0; + } + foreach my $needsconfirmation (keys %$question) { + warn "needsconfirmation : $needsconfirmation : "; #.%$error->{$needsconfirmation}; + $template->param($needsconfirmation => 1, + NEEDSCONFIRMATION => 1); + $noquestion = 0; + } + if ($noerror && ($noquestion || $issueconfirmed)) { + warn "NO ERROR"; +# issuebook(\%env, $borrower, $barcode, $datedue); + } + +# } } # reload the borrower info for the sake of reseting the flags..... if ($borrowernumber) { - ($borrower, $flags) = getpatroninformation(\%env,$borrowernumber,0); -} - -################################################################################## -# HTML code.... - -my %responseform; -my @responsearray; -foreach (keys %responses) { -# $responsesform.="\n"; - $responseform{'name'}=$_; - $responseform{'value'}=$responses{$_}; - push @responsearray,\%responseform; -} -my $questionform; -my $stickyduedate; -if ($question) { - $stickyduedate=$query->param('stickyduedate'); + $borrower = getpatroninformation(\%env,$borrowernumber,0); } -# Barcode entry box, with hidden inputs attached.... - -# FIXME - How can we move this HTML into the template? Can we create -# arrays of the months, dates, etc and use in the template to -# output the data that's getting built here? -my $counter = 1; -my $dayoptions = ''; -my $monthoptions = ''; -my $yearoptions = ''; -for (my $i=1; $i<32; $i++) { - my $selected=''; - if (($query->param('stickyduedate')) && ($day==$i)) { - $selected='selected'; - } - $dayoptions.="