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 $sth = $dbh->prepare("UPDATE accountlines
175 SET amountoutstanding = 0
176 WHERE borrowernumber = ?
178 $sth->execute($borrowernumber, $accountno);
181 my $payment = 0 - $amount;
182 $sth = $dbh->prepare("INSERT INTO accountlines
183 (borrowernumber, accountno, date, amount,itemnumber,
184 description, accounttype, amountoutstanding, manager_id)
185 VALUES (?,?,now(),?,?,?,'Pay',0,?)");
186 $sth->execute($borrowernumber, $nextaccntno, $payment, $data->{'itemnumber'},"Payment,thanks - $user", $manager_id);
188 # FIXME - The second argument to &UpdateStats is supposed to be the
190 # UpdateStats is now being passed $accountno too. MTJ
191 UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber,
193 #from perldoc: for SELECT only #$sth->finish;
195 #check to see what accounttype
196 if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
197 returnlost( $borrowernumber, $data->{'itemnumber'} );
203 $nextacct = &getnextacctno($borrowernumber);
205 Returns the next unused account number for the patron with the given
211 # FIXME - Okay, so what does the above actually _mean_?
212 sub getnextacctno ($) {
213 my ($borrowernumber) = shift or return undef;
214 my $sth = C4::Context->dbh->prepare(
215 "SELECT accountno+1 FROM accountlines
216 WHERE (borrowernumber = ?)
217 ORDER BY accountno DESC
220 $sth->execute($borrowernumber);
221 return ($sth->fetchrow || 1);
224 =head2 fixaccounts (removed)
226 &fixaccounts($borrowernumber, $accountnumber, $amount);
229 # FIXME - I don't understand what this function does.
231 my ( $borrowernumber, $accountno, $amount ) = @_;
232 my $dbh = C4::Context->dbh;
233 my $sth = $dbh->prepare(
234 "SELECT * FROM accountlines WHERE borrowernumber=?
237 $sth->execute( $borrowernumber, $accountno );
238 my $data = $sth->fetchrow_hashref;
240 # FIXME - Error-checking
241 my $diff = $amount - $data->{'amount'};
242 my $outstanding = $data->{'amountoutstanding'} + $diff;
247 SET amount = '$amount',
248 amountoutstanding = '$outstanding'
249 WHERE borrowernumber = $borrowernumber
250 AND accountno = $accountno
252 # FIXME: exceedingly bad form. Use prepare with placholders ("?") in query and execute args.
258 my ( $borrowernumber, $itemnum ) = @_;
259 C4::Circulation::MarkIssueReturned( $borrowernumber, $itemnum );
260 my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
261 my @datearr = localtime(time);
262 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
263 my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
264 ModItem({ paidfor => "Paid for by $bor $date" }, undef, $itemnum);
269 # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for
270 # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that
271 # a charge has been added
272 # FIXME : if no replacement price, borrower just doesn't get charged?
274 my $dbh = C4::Context->dbh();
275 my ($itemnumber) = @_;
276 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
278 JOIN items USING (itemnumber)
279 JOIN biblio USING (biblionumber)
280 WHERE issues.itemnumber=?");
281 $sth->execute($itemnumber);
282 my $issues=$sth->fetchrow_hashref();
284 # if a borrower lost the item, add a replacement cost to the their record
285 if ( $issues->{borrowernumber} ){
287 # first make sure the borrower hasn't already been charged for this item
288 my $sth1=$dbh->prepare("SELECT * from accountlines
289 WHERE borrowernumber=? AND itemnumber=? and accounttype='L'");
290 $sth1->execute($issues->{'borrowernumber'},$itemnumber);
291 my $existing_charge_hashref=$sth1->fetchrow_hashref();
294 unless ($existing_charge_hashref) {
295 # This item is on issue ... add replacement cost to the borrower's record and mark it returned
296 # Note that we add this to the account even if there's no replacement price, allowing some other
297 # process (or person) to update it, since we don't handle any defaults for replacement prices.
298 my $accountno = getnextacctno($issues->{'borrowernumber'});
299 my $sth2=$dbh->prepare("INSERT INTO accountlines
300 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber)
301 VALUES (?,?,now(),?,?,'L',?,?)");
302 $sth2->execute($issues->{'borrowernumber'},$accountno,$issues->{'replacementprice'},
303 "Lost Item $issues->{'title'} $issues->{'barcode'}",
304 $issues->{'replacementprice'},$itemnumber);
308 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
309 #warn " $issues->{'borrowernumber'} / $itemnumber ";
310 C4::Circulation::MarkIssueReturned($issues->{borrowernumber},$itemnumber);
311 # Shouldn't MarkIssueReturned do this?
312 C4::Items::ModItem({ onloan => undef }, undef, $itemnumber);
319 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
322 C<$borrowernumber> is the patron's borrower number.
323 C<$description> is a description of the transaction.
324 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
326 C<$itemnumber> is the item involved, if pertinent; otherwise, it
327 should be the empty string.
332 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
335 # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
338 # 'A' = Account Management fee
344 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_;
346 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
347 my $dbh = C4::Context->dbh;
351 my $accountno = getnextacctno($borrowernumber);
352 my $amountleft = $amount;
360 # my $amount2 = $amount * -1; # FIXME - $amount2 = -$amount
362 # fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user );
364 if ( $type eq 'N' ) {
365 $desc .= " New Card";
367 if ( $type eq 'F' ) {
370 if ( $type eq 'A' ) {
371 $desc .= " Account Management fee";
373 if ( $type eq 'M' ) {
377 if ( $type eq 'L' && $desc eq '' ) {
379 $desc = " Lost Item";
381 # if ( $type eq 'REF' ) {
382 # $desc .= " Cash Refund";
383 # $amountleft = refund( '', $borrowernumber, $amount );
385 if ( ( $type eq 'L' )
389 or ( $type eq 'M' ) )
394 if ( $itemnum ne '' ) {
395 $desc .= " " . $itemnum;
396 my $sth = $dbh->prepare(
397 "INSERT INTO accountlines
398 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id)
399 VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)");
400 $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr;
402 my $sth=$dbh->prepare("INSERT INTO accountlines
403 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id)
404 VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)"
406 $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
407 $amountleft, $notifyid, $note, $manager_id );
412 =head2 fixcredit #### DEPRECATED
414 $amountleft = &fixcredit($borrowernumber, $data, $barcode, $type, $user);
416 This function is only used internally, not exported.
420 # This function is deprecated in 3.0
424 #here we update both the accountoffsets and the account lines
425 my ( $borrowernumber, $data, $barcode, $type, $user ) = @_;
426 my $dbh = C4::Context->dbh;
429 my $amountleft = $data;
430 if ( $barcode ne '' ) {
431 my $item = GetBiblioFromItemNumber( '', $barcode );
432 my $nextaccntno = getnextacctno($borrowernumber);
433 my $query = "SELECT * FROM accountlines WHERE (borrowernumber=?
434 AND itemnumber=? AND amountoutstanding > 0)";
435 if ( $type eq 'CL' ) {
436 $query .= " AND (accounttype = 'L' OR accounttype = 'Rep')";
438 elsif ( $type eq 'CF' ) {
439 $query .= " AND (accounttype = 'F' OR accounttype = 'FU' OR
440 accounttype='Res' OR accounttype='Rent')";
442 elsif ( $type eq 'CB' ) {
443 $query .= " and accounttype='A'";
447 my $sth = $dbh->prepare($query);
448 $sth->execute( $borrowernumber, $item->{'itemnumber'} );
449 $accdata = $sth->fetchrow_hashref;
451 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
453 $amountleft -= $accdata->{'amountoutstanding'};
456 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
459 my $thisacct = $accdata->{accountno};
460 my $usth = $dbh->prepare(
461 "UPDATE accountlines SET amountoutstanding= ?
462 WHERE (borrowernumber = ?) AND (accountno=?)"
464 $usth->execute( $newamtos, $borrowernumber, $thisacct );
466 $usth = $dbh->prepare(
467 "INSERT INTO accountoffsets
468 (borrowernumber, accountno, offsetaccount, offsetamount)
471 $usth->execute( $borrowernumber, $accdata->{'accountno'},
472 $nextaccntno, $newamtos );
477 my $nextaccntno = getnextacctno($borrowernumber);
479 # get lines with outstanding amounts to offset
480 my $sth = $dbh->prepare(
481 "SELECT * FROM accountlines
482 WHERE (borrowernumber = ?) AND (amountoutstanding >0)
485 $sth->execute($borrowernumber);
488 # offset transactions
489 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
490 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
492 $amountleft -= $accdata->{'amountoutstanding'};
495 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
498 my $thisacct = $accdata->{accountno};
499 my $usth = $dbh->prepare(
500 "UPDATE accountlines SET amountoutstanding= ?
501 WHERE (borrowernumber = ?) AND (accountno=?)"
503 $usth->execute( $newamtos, $borrowernumber, $thisacct );
505 $usth = $dbh->prepare(
506 "INSERT INTO accountoffsets
507 (borrowernumber, accountno, offsetaccount, offsetamount)
510 $usth->execute( $borrowernumber, $accdata->{'accountno'},
511 $nextaccntno, $newamtos );
515 $type = "Credit " . $type;
516 UpdateStats( $user, $type, $data, $user, '', '', $borrowernumber );
518 return ($amountleft);
524 #FIXME : DEPRECATED SUB
525 This subroutine tracks payments and/or credits against fines/charges
526 using the accountoffsets table, which is not used consistently in
527 Koha's fines management, and so is not used in 3.0
533 #here we update both the accountoffsets and the account lines
534 my ( $borrowernumber, $data ) = @_;
535 my $dbh = C4::Context->dbh;
538 my $amountleft = $data * -1;
541 my $nextaccntno = getnextacctno($borrowernumber);
543 # get lines with outstanding amounts to offset
544 my $sth = $dbh->prepare(
545 "SELECT * FROM accountlines
546 WHERE (borrowernumber = ?) AND (amountoutstanding<0)
549 $sth->execute($borrowernumber);
552 # offset transactions
553 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) {
554 if ( $accdata->{'amountoutstanding'} > $amountleft ) {
556 $amountleft -= $accdata->{'amountoutstanding'};
559 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
564 my $thisacct = $accdata->{accountno};
565 my $usth = $dbh->prepare(
566 "UPDATE accountlines SET amountoutstanding= ?
567 WHERE (borrowernumber = ?) AND (accountno=?)"
569 $usth->execute( $newamtos, $borrowernumber, $thisacct );
571 $usth = $dbh->prepare(
572 "INSERT INTO accountoffsets
573 (borrowernumber, accountno, offsetaccount, offsetamount)
576 $usth->execute( $borrowernumber, $accdata->{'accountno'},
577 $nextaccntno, $newamtos );
581 return ($amountleft);
585 my ( $borrowerno, $timestamp, $accountno ) = @_;
586 my $dbh = C4::Context->dbh;
587 my $timestamp2 = $timestamp - 1;
589 my $sth = $dbh->prepare(
590 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
592 $sth->execute( $borrowerno, $accountno );
595 while ( my $data = $sth->fetchrow_hashref ) {
602 my ( $borrowernumber, $accountno, $note ) = @_;
603 my $dbh = C4::Context->dbh;
604 my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE borrowernumber = ? AND accountno = ?');
605 $sth->execute( $note, $borrowernumber, $accountno );
609 my ( $date, $date2 ) = @_;
610 my $dbh = C4::Context->dbh;
611 my $sth = $dbh->prepare(
612 "SELECT * FROM accountlines,borrowers
613 WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber
614 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
617 $sth->execute( $date, $date2 );
619 while ( my $data = $sth->fetchrow_hashref ) {
620 $data->{'date'} = $data->{'timestamp'};
628 my ( $date, $date2 ) = @_;
629 my $dbh = C4::Context->dbh;
631 my $sth = $dbh->prepare(
632 "SELECT *,timestamp AS datetime
633 FROM accountlines,borrowers
634 WHERE (accounttype = 'REF'
635 AND accountlines.borrowernumber = borrowers.borrowernumber
636 AND date >=? AND date <?)"
639 $sth->execute( $date, $date2 );
642 while ( my $data = $sth->fetchrow_hashref ) {
650 my ( $borrowernumber, $accountno ) = @_;
651 my $dbh = C4::Context->dbh;
653 my $sth = $dbh->prepare('SELECT amountoutstanding FROM accountlines WHERE borrowernumber = ? AND accountno = ?');
654 $sth->execute( $borrowernumber, $accountno );
655 my $row = $sth->fetchrow_hashref();
656 my $amount_outstanding = $row->{'amountoutstanding'};
658 if ( $amount_outstanding <= 0 ) {
659 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
660 $sth->execute( $borrowernumber, $accountno );
662 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
663 $sth->execute( $borrowernumber, $accountno );
667 END { } # module clean-up code here (global destructor)