BUGFIX issuingrules : total for all itemtype was not properly calculated
[koha.git] / C4 / Circulation.pm
index 11e3210..91a7b77 100644 (file)
@@ -69,6 +69,7 @@ BEGIN {
                &GetItemIssues
                &GetBorrowerIssues
                &GetIssuingCharges
+               &GetIssuingRule
                &GetBiblioIssues
                &AnonymiseIssueHistory
        );
@@ -105,21 +106,26 @@ Also deals with stocktaking.
 
 =head1 FUNCTIONS
 
-=head2 decode
+=head2 barcodedecode
 
-=head3 $str = &decode($chunk);
+=head3 $str = &barcodedecode($barcode);
 
 =over 4
 
 =item Generic filter function for barcode string.
+Called on every circ if the System Pref itemBarcodeInputFilter is set.
+Will do some manipulation of the barcode for systems that deliver a barcode
+to circulation.pl that differs from the barcode stored for the item.
+For proper functioning of this filter, calling the function on the 
+correct barcode string (items.barcode) should return an unaltered barcode.
 
 =back
 
 =cut
 
-# FIXME From Paul : i don't understand what this sub does & why it has to be called on every circ. Speak of this with chris maybe ?
 # FIXME -- the &decode fcn below should be wrapped into this one.
-
+# FIXME -- these plugins should be moved out of Circulation.pm
+#
 sub barcodedecode {
     my ($barcode) = @_;
     my $filter = C4::Context->preference('itemBarcodeInputFilter');
@@ -137,8 +143,14 @@ sub barcodedecode {
                return $barcode;
            }
        } elsif($filter eq 'T-prefix') {
-               my $num = ( $barcode =~ /^[Tt] /) ? substr($barcode,2) + 0 : $barcode;
-               return sprintf( "T%07d",$num);
+               if ( $barcode =~ /^[Tt]/) {
+                       if (substr($barcode,1,1) eq '0') {
+                               return $barcode;
+                       } else {
+                               $barcode = substr($barcode,2) + 0 ;
+                       }
+               }
+               return sprintf( "T%07d",$barcode);
        }
 }
 
