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;
174 SET amountoutstanding = 0
175 WHERE borrowernumber = $borrowernumber
176 AND accountno = $accountno
182 # INSERT INTO accountoffsets
183 # (borrowernumber, accountno, offsetaccount,
185 # VALUES ($borrowernumber, $accountno, $nextaccntno, $newamtos)
189 my $payment = 0 - $amount;
191 INSERT INTO accountlines
192 (borrowernumber, accountno, date, amount,
193 description, accounttype, amountoutstanding)
194 VALUES ($borrowernumber, $nextaccntno, now(), $payment,
195 'Payment,thanks - $user', 'Pay', 0)
198 # FIXME - The second argument to &UpdateStats is supposed to be the
200 # UpdateStats is now being passed $accountno too. MTJ
201 UpdateStats
( $user, 'payment', $amount, '', '', '', $borrowernumber,
205 #check to see what accounttype
206 if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
207 returnlost
( $borrowernumber, $data->{'itemnumber'} );
213 $nextacct = &getnextacctno($borrowernumber);
215 Returns the next unused account number for the patron with the given
221 # FIXME - Okay, so what does the above actually _mean_?
222 sub getnextacctno
($) {
223 my ($borrowernumber) = shift or return undef;
224 my $sth = C4
::Context
->dbh->prepare(
225 "SELECT accountno+1 FROM accountlines
226 WHERE (borrowernumber = ?)
227 ORDER BY accountno DESC
230 $sth->execute($borrowernumber);
231 return ($sth->fetchrow || 1);
234 =head2 fixaccounts (removed)
236 &fixaccounts($borrowernumber, $accountnumber, $amount);
239 # FIXME - I don't understand what this function does.
241 my ( $borrowernumber, $accountno, $amount ) = @_;
242 my $dbh = C4::Context->dbh;
243 my $sth = $dbh->prepare(
244 "SELECT * FROM accountlines WHERE borrowernumber=?
247 $sth->execute( $borrowernumber, $accountno );
248 my $data = $sth->fetchrow_hashref;
250 # FIXME - Error-checking
251 my $diff = $amount - $data->{'amount'};
252 my $outstanding = $data->{'amountoutstanding'} + $diff;
257 SET amount = '$amount',
258 amountoutstanding = '$outstanding'
259 WHERE borrowernumber = $borrowernumber
260 AND accountno = $accountno
262 # FIXME: exceedingly bad form. Use prepare with placholders ("?") in query and execute args.
268 my ( $borrowernumber, $itemnum ) = @_;
269 C4
::Circulation
::MarkIssueReturned
( $borrowernumber, $itemnum );
270 my $borrower = C4
::Members
::GetMember
( 'borrowernumber'=>$borrowernumber );
271 my @datearr = localtime(time);
272 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
273 my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
274 ModItem
({ paidfor
=> "Paid for by $bor $date" }, undef, $itemnum);
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 issues.*,items.*,biblio.title
288 JOIN items USING (itemnumber)
289 JOIN biblio USING (biblionumber)
290 WHERE issues.itemnumber=?");
291 $sth->execute($itemnumber);
292 my $issues=$sth->fetchrow_hashref();
294 # if a borrower lost the item, add a replacement cost to the their record
295 if ( $issues->{borrowernumber
} ){
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($issues->{'borrowernumber'},$itemnumber);
301 my $existing_charge_hashref=$sth1->fetchrow_hashref();
304 unless ($existing_charge_hashref) {
305 # This item is on issue ... add replacement cost to the borrower's record and mark it returned
306 # Note that we add this to the account even if there's no replacement price, allowing some other
307 # process (or person) to update it, since we don't handle any defaults for replacement prices.
308 my $accountno = getnextacctno
($issues->{'borrowernumber'});
309 my $sth2=$dbh->prepare("INSERT INTO accountlines
310 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber)
311 VALUES (?,?,now(),?,?,'L',?,?)");
312 $sth2->execute($issues->{'borrowernumber'},$accountno,$issues->{'replacementprice'},
313 "Lost Item $issues->{'title'} $issues->{'barcode'}",
314 $issues->{'replacementprice'},$itemnumber);
318 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
319 #warn " $issues->{'borrowernumber'} / $itemnumber ";
320 C4
::Circulation
::MarkIssueReturned
($issues->{borrowernumber
},$itemnumber);
321 # Shouldn't MarkIssueReturned do this?
322 C4
::Items
::ModItem
({ onloan
=> undef }, undef, $itemnumber);
329 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
332 C<$borrowernumber> is the patron's borrower number.
333 C<$description> is a description of the transaction.
334 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
336 C<$itemnumber> is the item involved, if pertinent; otherwise, it
337 should be the empty string.
342 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
345 # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
348 # 'A' = Account Management fee
354 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_;
356 $manager_id = C4
::Context
->userenv->{'number'} if C4
::Context
->userenv;
357 my $dbh = C4
::Context
->dbh;
361 my $accountno = getnextacctno
($borrowernumber);
362 my $amountleft = $amount;
370 # my $amount2 = $amount * -1; # FIXME - $amount2 = -$amount
372 # fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user );
374 if ( $type eq 'N' ) {
375 $desc .= " New Card";
377 if ( $type eq 'F' ) {
380 if ( $type eq 'A' ) {
381 $desc .= " Account Management fee";
383 if ( $type eq 'M' ) {
387 if ( $type eq 'L' && $desc eq '' ) {
389 $desc = " Lost Item";
391 # if ( $type eq 'REF' ) {
392 # $desc .= " Cash Refund";
393 # $amountleft = refund( '', $borrowernumber, $amount );
395 if ( ( $type eq 'L' )
399 or ( $type eq 'M' ) )
404 if ( $itemnum ne '' ) {
405 $desc .= " " . $itemnum;
406 my $sth = $dbh->prepare(
407 "INSERT INTO accountlines
408 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id)
409 VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)");
410 $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr;
412 my $sth=$dbh->prepare("INSERT INTO accountlines
413 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id)
414 VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)"
416 $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
417 $amountleft, $notifyid, $note, $manager_id );
422 =head2 fixcredit #### DEPRECATED
424 $amountleft = &fixcredit($borrowernumber, $data, $barcode, $type, $user);
426 This function is only used internally, not exported.
430 # This function is deprecated in 3.0
434 #here we update both the accountoffsets and the account lines
435 my ( $borrowernumber, $data, $barcode, $type, $user ) = @_;
436 my $dbh = C4
::Context
->dbh;
439 my $amountleft = $data;
440 if ( $barcode ne '' ) {
441 my $item = GetBiblioFromItemNumber
( '', $barcode );
442 my $nextaccntno = getnextacctno
($borrowernumber);
443 my $query = "SELECT * FROM accountlines WHERE (borrowernumber=?
444 AND itemnumber=? AND amountoutstanding > 0)";
445 if ( $type eq 'CL' ) {
446 $query .= " AND (accounttype = 'L' OR accounttype = 'Rep')";
448 elsif ( $type eq 'CF' ) {
449 $query .= " AND (accounttype = 'F' OR accounttype = 'FU' OR
450 accounttype='Res' OR accounttype='Rent')";
452 elsif ( $type eq 'CB' ) {
453 $query .= " and accounttype='A'";
457 my $sth = $dbh->prepare($query);
458 $sth->execute( $borrowernumber, $item->{'itemnumber'} );
459 $accdata = $sth->fetchrow_hashref;
461 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
463 $amountleft -= $accdata->{'amountoutstanding'};
466 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
469 my $thisacct = $accdata->{accountno
};
470 my $usth = $dbh->prepare(
471 "UPDATE accountlines SET amountoutstanding= ?
472 WHERE (borrowernumber = ?) AND (accountno=?)"
474 $usth->execute( $newamtos, $borrowernumber, $thisacct );
476 $usth = $dbh->prepare(
477 "INSERT INTO accountoffsets
478 (borrowernumber, accountno, offsetaccount, offsetamount)
481 $usth->execute( $borrowernumber, $accdata->{'accountno'},
482 $nextaccntno, $newamtos );
487 my $nextaccntno = getnextacctno
($borrowernumber);
489 # get lines with outstanding amounts to offset
490 my $sth = $dbh->prepare(
491 "SELECT * FROM accountlines
492 WHERE (borrowernumber = ?) AND (amountoutstanding >0)
495 $sth->execute($borrowernumber);
498 # offset transactions
499 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
500 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
502 $amountleft -= $accdata->{'amountoutstanding'};
505 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
508 my $thisacct = $accdata->{accountno
};
509 my $usth = $dbh->prepare(
510 "UPDATE accountlines SET amountoutstanding= ?
511 WHERE (borrowernumber = ?) AND (accountno=?)"
513 $usth->execute( $newamtos, $borrowernumber, $thisacct );
515 $usth = $dbh->prepare(
516 "INSERT INTO accountoffsets
517 (borrowernumber, accountno, offsetaccount, offsetamount)
520 $usth->execute( $borrowernumber, $accdata->{'accountno'},
521 $nextaccntno, $newamtos );
525 $type = "Credit " . $type;
526 UpdateStats
( $user, $type, $data, $user, '', '', $borrowernumber );
528 return ($amountleft);
534 #FIXME : DEPRECATED SUB
535 This subroutine tracks payments and/or credits against fines/charges
536 using the accountoffsets table, which is not used consistently in
537 Koha's fines management, and so is not used in 3.0
543 #here we update both the accountoffsets and the account lines
544 my ( $borrowernumber, $data ) = @_;
545 my $dbh = C4
::Context
->dbh;
548 my $amountleft = $data * -1;
551 my $nextaccntno = getnextacctno
($borrowernumber);
553 # get lines with outstanding amounts to offset
554 my $sth = $dbh->prepare(
555 "SELECT * FROM accountlines
556 WHERE (borrowernumber = ?) AND (amountoutstanding<0)
559 $sth->execute($borrowernumber);
562 # offset transactions
563 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) {
564 if ( $accdata->{'amountoutstanding'} > $amountleft ) {
566 $amountleft -= $accdata->{'amountoutstanding'};
569 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
574 my $thisacct = $accdata->{accountno
};
575 my $usth = $dbh->prepare(
576 "UPDATE accountlines SET amountoutstanding= ?
577 WHERE (borrowernumber = ?) AND (accountno=?)"
579 $usth->execute( $newamtos, $borrowernumber, $thisacct );
581 $usth = $dbh->prepare(
582 "INSERT INTO accountoffsets
583 (borrowernumber, accountno, offsetaccount, offsetamount)
586 $usth->execute( $borrowernumber, $accdata->{'accountno'},
587 $nextaccntno, $newamtos );
591 return ($amountleft);
595 my ( $borrowerno, $timestamp, $accountno ) = @_;
596 my $dbh = C4
::Context
->dbh;
597 my $timestamp2 = $timestamp - 1;
599 my $sth = $dbh->prepare(
600 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
602 $sth->execute( $borrowerno, $accountno );
605 while ( my $data = $sth->fetchrow_hashref ) {
612 my ( $borrowernumber, $accountno, $note ) = @_;
613 my $dbh = C4
::Context
->dbh;
614 my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE borrowernumber = ? AND accountno = ?');
615 $sth->execute( $note, $borrowernumber, $accountno );
619 my ( $date, $date2 ) = @_;
620 my $dbh = C4
::Context
->dbh;
621 my $sth = $dbh->prepare(
622 "SELECT * FROM accountlines,borrowers
623 WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber
624 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
627 $sth->execute( $date, $date2 );
629 while ( my $data = $sth->fetchrow_hashref ) {
630 $data->{'date'} = $data->{'timestamp'};
638 my ( $date, $date2 ) = @_;
639 my $dbh = C4
::Context
->dbh;
641 my $sth = $dbh->prepare(
642 "SELECT *,timestamp AS datetime
643 FROM accountlines,borrowers
644 WHERE (accounttype = 'REF'
645 AND accountlines.borrowernumber = borrowers.borrowernumber
646 AND date >=? AND date <?)"
649 $sth->execute( $date, $date2 );
652 while ( my $data = $sth->fetchrow_hashref ) {
660 my ( $borrowernumber, $accountno ) = @_;
661 my $dbh = C4
::Context
->dbh;
663 my $sth = $dbh->prepare('SELECT amountoutstanding FROM accountlines WHERE borrowernumber = ? AND accountno = ?');
664 $sth->execute( $borrowernumber, $accountno );
665 my $row = $sth->fetchrow_hashref();
666 my $amount_outstanding = $row->{'amountoutstanding'};
668 if ( $amount_outstanding <= 0 ) {
669 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
670 $sth->execute( $borrowernumber, $accountno );
672 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
673 $sth->execute( $borrowernumber, $accountno );
677 END { } # module clean-up code here (global destructor)