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;
163 my $nextaccntno = getnextacctno
($borrowernumber);
167 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?");
168 $sth->execute( $borrowernumber, $accountno );
169 my $data = $sth->fetchrow_hashref;
172 $sth = $dbh->prepare("UPDATE accountlines
173 SET amountoutstanding = 0
174 WHERE borrowernumber = ?
176 $sth->execute($borrowernumber, $accountno);
180 # INSERT INTO accountoffsets
181 # (borrowernumber, accountno, offsetaccount,
183 # VALUES ($borrowernumber, $accountno, $nextaccntno, $newamtos)
187 my $payment = 0 - $amount;
188 $sth = $dbh->prepare("INSERT INTO accountlines
189 (borrowernumber, accountno, date, amount,
190 description, accounttype, amountoutstanding)
191 VALUES (?,?,now(),?,?,'Pay',0)");
192 $sth->execute($borrowernumber, $nextaccntno, $payment, "Payment,thanks - $user");
194 # FIXME - The second argument to &UpdateStats is supposed to be the
196 # UpdateStats is now being passed $accountno too. MTJ
197 UpdateStats
( $user, 'payment', $amount, '', '', '', $borrowernumber,
199 #from perldoc: for SELECT only #$sth->finish;
201 #check to see what accounttype
202 if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
203 returnlost
( $borrowernumber, $data->{'itemnumber'} );
209 $nextacct = &getnextacctno($borrowernumber);
211 Returns the next unused account number for the patron with the given
217 # FIXME - Okay, so what does the above actually _mean_?
218 sub getnextacctno
($) {
219 my ($borrowernumber) = shift or return undef;
220 my $sth = C4
::Context
->dbh->prepare(
221 "SELECT accountno+1 FROM accountlines
222 WHERE (borrowernumber = ?)
223 ORDER BY accountno DESC
226 $sth->execute($borrowernumber);
227 return ($sth->fetchrow || 1);
230 =head2 fixaccounts (removed)
232 &fixaccounts($borrowernumber, $accountnumber, $amount);
235 # FIXME - I don't understand what this function does.
237 my ( $borrowernumber, $accountno, $amount ) = @_;
238 my $dbh = C4::Context->dbh;
239 my $sth = $dbh->prepare(
240 "SELECT * FROM accountlines WHERE borrowernumber=?
243 $sth->execute( $borrowernumber, $accountno );
244 my $data = $sth->fetchrow_hashref;
246 # FIXME - Error-checking
247 my $diff = $amount - $data->{'amount'};
248 my $outstanding = $data->{'amountoutstanding'} + $diff;
253 SET amount = '$amount',
254 amountoutstanding = '$outstanding'
255 WHERE borrowernumber = $borrowernumber
256 AND accountno = $accountno
258 # FIXME: exceedingly bad form. Use prepare with placholders ("?") in query and execute args.
264 my ( $borrowernumber, $itemnum ) = @_;
265 C4
::Circulation
::MarkIssueReturned
( $borrowernumber, $itemnum );
266 my $borrower = C4
::Members
::GetMember
( 'borrowernumber'=>$borrowernumber );
267 my @datearr = localtime(time);
268 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
269 my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
270 ModItem
({ paidfor
=> "Paid for by $bor $date" }, undef, $itemnum);
275 # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for
276 # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that
277 # a charge has been added
278 # FIXME : if no replacement price, borrower just doesn't get charged?
280 my $dbh = C4
::Context
->dbh();
281 my ($itemnumber) = @_;
282 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
284 JOIN items USING (itemnumber)
285 JOIN biblio USING (biblionumber)
286 WHERE 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 C4
::Items
::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, $note ) = @_;
352 $manager_id = C4
::Context
->userenv->{'number'} if C4
::Context
->userenv;
353 my $dbh = C4
::Context
->dbh;
357 my $accountno = getnextacctno
($borrowernumber);
358 my $amountleft = $amount;
366 # my $amount2 = $amount * -1; # FIXME - $amount2 = -$amount
368 # fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user );
370 if ( $type eq 'N' ) {
371 $desc .= " New Card";
373 if ( $type eq 'F' ) {
376 if ( $type eq 'A' ) {
377 $desc .= " Account Management fee";
379 if ( $type eq 'M' ) {
383 if ( $type eq 'L' && $desc eq '' ) {
385 $desc = " Lost Item";
387 # if ( $type eq 'REF' ) {
388 # $desc .= " Cash Refund";
389 # $amountleft = refund( '', $borrowernumber, $amount );
391 if ( ( $type eq 'L' )
395 or ( $type eq 'M' ) )
400 if ( $itemnum ne '' ) {
401 $desc .= " " . $itemnum;
402 my $sth = $dbh->prepare(
403 "INSERT INTO accountlines
404 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id)
405 VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)");
406 $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr;
408 my $sth=$dbh->prepare("INSERT INTO accountlines
409 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id)
410 VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)"
412 $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
413 $amountleft, $notifyid, $note, $manager_id );
418 =head2 fixcredit #### DEPRECATED
420 $amountleft = &fixcredit($borrowernumber, $data, $barcode, $type, $user);
422 This function is only used internally, not exported.
426 # This function is deprecated in 3.0
430 #here we update both the accountoffsets and the account lines
431 my ( $borrowernumber, $data, $barcode, $type, $user ) = @_;
432 my $dbh = C4
::Context
->dbh;
435 my $amountleft = $data;
436 if ( $barcode ne '' ) {
437 my $item = GetBiblioFromItemNumber
( '', $barcode );
438 my $nextaccntno = getnextacctno
($borrowernumber);
439 my $query = "SELECT * FROM accountlines WHERE (borrowernumber=?
440 AND itemnumber=? AND amountoutstanding > 0)";
441 if ( $type eq 'CL' ) {
442 $query .= " AND (accounttype = 'L' OR accounttype = 'Rep')";
444 elsif ( $type eq 'CF' ) {
445 $query .= " AND (accounttype = 'F' OR accounttype = 'FU' OR
446 accounttype='Res' OR accounttype='Rent')";
448 elsif ( $type eq 'CB' ) {
449 $query .= " and accounttype='A'";
453 my $sth = $dbh->prepare($query);
454 $sth->execute( $borrowernumber, $item->{'itemnumber'} );
455 $accdata = $sth->fetchrow_hashref;
457 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
459 $amountleft -= $accdata->{'amountoutstanding'};
462 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
465 my $thisacct = $accdata->{accountno
};
466 my $usth = $dbh->prepare(
467 "UPDATE accountlines SET amountoutstanding= ?
468 WHERE (borrowernumber = ?) AND (accountno=?)"
470 $usth->execute( $newamtos, $borrowernumber, $thisacct );
472 $usth = $dbh->prepare(
473 "INSERT INTO accountoffsets
474 (borrowernumber, accountno, offsetaccount, offsetamount)
477 $usth->execute( $borrowernumber, $accdata->{'accountno'},
478 $nextaccntno, $newamtos );
483 my $nextaccntno = getnextacctno
($borrowernumber);
485 # get lines with outstanding amounts to offset
486 my $sth = $dbh->prepare(
487 "SELECT * FROM accountlines
488 WHERE (borrowernumber = ?) AND (amountoutstanding >0)
491 $sth->execute($borrowernumber);
494 # offset transactions
495 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
496 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
498 $amountleft -= $accdata->{'amountoutstanding'};
501 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
504 my $thisacct = $accdata->{accountno
};
505 my $usth = $dbh->prepare(
506 "UPDATE accountlines SET amountoutstanding= ?
507 WHERE (borrowernumber = ?) AND (accountno=?)"
509 $usth->execute( $newamtos, $borrowernumber, $thisacct );
511 $usth = $dbh->prepare(
512 "INSERT INTO accountoffsets
513 (borrowernumber, accountno, offsetaccount, offsetamount)
516 $usth->execute( $borrowernumber, $accdata->{'accountno'},
517 $nextaccntno, $newamtos );
521 $type = "Credit " . $type;
522 UpdateStats
( $user, $type, $data, $user, '', '', $borrowernumber );
524 return ($amountleft);
530 #FIXME : DEPRECATED SUB
531 This subroutine tracks payments and/or credits against fines/charges
532 using the accountoffsets table, which is not used consistently in
533 Koha's fines management, and so is not used in 3.0
539 #here we update both the accountoffsets and the account lines
540 my ( $borrowernumber, $data ) = @_;
541 my $dbh = C4
::Context
->dbh;
544 my $amountleft = $data * -1;
547 my $nextaccntno = getnextacctno
($borrowernumber);
549 # get lines with outstanding amounts to offset
550 my $sth = $dbh->prepare(
551 "SELECT * FROM accountlines
552 WHERE (borrowernumber = ?) AND (amountoutstanding<0)
555 $sth->execute($borrowernumber);
558 # offset transactions
559 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) {
560 if ( $accdata->{'amountoutstanding'} > $amountleft ) {
562 $amountleft -= $accdata->{'amountoutstanding'};
565 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
570 my $thisacct = $accdata->{accountno
};
571 my $usth = $dbh->prepare(
572 "UPDATE accountlines SET amountoutstanding= ?
573 WHERE (borrowernumber = ?) AND (accountno=?)"
575 $usth->execute( $newamtos, $borrowernumber, $thisacct );
577 $usth = $dbh->prepare(
578 "INSERT INTO accountoffsets
579 (borrowernumber, accountno, offsetaccount, offsetamount)
582 $usth->execute( $borrowernumber, $accdata->{'accountno'},
583 $nextaccntno, $newamtos );
587 return ($amountleft);
591 my ( $borrowerno, $timestamp, $accountno ) = @_;
592 my $dbh = C4
::Context
->dbh;
593 my $timestamp2 = $timestamp - 1;
595 my $sth = $dbh->prepare(
596 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
598 $sth->execute( $borrowerno, $accountno );
601 while ( my $data = $sth->fetchrow_hashref ) {
608 my ( $borrowernumber, $accountno, $note ) = @_;
609 my $dbh = C4
::Context
->dbh;
610 my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE borrowernumber = ? AND accountno = ?');
611 $sth->execute( $note, $borrowernumber, $accountno );
615 my ( $date, $date2 ) = @_;
616 my $dbh = C4
::Context
->dbh;
617 my $sth = $dbh->prepare(
618 "SELECT * FROM accountlines,borrowers
619 WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber
620 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
623 $sth->execute( $date, $date2 );
625 while ( my $data = $sth->fetchrow_hashref ) {
626 $data->{'date'} = $data->{'timestamp'};
634 my ( $date, $date2 ) = @_;
635 my $dbh = C4
::Context
->dbh;
637 my $sth = $dbh->prepare(
638 "SELECT *,timestamp AS datetime
639 FROM accountlines,borrowers
640 WHERE (accounttype = 'REF'
641 AND accountlines.borrowernumber = borrowers.borrowernumber
642 AND date >=? AND date <?)"
645 $sth->execute( $date, $date2 );
648 while ( my $data = $sth->fetchrow_hashref ) {
656 my ( $borrowernumber, $accountno ) = @_;
657 my $dbh = C4
::Context
->dbh;
659 my $sth = $dbh->prepare('SELECT amountoutstanding FROM accountlines WHERE borrowernumber = ? AND accountno = ?');
660 $sth->execute( $borrowernumber, $accountno );
661 my $row = $sth->fetchrow_hashref();
662 my $amount_outstanding = $row->{'amountoutstanding'};
664 if ( $amount_outstanding <= 0 ) {
665 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
666 $sth->execute( $borrowernumber, $accountno );
668 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
669 $sth->execute( $borrowernumber, $accountno );
673 END { } # module clean-up code here (global destructor)