3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 #use warnings; FIXME - Bug 2505
26 use C4::Circulation qw(ReturnLostItem);
27 use C4::Log qw(logaction);
30 use Data::Dumper qw(Dumper);
32 use vars qw(@ISA @EXPORT);
49 &recordpayment_selectaccts
51 &purge_zero_balance_fees
57 C4::Accounts - Functions for dealing with Koha accounts
65 The functions in this module deal with the monetary aspect of Koha,
66 including looking up and modifying the amount of money owed by a
73 &recordpayment($borrowernumber, $payment, $sip_paytype, $note);
75 Record payment by a patron. C<$borrowernumber> is the patron's
76 borrower number. C<$payment> is a floating-point number, giving the
77 amount that was paid. C<$sip_paytype> is an optional flag to indicate this
78 payment was made over a SIP2 interface, rather than the staff client. The
79 value passed is the SIP2 payment type value (message 37, characters 21-22)
81 Amounts owed are paid off oldest first. That is, if the patron has a
82 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
83 of $1.50, then the oldest fine will be paid off in full, and $0.50
84 will be credited to the next one.
91 #here we update the account lines
92 my ( $borrowernumber, $data, $sip_paytype, $payment_note ) = @_;
94 return Koha::Account->new( { patron_id => $borrowernumber } )
95 ->pay( { amount => $data, sip => $sip_paytype, note => $payment_note } );
100 &makepayment($accountlines_id, $borrowernumber, $acctnumber, $amount, $branchcode);
102 Records the fact that a patron has paid off the entire amount he or
105 C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is
106 the account that was credited. C<$amount> is the amount paid (this is
107 only used to record the payment. It is assumed to be equal to the
108 amount owed). C<$branchcode> is the code of the branch where payment
114 # FIXME - I'm not at all sure about the above, because I don't
115 # understand what the acct* tables in the Koha database are for.
118 #here we update both the accountoffsets and the account lines
119 #updated to check, if they are paying off a lost item, we return the item
120 # from their card, and put a note on the item record
121 my ( $accountlines_id, $borrowernumber, $accountno, $amount, $user, $branch, $payment_note ) = @_;
122 my $dbh = C4::Context->dbh;
124 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
127 my $nextaccntno = getnextacctno($borrowernumber);
129 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE accountlines_id=?");
130 $sth->execute( $accountlines_id );
131 my $data = $sth->fetchrow_hashref;
134 if ( $data->{'accounttype'} eq "Pay" ){
138 SET amountoutstanding = 0
139 WHERE accountlines_id = ?
142 $udp->execute($accountlines_id);
147 SET amountoutstanding = 0
148 WHERE accountlines_id = ?
151 $udp->execute($accountlines_id);
154 my $payment = 0 - $amount;
155 $payment_note //= "";
160 INTO accountlines (borrowernumber, accountno, date, amount, itemnumber, description, accounttype, amountoutstanding, manager_id, note)
161 VALUES ( ?, ?, now(), ?, ?, '', 'Pay', 0, ?, ?)"
163 $ins->execute($borrowernumber, $nextaccntno, $payment, $data->{'itemnumber'}, $manager_id, $payment_note);
166 if ( C4::Context->preference("FinesLog") ) {
167 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
168 action => 'fee_payment',
169 borrowernumber => $borrowernumber,
170 old_amountoutstanding => $data->{'amountoutstanding'},
171 new_amountoutstanding => 0,
172 amount_paid => $data->{'amountoutstanding'},
173 accountlines_id => $data->{'accountlines_id'},
174 accountno => $data->{'accountno'},
175 manager_id => $manager_id,
179 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
180 action => 'create_payment',
181 borrowernumber => $borrowernumber,
182 accountno => $nextaccntno,
184 amountoutstanding => 0,,
185 accounttype => 'Pay',
186 accountlines_paid => [$data->{'accountlines_id'}],
187 manager_id => $manager_id,
195 borrowernumber => $borrowernumber,
196 accountno => $accountno
199 #check to see what accounttype
200 if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
201 C4::Circulation::ReturnLostItem( $borrowernumber, $data->{'itemnumber'} );
203 my $sthr = $dbh->prepare("SELECT max(accountlines_id) AS lastinsertid FROM accountlines");
205 my $datalastinsertid = $sthr->fetchrow_hashref;
206 return $datalastinsertid->{'lastinsertid'};
211 $nextacct = &getnextacctno($borrowernumber);
213 Returns the next unused account number for the patron with the given
219 # FIXME - Okay, so what does the above actually _mean_?
221 my ($borrowernumber) = shift or return;
222 my $sth = C4::Context->dbh->prepare(
223 "SELECT accountno+1 FROM accountlines
224 WHERE (borrowernumber = ?)
225 ORDER BY accountno DESC
228 $sth->execute($borrowernumber);
229 return ($sth->fetchrow || 1);
232 =head2 fixaccounts (removed)
234 &fixaccounts($accountlines_id, $borrowernumber, $accountnumber, $amount);
237 # FIXME - I don't understand what this function does.
239 my ( $accountlines_id, $borrowernumber, $accountno, $amount ) = @_;
240 my $dbh = C4::Context->dbh;
241 my $sth = $dbh->prepare(
242 "SELECT * FROM accountlines WHERE accountlines_id=?"
244 $sth->execute( $accountlines_id );
245 my $data = $sth->fetchrow_hashref;
247 # FIXME - Error-checking
248 my $diff = $amount - $data->{'amount'};
249 my $outstanding = $data->{'amountoutstanding'} + $diff;
254 SET amount = '$amount',
255 amountoutstanding = '$outstanding'
256 WHERE accountlines_id = $accountlines_id
258 # FIXME: exceedingly bad form. Use prepare with placholders ("?") in query and execute args.
264 # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for
265 # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that
266 # a charge has been added
267 # FIXME : if no replacement price, borrower just doesn't get charged?
268 my $dbh = C4::Context->dbh();
269 my ($borrowernumber, $itemnumber, $amount, $description) = @_;
271 # first make sure the borrower hasn't already been charged for this item
272 my $sth1=$dbh->prepare("SELECT * from accountlines
273 WHERE borrowernumber=? AND itemnumber=? and accounttype='L'");
274 $sth1->execute($borrowernumber,$itemnumber);
275 my $existing_charge_hashref=$sth1->fetchrow_hashref();
278 unless ($existing_charge_hashref) {
280 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
281 # This item is on issue ... add replacement cost to the borrower's record and mark it returned
282 # Note that we add this to the account even if there's no replacement price, allowing some other
283 # process (or person) to update it, since we don't handle any defaults for replacement prices.
284 my $accountno = getnextacctno($borrowernumber);
285 my $sth2=$dbh->prepare("INSERT INTO accountlines
286 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber,manager_id)
287 VALUES (?,?,now(),?,?,'L',?,?,?)");
288 $sth2->execute($borrowernumber,$accountno,$amount,
289 $description,$amount,$itemnumber,$manager_id);
291 if ( C4::Context->preference("FinesLog") ) {
292 logaction("FINES", 'CREATE', $borrowernumber, Dumper({
293 action => 'create_fee',
294 borrowernumber => $borrowernumber,
295 accountno => $accountno,
297 amountoutstanding => $amount,
298 description => $description,
300 itemnumber => $itemnumber,
301 manager_id => $manager_id,
310 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
313 C<$borrowernumber> is the patron's borrower number.
314 C<$description> is a description of the transaction.
315 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
317 C<$itemnumber> is the item involved, if pertinent; otherwise, it
318 should be the empty string.
323 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
326 # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
329 # 'A' = Account Management fee
335 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_;
337 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
338 my $dbh = C4::Context->dbh;
341 my $accountno = getnextacctno($borrowernumber);
342 my $amountleft = $amount;
344 if ( ( $type eq 'L' )
348 or ( $type eq 'M' ) )
354 $desc .= ' ' . $itemnum;
355 my $sth = $dbh->prepare(
356 'INSERT INTO accountlines
357 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id)
358 VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)');
359 $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr;
361 my $sth=$dbh->prepare("INSERT INTO accountlines
362 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id)
363 VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)"
365 $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
366 $amountleft, $notifyid, $note, $manager_id );
369 if ( C4::Context->preference("FinesLog") ) {
370 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
371 action => 'create_fee',
372 borrowernumber => $borrowernumber,
373 accountno => $accountno,
375 description => $desc,
376 accounttype => $type,
377 amountoutstanding => $amountleft,
378 notify_id => $notifyid,
380 itemnumber => $itemnum,
381 manager_id => $manager_id,
389 my ( $borrowerno, $timestamp, $accountno ) = @_;
390 my $dbh = C4::Context->dbh;
391 my $timestamp2 = $timestamp - 1;
393 my $sth = $dbh->prepare(
394 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
396 $sth->execute( $borrowerno, $accountno );
399 while ( my $data = $sth->fetchrow_hashref ) {
406 my ( $accountlines_id, $note ) = @_;
407 my $dbh = C4::Context->dbh;
408 my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE accountlines_id = ?');
409 $sth->execute( $note, $accountlines_id );
413 my ( $date, $date2 ) = @_;
414 my $dbh = C4::Context->dbh;
415 my $sth = $dbh->prepare(
416 "SELECT * FROM accountlines,borrowers
417 WHERE amount < 0 AND accounttype not like 'Pay%' AND accountlines.borrowernumber = borrowers.borrowernumber
418 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
421 $sth->execute( $date, $date2 );
423 while ( my $data = $sth->fetchrow_hashref ) {
424 $data->{'date'} = $data->{'timestamp'};
432 my ( $date, $date2 ) = @_;
433 my $dbh = C4::Context->dbh;
435 my $sth = $dbh->prepare(
436 "SELECT *,timestamp AS datetime
437 FROM accountlines,borrowers
438 WHERE (accounttype = 'REF'
439 AND accountlines.borrowernumber = borrowers.borrowernumber
440 AND date >=? AND date <?)"
443 $sth->execute( $date, $date2 );
446 while ( my $data = $sth->fetchrow_hashref ) {
454 my ( $accountlines_id ) = @_;
455 my $dbh = C4::Context->dbh;
457 my $sth = $dbh->prepare('SELECT * FROM accountlines WHERE accountlines_id = ?');
458 $sth->execute( $accountlines_id );
459 my $row = $sth->fetchrow_hashref();
460 my $amount_outstanding = $row->{'amountoutstanding'};
462 if ( $amount_outstanding <= 0 ) {
463 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE accountlines_id = ?');
464 $sth->execute( $accountlines_id );
466 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE accountlines_id = ?');
467 $sth->execute( $accountlines_id );
470 if ( C4::Context->preference("FinesLog") ) {
472 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
474 if ( $amount_outstanding <= 0 ) {
475 $row->{'amountoutstanding'} *= -1;
477 $row->{'amountoutstanding'} = '0';
479 $row->{'description'} .= ' Reversed -';
480 logaction("FINES", 'MODIFY', $row->{'borrowernumber'}, Dumper({
481 action => 'reverse_fee_payment',
482 borrowernumber => $row->{'borrowernumber'},
483 old_amountoutstanding => $row->{'amountoutstanding'},
484 new_amountoutstanding => 0 - $amount_outstanding,,
485 accountlines_id => $row->{'accountlines_id'},
486 accountno => $row->{'accountno'},
487 manager_id => $manager_id,
494 =head2 recordpayment_selectaccts
496 recordpayment_selectaccts($borrowernumber, $payment,$accts);
498 Record payment by a patron. C<$borrowernumber> is the patron's
499 borrower number. C<$payment> is a floating-point number, giving the
500 amount that was paid. C<$accts> is an array ref to a list of
501 accountnos which the payment can be recorded against
503 Amounts owed are paid off oldest first. That is, if the patron has a
504 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
505 of $1.50, then the oldest fine will be paid off in full, and $0.50
506 will be credited to the next one.
510 sub recordpayment_selectaccts {
511 my ( $borrowernumber, $amount, $accts, $note ) = @_;
513 my $dbh = C4::Context->dbh;
516 my $branch = C4::Context->userenv->{branch};
517 my $amountleft = $amount;
519 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
520 my $sql = 'SELECT * FROM accountlines WHERE (borrowernumber = ?) ' .
521 'AND (amountoutstanding<>0) ';
523 $sql .= ' AND accountlines_id IN ( ' . join ',', @{$accts};
526 $sql .= ' ORDER BY date';
528 my $nextaccntno = getnextacctno($borrowernumber);
530 # get lines with outstanding amounts to offset
531 my $rows = $dbh->selectall_arrayref($sql, { Slice => {} }, $borrowernumber);
533 # offset transactions
534 my $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding= ? ' .
535 'WHERE accountlines_id=?');
538 for my $accdata ( @{$rows} ) {
539 if ($amountleft == 0) {
542 if ( $accdata->{amountoutstanding} < $amountleft ) {
544 $amountleft -= $accdata->{amountoutstanding};
547 $newamtos = $accdata->{amountoutstanding} - $amountleft;
550 my $thisacct = $accdata->{accountlines_id};
551 $sth->execute( $newamtos, $thisacct );
553 if ( C4::Context->preference("FinesLog") ) {
554 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
555 action => 'fee_payment',
556 borrowernumber => $borrowernumber,
557 old_amountoutstanding => $accdata->{'amountoutstanding'},
558 new_amountoutstanding => $newamtos,
559 amount_paid => $accdata->{'amountoutstanding'} - $newamtos,
560 accountlines_id => $accdata->{'accountlines_id'},
561 accountno => $accdata->{'accountno'},
562 manager_id => $manager_id,
564 push( @ids, $accdata->{'accountlines_id'} );
570 $sql = 'INSERT INTO accountlines ' .
571 '(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id,note) ' .
572 q|VALUES (?,?,now(),?,'','Pay',?,?,?)|;
573 $dbh->do($sql,{},$borrowernumber, $nextaccntno, 0 - $amount, 0 - $amountleft, $manager_id, $note );
578 borrowernumber => $borrowernumber,
579 accountno => $nextaccntno}
582 if ( C4::Context->preference("FinesLog") ) {
583 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
584 action => 'create_payment',
585 borrowernumber => $borrowernumber,
586 accountno => $nextaccntno,
587 amount => 0 - $amount,
588 amountoutstanding => 0 - $amountleft,
589 accounttype => 'Pay',
590 accountlines_paid => \@ids,
591 manager_id => $manager_id,
598 # makepayment needs to be fixed to handle partials till then this separate subroutine
600 sub makepartialpayment {
601 my ( $accountlines_id, $borrowernumber, $accountno, $amount, $user, $branch, $payment_note ) = @_;
603 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
604 if (!$amount || $amount < 0) {
607 $payment_note //= "";
608 my $dbh = C4::Context->dbh;
610 my $nextaccntno = getnextacctno($borrowernumber);
613 my $data = $dbh->selectrow_hashref(
614 'SELECT * FROM accountlines WHERE accountlines_id=?',undef,$accountlines_id);
615 my $new_outstanding = $data->{amountoutstanding} - $amount;
617 my $update = 'UPDATE accountlines SET amountoutstanding = ? WHERE accountlines_id = ? ';
618 $dbh->do( $update, undef, $new_outstanding, $accountlines_id);
620 if ( C4::Context->preference("FinesLog") ) {
621 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
622 action => 'fee_payment',
623 borrowernumber => $borrowernumber,
624 old_amountoutstanding => $data->{'amountoutstanding'},
625 new_amountoutstanding => $new_outstanding,
626 amount_paid => $data->{'amountoutstanding'} - $new_outstanding,
627 accountlines_id => $data->{'accountlines_id'},
628 accountno => $data->{'accountno'},
629 manager_id => $manager_id,
634 my $insert = 'INSERT INTO accountlines (borrowernumber, accountno, date, amount, '
635 . 'description, accounttype, amountoutstanding, itemnumber, manager_id, note) '
636 . ' VALUES (?, ?, now(), ?, ?, ?, 0, ?, ?, ?)';
638 $dbh->do( $insert, undef, $borrowernumber, $nextaccntno, $amount,
639 '', 'Pay', $data->{'itemnumber'}, $manager_id, $payment_note);
645 borrowernumber => $borrowernumber,
646 accountno => $accountno
649 if ( C4::Context->preference("FinesLog") ) {
650 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
651 action => 'create_payment',
652 borrowernumber => $user,
653 accountno => $nextaccntno,
654 amount => 0 - $amount,
655 accounttype => 'Pay',
656 itemnumber => $data->{'itemnumber'},
657 accountlines_paid => [ $data->{'accountlines_id'} ],
658 manager_id => $manager_id,
667 WriteOffFee( $borrowernumber, $accountline_id, $itemnum, $accounttype, $amount, $branch, $payment_note );
669 Write off a fine for a patron.
670 C<$borrowernumber> is the patron's borrower number.
671 C<$accountline_id> is the accountline_id of the fee to write off.
672 C<$itemnum> is the itemnumber of of item whose fine is being written off.
673 C<$accounttype> is the account type of the fine being written off.
674 C<$amount> is a floating-point number, giving the amount that is being written off.
675 C<$branch> is the branchcode of the library where the writeoff occurred.
676 C<$payment_note> is the note to attach to this payment
681 my ( $borrowernumber, $accountlines_id, $itemnum, $accounttype, $amount, $branch, $payment_note ) = @_;
682 $payment_note //= "";
683 $branch ||= C4::Context->userenv->{branch};
685 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
687 # if no item is attached to fine, make sure to store it as a NULL
691 my $dbh = C4::Context->dbh();
694 UPDATE accountlines SET amountoutstanding = 0
695 WHERE accountlines_id = ? AND borrowernumber = ?
697 $sth = $dbh->prepare( $query );
698 $sth->execute( $accountlines_id, $borrowernumber );
700 if ( C4::Context->preference("FinesLog") ) {
701 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
702 action => 'fee_writeoff',
703 borrowernumber => $borrowernumber,
704 accountlines_id => $accountlines_id,
705 manager_id => $manager_id,
710 INSERT INTO accountlines
711 ( borrowernumber, accountno, itemnumber, date, amount, description, accounttype, manager_id, note )
712 VALUES ( ?, ?, ?, NOW(), ?, 'Writeoff', 'W', ?, ? )
714 $sth = $dbh->prepare( $query );
715 my $acct = getnextacctno($borrowernumber);
716 $sth->execute( $borrowernumber, $acct, $itemnum, $amount, $manager_id, $payment_note );
718 if ( C4::Context->preference("FinesLog") ) {
719 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
720 action => 'create_writeoff',
721 borrowernumber => $borrowernumber,
723 amount => 0 - $amount,
725 itemnumber => $itemnum,
726 accountlines_paid => [ $accountlines_id ],
727 manager_id => $manager_id,
735 borrowernumber => $borrowernumber}
740 =head2 purge_zero_balance_fees
742 purge_zero_balance_fees( $days );
744 Delete accountlines entries where amountoutstanding is 0 or NULL which are more than a given number of days old.
746 B<$days> -- Zero balance fees older than B<$days> days old will be deleted.
748 B<Warning:> Because fines and payments are not linked in accountlines, it is
749 possible for a fine to be deleted without the accompanying payment,
750 or vise versa. This won't affect the account balance, but might be
755 sub purge_zero_balance_fees {
759 my $dbh = C4::Context->dbh;
760 my $sth = $dbh->prepare(
762 DELETE FROM accountlines
763 WHERE date < date_sub(curdate(), INTERVAL ? DAY)
764 AND ( amountoutstanding = 0 or amountoutstanding IS NULL );
767 $sth->execute($days) or die $dbh->errstr;
770 END { } # module clean-up code here (global destructor)