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
41 ); # removed &fixaccounts
46 C4::Accounts - Functions for dealing with Koha accounts
54 The functions in this module deal with the monetary aspect of Koha,
55 including looking up and modifying the amount of money owed by a
62 &recordpayment($borrowernumber, $payment);
64 Record payment by a patron. C<$borrowernumber> is the patron's
65 borrower number. C<$payment> is a floating-point number, giving the
68 Amounts owed are paid off oldest first. That is, if the patron has a
69 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
70 of $1.50, then the oldest fine will be paid off in full, and $0.50
71 will be credited to the next one.
78 #here we update the account lines
79 my ( $borrowernumber, $data ) = @_;
80 my $dbh = C4::Context->dbh;
83 my $branch = C4::Context->userenv->{'branch'};
84 my $amountleft = $data;
87 my $nextaccntno = getnextacctno($borrowernumber);
89 # get lines with outstanding amounts to offset
90 my $sth = $dbh->prepare(
91 "SELECT * FROM accountlines
92 WHERE (borrowernumber = ?) AND (amountoutstanding<>0)
95 $sth->execute($borrowernumber);
98 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
99 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
101 $amountleft -= $accdata->{'amountoutstanding'};
104 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
107 my $thisacct = $accdata->{accountno};
108 my $usth = $dbh->prepare(
109 "UPDATE accountlines SET amountoutstanding= ?
110 WHERE (borrowernumber = ?) AND (accountno=?)"
112 $usth->execute( $newamtos, $borrowernumber, $thisacct );
114 # $usth = $dbh->prepare(
115 # "INSERT INTO accountoffsets
116 # (borrowernumber, accountno, offsetaccount, offsetamount)
119 # $usth->execute( $borrowernumber, $accdata->{'accountno'},
120 # $nextaccntno, $newamtos );
125 my $usth = $dbh->prepare(
126 "INSERT INTO accountlines
127 (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding)
128 VALUES (?,?,now(),?,'Payment,thanks','Pay',?)"
130 $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft );
132 UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno );
138 &makepayment($borrowernumber, $acctnumber, $amount, $branchcode);
140 Records the fact that a patron has paid off the entire amount he or
143 C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is
144 the account that was credited. C<$amount> is the amount paid (this is
145 only used to record the payment. It is assumed to be equal to the
146 amount owed). C<$branchcode> is the code of the branch where payment
152 # FIXME - I'm not at all sure about the above, because I don't
153 # understand what the acct* tables in the Koha database are for.
156 #here we update both the accountoffsets and the account lines
157 #updated to check, if they are paying off a lost item, we return the item
158 # from their card, and put a note on the item record
159 my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_;
160 my $dbh = C4::Context->dbh;
162 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
165 my $nextaccntno = getnextacctno($borrowernumber);
169 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?");
170 $sth->execute( $borrowernumber, $accountno );
171 my $data = $sth->fetchrow_hashref;
174 if($data->{'accounttype'} eq "Pay"){
178 SET amountoutstanding = 0, description = 'Payment,thanks'
179 WHERE borrowernumber = ?
183 $udp->execute($borrowernumber, $accountno );
189 SET amountoutstanding = 0
190 WHERE borrowernumber = ?
194 $udp->execute($borrowernumber, $accountno );
198 my $payment = 0 - $amount;
203 INTO accountlines (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding)
204 VALUES ( ?, ?, now(), ?, 'Payment,thanks', 'Pay', 0)"
206 $ins->execute($borrowernumber, $nextaccntno, $payment);
210 # FIXME - The second argument to &UpdateStats is supposed to be the
212 # UpdateStats is now being passed $accountno too. MTJ
213 UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber,
215 #from perldoc: for SELECT only #$sth->finish;
217 #check to see what accounttype
218 if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
219 returnlost( $borrowernumber, $data->{'itemnumber'} );
225 $nextacct = &getnextacctno($borrowernumber);
227 Returns the next unused account number for the patron with the given
233 # FIXME - Okay, so what does the above actually _mean_?
234 sub getnextacctno ($) {
235 my ($borrowernumber) = shift or return undef;
236 my $sth = C4::Context->dbh->prepare(
237 "SELECT accountno+1 FROM accountlines
238 WHERE (borrowernumber = ?)
239 ORDER BY accountno DESC
242 $sth->execute($borrowernumber);
243 return ($sth->fetchrow || 1);
246 =head2 fixaccounts (removed)
248 &fixaccounts($borrowernumber, $accountnumber, $amount);
251 # FIXME - I don't understand what this function does.
253 my ( $borrowernumber, $accountno, $amount ) = @_;
254 my $dbh = C4::Context->dbh;
255 my $sth = $dbh->prepare(
256 "SELECT * FROM accountlines WHERE borrowernumber=?
259 $sth->execute( $borrowernumber, $accountno );
260 my $data = $sth->fetchrow_hashref;
262 # FIXME - Error-checking
263 my $diff = $amount - $data->{'amount'};
264 my $outstanding = $data->{'amountoutstanding'} + $diff;
269 SET amount = '$amount',
270 amountoutstanding = '$outstanding'
271 WHERE borrowernumber = $borrowernumber
272 AND accountno = $accountno
274 # FIXME: exceedingly bad form. Use prepare with placholders ("?") in query and execute args.
280 my ( $borrowernumber, $itemnum ) = @_;
281 C4::Circulation::MarkIssueReturned( $borrowernumber, $itemnum );
282 my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
283 my @datearr = localtime(time);
284 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
285 my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
286 ModItem({ paidfor => "Paid for by $bor $date" }, undef, $itemnum);
291 # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for
292 # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that
293 # a charge has been added
294 # FIXME : if no replacement price, borrower just doesn't get charged?
296 my $dbh = C4::Context->dbh();
297 my ($itemnumber) = @_;
298 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
300 JOIN items USING (itemnumber)
301 JOIN biblio USING (biblionumber)
302 WHERE issues.itemnumber=?");
303 $sth->execute($itemnumber);
304 my $issues=$sth->fetchrow_hashref();
306 # if a borrower lost the item, add a replacement cost to the their record
307 if ( $issues->{borrowernumber} ){
309 # first make sure the borrower hasn't already been charged for this item
310 my $sth1=$dbh->prepare("SELECT * from accountlines
311 WHERE borrowernumber=? AND itemnumber=? and accounttype='L'");
312 $sth1->execute($issues->{'borrowernumber'},$itemnumber);
313 my $existing_charge_hashref=$sth1->fetchrow_hashref();
316 unless ($existing_charge_hashref) {
317 # This item is on issue ... add replacement cost to the borrower's record and mark it returned
318 # Note that we add this to the account even if there's no replacement price, allowing some other
319 # process (or person) to update it, since we don't handle any defaults for replacement prices.
320 my $accountno = getnextacctno($issues->{'borrowernumber'});
321 my $sth2=$dbh->prepare("INSERT INTO accountlines
322 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber)
323 VALUES (?,?,now(),?,?,'L',?,?)");
324 $sth2->execute($issues->{'borrowernumber'},$accountno,$issues->{'replacementprice'},
325 "Lost Item $issues->{'title'} $issues->{'barcode'}",
326 $issues->{'replacementprice'},$itemnumber);
330 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
331 #warn " $issues->{'borrowernumber'} / $itemnumber ";
332 C4::Circulation::MarkIssueReturned($issues->{borrowernumber},$itemnumber);
333 # Shouldn't MarkIssueReturned do this?
334 C4::Items::ModItem({ onloan => undef }, undef, $itemnumber);
341 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
344 C<$borrowernumber> is the patron's borrower number.
345 C<$description> is a description of the transaction.
346 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
348 C<$itemnumber> is the item involved, if pertinent; otherwise, it
349 should be the empty string.
354 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
357 # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
360 # 'A' = Account Management fee
366 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_;
368 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
369 my $dbh = C4::Context->dbh;
373 my $accountno = getnextacctno($borrowernumber);
374 my $amountleft = $amount;
382 # my $amount2 = $amount * -1; # FIXME - $amount2 = -$amount
384 # fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user );
386 if ( $type eq 'N' ) {
387 $desc .= " New Card";
389 if ( $type eq 'F' ) {
392 if ( $type eq 'A' ) {
393 $desc .= " Account Management fee";
395 if ( $type eq 'M' ) {
399 if ( $type eq 'L' && $desc eq '' ) {
401 $desc = " Lost Item";
403 # if ( $type eq 'REF' ) {
404 # $desc .= " Cash Refund";
405 # $amountleft = refund( '', $borrowernumber, $amount );
407 if ( ( $type eq 'L' )
411 or ( $type eq 'M' ) )
416 if ( $itemnum ne '' ) {
417 $desc .= " " . $itemnum;
418 my $sth = $dbh->prepare(
419 "INSERT INTO accountlines
420 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id)
421 VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)");
422 $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr;
424 my $sth=$dbh->prepare("INSERT INTO accountlines
425 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id)
426 VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)"
428 $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
429 $amountleft, $notifyid, $note, $manager_id );
434 =head2 fixcredit #### DEPRECATED
436 $amountleft = &fixcredit($borrowernumber, $data, $barcode, $type, $user);
438 This function is only used internally, not exported.
442 # This function is deprecated in 3.0
446 #here we update both the accountoffsets and the account lines
447 my ( $borrowernumber, $data, $barcode, $type, $user ) = @_;
448 my $dbh = C4::Context->dbh;
451 my $amountleft = $data;
452 if ( $barcode ne '' ) {
453 my $item = GetBiblioFromItemNumber( '', $barcode );
454 my $nextaccntno = getnextacctno($borrowernumber);
455 my $query = "SELECT * FROM accountlines WHERE (borrowernumber=?
456 AND itemnumber=? AND amountoutstanding > 0)";
457 if ( $type eq 'CL' ) {
458 $query .= " AND (accounttype = 'L' OR accounttype = 'Rep')";
460 elsif ( $type eq 'CF' ) {
461 $query .= " AND (accounttype = 'F' OR accounttype = 'FU' OR
462 accounttype='Res' OR accounttype='Rent')";
464 elsif ( $type eq 'CB' ) {
465 $query .= " and accounttype='A'";
469 my $sth = $dbh->prepare($query);
470 $sth->execute( $borrowernumber, $item->{'itemnumber'} );
471 $accdata = $sth->fetchrow_hashref;
473 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
475 $amountleft -= $accdata->{'amountoutstanding'};
478 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
481 my $thisacct = $accdata->{accountno};
482 my $usth = $dbh->prepare(
483 "UPDATE accountlines SET amountoutstanding= ?
484 WHERE (borrowernumber = ?) AND (accountno=?)"
486 $usth->execute( $newamtos, $borrowernumber, $thisacct );
488 $usth = $dbh->prepare(
489 "INSERT INTO accountoffsets
490 (borrowernumber, accountno, offsetaccount, offsetamount)
493 $usth->execute( $borrowernumber, $accdata->{'accountno'},
494 $nextaccntno, $newamtos );
499 my $nextaccntno = getnextacctno($borrowernumber);
501 # get lines with outstanding amounts to offset
502 my $sth = $dbh->prepare(
503 "SELECT * FROM accountlines
504 WHERE (borrowernumber = ?) AND (amountoutstanding >0)
507 $sth->execute($borrowernumber);
510 # offset transactions
511 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
512 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
514 $amountleft -= $accdata->{'amountoutstanding'};
517 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
520 my $thisacct = $accdata->{accountno};
521 my $usth = $dbh->prepare(
522 "UPDATE accountlines SET amountoutstanding= ?
523 WHERE (borrowernumber = ?) AND (accountno=?)"
525 $usth->execute( $newamtos, $borrowernumber, $thisacct );
527 $usth = $dbh->prepare(
528 "INSERT INTO accountoffsets
529 (borrowernumber, accountno, offsetaccount, offsetamount)
532 $usth->execute( $borrowernumber, $accdata->{'accountno'},
533 $nextaccntno, $newamtos );
537 $type = "Credit " . $type;
538 UpdateStats( $user, $type, $data, $user, '', '', $borrowernumber );
540 return ($amountleft);
546 #FIXME : DEPRECATED SUB
547 This subroutine tracks payments and/or credits against fines/charges
548 using the accountoffsets table, which is not used consistently in
549 Koha's fines management, and so is not used in 3.0
555 #here we update both the accountoffsets and the account lines
556 my ( $borrowernumber, $data ) = @_;
557 my $dbh = C4::Context->dbh;
560 my $amountleft = $data * -1;
563 my $nextaccntno = getnextacctno($borrowernumber);
565 # get lines with outstanding amounts to offset
566 my $sth = $dbh->prepare(
567 "SELECT * FROM accountlines
568 WHERE (borrowernumber = ?) AND (amountoutstanding<0)
571 $sth->execute($borrowernumber);
574 # offset transactions
575 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) {
576 if ( $accdata->{'amountoutstanding'} > $amountleft ) {
578 $amountleft -= $accdata->{'amountoutstanding'};
581 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
586 my $thisacct = $accdata->{accountno};
587 my $usth = $dbh->prepare(
588 "UPDATE accountlines SET amountoutstanding= ?
589 WHERE (borrowernumber = ?) AND (accountno=?)"
591 $usth->execute( $newamtos, $borrowernumber, $thisacct );
593 $usth = $dbh->prepare(
594 "INSERT INTO accountoffsets
595 (borrowernumber, accountno, offsetaccount, offsetamount)
598 $usth->execute( $borrowernumber, $accdata->{'accountno'},
599 $nextaccntno, $newamtos );
603 return ($amountleft);
607 my ( $borrowerno, $timestamp, $accountno ) = @_;
608 my $dbh = C4::Context->dbh;
609 my $timestamp2 = $timestamp - 1;
611 my $sth = $dbh->prepare(
612 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
614 $sth->execute( $borrowerno, $accountno );
617 while ( my $data = $sth->fetchrow_hashref ) {
624 my ( $borrowernumber, $accountno, $note ) = @_;
625 my $dbh = C4::Context->dbh;
626 my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE borrowernumber = ? AND accountno = ?');
627 $sth->execute( $note, $borrowernumber, $accountno );
631 my ( $date, $date2 ) = @_;
632 my $dbh = C4::Context->dbh;
633 my $sth = $dbh->prepare(
634 "SELECT * FROM accountlines,borrowers
635 WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber
636 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
639 $sth->execute( $date, $date2 );
641 while ( my $data = $sth->fetchrow_hashref ) {
642 $data->{'date'} = $data->{'timestamp'};
650 my ( $date, $date2 ) = @_;
651 my $dbh = C4::Context->dbh;
653 my $sth = $dbh->prepare(
654 "SELECT *,timestamp AS datetime
655 FROM accountlines,borrowers
656 WHERE (accounttype = 'REF'
657 AND accountlines.borrowernumber = borrowers.borrowernumber
658 AND date >=? AND date <?)"
661 $sth->execute( $date, $date2 );
664 while ( my $data = $sth->fetchrow_hashref ) {
672 my ( $borrowernumber, $accountno ) = @_;
673 my $dbh = C4::Context->dbh;
675 my $sth = $dbh->prepare('SELECT amountoutstanding FROM accountlines WHERE borrowernumber = ? AND accountno = ?');
676 $sth->execute( $borrowernumber, $accountno );
677 my $row = $sth->fetchrow_hashref();
678 my $amount_outstanding = $row->{'amountoutstanding'};
680 if ( $amount_outstanding <= 0 ) {
681 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
682 $sth->execute( $borrowernumber, $accountno );
684 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
685 $sth->execute( $borrowernumber, $accountno );
689 END { } # module clean-up code here (global destructor)