@@ -433,7 +445,6 @@ sub TooMany {
     $sth->execute( $cat_borrower, $type, $branch );
     my $result = $sth->fetchrow_hashref;
 #     warn "$cat_borrower, $type, $branch = ".Data::Dumper::Dumper($result);
-
     if ( $result->{maxissueqty} ne '' ) {
 #         warn "checking on everything set";
         $sth2->execute( $borrower->{'borrowernumber'}, $type );
@@ -445,8 +456,8 @@ sub TooMany {
         $sth->execute( $cat_borrower, '*', $branch );
         my $result = $sth->fetchrow_hashref;
         if ( $result->{maxissueqty} ne '' ) {
-            $sth2->execute( $borrower->{'borrowernumber'}, $type );
-            my $alreadyissued = $sth2->fetchrow;
+            $sth3->execute( $borrower->{'borrowernumber'} );
+            my $alreadyissued = $sth3->fetchrow;
             if ( $result->{'maxissueqty'} <= $alreadyissued ) {
                 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch/category/total failed)"  );
             }
@@ -469,8 +480,8 @@ sub TooMany {
         $sth->execute( '*', '*', $branch );
         my $result = $sth->fetchrow_hashref;
         if ( $result->{maxissueqty} ne '' ) {
-            $sth2->execute( $borrower->{'borrowernumber'}, $type );
-            my $alreadyissued = $sth2->fetchrow;
+            $sth3->execute( $borrower->{'borrowernumber'} );
+            my $alreadyissued = $sth3->fetchrow;
             if ( $result->{'maxissueqty'} <= $alreadyissued ) {
                 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch / default category / total failed)" );
             }
@@ -493,8 +504,8 @@ sub TooMany {
         $sth->execute( $cat_borrower, '*', '*' );
         my $result = $sth->fetchrow_hashref;
         if ( $result->{maxissueqty} ne '' ) {
-            $sth2->execute( $borrower->{'borrowernumber'}, $type );
-            my $alreadyissued = $sth2->fetchrow;
+            $sth3->execute( $borrower->{'borrowernumber'} );
+            my $alreadyissued = $sth3->fetchrow;
             if ( $result->{'maxissueqty'} <= $alreadyissued ) {
                 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / category / total failed)"  );
             }
@@ -1022,11 +1033,11 @@ sub AddIssue {
             C4::Context->userenv->{'branch'},
             'issue',                        $charge,
             '',                             $item->{'itemnumber'},
-            $item->{'itemtype'}, $borrower->{'borrowernumber'}
+            $item->{'itype'}, $borrower->{'borrowernumber'}
         );
     }
     
-    &logaction(C4::Context->userenv->{'number'},"CIRCULATION","ISSUE",$borrower->{'borrowernumber'},$biblio->{'biblionumber'}) 
+    logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'}) 
         if C4::Context->preference("IssueLog");
     return ($datedue);
   }
@@ -1094,16 +1105,75 @@ sub GetLoanLength {
     return 21;
 }
 
+=head2 GetIssuingRule
+
+FIXME - This is a copy-paste of GetLoanLength 
+as a stop-gap.  Do not wish to change API for GetLoanLength 
+this close to release, however, Overdues::GetIssuingRules is broken.
+
+Get the issuing rule for an itemtype, a borrower type and a branch
+Returns a hashref from the issuingrules table.
+
+my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
+
+=cut
+
+sub GetIssuingRule {
+    my ( $borrowertype, $itemtype, $branchcode ) = @_;
+    my $dbh = C4::Context->dbh;
+    my $sth =  $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"  );
+    my $irule;
+
+       $sth->execute( $borrowertype, $itemtype, $branchcode );
+    $irule = $sth->fetchrow_hashref;
+    return $irule if defined($irule) ;
+
+    $sth->execute( $borrowertype, $itemtype, "*" );
+    $irule = $sth->fetchrow_hashref;
+    return $irule if defined($irule) ;
+
+    $sth->execute( $borrowertype, "*", $branchcode );
+    $irule = $sth->fetchrow_hashref;
+    return $irule if defined($irule) ;
+
+    $sth->execute( "*", $itemtype, $branchcode );
+    $irule = $sth->fetchrow_hashref;
+    return $irule if defined($irule) ;
+
+    $sth->execute( $borrowertype, "*", "*" );
+    $irule = $sth->fetchrow_hashref;
+    return $irule if defined($irule) ;
+
+    $sth->execute( "*", "*", $branchcode );
+    $irule = $sth->fetchrow_hashref;
+    return $irule if defined($irule) ;
+
+    $sth->execute( "*", $itemtype, "*" );
+    $irule = $sth->fetchrow_hashref;
+    return $irule if defined($irule) ;
+
+    $sth->execute( "*", "*", "*" );
+    $irule = $sth->fetchrow_hashref;
+    return $irule if defined($irule) ;
+
+    # if no rule matches,
+    return undef;
+}
+
 =head2 AddReturn
 
 ($doreturn, $messages, $iteminformation, $borrower) =
-    &AddReturn($barcode, $branch, $exemptfine);
+    &AddReturn($barcode, $branch, $exemptfine, $dropbox);
 
 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<$exemptfine>
-indicates that overdue charges for the item will not be applied.
+indicates that overdue charges for the item will be removed.  C<$dropbox>
+indicates that the check-in date is assumed to be yesterday, or the last
+non-holiday as defined in C4::Calendar .  If overdue
+charges are applied and C<$dropbox> is true, the last charge will be removed.
+This assumes that the fines accrual script has run for _today_.
 
 C<&AddReturn> returns a list of four items:
 
@@ -1146,7 +1216,7 @@ patron who last borrowed the book.
 =cut
 
 sub AddReturn {
-    my ( $barcode, $branch, $exemptfine ) = @_;
+    my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
     my $dbh      = C4::Context->dbh;
     my $messages;
     my $doreturn = 1;
@@ -1165,12 +1235,18 @@ sub AddReturn {
         # find the borrower
         if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) {
             $messages->{'NotIssued'} = $barcode;
+            # even though item is not on loan, it may still
+            # be transferred; therefore, get current branch information
+            my $curr_iteminfo = GetItem($iteminformation->{'itemnumber'});
+            $iteminformation->{'homebranch'} = $curr_iteminfo->{'homebranch'};
+            $iteminformation->{'holdingbranch'} = $curr_iteminfo->{'holdingbranch'};
             $doreturn = 0;
         }
     
         # check if the book is in a permanent collection....
-        my $hbr      = $iteminformation->{'homebranch'};
+        my $hbr      = $iteminformation->{C4::Context->preference("HomeOrHoldingBranch")};
         my $branches = GetBranches();
+               # FIXME -- This 'PE' attribute is largely undocumented.  afaict, there's no user interface that reflects this functionality.
         if ( $hbr && $branches->{$hbr}->{'PE'} ) {
             $messages->{'IsPermanent'} = $hbr;
         }
@@ -1195,7 +1271,20 @@ sub AddReturn {
     # case of a return of document (deal with issues and holdingbranch)
     
         if ($doreturn) {
-            MarkIssueReturned($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
+                       my $circControlBranch;
+                       if($dropbox) {
+                               # don't allow dropbox mode to create an invalid entry in issues ( issuedate > returndate)
+                               undef($dropbox) if ( $iteminformation->{'issuedate'} eq C4::Dates->today('iso') );
+                               if (C4::Context->preference('CircControl') eq 'ItemHomeBranch' ) {
+                                       $circControlBranch = $iteminformation->{homebranch};
+                               } elsif ( C4::Context->preference('CircControl') eq 'PatronLibrary') {
+                                       $circControlBranch = $borrower->{branchcode};
+                               } else { # CircControl must be PickupLibrary.
+                                       $circControlBranch = $iteminformation->{holdingbranch};
+                                       # FIXME - is this right ? are we sure that the holdingbranch is still the pickup branch?
+                               }
+                       }
+            MarkIssueReturned($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'},$circControlBranch);
             $messages->{'WasReturned'} = 1;    # FIXME is the "= 1" right?
         }
     
@@ -1249,7 +1338,7 @@ sub AddReturn {
         }
         # fix up the overdues in accounts...
         FixOverduesOnReturn( $borrower->{'borrowernumber'},
-            $iteminformation->{'itemnumber'}, $exemptfine );
+            $iteminformation->{'itemnumber'}, $exemptfine, $dropbox );
     
     # find reserves.....
     #     if we don't have a reserve with the status W, we launch the Checkreserves routine
@@ -1270,7 +1359,7 @@ sub AddReturn {
             $borrower->{'borrowernumber'}
         );
         
-        &logaction(C4::Context->userenv->{'number'},"CIRCULATION","RETURN",$iteminformation->{borrowernumber},$iteminformation->{'biblionumber'}) 
+        logaction("CIRCULATION", "RETURN", $iteminformation->{borrowernumber}, $iteminformation->{'biblionumber'}) 
             if C4::Context->preference("ReturnLog");
         
         #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
@@ -1293,13 +1382,16 @@ sub AddReturn {
 
 =over 4
 
-MarkIssueReturned($borrowernumber, $itemnumber);
+MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch);
 
 =back
 
 Unconditionally marks an issue as being returned by
 moving the C<issues> row to C<old_issues> and
-setting C<returndate> to the current date.
+setting C<returndate> to the current date, or
+the last non-holiday date of the branccode specified in
+C<dropbox> .  Assumes you've already checked that 
+it's safe to do this, i.e. last non-holiday > issuedate.
 
 Ideally, this function would be internal to C<C4::Circulation>,
 not exported, but it is currently needed by one 
@@ -1308,14 +1400,22 @@ routine in C<C4::Accounts>.
 =cut
 
 sub MarkIssueReturned {
-    my ($borrowernumber, $itemnumber) = @_;
-
-    my $dbh = C4::Context->dbh;
+    my ($borrowernumber, $itemnumber, $dropbox_branch ) = @_;
+       my $dbh = C4::Context->dbh;
+       my $query = "UPDATE issues SET returndate=";
+       my @bind = ($borrowernumber,$itemnumber);
+       if($dropbox_branch) {
+               my $calendar = C4::Calendar->new(  branchcode => $dropbox_branch );
+               my $dropboxdate = $calendar->addDate(C4::Dates->new(), -1 );
+               unshift @bind, $dropboxdate->output('iso') ;
+               $query .= " ? "
+       } else {
+               $query .= " now() ";
+       }
+       $query .=  " WHERE  borrowernumber = ?  AND itemnumber = ?";
     # FIXME transaction
-    my $sth_upd  = $dbh->prepare("UPDATE issues SET returndate = now() 
-                                  WHERE borrowernumber = ?
-                                  AND itemnumber = ?");
-    $sth_upd->execute($borrowernumber, $itemnumber);
+    my $sth_upd  = $dbh->prepare($query);
+    $sth_upd->execute(@bind);
     my $sth_copy = $dbh->prepare("INSERT INTO old_issues SELECT * FROM issues 
                                   WHERE borrowernumber = ?
                                   AND itemnumber = ?");
@@ -1328,18 +1428,21 @@ sub MarkIssueReturned {
 
 =head2 FixOverduesOnReturn
 
-    &FixOverduesOnReturn($brn,$itm, $exemptfine);
+    &FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
 
 C<$brn> borrowernumber
 
 C<$itm> itemnumber
 
+C<$exemptfine> BOOL -- remove overdue charge associated with this issue. 
+C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
+
 internal function, called only by AddReturn
 
 =cut
 
 sub FixOverduesOnReturn {
-    my ( $borrowernumber, $item, $exemptfine ) = @_;
+    my ( $borrowernumber, $item, $exemptfine, $dropbox ) = @_;
     my $dbh = C4::Context->dbh;
 
     # check for overdue fine
@@ -1352,10 +1455,30 @@ sub FixOverduesOnReturn {
     # alter fine to show that the book has been returned
    my $data; 
        if ($data = $sth->fetchrow_hashref) {
-        my $uquery =($exemptfine)? "update accountlines set accounttype='FFOR', amountoutstanding=0":"update accountlines set accounttype='F' ";
+        my $uquery;
+               my @bind = ($borrowernumber,$item ,$data->{'accountno'});
+               if ($exemptfine) {
+                       $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
+                       if (C4::Context->preference("FinesLog")) {
+                       &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
+                       }
+               } elsif ($dropbox && $data->{lastincrement}) {
+                       my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
+                       my $amt = $data->{amount} - $data->{lastincrement} ;
+                       if (C4::Context->preference("FinesLog")) {
+                       &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
+                       }
+                        $uquery = "update accountlines set accounttype='F' ";
+                        if($outstanding  >= 0 && $amt >=0) {
+                               $uquery .= ", amount = ? , amountoutstanding=? ";
+                               unshift @bind, ($amt, $outstanding) ;
+                       }
+               } else {
+                       $uquery = "update accountlines set accounttype='F' ";
+               }
                $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
         my $usth = $dbh->prepare($uquery);
-        $usth->execute($borrowernumber,$item ,$data->{'accountno'});
+        $usth->execute(@bind);
         $usth->finish();
     }
 
@@ -1379,7 +1502,6 @@ Internal function, called by AddReturn
 
 sub FixAccountForLostAndReturned {
        my ($iteminfo, $borrower) = @_;
-       my %env;
        my $dbh = C4::Context->dbh;
        my $itm = $iteminfo->{'itemnumber'};
        # check for charge made for lost book
@@ -1404,7 +1526,7 @@ sub FixAccountForLostAndReturned {
                $usth->execute($data->{'borrowernumber'},$itm,$acctno);
                $usth->finish;
        #check if any credit is left if so writeoff other accounts
-               my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
+               my $nextaccntno = getnextacctno($data->{'borrowernumber'});
                if ($amountleft < 0){
                $amountleft*=-1;
                }
@@ -1670,7 +1792,7 @@ sub CanBookBeRenewed {
 
 =head2 AddRenewal
 
-&AddRenewal($borrowernumber, $itemnumber, $datedue);
+&AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue]);
 
 Renews a loan.
 
@@ -1679,41 +1801,38 @@ has the item.
 
 C<$itemnumber> is the number of the item to renew.
 
-C<$datedue> can be used to set the due date. If C<$datedue> is the
-empty string, C<&AddRenewal> will calculate the due date automatically
-from the book's item type. If you wish to set the due date manually,
-C<$datedue> should be in the form YYYY-MM-DD.
+C<$branch> is the library branch.  Defaults to the homebranch of the ITEM.
+
+C<$datedue> can be a C4::Dates object used to set the due date.
+
+If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
+from the book's item type.
 
 =cut
 
 sub AddRenewal {
-
-    my ( $borrowernumber, $itemnumber, $branch ,$datedue ) = @_;
-    my $dbh = C4::Context->dbh;
-    my $biblio = GetBiblioFromItemNumber($itemnumber);
+       my $borrowernumber = shift or return undef;
+       my     $itemnumber = shift or return undef;
+    my $item   = GetItem($itemnumber) or return undef;
+    my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
+    my $branch  = (@_) ? shift : $item->{homebranch};  # opac-renew doesn't send branch
+    my $datedue;
     # If the due date wasn't specified, calculate it by adding the
     # book's loan length to today's date.
-    unless ( $datedue ) {
-
+    unless (@_ and $datedue = shift and $datedue->output('iso')) {
 
-        my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 );
+        my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef;
         my $loanlength = GetLoanLength(
             $borrower->{'categorycode'},
              (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
-                       $borrower->{'branchcode'}
+                       $item->{homebranch}                     # item's homebranch determines loanlength OR do we want the branch specified by the AddRenewal argument?
         );
-               #FIXME --  choose issuer or borrower branch -- use circControl.
-
-               #FIXME -- $debug-ify the (0)
-        #my @darray = Add_Delta_DHMS( Today_and_Now(), $loanlength, 0, 0, 0 );
-        #$datedue = C4::Dates->new( sprintf("%04d-%02d-%02d",@darray[0..2]), 'iso');
-               #(0) and print STDERR  "C4::Dates->new->output = " . C4::Dates->new()->output()
-               #               . "\ndatedue->output = " . $datedue->output()
-               #               . "\n(Y,M,D) = " . join ',', @darray;
-               #$datedue=CheckValidDatedue($datedue,$itemnumber,$branch,$loanlength);
-               $datedue =  CalcDateDue(C4::Dates->new(),$loanlength,$branch);
+               #FIXME -- use circControl?
+               $datedue =  CalcDateDue(C4::Dates->new(),$loanlength,$branch);  # this branch is the transactional branch.
+                                                               # The question of whether to use item's homebranch calendar is open.
     }
 
+    my $dbh = C4::Context->dbh;
     # Find the issues record for this book
     my $sth =
       $dbh->prepare("SELECT * FROM issues
@@ -1745,10 +1864,12 @@ sub AddRenewal {
         my $item = GetBiblioFromItemNumber($itemnumber);
         $sth = $dbh->prepare(
                 "INSERT INTO accountlines
-                    (borrowernumber,accountno,date,amount,
-                        description,accounttype,amountoutstanding,
-                    itemnumber)
-                    VALUES (?,?,now(),?,?,?,?,?)"
+                    (date,
+                                       borrowernumber, accountno, amount,
+                    description,
+                                       accounttype, amountoutstanding, itemnumber
+                                       )
+                    VALUES (now(),?,?,?,?,?,?,?)"
         );
         $sth->execute( $borrowernumber, $accountno, $charge,
             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
@@ -1756,7 +1877,7 @@ sub AddRenewal {
         $sth->finish;
     }
     # Log the renewal
-    UpdateStats( $branch, 'renew', $charge, '', $itemnumber );
+    UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
 }
 
 sub GetRenewCount {