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);
48 &recordpayment_selectaccts
50 &purge_zero_balance_fees
56 C4::Accounts - Functions for dealing with Koha accounts
64 The functions in this module deal with the monetary aspect of Koha,
65 including looking up and modifying the amount of money owed by a
72 &makepayment($accountlines_id, $borrowernumber, $acctnumber, $amount, $branchcode);
74 Records the fact that a patron has paid off the entire amount he or
77 C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is
78 the account that was credited. C<$amount> is the amount paid (this is
79 only used to record the payment. It is assumed to be equal to the
80 amount owed). C<$branchcode> is the code of the branch where payment
86 # FIXME - I'm not at all sure about the above, because I don't
87 # understand what the acct* tables in the Koha database are for.
90 #here we update both the accountoffsets and the account lines
91 #updated to check, if they are paying off a lost item, we return the item
92 # from their card, and put a note on the item record
93 my ( $accountlines_id, $borrowernumber, $accountno, $amount, $user, $branch, $payment_note ) = @_;
94 my $dbh = C4::Context->dbh;
96 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
99 my $nextaccntno = getnextacctno($borrowernumber);
101 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE accountlines_id=?");
102 $sth->execute( $accountlines_id );
103 my $data = $sth->fetchrow_hashref;
106 if ( $data->{'accounttype'} eq "Pay" ){
110 SET amountoutstanding = 0
111 WHERE accountlines_id = ?
114 $udp->execute($accountlines_id);
119 SET amountoutstanding = 0
120 WHERE accountlines_id = ?
123 $udp->execute($accountlines_id);
126 my $payment = 0 - $amount;
127 $payment_note //= "";
132 INTO accountlines (borrowernumber, accountno, date, amount, itemnumber, description, accounttype, amountoutstanding, manager_id, note)
133 VALUES ( ?, ?, now(), ?, ?, '', 'Pay', 0, ?, ?)"
135 $ins->execute($borrowernumber, $nextaccntno, $payment, $data->{'itemnumber'}, $manager_id, $payment_note);
138 if ( C4::Context->preference("FinesLog") ) {
139 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
140 action => 'fee_payment',
141 borrowernumber => $borrowernumber,
142 old_amountoutstanding => $data->{'amountoutstanding'},
143 new_amountoutstanding => 0,
144 amount_paid => $data->{'amountoutstanding'},
145 accountlines_id => $data->{'accountlines_id'},
146 accountno => $data->{'accountno'},
147 manager_id => $manager_id,
151 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
152 action => 'create_payment',
153 borrowernumber => $borrowernumber,
154 accountno => $nextaccntno,
156 amountoutstanding => 0,,
157 accounttype => 'Pay',
158 accountlines_paid => [$data->{'accountlines_id'}],
159 manager_id => $manager_id,
167 borrowernumber => $borrowernumber,
168 accountno => $accountno
171 #check to see what accounttype
172 if ( $data->{itemnumber} && ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) ) {
173 C4::Circulation::ReturnLostItem( $borrowernumber, $data->{'itemnumber'} );
175 my $sthr = $dbh->prepare("SELECT max(accountlines_id) AS lastinsertid FROM accountlines");
177 my $datalastinsertid = $sthr->fetchrow_hashref;
178 return $datalastinsertid->{'lastinsertid'};
183 $nextacct = &getnextacctno($borrowernumber);
185 Returns the next unused account number for the patron with the given
191 # FIXME - Okay, so what does the above actually _mean_?
193 my ($borrowernumber) = shift or return;
194 my $sth = C4::Context->dbh->prepare(
195 "SELECT accountno+1 FROM accountlines
196 WHERE (borrowernumber = ?)
197 ORDER BY accountno DESC
200 $sth->execute($borrowernumber);
201 return ($sth->fetchrow || 1);
204 =head2 fixaccounts (removed)
206 &fixaccounts($accountlines_id, $borrowernumber, $accountnumber, $amount);
209 # FIXME - I don't understand what this function does.
211 my ( $accountlines_id, $borrowernumber, $accountno, $amount ) = @_;
212 my $dbh = C4::Context->dbh;
213 my $sth = $dbh->prepare(
214 "SELECT * FROM accountlines WHERE accountlines_id=?"
216 $sth->execute( $accountlines_id );
217 my $data = $sth->fetchrow_hashref;
219 # FIXME - Error-checking
220 my $diff = $amount - $data->{'amount'};
221 my $outstanding = $data->{'amountoutstanding'} + $diff;
226 SET amount = '$amount',
227 amountoutstanding = '$outstanding'
228 WHERE accountlines_id = $accountlines_id
230 # FIXME: exceedingly bad form. Use prepare with placholders ("?") in query and execute args.
236 # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for
237 # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that
238 # a charge has been added
239 # FIXME : if no replacement price, borrower just doesn't get charged?
240 my $dbh = C4::Context->dbh();
241 my ($borrowernumber, $itemnumber, $amount, $description) = @_;
243 # first make sure the borrower hasn't already been charged for this item
244 my $sth1=$dbh->prepare("SELECT * from accountlines
245 WHERE borrowernumber=? AND itemnumber=? and accounttype='L'");
246 $sth1->execute($borrowernumber,$itemnumber);
247 my $existing_charge_hashref=$sth1->fetchrow_hashref();
250 unless ($existing_charge_hashref) {
252 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
253 # This item is on issue ... add replacement cost to the borrower's record and mark it returned
254 # Note that we add this to the account even if there's no replacement price, allowing some other
255 # process (or person) to update it, since we don't handle any defaults for replacement prices.
256 my $accountno = getnextacctno($borrowernumber);
257 my $sth2=$dbh->prepare("INSERT INTO accountlines
258 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber,manager_id)
259 VALUES (?,?,now(),?,?,'L',?,?,?)");
260 $sth2->execute($borrowernumber,$accountno,$amount,
261 $description,$amount,$itemnumber,$manager_id);
263 if ( C4::Context->preference("FinesLog") ) {
264 logaction("FINES", 'CREATE', $borrowernumber, Dumper({
265 action => 'create_fee',
266 borrowernumber => $borrowernumber,
267 accountno => $accountno,
269 amountoutstanding => $amount,
270 description => $description,
272 itemnumber => $itemnumber,
273 manager_id => $manager_id,
282 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
285 C<$borrowernumber> is the patron's borrower number.
286 C<$description> is a description of the transaction.
287 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
289 C<$itemnumber> is the item involved, if pertinent; otherwise, it
290 should be the empty string.
295 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
298 # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
301 # 'A' = Account Management fee
307 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_;
309 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
310 my $dbh = C4::Context->dbh;
313 my $accountno = getnextacctno($borrowernumber);
314 my $amountleft = $amount;
316 if ( ( $type eq 'L' )
320 or ( $type eq 'M' ) )
326 $desc .= ' ' . $itemnum;
327 my $sth = $dbh->prepare(
328 'INSERT INTO accountlines
329 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id)
330 VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)');
331 $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr;
333 my $sth=$dbh->prepare("INSERT INTO accountlines
334 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id)
335 VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)"
337 $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
338 $amountleft, $notifyid, $note, $manager_id );
341 if ( C4::Context->preference("FinesLog") ) {
342 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
343 action => 'create_fee',
344 borrowernumber => $borrowernumber,
345 accountno => $accountno,
347 description => $desc,
348 accounttype => $type,
349 amountoutstanding => $amountleft,
350 notify_id => $notifyid,
352 itemnumber => $itemnum,
353 manager_id => $manager_id,
361 my ( $borrowerno, $timestamp, $accountno ) = @_;
362 my $dbh = C4::Context->dbh;
363 my $timestamp2 = $timestamp - 1;
365 my $sth = $dbh->prepare(
366 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
368 $sth->execute( $borrowerno, $accountno );
371 while ( my $data = $sth->fetchrow_hashref ) {
378 my ( $accountlines_id, $note ) = @_;
379 my $dbh = C4::Context->dbh;
380 my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE accountlines_id = ?');
381 $sth->execute( $note, $accountlines_id );
385 my ( $date, $date2 ) = @_;
386 my $dbh = C4::Context->dbh;
387 my $sth = $dbh->prepare(
388 "SELECT * FROM accountlines,borrowers
389 WHERE amount < 0 AND accounttype not like 'Pay%' AND accountlines.borrowernumber = borrowers.borrowernumber
390 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
393 $sth->execute( $date, $date2 );
395 while ( my $data = $sth->fetchrow_hashref ) {
396 $data->{'date'} = $data->{'timestamp'};
404 my ( $date, $date2 ) = @_;
405 my $dbh = C4::Context->dbh;
407 my $sth = $dbh->prepare(
408 "SELECT *,timestamp AS datetime
409 FROM accountlines,borrowers
410 WHERE (accounttype = 'REF'
411 AND accountlines.borrowernumber = borrowers.borrowernumber
412 AND date >=? AND date <?)"
415 $sth->execute( $date, $date2 );
418 while ( my $data = $sth->fetchrow_hashref ) {
426 my ( $accountlines_id ) = @_;
427 my $dbh = C4::Context->dbh;
429 my $sth = $dbh->prepare('SELECT * FROM accountlines WHERE accountlines_id = ?');
430 $sth->execute( $accountlines_id );
431 my $row = $sth->fetchrow_hashref();
432 my $amount_outstanding = $row->{'amountoutstanding'};
434 if ( $amount_outstanding <= 0 ) {
435 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE accountlines_id = ?');
436 $sth->execute( $accountlines_id );
438 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE accountlines_id = ?');
439 $sth->execute( $accountlines_id );
442 if ( C4::Context->preference("FinesLog") ) {
444 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
446 if ( $amount_outstanding <= 0 ) {
447 $row->{'amountoutstanding'} *= -1;
449 $row->{'amountoutstanding'} = '0';
451 $row->{'description'} .= ' Reversed -';
452 logaction("FINES", 'MODIFY', $row->{'borrowernumber'}, Dumper({
453 action => 'reverse_fee_payment',
454 borrowernumber => $row->{'borrowernumber'},
455 old_amountoutstanding => $row->{'amountoutstanding'},
456 new_amountoutstanding => 0 - $amount_outstanding,,
457 accountlines_id => $row->{'accountlines_id'},
458 accountno => $row->{'accountno'},
459 manager_id => $manager_id,
466 =head2 recordpayment_selectaccts
468 recordpayment_selectaccts($borrowernumber, $payment,$accts);
470 Record payment by a patron. C<$borrowernumber> is the patron's
471 borrower number. C<$payment> is a floating-point number, giving the
472 amount that was paid. C<$accts> is an array ref to a list of
473 accountnos which the payment can be recorded against
475 Amounts owed are paid off oldest first. That is, if the patron has a
476 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
477 of $1.50, then the oldest fine will be paid off in full, and $0.50
478 will be credited to the next one.
482 sub recordpayment_selectaccts {
483 my ( $borrowernumber, $amount, $accts, $note ) = @_;
485 my $dbh = C4::Context->dbh;
488 my $branch = C4::Context->userenv->{branch};
489 my $amountleft = $amount;
491 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
492 my $sql = 'SELECT * FROM accountlines WHERE (borrowernumber = ?) ' .
493 'AND (amountoutstanding<>0) ';
495 $sql .= ' AND accountlines_id IN ( ' . join ',', @{$accts};
498 $sql .= ' ORDER BY date';
500 my $nextaccntno = getnextacctno($borrowernumber);
502 # get lines with outstanding amounts to offset
503 my $rows = $dbh->selectall_arrayref($sql, { Slice => {} }, $borrowernumber);
505 # offset transactions
506 my $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding= ? ' .
507 'WHERE accountlines_id=?');
510 for my $accdata ( @{$rows} ) {
511 if ($amountleft == 0) {
514 if ( $accdata->{amountoutstanding} < $amountleft ) {
516 $amountleft -= $accdata->{amountoutstanding};
519 $newamtos = $accdata->{amountoutstanding} - $amountleft;
522 my $thisacct = $accdata->{accountlines_id};
523 $sth->execute( $newamtos, $thisacct );
525 if ( C4::Context->preference("FinesLog") ) {
526 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
527 action => 'fee_payment',
528 borrowernumber => $borrowernumber,
529 old_amountoutstanding => $accdata->{'amountoutstanding'},
530 new_amountoutstanding => $newamtos,
531 amount_paid => $accdata->{'amountoutstanding'} - $newamtos,
532 accountlines_id => $accdata->{'accountlines_id'},
533 accountno => $accdata->{'accountno'},
534 manager_id => $manager_id,
536 push( @ids, $accdata->{'accountlines_id'} );
542 $sql = 'INSERT INTO accountlines ' .
543 '(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id,note) ' .
544 q|VALUES (?,?,now(),?,'','Pay',?,?,?)|;
545 $dbh->do($sql,{},$borrowernumber, $nextaccntno, 0 - $amount, 0 - $amountleft, $manager_id, $note );
550 borrowernumber => $borrowernumber,
551 accountno => $nextaccntno}
554 if ( C4::Context->preference("FinesLog") ) {
555 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
556 action => 'create_payment',
557 borrowernumber => $borrowernumber,
558 accountno => $nextaccntno,
559 amount => 0 - $amount,
560 amountoutstanding => 0 - $amountleft,
561 accounttype => 'Pay',
562 accountlines_paid => \@ids,
563 manager_id => $manager_id,
570 # makepayment needs to be fixed to handle partials till then this separate subroutine
572 sub makepartialpayment {
573 my ( $accountlines_id, $borrowernumber, $accountno, $amount, $user, $branch, $payment_note ) = @_;
575 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
576 if (!$amount || $amount < 0) {
579 $payment_note //= "";
580 my $dbh = C4::Context->dbh;
582 my $nextaccntno = getnextacctno($borrowernumber);
585 my $data = $dbh->selectrow_hashref(
586 'SELECT * FROM accountlines WHERE accountlines_id=?',undef,$accountlines_id);
587 my $new_outstanding = $data->{amountoutstanding} - $amount;
589 my $update = 'UPDATE accountlines SET amountoutstanding = ? WHERE accountlines_id = ? ';
590 $dbh->do( $update, undef, $new_outstanding, $accountlines_id);
592 if ( C4::Context->preference("FinesLog") ) {
593 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
594 action => 'fee_payment',
595 borrowernumber => $borrowernumber,
596 old_amountoutstanding => $data->{'amountoutstanding'},
597 new_amountoutstanding => $new_outstanding,
598 amount_paid => $data->{'amountoutstanding'} - $new_outstanding,
599 accountlines_id => $data->{'accountlines_id'},
600 accountno => $data->{'accountno'},
601 manager_id => $manager_id,
606 my $insert = 'INSERT INTO accountlines (borrowernumber, accountno, date, amount, '
607 . 'description, accounttype, amountoutstanding, itemnumber, manager_id, note) '
608 . ' VALUES (?, ?, now(), ?, ?, ?, 0, ?, ?, ?)';
610 $dbh->do( $insert, undef, $borrowernumber, $nextaccntno, $amount,
611 '', 'Pay', $data->{'itemnumber'}, $manager_id, $payment_note);
617 borrowernumber => $borrowernumber,
618 accountno => $accountno
621 if ( C4::Context->preference("FinesLog") ) {
622 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
623 action => 'create_payment',
624 borrowernumber => $user,
625 accountno => $nextaccntno,
626 amount => 0 - $amount,
627 accounttype => 'Pay',
628 itemnumber => $data->{'itemnumber'},
629 accountlines_paid => [ $data->{'accountlines_id'} ],
630 manager_id => $manager_id,
639 WriteOffFee( $borrowernumber, $accountline_id, $itemnum, $accounttype, $amount, $branch, $payment_note );
641 Write off a fine for a patron.
642 C<$borrowernumber> is the patron's borrower number.
643 C<$accountline_id> is the accountline_id of the fee to write off.
644 C<$itemnum> is the itemnumber of of item whose fine is being written off.
645 C<$accounttype> is the account type of the fine being written off.
646 C<$amount> is a floating-point number, giving the amount that is being written off.
647 C<$branch> is the branchcode of the library where the writeoff occurred.
648 C<$payment_note> is the note to attach to this payment
653 my ( $borrowernumber, $accountlines_id, $itemnum, $accounttype, $amount, $branch, $payment_note ) = @_;
654 $payment_note //= "";
655 $branch ||= C4::Context->userenv->{branch};
657 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
659 # if no item is attached to fine, make sure to store it as a NULL
663 my $dbh = C4::Context->dbh();
666 UPDATE accountlines SET amountoutstanding = 0
667 WHERE accountlines_id = ? AND borrowernumber = ?
669 $sth = $dbh->prepare( $query );
670 $sth->execute( $accountlines_id, $borrowernumber );
672 if ( C4::Context->preference("FinesLog") ) {
673 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
674 action => 'fee_writeoff',
675 borrowernumber => $borrowernumber,
676 accountlines_id => $accountlines_id,
677 manager_id => $manager_id,
682 INSERT INTO accountlines
683 ( borrowernumber, accountno, itemnumber, date, amount, description, accounttype, manager_id, note )
684 VALUES ( ?, ?, ?, NOW(), ?, 'Writeoff', 'W', ?, ? )
686 $sth = $dbh->prepare( $query );
687 my $acct = getnextacctno($borrowernumber);
688 $sth->execute( $borrowernumber, $acct, $itemnum, $amount, $manager_id, $payment_note );
690 if ( C4::Context->preference("FinesLog") ) {
691 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
692 action => 'create_writeoff',
693 borrowernumber => $borrowernumber,
695 amount => 0 - $amount,
697 itemnumber => $itemnum,
698 accountlines_paid => [ $accountlines_id ],
699 manager_id => $manager_id,
707 borrowernumber => $borrowernumber}
712 =head2 purge_zero_balance_fees
714 purge_zero_balance_fees( $days );
716 Delete accountlines entries where amountoutstanding is 0 or NULL which are more than a given number of days old.
718 B<$days> -- Zero balance fees older than B<$days> days old will be deleted.
720 B<Warning:> Because fines and payments are not linked in accountlines, it is
721 possible for a fine to be deleted without the accompanying payment,
722 or vise versa. This won't affect the account balance, but might be
727 sub purge_zero_balance_fees {
731 my $dbh = C4::Context->dbh;
732 my $sth = $dbh->prepare(
734 DELETE FROM accountlines
735 WHERE date < date_sub(curdate(), INTERVAL ? DAY)
736 AND ( amountoutstanding = 0 or amountoutstanding IS NULL );
739 $sth->execute($days) or die $dbh->errstr;
742 END { } # module clean-up code here (global destructor)