[Koha-cvs] CVS: koha/C4/Circulation Circ2.pm,1.71,1.72

[Paul POULAIN]

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
        &currentissues &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
        &currentissues &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 address@hidden;
  }
  =item getpatroninformation
  
!   ($borrower, $flags) = &getpatroninformation($env, $borrowernumber,
!                                       $cardnumber);
  
  Looks up a patron and returns information about him or her. If
--- 101,108 ----
        return address@hidden;
  }
+ 
  =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)address@hidden;
-       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__