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
26 use C4::Circulation qw(ReturnLostItem);
28 use vars qw($VERSION @ISA @EXPORT);
31 # set the version for version checking
32 $VERSION = 3.07.00.049;
48 &recordpayment_selectaccts
55 C4::Accounts - Functions for dealing with Koha accounts
63 The functions in this module deal with the monetary aspect of Koha,
64 including looking up and modifying the amount of money owed by a
71 &recordpayment($borrowernumber, $payment);
73 Record payment by a patron. C<$borrowernumber> is the patron's
74 borrower number. C<$payment> is a floating-point number, giving the
77 Amounts owed are paid off oldest first. That is, if the patron has a
78 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
79 of $1.50, then the oldest fine will be paid off in full, and $0.50
80 will be credited to the next one.
87 #here we update the account lines
88 my ( $borrowernumber, $data ) = @_;
89 my $dbh = C4::Context->dbh;
92 my $branch = C4::Context->userenv->{'branch'};
93 my $amountleft = $data;
95 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
98 my $nextaccntno = getnextacctno($borrowernumber);
100 # get lines with outstanding amounts to offset
101 my $sth = $dbh->prepare(
102 "SELECT * FROM accountlines
103 WHERE (borrowernumber = ?) AND (amountoutstanding<>0)
106 $sth->execute($borrowernumber);
108 # offset transactions
109 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
110 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
112 $amountleft -= $accdata->{'amountoutstanding'};
115 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
118 my $thisacct = $accdata->{accountlines_id};
119 my $usth = $dbh->prepare(
120 "UPDATE accountlines SET amountoutstanding= ?
121 WHERE (accountlines_id = ?)"
123 $usth->execute( $newamtos, $thisacct );
125 # $usth = $dbh->prepare(
126 # "INSERT INTO accountoffsets
127 # (borrowernumber, accountno, offsetaccount, offsetamount)
130 # $usth->execute( $borrowernumber, $accdata->{'accountno'},
131 # $nextaccntno, $newamtos );
136 my $usth = $dbh->prepare(
137 "INSERT INTO accountlines
138 (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id)
139 VALUES (?,?,now(),?,'Payment,thanks','Pay',?,?)"
141 $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft, $manager_id );
143 UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno );
149 &makepayment($accountlines_id, $borrowernumber, $acctnumber, $amount, $branchcode);
151 Records the fact that a patron has paid off the entire amount he or
154 C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is
155 the account that was credited. C<$amount> is the amount paid (this is
156 only used to record the payment. It is assumed to be equal to the
157 amount owed). C<$branchcode> is the code of the branch where payment
163 # FIXME - I'm not at all sure about the above, because I don't
164 # understand what the acct* tables in the Koha database are for.
167 #here we update both the accountoffsets and the account lines
168 #updated to check, if they are paying off a lost item, we return the item
169 # from their card, and put a note on the item record
170 my ( $accountlines_id, $borrowernumber, $accountno, $amount, $user, $branch ) = @_;
171 my $dbh = C4::Context->dbh;
173 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
176 my $nextaccntno = getnextacctno($borrowernumber);
178 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE accountlines_id=?");
179 $sth->execute( $accountlines_id );
180 my $data = $sth->fetchrow_hashref;
183 if($data->{'accounttype'} eq "Pay"){
187 SET amountoutstanding = 0, description = 'Payment,thanks'
188 WHERE accountlines_id = ?
191 $udp->execute($accountlines_id);
197 SET amountoutstanding = 0
198 WHERE accountlines_id = ?
201 $udp->execute($accountlines_id);
205 my $payment = 0 - $amount;
210 INTO accountlines (borrowernumber, accountno, date, amount, itemnumber, description, accounttype, amountoutstanding, manager_id)
211 VALUES ( ?, ?, now(), ?, ?, 'Payment,thanks', 'Pay', 0, ?)"
213 $ins->execute($borrowernumber, $nextaccntno, $payment, $data->{'itemnumber'}, $manager_id);
217 # FIXME - The second argument to &UpdateStats is supposed to be the
219 # UpdateStats is now being passed $accountno too. MTJ
220 UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber,
222 #from perldoc: for SELECT only #$sth->finish;
224 #check to see what accounttype
225 if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
226 C4::Circulation::ReturnLostItem( $borrowernumber, $data->{'itemnumber'} );
228 my $sthr = $dbh->prepare("SELECT max(accountlines_id) AS lastinsertid FROM accountlines");
230 my $datalastinsertid = $sthr->fetchrow_hashref;
232 return $datalastinsertid->{'lastinsertid'};
237 $nextacct = &getnextacctno($borrowernumber);
239 Returns the next unused account number for the patron with the given
245 # FIXME - Okay, so what does the above actually _mean_?
247 my ($borrowernumber) = shift or return;
248 my $sth = C4::Context->dbh->prepare(
249 "SELECT accountno+1 FROM accountlines
250 WHERE (borrowernumber = ?)
251 ORDER BY accountno DESC
254 $sth->execute($borrowernumber);
255 return ($sth->fetchrow || 1);
258 =head2 fixaccounts (removed)
260 &fixaccounts($accountlines_id, $borrowernumber, $accountnumber, $amount);
263 # FIXME - I don't understand what this function does.
265 my ( $accountlines_id, $borrowernumber, $accountno, $amount ) = @_;
266 my $dbh = C4::Context->dbh;
267 my $sth = $dbh->prepare(
268 "SELECT * FROM accountlines WHERE accountlines_id=?"
270 $sth->execute( $accountlines_id );
271 my $data = $sth->fetchrow_hashref;
273 # FIXME - Error-checking
274 my $diff = $amount - $data->{'amount'};
275 my $outstanding = $data->{'amountoutstanding'} + $diff;
280 SET amount = '$amount',
281 amountoutstanding = '$outstanding'
282 WHERE accountlines_id = $accountlines_id
284 # FIXME: exceedingly bad form. Use prepare with placholders ("?") in query and execute args.
290 # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for
291 # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that
292 # a charge has been added
293 # FIXME : if no replacement price, borrower just doesn't get charged?
294 my $dbh = C4::Context->dbh();
295 my ($borrowernumber, $itemnumber, $amount, $description) = @_;
297 # first make sure the borrower hasn't already been charged for this item
298 my $sth1=$dbh->prepare("SELECT * from accountlines
299 WHERE borrowernumber=? AND itemnumber=? and accounttype='L'");
300 $sth1->execute($borrowernumber,$itemnumber);
301 my $existing_charge_hashref=$sth1->fetchrow_hashref();
304 unless ($existing_charge_hashref) {
306 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
307 # This item is on issue ... add replacement cost to the borrower's record and mark it returned
308 # Note that we add this to the account even if there's no replacement price, allowing some other
309 # process (or person) to update it, since we don't handle any defaults for replacement prices.
310 my $accountno = getnextacctno($borrowernumber);
311 my $sth2=$dbh->prepare("INSERT INTO accountlines
312 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber,manager_id)
313 VALUES (?,?,now(),?,?,'L',?,?,?)");
314 $sth2->execute($borrowernumber,$accountno,$amount,
315 $description,$amount,$itemnumber,$manager_id);
323 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
326 C<$borrowernumber> is the patron's borrower number.
327 C<$description> is a description of the transaction.
328 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
330 C<$itemnumber> is the item involved, if pertinent; otherwise, it
331 should be the empty string.
336 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
339 # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
342 # 'A' = Account Management fee
348 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_;
350 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
351 my $dbh = C4::Context->dbh;
354 my $accountno = getnextacctno($borrowernumber);
355 my $amountleft = $amount;
363 # my $amount2 = $amount * -1; # FIXME - $amount2 = -$amount
365 # fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user );
367 if ( $type eq 'N' ) {
368 $desc .= " New Card";
370 if ( $type eq 'F' ) {
373 if ( $type eq 'A' ) {
374 $desc .= " Account Management fee";
376 if ( $type eq 'M' ) {
380 if ( $type eq 'L' && $desc eq '' ) {
382 $desc = " Lost Item";
384 # if ( $type eq 'REF' ) {
385 # $desc .= " Cash Refund";
386 # $amountleft = refund( '', $borrowernumber, $amount );
388 if ( ( $type eq 'L' )
392 or ( $type eq 'M' ) )
398 $desc .= ' ' . $itemnum;
399 my $sth = $dbh->prepare(
400 'INSERT INTO accountlines
401 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id)
402 VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)');
403 $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr;
405 my $sth=$dbh->prepare("INSERT INTO accountlines
406 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id)
407 VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)"
409 $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
410 $amountleft, $notifyid, $note, $manager_id );
415 =head2 fixcredit #### DEPRECATED
417 $amountleft = &fixcredit($borrowernumber, $data, $barcode, $type, $user);
419 This function is only used internally, not exported.
423 # This function is deprecated in 3.0
427 #here we update both the accountoffsets and the account lines
428 my ( $borrowernumber, $data, $barcode, $type, $user ) = @_;
429 my $dbh = C4::Context->dbh;
432 my $amountleft = $data;
433 if ( $barcode ne '' ) {
434 my $item = GetBiblioFromItemNumber( '', $barcode );
435 my $nextaccntno = getnextacctno($borrowernumber);
436 my $query = "SELECT * FROM accountlines WHERE (borrowernumber=?
437 AND itemnumber=? AND amountoutstanding > 0)";
438 if ( $type eq 'CL' ) {
439 $query .= " AND (accounttype = 'L' OR accounttype = 'Rep')";
441 elsif ( $type eq 'CF' ) {
442 $query .= " AND (accounttype = 'F' OR accounttype = 'FU' OR
443 accounttype='Res' OR accounttype='Rent')";
445 elsif ( $type eq 'CB' ) {
446 $query .= " and accounttype='A'";
450 my $sth = $dbh->prepare($query);
451 $sth->execute( $borrowernumber, $item->{'itemnumber'} );
452 $accdata = $sth->fetchrow_hashref;
454 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
456 $amountleft -= $accdata->{'amountoutstanding'};
459 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
462 my $thisacct = $accdata->{accountlines_id};
463 my $usth = $dbh->prepare(
464 "UPDATE accountlines SET amountoutstanding= ?
465 WHERE (accountlines_id = ?)"
467 $usth->execute( $newamtos, $thisacct );
469 $usth = $dbh->prepare(
470 "INSERT INTO accountoffsets
471 (borrowernumber, accountno, offsetaccount, offsetamount)
474 $usth->execute( $borrowernumber, $accdata->{'accountno'},
475 $nextaccntno, $newamtos );
480 my $nextaccntno = getnextacctno($borrowernumber);
482 # get lines with outstanding amounts to offset
483 my $sth = $dbh->prepare(
484 "SELECT * FROM accountlines
485 WHERE (borrowernumber = ?) AND (amountoutstanding >0)
488 $sth->execute($borrowernumber);
491 # offset transactions
492 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
493 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
495 $amountleft -= $accdata->{'amountoutstanding'};
498 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
501 my $thisacct = $accdata->{accountlines_id};
502 my $usth = $dbh->prepare(
503 "UPDATE accountlines SET amountoutstanding= ?
504 WHERE (accountlines_id = ?)"
506 $usth->execute( $newamtos, $thisacct );
508 $usth = $dbh->prepare(
509 "INSERT INTO accountoffsets
510 (borrowernumber, accountno, offsetaccount, offsetamount)
513 $usth->execute( $borrowernumber, $accdata->{'accountno'},
514 $nextaccntno, $newamtos );
518 $type = "Credit " . $type;
519 UpdateStats( $user, $type, $data, $user, '', '', $borrowernumber );
521 return ($amountleft);
527 #FIXME : DEPRECATED SUB
528 This subroutine tracks payments and/or credits against fines/charges
529 using the accountoffsets table, which is not used consistently in
530 Koha's fines management, and so is not used in 3.0
536 #here we update both the accountoffsets and the account lines
537 my ( $borrowernumber, $data ) = @_;
538 my $dbh = C4::Context->dbh;
541 my $amountleft = $data * -1;
544 my $nextaccntno = getnextacctno($borrowernumber);
546 # get lines with outstanding amounts to offset
547 my $sth = $dbh->prepare(
548 "SELECT * FROM accountlines
549 WHERE (borrowernumber = ?) AND (amountoutstanding<0)
552 $sth->execute($borrowernumber);
555 # offset transactions
556 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) {
557 if ( $accdata->{'amountoutstanding'} > $amountleft ) {
559 $amountleft -= $accdata->{'amountoutstanding'};
562 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
567 my $thisacct = $accdata->{accountlines_id};
568 my $usth = $dbh->prepare(
569 "UPDATE accountlines SET amountoutstanding= ?
570 WHERE (accountlines_id = ?)"
572 $usth->execute( $newamtos, $thisacct );
574 $usth = $dbh->prepare(
575 "INSERT INTO accountoffsets
576 (borrowernumber, accountno, offsetaccount, offsetamount)
579 $usth->execute( $borrowernumber, $accdata->{'accountno'},
580 $nextaccntno, $newamtos );
584 return ($amountleft);
588 my ( $borrowerno, $timestamp, $accountno ) = @_;
589 my $dbh = C4::Context->dbh;
590 my $timestamp2 = $timestamp - 1;
592 my $sth = $dbh->prepare(
593 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
595 $sth->execute( $borrowerno, $accountno );
598 while ( my $data = $sth->fetchrow_hashref ) {
605 my ( $accountlines_id, $note ) = @_;
606 my $dbh = C4::Context->dbh;
607 my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE accountlines_id = ?');
608 $sth->execute( $note, $accountlines_id );
612 my ( $date, $date2 ) = @_;
613 my $dbh = C4::Context->dbh;
614 my $sth = $dbh->prepare(
615 "SELECT * FROM accountlines,borrowers
616 WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber
617 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
620 $sth->execute( $date, $date2 );
622 while ( my $data = $sth->fetchrow_hashref ) {
623 $data->{'date'} = $data->{'timestamp'};
631 my ( $date, $date2 ) = @_;
632 my $dbh = C4::Context->dbh;
634 my $sth = $dbh->prepare(
635 "SELECT *,timestamp AS datetime
636 FROM accountlines,borrowers
637 WHERE (accounttype = 'REF'
638 AND accountlines.borrowernumber = borrowers.borrowernumber
639 AND date >=? AND date <?)"
642 $sth->execute( $date, $date2 );
645 while ( my $data = $sth->fetchrow_hashref ) {
653 my ( $accountlines_id ) = @_;
654 my $dbh = C4::Context->dbh;
656 my $sth = $dbh->prepare('SELECT amountoutstanding FROM accountlines WHERE accountlines_id = ?');
657 $sth->execute( $accountlines_id );
658 my $row = $sth->fetchrow_hashref();
659 my $amount_outstanding = $row->{'amountoutstanding'};
661 if ( $amount_outstanding <= 0 ) {
662 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE accountlines_id = ?');
663 $sth->execute( $accountlines_id );
665 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE accountlines_id = ?');
666 $sth->execute( $accountlines_id );
670 =head2 recordpayment_selectaccts
672 recordpayment_selectaccts($borrowernumber, $payment,$accts);
674 Record payment by a patron. C<$borrowernumber> is the patron's
675 borrower number. C<$payment> is a floating-point number, giving the
676 amount that was paid. C<$accts> is an array ref to a list of
677 accountnos which the payment can be recorded against
679 Amounts owed are paid off oldest first. That is, if the patron has a
680 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
681 of $1.50, then the oldest fine will be paid off in full, and $0.50
682 will be credited to the next one.
686 sub recordpayment_selectaccts {
687 my ( $borrowernumber, $amount, $accts ) = @_;
689 my $dbh = C4::Context->dbh;
692 my $branch = C4::Context->userenv->{branch};
693 my $amountleft = $amount;
695 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
696 my $sql = 'SELECT * FROM accountlines WHERE (borrowernumber = ?) ' .
697 'AND (amountoutstanding<>0) ';
699 $sql .= ' AND accountno IN ( ' . join ',', @{$accts};
702 $sql .= ' ORDER BY date';
704 my $nextaccntno = getnextacctno($borrowernumber);
706 # get lines with outstanding amounts to offset
707 my $rows = $dbh->selectall_arrayref($sql, { Slice => {} }, $borrowernumber);
709 # offset transactions
710 my $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding= ? ' .
711 'WHERE accountlines_id=?');
712 for my $accdata ( @{$rows} ) {
713 if ($amountleft == 0) {
716 if ( $accdata->{amountoutstanding} < $amountleft ) {
718 $amountleft -= $accdata->{amountoutstanding};
721 $newamtos = $accdata->{amountoutstanding} - $amountleft;
724 my $thisacct = $accdata->{accountlines_id};
725 $sth->execute( $newamtos, $thisacct );
729 $sql = 'INSERT INTO accountlines ' .
730 '(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id) ' .
731 q|VALUES (?,?,now(),?,'Payment,thanks','Pay',?,?)|;
732 $dbh->do($sql,{},$borrowernumber, $nextaccntno, 0 - $amount, 0 - $amountleft, $manager_id );
733 UpdateStats( $branch, 'payment', $amount, '', '', '', $borrowernumber, $nextaccntno );
737 # makepayment needs to be fixed to handle partials till then this separate subroutine
739 sub makepartialpayment {
740 my ( $accountlines_id, $borrowernumber, $accountno, $amount, $user, $branch ) = @_;
742 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
743 if (!$amount || $amount < 0) {
746 my $dbh = C4::Context->dbh;
748 my $nextaccntno = getnextacctno($borrowernumber);
751 my $data = $dbh->selectrow_hashref(
752 'SELECT * FROM accountlines WHERE accountlines_id=?',undef,$accountlines_id);
753 my $new_outstanding = $data->{amountoutstanding} - $amount;
755 my $update = 'UPDATE accountlines SET amountoutstanding = ? WHERE accountlines_id = ? ';
756 $dbh->do( $update, undef, $new_outstanding, $accountlines_id);
759 my $insert = 'INSERT INTO accountlines (borrowernumber, accountno, date, amount, '
760 . 'description, accounttype, amountoutstanding, itemnumber, manager_id) '
761 . ' VALUES (?, ?, now(), ?, ?, ?, 0, ?, ?)';
763 $dbh->do( $insert, undef, $borrowernumber, $nextaccntno, 0 - $amount,
764 "Payment, thanks - $user", 'Pay', $data->{'itemnumber'}, $manager_id);
766 UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber, $accountno );
773 WriteOff( $borrowernumber, $accountline_id, $itemnum, $accounttype, $amount, $branch );
775 Write off a fine for a patron.
776 C<$borrowernumber> is the patron's borrower number.
777 C<$accountline_id> is the accountline_id of the fee to write off.
778 C<$itemnum> is the itemnumber of of item whose fine is being written off.
779 C<$accounttype> is the account type of the fine being written off.
780 C<$amount> is a floating-point number, giving the amount that is being written off.
781 C<$branch> is the branchcode of the library where the writeoff occurred.
786 my ( $borrowernumber, $accountline_id, $itemnum, $accounttype, $amount, $branch ) = @_;
787 $branch ||= C4::Context->userenv->{branch};
789 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
791 # if no item is attached to fine, make sure to store it as a NULL
795 my $dbh = C4::Context->dbh();
798 UPDATE accountlines SET amountoutstanding = 0
799 WHERE accountlines_id = ? AND borrowernumber = ?
801 $sth = $dbh->prepare( $query );
802 $sth->execute( $accountline_id, $borrowernumber );
805 INSERT INTO accountlines
806 ( borrowernumber, accountno, itemnumber, date, amount, description, accounttype, manager_id )
807 VALUES ( ?, ?, ?, NOW(), ?, 'Writeoff', 'W', ? )
809 $sth = $dbh->prepare( $query );
810 my $acct = getnextacctno($borrowernumber);
811 $sth->execute( $borrowernumber, $acct, $itemnum, $amount, $manager_id );
813 UpdateStats( $branch, 'writeoff', $amount, q{}, q{}, q{}, $borrowernumber );
817 END { } # module clean-up code here (global destructor)