X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FAccounts.pm;h=d2c597a08a5a290b916ae3ad783c375ed3696972;hb=3f7b2fa41898f59ce39d1725f8dfe6001095f796;hp=3606393510d787ffe081d521b0ccaa7227ee397d;hpb=31a0ed0a43bb4ecfde0b762eb6e654c51da6f66e;p=koha.git diff --git a/C4/Accounts.pm b/C4/Accounts.pm index 3606393510..d2c597a08a 100644 --- a/C4/Accounts.pm +++ b/C4/Accounts.pm @@ -4,18 +4,18 @@ package C4::Accounts; # # This file is part of Koha. # -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. # -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. # -# You should have received a copy of the GNU General Public License along -# with Koha; if not, write to the Free Software Foundation, Inc., -# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . use strict; @@ -23,31 +23,25 @@ use strict; use C4::Context; use C4::Stats; use C4::Members; -use C4::Circulation qw(ReturnLostItem); +use C4::Log qw(logaction); +use Koha::Account; +use Koha::Account::Lines; +use Koha::Account::Offsets; +use Koha::Items; -use vars qw($VERSION @ISA @EXPORT); +use Data::Dumper qw(Dumper); + +use vars qw(@ISA @EXPORT); BEGIN { - # set the version for version checking - $VERSION = 3.07.00.049; - require Exporter; - @ISA = qw(Exporter); - @EXPORT = qw( - &recordpayment - &makepayment - &manualinvoice - &getnextacctno - &reconcileaccount - &getcharges - &ModNote - &getcredits - &getrefunds - &chargelostitem - &ReversePayment - &makepartialpayment - &recordpayment_selectaccts - &WriteOffFee - ); + require Exporter; + @ISA = qw(Exporter); + @EXPORT = qw( + &manualinvoice + &getnextacctno + &chargelostitem + &purge_zero_balance_fees + ); } =head1 NAME @@ -66,171 +60,6 @@ patron. =head1 FUNCTIONS -=head2 recordpayment - - &recordpayment($borrowernumber, $payment); - -Record payment by a patron. C<$borrowernumber> is the patron's -borrower number. C<$payment> is a floating-point number, giving the -amount that was paid. - -Amounts owed are paid off oldest first. That is, if the patron has a -$1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment -of $1.50, then the oldest fine will be paid off in full, and $0.50 -will be credited to the next one. - -=cut - -#' -sub recordpayment { - - #here we update the account lines - my ( $borrowernumber, $data ) = @_; - my $dbh = C4::Context->dbh; - my $newamtos = 0; - my $accdata = ""; - my $branch = C4::Context->userenv->{'branch'}; - my $amountleft = $data; - my $manager_id = 0; - $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; - - # begin transaction - my $nextaccntno = getnextacctno($borrowernumber); - - # get lines with outstanding amounts to offset - my $sth = $dbh->prepare( - "SELECT * FROM accountlines - WHERE (borrowernumber = ?) AND (amountoutstanding<>0) - ORDER BY date" - ); - $sth->execute($borrowernumber); - - # offset transactions - while ( ( $accdata = $sth->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, $borrowernumber, $thisacct ); - $usth->finish; -# $usth = $dbh->prepare( -# "INSERT INTO accountoffsets -# (borrowernumber, accountno, offsetaccount, offsetamount) -# VALUES (?,?,?,?)" -# ); -# $usth->execute( $borrowernumber, $accdata->{'accountno'}, -# $nextaccntno, $newamtos ); - $usth->finish; - } - - # create new line - my $usth = $dbh->prepare( - "INSERT INTO accountlines - (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id) - VALUES (?,?,now(),?,'Payment,thanks','Pay',?,?)" - ); - $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft, $manager_id ); - $usth->finish; - UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno ); - $sth->finish; -} - -=head2 makepayment - - &makepayment($borrowernumber, $acctnumber, $amount, $branchcode); - -Records the fact that a patron has paid off the entire amount he or -she owes. - -C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is -the account that was credited. C<$amount> is the amount paid (this is -only used to record the payment. It is assumed to be equal to the -amount owed). C<$branchcode> is the code of the branch where payment -was made. - -=cut - -#' -# FIXME - I'm not at all sure about the above, because I don't -# understand what the acct* tables in the Koha database are for. -sub makepayment { - - #here we update both the accountoffsets and the account lines - #updated to check, if they are paying off a lost item, we return the item - # from their card, and put a note on the item record - my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_; - my $dbh = C4::Context->dbh; - my $manager_id = 0; - $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; - - # begin transaction - my $nextaccntno = getnextacctno($borrowernumber); - my $newamtos = 0; - my $sth = - $dbh->prepare( - "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?"); - $sth->execute( $borrowernumber, $accountno ); - my $data = $sth->fetchrow_hashref; - $sth->finish; - - if($data->{'accounttype'} eq "Pay"){ - my $udp = - $dbh->prepare( - "UPDATE accountlines - SET amountoutstanding = 0, description = 'Payment,thanks' - WHERE borrowernumber = ? - AND accountno = ? - " - ); - $udp->execute($borrowernumber, $accountno ); - $udp->finish; - }else{ - my $udp = - $dbh->prepare( - "UPDATE accountlines - SET amountoutstanding = 0 - WHERE borrowernumber = ? - AND accountno = ? - " - ); - $udp->execute($borrowernumber, $accountno ); - $udp->finish; - - # create new line - my $payment = 0 - $amount; - - my $ins = - $dbh->prepare( - "INSERT - INTO accountlines (borrowernumber, accountno, date, amount, itemnumber, description, accounttype, amountoutstanding, manager_id) - VALUES ( ?, ?, now(), ?, ?, 'Payment,thanks', 'Pay', 0, ?)" - ); - $ins->execute($borrowernumber, $nextaccntno, $payment, $data->{'itemnumber'}, $manager_id); - $ins->finish; - } - - # FIXME - The second argument to &UpdateStats is supposed to be the - # branch code. - # UpdateStats is now being passed $accountno too. MTJ - UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber, - $accountno ); - #from perldoc: for SELECT only #$sth->finish; - - #check to see what accounttype - if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) { - C4::Circulation::ReturnLostItem( $borrowernumber, $data->{'itemnumber'} ); - } -} - =head2 getnextacctno $nextacct = &getnextacctno($borrowernumber); @@ -242,80 +71,143 @@ borrower number. #' # FIXME - Okay, so what does the above actually _mean_? -sub getnextacctno ($) { - my ($borrowernumber) = shift or return undef; +sub getnextacctno { + my ($borrowernumber) = shift or return; my $sth = C4::Context->dbh->prepare( "SELECT accountno+1 FROM accountlines - WHERE (borrowernumber = ?) - ORDER BY accountno DESC - LIMIT 1" + WHERE (borrowernumber = ?) + ORDER BY accountno DESC + LIMIT 1" ); $sth->execute($borrowernumber); return ($sth->fetchrow || 1); } -=head2 fixaccounts (removed) +=head2 chargelostitem - &fixaccounts($borrowernumber, $accountnumber, $amount); +In a default install of Koha the following lost values are set +1 = Lost +2 = Long overdue +3 = Lost and paid for -#' -# FIXME - I don't understand what this function does. -sub fixaccounts { - my ( $borrowernumber, $accountno, $amount ) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare( - "SELECT * FROM accountlines WHERE borrowernumber=? - AND accountno=?" - ); - $sth->execute( $borrowernumber, $accountno ); - my $data = $sth->fetchrow_hashref; - - # FIXME - Error-checking - my $diff = $amount - $data->{'amount'}; - my $outstanding = $data->{'amountoutstanding'} + $diff; - $sth->finish; - - $dbh->do(<dbh(); my ($borrowernumber, $itemnumber, $amount, $description) = @_; + my $itype = Koha::ItemTypes->find({ itemtype => Koha::Items->find($itemnumber)->effective_itemtype() }); + my $replacementprice = $amount; + my $defaultreplacecost = $itype->defaultreplacecost; + my $processfee = $itype->processfee; + my $usedefaultreplacementcost = C4::Context->preference("useDefaultReplacementCost"); + my $processingfeenote = C4::Context->preference("ProcessingFeeNote"); + if ($usedefaultreplacementcost && $amount == 0 && $defaultreplacecost){ + $replacementprice = $defaultreplacecost; + } + + my $branchcode = C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef; # first make sure the borrower hasn't already been charged for this item - my $sth1=$dbh->prepare("SELECT * from accountlines - WHERE borrowernumber=? AND itemnumber=? and accounttype='L'"); - $sth1->execute($borrowernumber,$itemnumber); - my $existing_charge_hashref=$sth1->fetchrow_hashref(); + # FIXME this should be more exact + # there is no reason a user can't lose an item, find and return it, and lost it again + my $existing_charges = Koha::Account::Lines->search( + { + borrowernumber => $borrowernumber, + itemnumber => $itemnumber, + accounttype => 'L', + } + )->count(); # OK, they haven't - unless ($existing_charge_hashref) { - my $manager_id = 0; - $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; - # This item is on issue ... add replacement cost to the borrower's record and mark it returned - # Note that we add this to the account even if there's no replacement price, allowing some other - # process (or person) to update it, since we don't handle any defaults for replacement prices. - my $accountno = getnextacctno($borrowernumber); - my $sth2=$dbh->prepare("INSERT INTO accountlines - (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber,manager_id) - VALUES (?,?,now(),?,?,'L',?,?,?)"); - $sth2->execute($borrowernumber,$accountno,$amount, - $description,$amount,$itemnumber,$manager_id); - $sth2->finish; - # FIXME: Log this ? + unless ($existing_charges) { + my $checkout = Koha::Checkouts->find({ itemnumber => $itemnumber }); + my $issue_id = $checkout ? $checkout->issue_id : undef; + #add processing fee + if ($processfee && $processfee > 0){ + my $accountline = Koha::Account::Line->new( + { + borrowernumber => $borrowernumber, + issue_id => $issue_id, + accountno => getnextacctno($borrowernumber), + date => \'NOW()', + amount => $processfee, + description => $description, + accounttype => 'PF', + amountoutstanding => $processfee, + itemnumber => $itemnumber, + note => $processingfeenote, + manager_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : 0, + branchcode => $branchcode, + } + )->store(); + + my $account_offset = Koha::Account::Offset->new( + { + debit_id => $accountline->id, + type => 'Processing Fee', + amount => $accountline->amount, + } + )->store(); + + if ( C4::Context->preference("FinesLog") ) { + logaction("FINES", 'CREATE',$borrowernumber,Dumper({ + action => 'create_fee', + borrowernumber => $accountline->borrowernumber,, + accountno => $accountline->accountno, + amount => $accountline->amount, + description => $accountline->description, + accounttype => $accountline->accounttype, + amountoutstanding => $accountline->amountoutstanding, + note => $accountline->note, + itemnumber => $accountline->itemnumber, + manager_id => $accountline->manager_id, + })); + } + } + #add replace cost + if ($replacementprice > 0){ + my $accountline = Koha::Account::Line->new( + { + borrowernumber => $borrowernumber, + issue_id => $issue_id, + accountno => getnextacctno($borrowernumber), + date => \'NOW()', + amount => $replacementprice, + description => $description, + accounttype => 'L', + amountoutstanding => $replacementprice, + itemnumber => $itemnumber, + manager_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : 0, + branchcode => $branchcode, + } + )->store(); + + my $account_offset = Koha::Account::Offset->new( + { + debit_id => $accountline->id, + type => 'Lost Item', + amount => $accountline->amount, + } + )->store(); + + if ( C4::Context->preference("FinesLog") ) { + logaction("FINES", 'CREATE',$borrowernumber,Dumper({ + action => 'create_fee', + borrowernumber => $accountline->borrowernumber,, + accountno => $accountline->accountno, + amount => $accountline->amount, + description => $accountline->description, + accounttype => $accountline->accounttype, + amountoutstanding => $accountline->amountoutstanding, + note => $accountline->note, + itemnumber => $accountline->itemnumber, + manager_id => $accountline->manager_id, + })); + } + } } } @@ -335,7 +227,7 @@ should be the empty string. #' # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function -# are : +# are: # 'C' = CREDIT # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere) # 'N' = New Card fee @@ -350,470 +242,91 @@ sub manualinvoice { my $manager_id = 0; $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; my $dbh = C4::Context->dbh; - my $notifyid = 0; my $insert; my $accountno = getnextacctno($borrowernumber); my $amountleft = $amount; -# if ( $type eq 'CS' -# || $type eq 'CB' -# || $type eq 'CW' -# || $type eq 'CF' -# || $type eq 'CL' ) -# { -# my $amount2 = $amount * -1; # FIXME - $amount2 = -$amount -# $amountleft = -# fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user ); -# } - if ( $type eq 'N' ) { - $desc .= " New Card"; - } - if ( $type eq 'F' ) { - $desc .= " Fine"; - } - if ( $type eq 'A' ) { - $desc .= " Account Management fee"; - } - if ( $type eq 'M' ) { - $desc .= " Sundry"; - } - - if ( $type eq 'L' && $desc eq '' ) { - - $desc = " Lost Item"; - } -# if ( $type eq 'REF' ) { -# $desc .= " Cash Refund"; -# $amountleft = refund( '', $borrowernumber, $amount ); -# } - if ( ( $type eq 'L' ) - or ( $type eq 'F' ) - or ( $type eq 'A' ) - or ( $type eq 'N' ) - or ( $type eq 'M' ) ) - { - $notifyid = 1; - } - - if ( $itemnum ) { - $desc .= ' ' . $itemnum; - my $sth = $dbh->prepare( - 'INSERT INTO accountlines - (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id) - VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)'); - $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr; - } else { - my $sth=$dbh->prepare("INSERT INTO accountlines - (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id) - VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)" - ); - $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type, - $amountleft, $notifyid, $note, $manager_id ); - } - return 0; -} - -=head2 fixcredit #### DEPRECATED - - $amountleft = &fixcredit($borrowernumber, $data, $barcode, $type, $user); - - This function is only used internally, not exported. - -=cut - -# This function is deprecated in 3.0 - -sub fixcredit { - - #here we update both the accountoffsets and the account lines - my ( $borrowernumber, $data, $barcode, $type, $user ) = @_; - my $dbh = C4::Context->dbh; - my $newamtos = 0; - my $accdata = ""; - my $amountleft = $data; - if ( $barcode ne '' ) { - my $item = GetBiblioFromItemNumber( '', $barcode ); - my $nextaccntno = getnextacctno($borrowernumber); - my $query = "SELECT * FROM accountlines WHERE (borrowernumber=? - AND itemnumber=? AND amountoutstanding > 0)"; - if ( $type eq 'CL' ) { - $query .= " AND (accounttype = 'L' OR accounttype = 'Rep')"; - } - elsif ( $type eq 'CF' ) { - $query .= " AND (accounttype = 'F' OR accounttype = 'FU' OR - accounttype='Res' OR accounttype='Rent')"; - } - elsif ( $type eq 'CB' ) { - $query .= " and accounttype='A'"; + my $branchcode = C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef; + + my $accountline = Koha::Account::Line->new( + { + borrowernumber => $borrowernumber, + accountno => $accountno, + date => \'NOW()', + amount => $amount, + description => $desc, + accounttype => $type, + amountoutstanding => $amountleft, + itemnumber => $itemnum || undef, + note => $note, + manager_id => $manager_id, + branchcode => $branchcode, } + )->store(); - # print $query; - my $sth = $dbh->prepare($query); - $sth->execute( $borrowernumber, $item->{'itemnumber'} ); - $accdata = $sth->fetchrow_hashref; - $sth->finish; - if ( $accdata->{'amountoutstanding'} < $amountleft ) { - $newamtos = 0; - $amountleft -= $accdata->{'amountoutstanding'}; + my $account_offset = Koha::Account::Offset->new( + { + debit_id => $accountline->id, + type => 'Manual Debit', + amount => $amount, } - 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, $borrowernumber, $thisacct ); - $usth->finish; - $usth = $dbh->prepare( - "INSERT INTO accountoffsets - (borrowernumber, accountno, offsetaccount, offsetamount) - VALUES (?,?,?,?)" - ); - $usth->execute( $borrowernumber, $accdata->{'accountno'}, - $nextaccntno, $newamtos ); - $usth->finish; + )->store(); + + if ( C4::Context->preference("FinesLog") ) { + logaction("FINES", 'CREATE',$borrowernumber,Dumper({ + action => 'create_fee', + borrowernumber => $borrowernumber, + accountno => $accountno, + amount => $amount, + description => $desc, + accounttype => $type, + amountoutstanding => $amountleft, + note => $note, + itemnumber => $itemnum, + manager_id => $manager_id, + })); } - # begin transaction - my $nextaccntno = getnextacctno($borrowernumber); - - # get lines with outstanding amounts to offset - my $sth = $dbh->prepare( - "SELECT * FROM accountlines - WHERE (borrowernumber = ?) AND (amountoutstanding >0) - ORDER BY date" - ); - $sth->execute($borrowernumber); - - # print $query; - # offset transactions - while ( ( $accdata = $sth->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, $borrowernumber, $thisacct ); - $usth->finish; - $usth = $dbh->prepare( - "INSERT INTO accountoffsets - (borrowernumber, accountno, offsetaccount, offsetamount) - VALUE (?,?,?,?)" - ); - $usth->execute( $borrowernumber, $accdata->{'accountno'}, - $nextaccntno, $newamtos ); - $usth->finish; - } - $sth->finish; - $type = "Credit " . $type; - UpdateStats( $user, $type, $data, $user, '', '', $borrowernumber ); - $amountleft *= -1; - return ($amountleft); - -} - -=head2 refund - -#FIXME : DEPRECATED SUB - This subroutine tracks payments and/or credits against fines/charges - using the accountoffsets table, which is not used consistently in - Koha's fines management, and so is not used in 3.0 - -=cut - -sub refund { - - #here we update both the accountoffsets and the account lines - my ( $borrowernumber, $data ) = @_; - my $dbh = C4::Context->dbh; - my $newamtos = 0; - my $accdata = ""; - my $amountleft = $data * -1; - - # begin transaction - my $nextaccntno = getnextacctno($borrowernumber); - - # get lines with outstanding amounts to offset - my $sth = $dbh->prepare( - "SELECT * FROM accountlines - WHERE (borrowernumber = ?) AND (amountoutstanding<0) - ORDER BY date" - ); - $sth->execute($borrowernumber); - - # print $amountleft; - # offset transactions - while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) { - if ( $accdata->{'amountoutstanding'} > $amountleft ) { - $newamtos = 0; - $amountleft -= $accdata->{'amountoutstanding'}; - } - else { - $newamtos = $accdata->{'amountoutstanding'} - $amountleft; - $amountleft = 0; - } - - # print $amountleft; - my $thisacct = $accdata->{accountno}; - my $usth = $dbh->prepare( - "UPDATE accountlines SET amountoutstanding= ? - WHERE (borrowernumber = ?) AND (accountno=?)" - ); - $usth->execute( $newamtos, $borrowernumber, $thisacct ); - $usth->finish; - $usth = $dbh->prepare( - "INSERT INTO accountoffsets - (borrowernumber, accountno, offsetaccount, offsetamount) - VALUES (?,?,?,?)" - ); - $usth->execute( $borrowernumber, $accdata->{'accountno'}, - $nextaccntno, $newamtos ); - $usth->finish; - } - $sth->finish; - return ($amountleft); -} - -sub getcharges { - my ( $borrowerno, $timestamp, $accountno ) = @_; - my $dbh = C4::Context->dbh; - my $timestamp2 = $timestamp - 1; - my $query = ""; - my $sth = $dbh->prepare( - "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?" - ); - $sth->execute( $borrowerno, $accountno ); - - my @results; - while ( my $data = $sth->fetchrow_hashref ) { - push @results,$data; - } - return (@results); -} - -sub ModNote { - my ( $borrowernumber, $accountno, $note ) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE borrowernumber = ? AND accountno = ?'); - $sth->execute( $note, $borrowernumber, $accountno ); -} - -sub getcredits { - my ( $date, $date2 ) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare( - "SELECT * FROM accountlines,borrowers - WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber - AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)" - ); - - $sth->execute( $date, $date2 ); - my @results; - while ( my $data = $sth->fetchrow_hashref ) { - $data->{'date'} = $data->{'timestamp'}; - push @results,$data; - } - return (@results); -} - - -sub getrefunds { - my ( $date, $date2 ) = @_; - my $dbh = C4::Context->dbh; - - my $sth = $dbh->prepare( - "SELECT *,timestamp AS datetime - FROM accountlines,borrowers - WHERE (accounttype = 'REF' - AND accountlines.borrowernumber = borrowers.borrowernumber - AND date >=? AND date execute( $date, $date2 ); - - my @results; - while ( my $data = $sth->fetchrow_hashref ) { - push @results,$data; - - } - return (@results); + return 0; } -sub ReversePayment { - my ( $borrowernumber, $accountno ) = @_; - my $dbh = C4::Context->dbh; - - my $sth = $dbh->prepare('SELECT amountoutstanding FROM accountlines WHERE borrowernumber = ? AND accountno = ?'); - $sth->execute( $borrowernumber, $accountno ); - my $row = $sth->fetchrow_hashref(); - my $amount_outstanding = $row->{'amountoutstanding'}; - - if ( $amount_outstanding <= 0 ) { - $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?'); - $sth->execute( $borrowernumber, $accountno ); - } else { - $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?'); - $sth->execute( $borrowernumber, $accountno ); - } -} +=head2 purge_zero_balance_fees -=head2 recordpayment_selectaccts + purge_zero_balance_fees( $days ); - recordpayment_selectaccts($borrowernumber, $payment,$accts); +Delete accountlines entries where amountoutstanding is 0 or NULL which are more than a given number of days old. -Record payment by a patron. C<$borrowernumber> is the patron's -borrower number. C<$payment> is a floating-point number, giving the -amount that was paid. C<$accts> is an array ref to a list of -accountnos which the payment can be recorded against +B<$days> -- Zero balance fees older than B<$days> days old will be deleted. -Amounts owed are paid off oldest first. That is, if the patron has a -$1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment -of $1.50, then the oldest fine will be paid off in full, and $0.50 -will be credited to the next one. +B Because fines and payments are not linked in accountlines, it is +possible for a fine to be deleted without the accompanying payment, +or vise versa. This won't affect the account balance, but might be +confusing to staff. =cut -sub recordpayment_selectaccts { - my ( $borrowernumber, $amount, $accts ) = @_; - - my $dbh = C4::Context->dbh; - my $newamtos = 0; - my $accdata = q{}; - my $branch = C4::Context->userenv->{branch}; - my $amountleft = $amount; - my $manager_id = 0; - $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; - my $sql = 'SELECT * FROM accountlines WHERE (borrowernumber = ?) ' . - 'AND (amountoutstanding<>0) '; - if (@{$accts} ) { - $sql .= ' AND accountno IN ( ' . join ',', @{$accts}; - $sql .= ' ) '; - } - $sql .= ' ORDER BY date'; - # begin transaction - my $nextaccntno = getnextacctno($borrowernumber); - - # get lines with outstanding amounts to offset - my $rows = $dbh->selectall_arrayref($sql, { Slice => {} }, $borrowernumber); - - # offset transactions - my $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding= ? ' . - 'WHERE (borrowernumber = ?) AND (accountno=?)'); - for my $accdata ( @{$rows} ) { - if ($amountleft == 0) { - last; - } - if ( $accdata->{amountoutstanding} < $amountleft ) { - $newamtos = 0; - $amountleft -= $accdata->{amountoutstanding}; - } - else { - $newamtos = $accdata->{amountoutstanding} - $amountleft; - $amountleft = 0; - } - my $thisacct = $accdata->{accountno}; - $sth->execute( $newamtos, $borrowernumber, $thisacct ); - } - - # create new line - $sql = 'INSERT INTO accountlines ' . - '(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id) ' . - q|VALUES (?,?,now(),?,'Payment,thanks','Pay',?,?)|; - $dbh->do($sql,{},$borrowernumber, $nextaccntno, 0 - $amount, 0 - $amountleft, $manager_id ); - UpdateStats( $branch, 'payment', $amount, '', '', '', $borrowernumber, $nextaccntno ); - return; -} +sub purge_zero_balance_fees { + my $days = shift; + my $count = 0; -# makepayment needs to be fixed to handle partials till then this separate subroutine -# fills in -sub makepartialpayment { - my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_; - my $manager_id = 0; - $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; - if (!$amount || $amount < 0) { - return; - } my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( + q{ + DELETE a1 FROM accountlines a1 - my $nextaccntno = getnextacctno($borrowernumber); - my $newamtos = 0; - - my $data = $dbh->selectrow_hashref( - 'SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?',undef,$borrowernumber,$accountno); - my $new_outstanding = $data->{amountoutstanding} - $amount; - - my $update = 'UPDATE accountlines SET amountoutstanding = ? WHERE borrowernumber = ? ' - . ' AND accountno = ?'; - $dbh->do( $update, undef, $new_outstanding, $borrowernumber, $accountno); - - # create new line - my $insert = 'INSERT INTO accountlines (borrowernumber, accountno, date, amount, ' - . 'description, accounttype, amountoutstanding, itemnumber, manager_id) ' - . ' VALUES (?, ?, now(), ?, ?, ?, 0, ?, ?)'; - - $dbh->do( $insert, undef, $borrowernumber, $nextaccntno, $amount, - "Payment, thanks - $user", 'Pay', $data->{'itemnumber'}, $manager_id); - - UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber, $accountno ); - - return; -} - -=head2 WriteOff - - WriteOff( $borrowernumber, $accountnum, $itemnum, $accounttype, $amount, $branch ); - -Write off a fine for a patron. -C<$borrowernumber> is the patron's borrower number. -C<$accountnum> is the accountnumber of the fee to write off. -C<$itemnum> is the itemnumber of of item whose fine is being written off. -C<$accounttype> is the account type of the fine being written off. -C<$amount> is a floating-point number, giving the amount that is being written off. -C<$branch> is the branchcode of the library where the writeoff occurred. - -=cut - -sub WriteOffFee { - my ( $borrowernumber, $accountnum, $itemnum, $accounttype, $amount, $branch ) = @_; - $branch ||= C4::Context->userenv->{branch}; - my $manager_id = 0; - $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; - - # if no item is attached to fine, make sure to store it as a NULL - $itemnum ||= undef; - - my ( $sth, $query ); - my $dbh = C4::Context->dbh(); - - $query = " - UPDATE accountlines SET amountoutstanding = 0 - WHERE accountno = ? AND borrowernumber = ? - "; - $sth = $dbh->prepare( $query ); - $sth->execute( $accountnum, $borrowernumber ); - - $query =" - INSERT INTO accountlines - ( borrowernumber, accountno, itemnumber, date, amount, description, accounttype, manager_id ) - VALUES ( ?, ?, ?, NOW(), ?, 'Writeoff', 'W', ? ) - "; - $sth = $dbh->prepare( $query ); - my $acct = getnextacctno($borrowernumber); - $sth->execute( $borrowernumber, $acct, $itemnum, $amount, $manager_id ); + LEFT JOIN account_offsets credit_offset ON ( a1.accountlines_id = credit_offset.credit_id ) + LEFT JOIN accountlines a2 ON ( credit_offset.debit_id = a2.accountlines_id ) - UpdateStats( $branch, 'writeoff', $amount, q{}, q{}, q{}, $borrowernumber ); + LEFT JOIN account_offsets debit_offset ON ( a1.accountlines_id = debit_offset.debit_id ) + LEFT JOIN accountlines a3 ON ( debit_offset.credit_id = a3.accountlines_id ) + WHERE a1.date < date_sub(curdate(), INTERVAL ? DAY) + AND ( a1.amountoutstanding = 0 OR a1.amountoutstanding IS NULL ) + AND ( a2.amountoutstanding = 0 OR a2.amountoutstanding IS NULL ) + AND ( a3.amountoutstanding = 0 OR a3.amountoutstanding IS NULL ) + } + ); + $sth->execute($days) or die $dbh->errstr; } END { } # module clean-up code here (global destructor)