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 with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
26 use C4
::Circulation
qw(MarkIssueReturned);
28 use vars
qw($VERSION @ISA @EXPORT);
31 # set the version for version checking
36 &recordpayment &makepayment &manualinvoice
37 &getnextacctno &reconcileaccount &getcharges &getcredits
38 &getrefunds &chargelostitem
40 ); # removed &fixaccounts
45 C4::Accounts - Functions for dealing with Koha accounts
53 The functions in this module deal with the monetary aspect of Koha,
54 including looking up and modifying the amount of money owed by a
61 &recordpayment($borrowernumber, $payment);
63 Record payment by a patron. C<$borrowernumber> is the patron's
64 borrower number. C<$payment> is a floating-point number, giving the
67 Amounts owed are paid off oldest first. That is, if the patron has a
68 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
69 of $1.50, then the oldest fine will be paid off in full, and $0.50
70 will be credited to the next one.
77 #here we update the account lines
78 my ( $borrowernumber, $data ) = @_;
79 my $dbh = C4
::Context
->dbh;
82 my $branch = C4
::Context
->userenv->{'branch'};
83 my $amountleft = $data;
86 my $nextaccntno = getnextacctno
($borrowernumber);
88 # get lines with outstanding amounts to offset
89 my $sth = $dbh->prepare(
90 "SELECT * FROM accountlines
91 WHERE (borrowernumber = ?) AND (amountoutstanding<>0)
94 $sth->execute($borrowernumber);
97 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
98 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
100 $amountleft -= $accdata->{'amountoutstanding'};
103 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
106 my $thisacct = $accdata->{accountno
};
107 my $usth = $dbh->prepare(
108 "UPDATE accountlines SET amountoutstanding= ?
109 WHERE (borrowernumber = ?) AND (accountno=?)"
111 $usth->execute( $newamtos, $borrowernumber, $thisacct );
113 # $usth = $dbh->prepare(
114 # "INSERT INTO accountoffsets
115 # (borrowernumber, accountno, offsetaccount, offsetamount)
118 # $usth->execute( $borrowernumber, $accdata->{'accountno'},
119 # $nextaccntno, $newamtos );
124 my $usth = $dbh->prepare(
125 "INSERT INTO accountlines
126 (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding)
127 VALUES (?,?,now(),?,'Payment,thanks','Pay',?)"
129 $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft );
131 UpdateStats
( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno );
137 &makepayment($borrowernumber, $acctnumber, $amount, $branchcode);
139 Records the fact that a patron has paid off the entire amount he or
142 C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is
143 the account that was credited. C<$amount> is the amount paid (this is
144 only used to record the payment. It is assumed to be equal to the
145 amount owed). C<$branchcode> is the code of the branch where payment
151 # FIXME - I'm not at all sure about the above, because I don't
152 # understand what the acct* tables in the Koha database are for.
155 #here we update both the accountoffsets and the account lines
156 #updated to check, if they are paying off a lost item, we return the item
157 # from their card, and put a note on the item record
158 my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_;
159 my $dbh = C4
::Context
->dbh;
162 my $nextaccntno = getnextacctno
($borrowernumber);
166 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?");
167 $sth->execute( $borrowernumber, $accountno );
168 my $data = $sth->fetchrow_hashref;
173 SET amountoutstanding = 0
174 WHERE borrowernumber = $borrowernumber
175 AND accountno = $accountno
181 # INSERT INTO accountoffsets
182 # (borrowernumber, accountno, offsetaccount,
184 # VALUES ($borrowernumber, $accountno, $nextaccntno, $newamtos)
188 my $payment = 0 - $amount;
190 INSERT INTO accountlines
191 (borrowernumber, accountno, date, amount,
192 description, accounttype, amountoutstanding)
193 VALUES ($borrowernumber, $nextaccntno, now(), $payment,
194 'Payment,thanks - $user', 'Pay', 0)
197 # FIXME - The second argument to &UpdateStats is supposed to be the
199 # UpdateStats is now being passed $accountno too. MTJ
200 UpdateStats
( $user, 'payment', $amount, '', '', '', $borrowernumber,
204 #check to see what accounttype
205 if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
206 returnlost
( $borrowernumber, $data->{'itemnumber'} );
212 $nextacct = &getnextacctno($borrowernumber);
214 Returns the next unused account number for the patron with the given
220 # FIXME - Okay, so what does the above actually _mean_?
221 sub getnextacctno
($) {
222 my ($borrowernumber) = shift or return undef;
223 my $sth = C4
::Context
->dbh->prepare(
224 "SELECT accountno+1 FROM accountlines
225 WHERE (borrowernumber = ?)
226 ORDER BY accountno DESC
229 $sth->execute($borrowernumber);
230 return ($sth->fetchrow || 1);
233 =head2 fixaccounts (removed)
235 &fixaccounts($borrowernumber, $accountnumber, $amount);
238 # FIXME - I don't understand what this function does.
240 my ( $borrowernumber, $accountno, $amount ) = @_;
241 my $dbh = C4::Context->dbh;
242 my $sth = $dbh->prepare(
243 "SELECT * FROM accountlines WHERE borrowernumber=?
246 $sth->execute( $borrowernumber, $accountno );
247 my $data = $sth->fetchrow_hashref;
249 # FIXME - Error-checking
250 my $diff = $amount - $data->{'amount'};
251 my $outstanding = $data->{'amountoutstanding'} + $diff;
256 SET amount = '$amount',
257 amountoutstanding = '$outstanding'
258 WHERE borrowernumber = $borrowernumber
259 AND accountno = $accountno
261 # FIXME: exceedingly bad form. Use prepare with placholders ("?") in query and execute args.
267 my ( $borrowernumber, $itemnum ) = @_;
268 C4
::Circulation
::MarkIssueReturned
( $borrowernumber, $itemnum );
269 my $borrower = C4
::Members
::GetMember
( 'borrowernumber'=>$borrowernumber );
270 my @datearr = localtime(time);
271 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
272 my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
273 ModItem
({ paidfor
=> "Paid for by $bor $date" }, undef, $itemnum);
278 # http://wiki.koha.org/doku.php?id=en:development:kohastatuses
279 # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for
280 # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that
281 # a charge has been added
282 # FIXME : if no replacement price, borrower just doesn't get charged?
284 my $dbh = C4
::Context
->dbh();
285 my ($itemnumber) = @_;
286 my $sth=$dbh->prepare("SELECT * FROM issues, items WHERE issues.itemnumber=items.itemnumber and issues.itemnumber=?");
287 $sth->execute($itemnumber);
288 my $issues=$sth->fetchrow_hashref();
290 # if a borrower lost the item, add a replacement cost to the their record
291 if ( $issues->{borrowernumber
} ){
293 # first make sure the borrower hasn't already been charged for this item
294 my $sth1=$dbh->prepare("SELECT * from accountlines
295 WHERE borrowernumber=? AND itemnumber=? and accounttype='L'");
296 $sth1->execute($issues->{'borrowernumber'},$itemnumber);
297 my $existing_charge_hashref=$sth1->fetchrow_hashref();
300 unless ($existing_charge_hashref) {
301 # This item is on issue ... add replacement cost to the borrower's record and mark it returned
302 # Note that we add this to the account even if there's no replacement price, allowing some other
303 # process (or person) to update it, since we don't handle any defaults for replacement prices.
304 my $accountno = getnextacctno
($issues->{'borrowernumber'});
305 my $sth2=$dbh->prepare("INSERT INTO accountlines
306 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber)
307 VALUES (?,?,now(),?,?,'L',?,?)");
308 $sth2->execute($issues->{'borrowernumber'},$accountno,$issues->{'replacementprice'},
309 "Lost Item $issues->{'title'} $issues->{'barcode'}",
310 $issues->{'replacementprice'},$itemnumber);
314 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
315 warn " $issues->{'borrowernumber'} / $itemnumber ";
316 C4
::Circulation
::MarkIssueReturned
($issues->{borrowernumber
},$itemnumber);
317 # Shouldn't MarkIssueReturned do this?
318 ModItem
({ onloan
=> undef }, undef, $itemnumber);
325 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
328 C<$borrowernumber> is the patron's borrower number.
329 C<$description> is a description of the transaction.
330 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
332 C<$itemnumber> is the item involved, if pertinent; otherwise, it
333 should be the empty string.
338 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
341 # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
344 # 'A' = Account Management fee
350 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $user ) = @_;
351 my $dbh = C4
::Context
->dbh;
355 my $accountno = getnextacctno
($borrowernumber);
356 my $amountleft = $amount;
364 # my $amount2 = $amount * -1; # FIXME - $amount2 = -$amount
366 # fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user );
368 if ( $type eq 'N' ) {
369 $desc .= " New Card";
371 if ( $type eq 'F' ) {
374 if ( $type eq 'A' ) {
375 $desc .= " Account Management fee";
377 if ( $type eq 'M' ) {
381 if ( $type eq 'L' && $desc eq '' ) {
383 $desc = " Lost Item";
385 # if ( $type eq 'REF' ) {
386 # $desc .= " Cash Refund";
387 # $amountleft = refund( '', $borrowernumber, $amount );
389 if ( ( $type eq 'L' )
393 or ( $type eq 'M' ) )
398 if ( $itemnum ne '' ) {
399 $desc .= " " . $itemnum;
400 my $sth = $dbh->prepare(
401 "INSERT INTO accountlines
402 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id)
403 VALUES (?, ?, now(), ?,?, ?,?,?,?)");
404 $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid) || return $sth->errstr;
406 my $sth=$dbh->prepare("INSERT INTO accountlines
407 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id)
408 VALUES (?, ?, now(), ?, ?, ?, ?,?)"
410 $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
411 $amountleft, $notifyid );
416 =head2 fixcredit #### DEPRECATED
418 $amountleft = &fixcredit($borrowernumber, $data, $barcode, $type, $user);
420 This function is only used internally, not exported.
424 # This function is deprecated in 3.0
428 #here we update both the accountoffsets and the account lines
429 my ( $borrowernumber, $data, $barcode, $type, $user ) = @_;
430 my $dbh = C4
::Context
->dbh;
433 my $amountleft = $data;
434 if ( $barcode ne '' ) {
435 my $item = GetBiblioFromItemNumber
( '', $barcode );
436 my $nextaccntno = getnextacctno
($borrowernumber);
437 my $query = "SELECT * FROM accountlines WHERE (borrowernumber=?
438 AND itemnumber=? AND amountoutstanding > 0)";
439 if ( $type eq 'CL' ) {
440 $query .= " AND (accounttype = 'L' OR accounttype = 'Rep')";
442 elsif ( $type eq 'CF' ) {
443 $query .= " AND (accounttype = 'F' OR accounttype = 'FU' OR
444 accounttype='Res' OR accounttype='Rent')";
446 elsif ( $type eq 'CB' ) {
447 $query .= " and accounttype='A'";
451 my $sth = $dbh->prepare($query);
452 $sth->execute( $borrowernumber, $item->{'itemnumber'} );
453 $accdata = $sth->fetchrow_hashref;
455 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
457 $amountleft -= $accdata->{'amountoutstanding'};
460 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
463 my $thisacct = $accdata->{accountno
};
464 my $usth = $dbh->prepare(
465 "UPDATE accountlines SET amountoutstanding= ?
466 WHERE (borrowernumber = ?) AND (accountno=?)"
468 $usth->execute( $newamtos, $borrowernumber, $thisacct );
470 $usth = $dbh->prepare(
471 "INSERT INTO accountoffsets
472 (borrowernumber, accountno, offsetaccount, offsetamount)
475 $usth->execute( $borrowernumber, $accdata->{'accountno'},
476 $nextaccntno, $newamtos );
481 my $nextaccntno = getnextacctno
($borrowernumber);
483 # get lines with outstanding amounts to offset
484 my $sth = $dbh->prepare(
485 "SELECT * FROM accountlines
486 WHERE (borrowernumber = ?) AND (amountoutstanding >0)
489 $sth->execute($borrowernumber);
492 # offset transactions
493 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
494 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
496 $amountleft -= $accdata->{'amountoutstanding'};
499 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
502 my $thisacct = $accdata->{accountno
};
503 my $usth = $dbh->prepare(
504 "UPDATE accountlines SET amountoutstanding= ?
505 WHERE (borrowernumber = ?) AND (accountno=?)"
507 $usth->execute( $newamtos, $borrowernumber, $thisacct );
509 $usth = $dbh->prepare(
510 "INSERT INTO accountoffsets
511 (borrowernumber, accountno, offsetaccount, offsetamount)
514 $usth->execute( $borrowernumber, $accdata->{'accountno'},
515 $nextaccntno, $newamtos );
519 $type = "Credit " . $type;
520 UpdateStats
( $user, $type, $data, $user, '', '', $borrowernumber );
522 return ($amountleft);
528 #FIXME : DEPRECATED SUB
529 This subroutine tracks payments and/or credits against fines/charges
530 using the accountoffsets table, which is not used consistently in
531 Koha's fines management, and so is not used in 3.0
537 #here we update both the accountoffsets and the account lines
538 my ( $borrowernumber, $data ) = @_;
539 my $dbh = C4
::Context
->dbh;
542 my $amountleft = $data * -1;
545 my $nextaccntno = getnextacctno
($borrowernumber);
547 # get lines with outstanding amounts to offset
548 my $sth = $dbh->prepare(
549 "SELECT * FROM accountlines
550 WHERE (borrowernumber = ?) AND (amountoutstanding<0)
553 $sth->execute($borrowernumber);
556 # offset transactions
557 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) {
558 if ( $accdata->{'amountoutstanding'} > $amountleft ) {
560 $amountleft -= $accdata->{'amountoutstanding'};
563 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
568 my $thisacct = $accdata->{accountno
};
569 my $usth = $dbh->prepare(
570 "UPDATE accountlines SET amountoutstanding= ?
571 WHERE (borrowernumber = ?) AND (accountno=?)"
573 $usth->execute( $newamtos, $borrowernumber, $thisacct );
575 $usth = $dbh->prepare(
576 "INSERT INTO accountoffsets
577 (borrowernumber, accountno, offsetaccount, offsetamount)
580 $usth->execute( $borrowernumber, $accdata->{'accountno'},
581 $nextaccntno, $newamtos );
585 return ($amountleft);
589 my ( $borrowerno, $timestamp, $accountno ) = @_;
590 my $dbh = C4
::Context
->dbh;
591 my $timestamp2 = $timestamp - 1;
593 my $sth = $dbh->prepare(
594 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
596 $sth->execute( $borrowerno, $accountno );
599 while ( my $data = $sth->fetchrow_hashref ) {
607 my ( $date, $date2 ) = @_;
608 my $dbh = C4
::Context
->dbh;
609 my $sth = $dbh->prepare(
610 "SELECT * FROM accountlines,borrowers
611 WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber
612 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
615 $sth->execute( $date, $date2 );
617 while ( my $data = $sth->fetchrow_hashref ) {
618 $data->{'date'} = $data->{'timestamp'};
626 my ( $date, $date2 ) = @_;
627 my $dbh = C4
::Context
->dbh;
629 my $sth = $dbh->prepare(
630 "SELECT *,timestamp AS datetime
631 FROM accountlines,borrowers
632 WHERE (accounttype = 'REF'
633 AND accountlines.borrowernumber = borrowers.borrowernumber
634 AND date >=? AND date <?)"
637 $sth->execute( $date, $date2 );
640 while ( my $data = $sth->fetchrow_hashref ) {
648 my ( $borrowernumber, $accountno ) = @_;
649 my $dbh = C4
::Context
->dbh;
651 my $sth = $dbh->prepare('SELECT amountoutstanding FROM accountlines WHERE borrowernumber = ? AND accountno = ?');
652 $sth->execute( $borrowernumber, $accountno );
653 my $row = $sth->fetchrow_hashref();
654 my $amount_outstanding = $row->{'amountoutstanding'};
656 if ( $amount_outstanding <= 0 ) {
657 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
658 $sth->execute( $borrowernumber, $accountno );
660 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
661 $sth->execute( $borrowernumber, $accountno );
665 END { } # module clean-up code here (global destructor)