[Koha-cvs] CVS: koha/C4/Circulation Circ2.pm,1.71,1.72
Paul POULAIN
tipaul at users.sourceforge.net
Mon May 3 11:02:15 CEST 2004
Update of /cvsroot/koha/koha/C4/Circulation
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32369/C4/Circulation
Modified Files:
Circ2.pm
Log Message:
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.
Index: Circ2.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Circulation/Circ2.pm,v
retrieving revision 1.71
retrieving revision 1.72
diff -C2 -r1.71 -r1.72
*** Circ2.pm 2 Apr 2004 14:55:47 -0000 1.71
--- Circ2.pm 3 May 2004 09:02:12 -0000 1.72
***************
*** 35,38 ****
--- 35,39 ----
use C4::Reserves2;
use C4::Koha;
+ use C4::Accounts;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
***************
*** 64,80 ****
@EXPORT = qw(&getpatroninformation
¤tissues &getissues &getiteminformation
! &issuebook &returnbook &find_reserves &transferbook &decode
! &calc_charges &listitemsforinventory &itemseen);
# &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) = @_;
--- 65,81 ----
@EXPORT = qw(&getpatroninformation
¤tissues &getissues &getiteminformation
! &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
=cut
+
sub itemseen {
my ($itemnum) = @_;
***************
*** 100,107 ****
return \@results;
}
=item getpatroninformation
! ($borrower, $flags) = &getpatroninformation($env, $borrowernumber,
! $cardnumber);
Looks up a patron and returns information about him or her. If
--- 101,108 ----
return \@results;
}
+
=item getpatroninformation
! ($borrower, $flags) = &getpatroninformation($env, $borrowernumber, $cardnumber);
Looks up a patron and returns information about him or her. If
***************
*** 114,128 ****
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
--- 115,124 ----
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 a hash giving more detailed information
! about the patron. Its keys act as flags :
! if $borrower->{flags}->{LOST} {
! # Patron's card was reported lost
! }
Each flag has a C<message> key, giving a human-readable explanation of
***************
*** 179,182 ****
--- 175,179 ----
=cut
+
#'
sub getpatroninformation {
***************
*** 202,206 ****
my $flags = patronflags($env, $borrower, $dbh);
my $accessflagshash;
!
$sth=$dbh->prepare("select bit,flag from userflags");
$sth->execute;
--- 199,203 ----
my $flags = patronflags($env, $borrower, $dbh);
my $accessflagshash;
!
$sth=$dbh->prepare("select bit,flag from userflags");
$sth->execute;
***************
*** 212,216 ****
$sth->finish;
$borrower->{'flags'}=$flags;
! return ($borrower, $flags, $accessflagshash);
}
--- 209,214 ----
$sth->finish;
$borrower->{'flags'}=$flags;
! $borrower->{'authflags'} = $accessflagshash;
! return ($borrower); #, $flags, $accessflagshash);
}
***************
*** 223,226 ****
--- 221,225 ----
=cut
+
#'
# FIXME - At least, I'm pretty sure this is for decoding CueCat stuff.
***************
*** 285,288 ****
--- 284,288 ----
=cut
+
#'
sub getiteminformation {
***************
*** 400,403 ****
--- 400,404 ----
=cut
+
#'
# FIXME - This function tries to do too much, and its API is clumsy.
***************
*** 482,485 ****
--- 483,669 ----
}
+ # 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
***************
*** 562,565 ****
--- 746,750 ----
=cut
+
#'
# FIXME - The business with $responses is absurd. For one thing, these
***************
*** 585,589 ****
# 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;
--- 770,774 ----
# various questions? Why not document the various problems and allow
# the caller to decide?
! sub issuebook2 {
my ($env, $patroninformation, $barcode, $responses, $date) = @_;
my $dbh = C4::Context->dbh;
***************
*** 861,864 ****
--- 1046,1050 ----
=cut
+
#'
# FIXME - This API is bogus. There's no need to return $borrower and
***************
*** 1272,1275 ****
--- 1458,1462 ----
=cut
+
#'
sub currentissues {
***************
*** 1444,1480 ****
}
- # 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.
--- 1631,1634 ----
***************
*** 1703,1706 ****
--- 1857,1884 ----
}
+ 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__
More information about the Koha-cvs
mailing list