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 under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
22 #use warnings; FIXME - Bug 2505
27 use C4::Circulation qw(MarkIssueReturned);
29 use vars qw($VERSION @ISA @EXPORT);
32 # set the version for version checking
37 &recordpayment &makepayment &manualinvoice
38 &getnextacctno &reconcileaccount &getcharges &ModNote &getcredits
39 &getrefunds &chargelostitem
42 recordpayment_selectaccts
48 C4::Accounts - Functions for dealing with Koha accounts
56 The functions in this module deal with the monetary aspect of Koha,
57 including looking up and modifying the amount of money owed by a
64 &recordpayment($borrowernumber, $payment);
66 Record payment by a patron. C<$borrowernumber> is the patron's
67 borrower number. C<$payment> is a floating-point number, giving the
70 Amounts owed are paid off oldest first. That is, if the patron has a
71 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
72 of $1.50, then the oldest fine will be paid off in full, and $0.50
73 will be credited to the next one.
80 #here we update the account lines
81 my ( $borrowernumber, $data ) = @_;
82 my $dbh = C4::Context->dbh;
85 my $branch = C4::Context->userenv->{'branch'};
86 my $amountleft = $data;
89 my $nextaccntno = getnextacctno($borrowernumber);
91 # get lines with outstanding amounts to offset
92 my $sth = $dbh->prepare(
93 "SELECT * FROM accountlines
94 WHERE (borrowernumber = ?) AND (amountoutstanding<>0)
97 $sth->execute($borrowernumber);
100 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
101 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
103 $amountleft -= $accdata->{'amountoutstanding'};
106 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
109 my $thisacct = $accdata->{accountno};
110 my $usth = $dbh->prepare(
111 "UPDATE accountlines SET amountoutstanding= ?
112 WHERE (borrowernumber = ?) AND (accountno=?)"
114 $usth->execute( $newamtos, $borrowernumber, $thisacct );
116 # $usth = $dbh->prepare(
117 # "INSERT INTO accountoffsets
118 # (borrowernumber, accountno, offsetaccount, offsetamount)
121 # $usth->execute( $borrowernumber, $accdata->{'accountno'},
122 # $nextaccntno, $newamtos );
127 my $usth = $dbh->prepare(
128 "INSERT INTO accountlines
129 (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding)
130 VALUES (?,?,now(),?,'Payment,thanks','Pay',?)"
132 $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft );
134 UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno );
140 &makepayment($borrowernumber, $acctnumber, $amount, $branchcode);
142 Records the fact that a patron has paid off the entire amount he or
145 C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is
146 the account that was credited. C<$amount> is the amount paid (this is
147 only used to record the payment. It is assumed to be equal to the
148 amount owed). C<$branchcode> is the code of the branch where payment
154 # FIXME - I'm not at all sure about the above, because I don't
155 # understand what the acct* tables in the Koha database are for.
158 #here we update both the accountoffsets and the account lines
159 #updated to check, if they are paying off a lost item, we return the item
160 # from their card, and put a note on the item record
161 my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_;
162 my $dbh = C4::Context->dbh;
164 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
167 my $nextaccntno = getnextacctno($borrowernumber);
171 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?");
172 $sth->execute( $borrowernumber, $accountno );
173 my $data = $sth->fetchrow_hashref;
176 if($data->{'accounttype'} eq "Pay"){
180 SET amountoutstanding = 0, description = 'Payment,thanks'
181 WHERE borrowernumber = ?
185 $udp->execute($borrowernumber, $accountno );
191 SET amountoutstanding = 0
192 WHERE borrowernumber = ?
196 $udp->execute($borrowernumber, $accountno );
200 my $payment = 0 - $amount;
205 INTO accountlines (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding)
206 VALUES ( ?, ?, now(), ?, 'Payment,thanks', 'Pay', 0)"
208 $ins->execute($borrowernumber, $nextaccntno, $payment);
212 # FIXME - The second argument to &UpdateStats is supposed to be the
214 # UpdateStats is now being passed $accountno too. MTJ
215 UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber,
217 #from perldoc: for SELECT only #$sth->finish;
219 #check to see what accounttype
220 if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
221 returnlost( $borrowernumber, $data->{'itemnumber'} );
227 $nextacct = &getnextacctno($borrowernumber);
229 Returns the next unused account number for the patron with the given
235 # FIXME - Okay, so what does the above actually _mean_?
236 sub getnextacctno ($) {
237 my ($borrowernumber) = shift or return undef;
238 my $sth = C4::Context->dbh->prepare(
239 "SELECT accountno+1 FROM accountlines
240 WHERE (borrowernumber = ?)
241 ORDER BY accountno DESC
244 $sth->execute($borrowernumber);
245 return ($sth->fetchrow || 1);
248 =head2 fixaccounts (removed)
250 &fixaccounts($borrowernumber, $accountnumber, $amount);
253 # FIXME - I don't understand what this function does.
255 my ( $borrowernumber, $accountno, $amount ) = @_;
256 my $dbh = C4::Context->dbh;
257 my $sth = $dbh->prepare(
258 "SELECT * FROM accountlines WHERE borrowernumber=?
261 $sth->execute( $borrowernumber, $accountno );
262 my $data = $sth->fetchrow_hashref;
264 # FIXME - Error-checking
265 my $diff = $amount - $data->{'amount'};
266 my $outstanding = $data->{'amountoutstanding'} + $diff;
271 SET amount = '$amount',
272 amountoutstanding = '$outstanding'
273 WHERE borrowernumber = $borrowernumber
274 AND accountno = $accountno
276 # FIXME: exceedingly bad form. Use prepare with placholders ("?") in query and execute args.
282 my ( $borrowernumber, $itemnum ) = @_;
283 C4::Circulation::MarkIssueReturned( $borrowernumber, $itemnum );
284 my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
285 my @datearr = localtime(time);
286 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
287 my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
288 ModItem({ paidfor => "Paid for by $bor $date" }, undef, $itemnum);
293 # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for
294 # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that
295 # a charge has been added
296 # FIXME : if no replacement price, borrower just doesn't get charged?
298 my $dbh = C4::Context->dbh();
299 my ($itemnumber) = @_;
300 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
302 JOIN items USING (itemnumber)
303 JOIN biblio USING (biblionumber)
304 WHERE issues.itemnumber=?");
305 $sth->execute($itemnumber);
306 my $issues=$sth->fetchrow_hashref();
308 # if a borrower lost the item, add a replacement cost to the their record
309 if ( $issues->{borrowernumber} ){
311 # first make sure the borrower hasn't already been charged for this item
312 my $sth1=$dbh->prepare("SELECT * from accountlines
313 WHERE borrowernumber=? AND itemnumber=? and accounttype='L'");
314 $sth1->execute($issues->{'borrowernumber'},$itemnumber);
315 my $existing_charge_hashref=$sth1->fetchrow_hashref();
318 unless ($existing_charge_hashref) {
319 # This item is on issue ... add replacement cost to the borrower's record and mark it returned
320 # Note that we add this to the account even if there's no replacement price, allowing some other
321 # process (or person) to update it, since we don't handle any defaults for replacement prices.
322 my $accountno = getnextacctno($issues->{'borrowernumber'});
323 my $sth2=$dbh->prepare("INSERT INTO accountlines
324 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber)
325 VALUES (?,?,now(),?,?,'L',?,?)");
326 $sth2->execute($issues->{'borrowernumber'},$accountno,$issues->{'replacementprice'},
327 "Lost Item $issues->{'title'} $issues->{'barcode'}",
328 $issues->{'replacementprice'},$itemnumber);
332 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
333 #warn " $issues->{'borrowernumber'} / $itemnumber ";
334 C4::Circulation::MarkIssueReturned($issues->{borrowernumber},$itemnumber);
335 # Shouldn't MarkIssueReturned do this?
336 C4::Items::ModItem({ onloan => undef }, undef, $itemnumber);
343 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
346 C<$borrowernumber> is the patron's borrower number.
347 C<$description> is a description of the transaction.
348 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
350 C<$itemnumber> is the item involved, if pertinent; otherwise, it
351 should be the empty string.
356 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
359 # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
362 # 'A' = Account Management fee
368 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_;
370 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
371 my $dbh = C4::Context->dbh;
374 my $accountno = getnextacctno($borrowernumber);
375 my $amountleft = $amount;
383 # my $amount2 = $amount * -1; # FIXME - $amount2 = -$amount
385 # fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user );
387 if ( $type eq 'N' ) {
388 $desc .= " New Card";
390 if ( $type eq 'F' ) {
393 if ( $type eq 'A' ) {
394 $desc .= " Account Management fee";
396 if ( $type eq 'M' ) {
400 if ( $type eq 'L' && $desc eq '' ) {
402 $desc = " Lost Item";
404 # if ( $type eq 'REF' ) {
405 # $desc .= " Cash Refund";
406 # $amountleft = refund( '', $borrowernumber, $amount );
408 if ( ( $type eq 'L' )
412 or ( $type eq 'M' ) )
418 $desc .= ' ' . $itemnum;
419 my $sth = $dbh->prepare(
420 'INSERT INTO accountlines
421 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id)
422 VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)');
423 $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr;
425 my $sth=$dbh->prepare("INSERT INTO accountlines
426 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id)
427 VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)"
429 $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
430 $amountleft, $notifyid, $note, $manager_id );
435 =head2 fixcredit #### DEPRECATED
437 $amountleft = &fixcredit($borrowernumber, $data, $barcode, $type, $user);
439 This function is only used internally, not exported.
443 # This function is deprecated in 3.0
447 #here we update both the accountoffsets and the account lines
448 my ( $borrowernumber, $data, $barcode, $type, $user ) = @_;
449 my $dbh = C4::Context->dbh;
452 my $amountleft = $data;
453 if ( $barcode ne '' ) {
454 my $item = GetBiblioFromItemNumber( '', $barcode );
455 my $nextaccntno = getnextacctno($borrowernumber);
456 my $query = "SELECT * FROM accountlines WHERE (borrowernumber=?
457 AND itemnumber=? AND amountoutstanding > 0)";
458 if ( $type eq 'CL' ) {
459 $query .= " AND (accounttype = 'L' OR accounttype = 'Rep')";
461 elsif ( $type eq 'CF' ) {
462 $query .= " AND (accounttype = 'F' OR accounttype = 'FU' OR
463 accounttype='Res' OR accounttype='Rent')";
465 elsif ( $type eq 'CB' ) {
466 $query .= " and accounttype='A'";
470 my $sth = $dbh->prepare($query);
471 $sth->execute( $borrowernumber, $item->{'itemnumber'} );
472 $accdata = $sth->fetchrow_hashref;
474 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
476 $amountleft -= $accdata->{'amountoutstanding'};
479 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
482 my $thisacct = $accdata->{accountno};
483 my $usth = $dbh->prepare(
484 "UPDATE accountlines SET amountoutstanding= ?
485 WHERE (borrowernumber = ?) AND (accountno=?)"
487 $usth->execute( $newamtos, $borrowernumber, $thisacct );
489 $usth = $dbh->prepare(
490 "INSERT INTO accountoffsets
491 (borrowernumber, accountno, offsetaccount, offsetamount)
494 $usth->execute( $borrowernumber, $accdata->{'accountno'},
495 $nextaccntno, $newamtos );
500 my $nextaccntno = getnextacctno($borrowernumber);
502 # get lines with outstanding amounts to offset
503 my $sth = $dbh->prepare(
504 "SELECT * FROM accountlines
505 WHERE (borrowernumber = ?) AND (amountoutstanding >0)
508 $sth->execute($borrowernumber);
511 # offset transactions
512 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
513 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
515 $amountleft -= $accdata->{'amountoutstanding'};
518 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
521 my $thisacct = $accdata->{accountno};
522 my $usth = $dbh->prepare(
523 "UPDATE accountlines SET amountoutstanding= ?
524 WHERE (borrowernumber = ?) AND (accountno=?)"
526 $usth->execute( $newamtos, $borrowernumber, $thisacct );
528 $usth = $dbh->prepare(
529 "INSERT INTO accountoffsets
530 (borrowernumber, accountno, offsetaccount, offsetamount)
533 $usth->execute( $borrowernumber, $accdata->{'accountno'},
534 $nextaccntno, $newamtos );
538 $type = "Credit " . $type;
539 UpdateStats( $user, $type, $data, $user, '', '', $borrowernumber );
541 return ($amountleft);
547 #FIXME : DEPRECATED SUB
548 This subroutine tracks payments and/or credits against fines/charges
549 using the accountoffsets table, which is not used consistently in
550 Koha's fines management, and so is not used in 3.0
556 #here we update both the accountoffsets and the account lines
557 my ( $borrowernumber, $data ) = @_;
558 my $dbh = C4::Context->dbh;
561 my $amountleft = $data * -1;
564 my $nextaccntno = getnextacctno($borrowernumber);
566 # get lines with outstanding amounts to offset
567 my $sth = $dbh->prepare(
568 "SELECT * FROM accountlines
569 WHERE (borrowernumber = ?) AND (amountoutstanding<0)
572 $sth->execute($borrowernumber);
575 # offset transactions
576 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) {
577 if ( $accdata->{'amountoutstanding'} > $amountleft ) {
579 $amountleft -= $accdata->{'amountoutstanding'};
582 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
587 my $thisacct = $accdata->{accountno};
588 my $usth = $dbh->prepare(
589 "UPDATE accountlines SET amountoutstanding= ?
590 WHERE (borrowernumber = ?) AND (accountno=?)"
592 $usth->execute( $newamtos, $borrowernumber, $thisacct );
594 $usth = $dbh->prepare(
595 "INSERT INTO accountoffsets
596 (borrowernumber, accountno, offsetaccount, offsetamount)
599 $usth->execute( $borrowernumber, $accdata->{'accountno'},
600 $nextaccntno, $newamtos );
604 return ($amountleft);
608 my ( $borrowerno, $timestamp, $accountno ) = @_;
609 my $dbh = C4::Context->dbh;
610 my $timestamp2 = $timestamp - 1;
612 my $sth = $dbh->prepare(
613 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
615 $sth->execute( $borrowerno, $accountno );
618 while ( my $data = $sth->fetchrow_hashref ) {
625 my ( $borrowernumber, $accountno, $note ) = @_;
626 my $dbh = C4::Context->dbh;
627 my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE borrowernumber = ? AND accountno = ?');
628 $sth->execute( $note, $borrowernumber, $accountno );
632 my ( $date, $date2 ) = @_;
633 my $dbh = C4::Context->dbh;
634 my $sth = $dbh->prepare(
635 "SELECT * FROM accountlines,borrowers
636 WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber
637 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
640 $sth->execute( $date, $date2 );
642 while ( my $data = $sth->fetchrow_hashref ) {
643 $data->{'date'} = $data->{'timestamp'};
651 my ( $date, $date2 ) = @_;
652 my $dbh = C4::Context->dbh;
654 my $sth = $dbh->prepare(
655 "SELECT *,timestamp AS datetime
656 FROM accountlines,borrowers
657 WHERE (accounttype = 'REF'
658 AND accountlines.borrowernumber = borrowers.borrowernumber
659 AND date >=? AND date <?)"
662 $sth->execute( $date, $date2 );
665 while ( my $data = $sth->fetchrow_hashref ) {
673 my ( $borrowernumber, $accountno ) = @_;
674 my $dbh = C4::Context->dbh;
676 my $sth = $dbh->prepare('SELECT amountoutstanding FROM accountlines WHERE borrowernumber = ? AND accountno = ?');
677 $sth->execute( $borrowernumber, $accountno );
678 my $row = $sth->fetchrow_hashref();
679 my $amount_outstanding = $row->{'amountoutstanding'};
681 if ( $amount_outstanding <= 0 ) {
682 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
683 $sth->execute( $borrowernumber, $accountno );
685 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
686 $sth->execute( $borrowernumber, $accountno );
690 =head2 recordpayment_selectaccts
692 recordpayment_selectaccts($borrowernumber, $payment,$accts);
694 Record payment by a patron. C<$borrowernumber> is the patron's
695 borrower number. C<$payment> is a floating-point number, giving the
696 amount that was paid. C<$accts> is an array ref to a list of
697 accountnos which the payment can be recorded against
699 Amounts owed are paid off oldest first. That is, if the patron has a
700 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
701 of $1.50, then the oldest fine will be paid off in full, and $0.50
702 will be credited to the next one.
706 sub recordpayment_selectaccts {
707 my ( $borrowernumber, $amount, $accts ) = @_;
709 my $dbh = C4::Context->dbh;
712 my $branch = C4::Context->userenv->{branch};
713 my $amountleft = $amount;
714 my $sql = 'SELECT * FROM accountlines WHERE (borrowernumber = ?) ' .
715 'AND (amountoutstanding<>0) ';
717 $sql .= ' AND accountno IN ( ' . join ',', @{$accts};
720 $sql .= ' ORDER BY date';
722 my $nextaccntno = getnextacctno($borrowernumber);
724 # get lines with outstanding amounts to offset
725 my $rows = $dbh->selectall_arrayref($sql, { Slice => {} }, $borrowernumber);
727 # offset transactions
728 my $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding= ? ' .
729 'WHERE (borrowernumber = ?) AND (accountno=?)');
730 for my $accdata ( @{$rows} ) {
731 if ($amountleft == 0) {
734 if ( $accdata->{amountoutstanding} < $amountleft ) {
736 $amountleft -= $accdata->{amountoutstanding};
739 $newamtos = $accdata->{amountoutstanding} - $amountleft;
742 my $thisacct = $accdata->{accountno};
743 $sth->execute( $newamtos, $borrowernumber, $thisacct );
747 $sql = 'INSERT INTO accountlines ' .
748 '(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding) ' .
749 q|VALUES (?,?,now(),?,'Payment,thanks','Pay',?)|;
750 $dbh->do($sql,{},$borrowernumber, $nextaccntno, 0 - $amount, 0 - $amountleft );
751 UpdateStats( $branch, 'payment', $amount, '', '', '', $borrowernumber, $nextaccntno );
755 # makepayment needs to be fixed to handle partials till then this separate subroutine
757 sub makepartialpayment {
758 my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_;
759 if (!$amount || $amount < 0) {
762 my $dbh = C4::Context->dbh;
764 my $nextaccntno = getnextacctno($borrowernumber);
767 my $data = $dbh->selectrow_hashref(
768 'SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?',undef,$borrowernumber,$accountno);
769 my $new_outstanding = $data->{amountoutstanding} - $amount;
771 my $update = 'UPDATE accountlines SET amountoutstanding = ? WHERE borrowernumber = ? '
772 . ' AND accountno = ?';
773 $dbh->do( $update, undef, $new_outstanding, $borrowernumber, $accountno);
776 my $insert = 'INSERT INTO accountlines (borrowernumber, accountno, date, amount, '
777 . 'description, accounttype, amountoutstanding) '
778 . ' VALUES (?, ?, now(), ?, ?, ?, 0)';
780 $dbh->do( $insert, undef, $borrowernumber, $nextaccntno, $amount,
781 "Payment, thanks - $user", 'Pay');
783 UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber, $accountno );
790 END { } # module clean-up code here (global destructor)