[Koha-cvs] koha/C4 Circulation.pm

[paul poulain]

CVSROOT:        /sources/koha
Module name:    koha
Changes by:     paul poulain <tipaul>   07/04/23 13:17:52

Modified files:
        C4             : Circulation.pm 

Log message:
        reintroducing fixaccountforlostandreturned as requested by rosalie

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Circulation.pm?cvsroot=koha&r1=1.15&r2=1.16

Patches:
Index: Circulation.pm
===================================================================
RCS file: /sources/koha/koha/C4/Circulation.pm,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -b -r1.15 -r1.16
--- Circulation.pm      23 Apr 2007 13:10:08 -0000      1.15
+++ Circulation.pm      23 Apr 2007 13:17:52 -0000      1.16
@@ -17,7 +17,7 @@
 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
 # Suite 330, Boston, MA  02111-1307 USA
 
-# $Id: Circulation.pm,v 1.15 2007/04/23 13:10:08 hdl Exp $
+# $Id: Circulation.pm,v 1.16 2007/04/23 13:17:52 tipaul Exp $
 
 use strict;
 require Exporter;
@@ -43,7 +43,7 @@
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 
 # set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.15 $' =~ /\d+/g; shift(@v).".".join( 
"_", map { sprintf "%03d", $_ } @v ); };
+$VERSION = do { my @v = '$Revision: 1.16 $' =~ /\d+/g; shift(@v).".".join( 
"_", map { sprintf "%03d", $_ } @v ); };
 
 =head1 NAME
 
@@ -67,7 +67,7 @@
 
 # FIXME subs that should probably be elsewhere
 push @EXPORT, qw(
-  &fixoverduesonreturn
+  &FixOverduesOnReturn
 );
 
 # subs to deal with issuing a book
@@ -1278,8 +1278,13 @@
         }
     
     # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
# # # 
+        # fix up the accounts.....
+        if ($iteminformation->{'itemlost'}) {
+                FixAccountForLostAndReturned($iteminformation, $borrower);
+                $messages->{'WasLost'} = 1;
+        }
     # fix up the overdues in accounts...
-        fixoverduesonreturn( $borrower->{'borrowernumber'},
+        FixOverduesOnReturn( $borrower->{'borrowernumber'},
             $iteminformation->{'itemnumber'} );
     
     # find reserves.....
@@ -1318,17 +1323,19 @@
     return ( $doreturn, $messages, $iteminformation, $borrower );
 }
 
-=head2 fixoverdueonreturn
+=head2 FixOverduesOnReturn
 
-    &fixoverdueonreturn($brn,$itm);
+    &FixOverduesOnReturn($brn,$itm);
 
 C<$brn> borrowernumber
 
 C<$itm> itemnumber
 
+internal function, called only by AddReturn
+
 =cut
 
-sub fixoverduesonreturn {
+sub FixOverduesOnReturn {
     my ( $borrowernumber, $item ) = @_;
     my $dbh = C4::Context->dbh;
 
@@ -1352,6 +1359,103 @@
     return;
 }
 
+=head2 FixAccountForLostAndReturned
+
+       &FixAccountForLostAndReturned($iteminfo,$borrower);
+
+Calculates the charge for a book lost and returned (Not exported & used only 
once)
+
+C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used.
+
+C<$borrower> is a hashref to borrower. Only {borrowernumber is used.
+
+Internal function, called by AddReturn
+
+=cut
+
+sub FixAccountForLostAndReturned {
+       my ($iteminfo, $borrower) = @_;
+       my %env;
+       my $dbh = C4::Context->dbh;
+       my $itm = $iteminfo->{'itemnumber'};
+       # check for charge made for lost book
+       my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = 
?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
+       $sth->execute($itm);
+       if (my $data = $sth->fetchrow_hashref) {
+       # writeoff this amount
+               my $offset;
+               my $amount = $data->{'amount'};
+               my $acctno = $data->{'accountno'};
+               my $amountleft;
+               if ($data->{'amountoutstanding'} == $amount) {
+               $offset = $data->{'amount'};
+               $amountleft = 0;
+               } else {
+               $offset = $amount - $data->{'amountoutstanding'};
+               $amountleft = $data->{'amountoutstanding'} - $amount;
+               }
+               my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 
'LR',amountoutstanding='0'
+                       WHERE (borrowernumber = ?)
+                       AND (itemnumber = ?) AND (accountno = ?) ");
+               $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);
+               if ($amountleft < 0){
+               $amountleft*=-1;
+               }
+               if ($amountleft > 0){
+               my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE 
(borrowernumber = ?)
+                                                       AND (amountoutstanding 
>0) ORDER BY date");
+               $msth->execute($data->{'borrowernumber'});
+       # offset transactions
+               my $newamtos;
+               my $accdata;
+               while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
+                       if ($accdata->{'amountoutstanding'} < $amountleft) {
+                       $newamtos = 0;
+                       $amountleft -= $accdata->{'amountoutstanding'};
+                       }  else {
+                       $newamtos = $accdata->{'amountoutstanding'} - 
$amountleft;
+                       $amountleft = 0;
+                       }
+                       my $thisacct = $accdata->{'accountno'};
+                       my $usth = $dbh->prepare("UPDATE accountlines SET 
amountoutstanding= ?
+                                       WHERE (borrowernumber = ?)
+                                       AND (accountno=?)");
+                       
$usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
+                       $usth->finish;
+                       $usth = $dbh->prepare("INSERT INTO accountoffsets
+                               (borrowernumber, accountno, offsetaccount,  
offsetamount)
+                               VALUES
+                               (?,?,?,?)");
+                       
$usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
+                       $usth->finish;
+               }
+               $msth->finish;
+               }
+               if ($amountleft > 0){
+                       $amountleft*=-1;
+               }
+               my $desc="Book Returned ".$iteminfo->{'barcode'};
+               $usth = $dbh->prepare("INSERT INTO accountlines
+                       
(borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
+                       VALUES (?,?,now(),?,?,'CR',?)");
+               
$usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
+               $usth->finish;
+               $usth = $dbh->prepare("INSERT INTO accountoffsets
+                       (borrowernumber, accountno, offsetaccount,  
offsetamount)
+                       VALUES (?,?,?,?)");
+               
$usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
+               $usth->finish;
+               $usth = $dbh->prepare("UPDATE items SET paidfor='' WHERE 
itemnumber=?");
+               $usth->execute($itm);
+               $usth->finish;
+       }
+       $sth->finish;
+       return;
+}
+
 =head2 GetItemIssue
 
 $issues = &GetBorrowerIssue($itemnumber);