X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FAccounts.pm;h=3942c39e2a434a7cfbc392403a4412a62c44b55e;hb=4cc79c77c904e9a8e5ff35ca872b7673b3c005c9;hp=fa1ef770f92dab70227186fa0fa2d328c72ff058;hpb=c8e99f313fe19dea6b11ed5fc05231e86283edf7;p=koha.git diff --git a/C4/Accounts.pm b/C4/Accounts.pm index fa1ef770f9..3942c39e2a 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; @@ -25,31 +25,27 @@ use C4::Stats; use C4::Members; use C4::Circulation qw(ReturnLostItem); use C4::Log qw(logaction); +use Koha::Account; +use Koha::Account::Lines; use Data::Dumper qw(Dumper); -use vars qw($VERSION @ISA @EXPORT); +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 - &getcharges - &ModNote - &getcredits - &getrefunds - &chargelostitem - &ReversePayment - &makepartialpayment - &recordpayment_selectaccts - &WriteOffFee - ); + require Exporter; + @ISA = qw(Exporter); + @EXPORT = qw( + &manualinvoice + &getnextacctno + &getcharges + &ModNote + &getcredits + &getrefunds + &chargelostitem + &ReversePayment + &purge_zero_balance_fees + ); } =head1 NAME @@ -68,223 +64,6 @@ patron. =head1 FUNCTIONS -=head2 recordpayment - - &recordpayment($borrowernumber, $payment, $sip_paytype); - -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<$sip_paytype> is an optional flag to indicate this -payment was made over a SIP2 interface, rather than the staff client. The -value passed is the SIP2 payment type value (message 37, characters 21-22) - -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, $sip_paytype ) = @_; - 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 - my @ids; - 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->{accountlines_id}; - my $usth = $dbh->prepare( - "UPDATE accountlines SET amountoutstanding= ? - WHERE (accountlines_id = ?)" - ); - $usth->execute( $newamtos, $thisacct ); - - if ( C4::Context->preference("FinesLog") ) { - $accdata->{'amountoutstanding_new'} = $newamtos; - logaction("FINES", 'MODIFY', $borrowernumber, Dumper({ - action => 'fee_payment', - borrowernumber => $accdata->{'borrowernumber'}, - old_amountoutstanding => $accdata->{'amountoutstanding'}, - new_amountoutstanding => $newamtos, - amount_paid => $accdata->{'amountoutstanding'} - $newamtos, - accountlines_id => $accdata->{'accountlines_id'}, - accountno => $accdata->{'accountno'}, - manager_id => $manager_id, - })); - push( @ids, $accdata->{'accountlines_id'} ); - } - } - - # create new line - my $usth = $dbh->prepare( - "INSERT INTO accountlines - (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id) - VALUES (?,?,now(),?,'Payment,thanks','Pay',?,?)" - ); - - my $payment_description = "Payment, thanks"; - $payment_description .= " (via SIP2)" if defined $sip_paytype; - my $paytype = "Pay"; - $paytype .= "-$sip_paytype" if defined $sip_paytype; - $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, $payment_description, $paytype, 0 - $amountleft, $manager_id ); - $usth->finish; - - UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno ); - - if ( C4::Context->preference("FinesLog") ) { - $accdata->{'amountoutstanding_new'} = $newamtos; - logaction("FINES", 'CREATE',$borrowernumber,Dumper({ - action => 'create_payment', - borrowernumber => $borrowernumber, - accountno => $nextaccntno, - amount => $data * -1, - amountoutstanding => $amountleft * -1, - accounttype => 'Pay', - accountlines_paid => \@ids, - manager_id => $manager_id, - })); - } - -} - -=head2 makepayment - - &makepayment($accountlines_id, $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 ( $accountlines_id, $borrowernumber, $accountno, $amount, $user, $branch, $payment_note ) = @_; - 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 accountlines_id=?"); - $sth->execute( $accountlines_id ); - my $data = $sth->fetchrow_hashref; - - my $payment; - if ( $data->{'accounttype'} eq "Pay" ){ - my $udp = - $dbh->prepare( - "UPDATE accountlines - SET amountoutstanding = 0 - WHERE accountlines_id = ? - " - ); - $udp->execute($accountlines_id); - }else{ - my $udp = - $dbh->prepare( - "UPDATE accountlines - SET amountoutstanding = 0 - WHERE accountlines_id = ? - " - ); - $udp->execute($accountlines_id); - - # create new line - my $payment = 0 - $amount; - $payment_note //= ""; - - my $ins = - $dbh->prepare( - "INSERT - INTO accountlines (borrowernumber, accountno, date, amount, itemnumber, description, accounttype, amountoutstanding, manager_id, note) - VALUES ( ?, ?, now(), ?, ?, '', 'Pay', 0, ?, ?)" - ); - $ins->execute($borrowernumber, $nextaccntno, $payment, $data->{'itemnumber'}, $manager_id, $payment_note); - } - - if ( C4::Context->preference("FinesLog") ) { - logaction("FINES", 'MODIFY', $borrowernumber, Dumper({ - action => 'fee_payment', - borrowernumber => $borrowernumber, - old_amountoutstanding => $data->{'amountoutstanding'}, - new_amountoutstanding => 0, - amount_paid => $data->{'amountoutstanding'}, - accountlines_id => $data->{'accountlines_id'}, - accountno => $data->{'accountno'}, - manager_id => $manager_id, - })); - - - logaction("FINES", 'CREATE',$borrowernumber,Dumper({ - action => 'create_payment', - borrowernumber => $borrowernumber, - accountno => $nextaccntno, - amount => $payment, - amountoutstanding => 0,, - accounttype => 'Pay', - accountlines_paid => [$data->{'accountlines_id'}], - manager_id => $manager_id, - })); - } - - - # 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 ); - - #check to see what accounttype - if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) { - C4::Circulation::ReturnLostItem( $borrowernumber, $data->{'itemnumber'} ); - } - my $sthr = $dbh->prepare("SELECT max(accountlines_id) AS lastinsertid FROM accountlines"); - $sthr->execute(); - my $datalastinsertid = $sthr->fetchrow_hashref; - return $datalastinsertid->{'lastinsertid'}; -} - =head2 getnextacctno $nextacct = &getnextacctno($borrowernumber); @@ -570,233 +349,34 @@ sub ReversePayment { } -=head2 recordpayment_selectaccts - - recordpayment_selectaccts($borrowernumber, $payment,$accts); +=head2 purge_zero_balance_fees -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 + purge_zero_balance_fees( $days ); -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 +Delete accountlines entries where amountoutstanding is 0 or NULL which are more than a given number of days old. -sub recordpayment_selectaccts { - my ( $borrowernumber, $amount, $accts, $note ) = @_; +B<$days> -- Zero balance fees older than B<$days> days old will be deleted. - 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 accountlines_id=?'); - - my @ids; - 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->{accountlines_id}; - $sth->execute( $newamtos, $thisacct ); - - if ( C4::Context->preference("FinesLog") ) { - logaction("FINES", 'MODIFY', $borrowernumber, Dumper({ - action => 'fee_payment', - borrowernumber => $borrowernumber, - old_amountoutstanding => $accdata->{'amountoutstanding'}, - new_amountoutstanding => $newamtos, - amount_paid => $accdata->{'amountoutstanding'} - $newamtos, - accountlines_id => $accdata->{'accountlines_id'}, - accountno => $accdata->{'accountno'}, - manager_id => $manager_id, - })); - push( @ids, $accdata->{'accountlines_id'} ); - } - - } - - # create new line - $sql = 'INSERT INTO accountlines ' . - '(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id,note) ' . - q|VALUES (?,?,now(),?,'','Pay',?,?,?)|; - $dbh->do($sql,{},$borrowernumber, $nextaccntno, 0 - $amount, 0 - $amountleft, $manager_id, $note ); - UpdateStats( $branch, 'payment', $amount, '', '', '', $borrowernumber, $nextaccntno ); - - if ( C4::Context->preference("FinesLog") ) { - logaction("FINES", 'CREATE',$borrowernumber,Dumper({ - action => 'create_payment', - borrowernumber => $borrowernumber, - accountno => $nextaccntno, - amount => 0 - $amount, - amountoutstanding => 0 - $amountleft, - accounttype => 'Pay', - accountlines_paid => \@ids, - manager_id => $manager_id, - })); - } - - return; -} - -# makepayment needs to be fixed to handle partials till then this separate subroutine -# fills in -sub makepartialpayment { - my ( $accountlines_id, $borrowernumber, $accountno, $amount, $user, $branch, $payment_note ) = @_; - my $manager_id = 0; - $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; - if (!$amount || $amount < 0) { - return; - } - $payment_note //= ""; - my $dbh = C4::Context->dbh; - - my $nextaccntno = getnextacctno($borrowernumber); - my $newamtos = 0; - - my $data = $dbh->selectrow_hashref( - 'SELECT * FROM accountlines WHERE accountlines_id=?',undef,$accountlines_id); - my $new_outstanding = $data->{amountoutstanding} - $amount; - - my $update = 'UPDATE accountlines SET amountoutstanding = ? WHERE accountlines_id = ? '; - $dbh->do( $update, undef, $new_outstanding, $accountlines_id); - - if ( C4::Context->preference("FinesLog") ) { - logaction("FINES", 'MODIFY', $borrowernumber, Dumper({ - action => 'fee_payment', - borrowernumber => $borrowernumber, - old_amountoutstanding => $data->{'amountoutstanding'}, - new_amountoutstanding => $new_outstanding, - amount_paid => $data->{'amountoutstanding'} - $new_outstanding, - accountlines_id => $data->{'accountlines_id'}, - accountno => $data->{'accountno'}, - manager_id => $manager_id, - })); - } - - # create new line - my $insert = 'INSERT INTO accountlines (borrowernumber, accountno, date, amount, ' - . 'description, accounttype, amountoutstanding, itemnumber, manager_id, note) ' - . ' VALUES (?, ?, now(), ?, ?, ?, 0, ?, ?, ?)'; - - $dbh->do( $insert, undef, $borrowernumber, $nextaccntno, $amount, - "Payment, thanks - $user", 'Pay', $data->{'itemnumber'}, $manager_id, $payment_note); - - UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber, $accountno ); - - if ( C4::Context->preference("FinesLog") ) { - logaction("FINES", 'CREATE',$borrowernumber,Dumper({ - action => 'create_payment', - borrowernumber => $user, - accountno => $nextaccntno, - amount => 0 - $amount, - accounttype => 'Pay', - itemnumber => $data->{'itemnumber'}, - accountlines_paid => [ $data->{'accountlines_id'} ], - manager_id => $manager_id, - })); - } - - return; -} - -=head2 WriteOffFee - - WriteOffFee( $borrowernumber, $accountline_id, $itemnum, $accounttype, $amount, $branch, $payment_note ); - -Write off a fine for a patron. -C<$borrowernumber> is the patron's borrower number. -C<$accountline_id> is the accountline_id 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. -C<$payment_note> is the note to attach to this payment +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 WriteOffFee { - my ( $borrowernumber, $accountlines_id, $itemnum, $accounttype, $amount, $branch, $payment_note ) = @_; - $payment_note //= ""; - $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 accountlines_id = ? AND borrowernumber = ? - "; - $sth = $dbh->prepare( $query ); - $sth->execute( $accountlines_id, $borrowernumber ); - - if ( C4::Context->preference("FinesLog") ) { - logaction("FINES", 'MODIFY', $borrowernumber, Dumper({ - action => 'fee_writeoff', - borrowernumber => $borrowernumber, - accountlines_id => $accountlines_id, - manager_id => $manager_id, - })); - } - - $query =" - INSERT INTO accountlines - ( borrowernumber, accountno, itemnumber, date, amount, description, accounttype, manager_id, note ) - VALUES ( ?, ?, ?, NOW(), ?, 'Writeoff', 'W', ?, ? ) - "; - $sth = $dbh->prepare( $query ); - my $acct = getnextacctno($borrowernumber); - $sth->execute( $borrowernumber, $acct, $itemnum, $amount, $manager_id, $payment_note ); - - if ( C4::Context->preference("FinesLog") ) { - logaction("FINES", 'CREATE',$borrowernumber,Dumper({ - action => 'create_writeoff', - borrowernumber => $borrowernumber, - accountno => $acct, - amount => 0 - $amount, - accounttype => 'W', - itemnumber => $itemnum, - accountlines_paid => [ $accountlines_id ], - manager_id => $manager_id, - })); - } - - UpdateStats( $branch, 'writeoff', $amount, q{}, q{}, q{}, $borrowernumber ); +sub purge_zero_balance_fees { + my $days = shift; + my $count = 0; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( + q{ + DELETE FROM accountlines + WHERE date < date_sub(curdate(), INTERVAL ? DAY) + AND ( amountoutstanding = 0 or amountoutstanding IS NULL ); + } + ); + $sth->execute($days) or die $dbh->errstr; } END { } # module clean-up code here (global destructor)