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
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 #use warnings; FIXME - Bug 2505
26 use C4
::Circulation
qw(ReturnLostItem);
27 use C4
::Log
qw(logaction);
30 use Data
::Dumper
qw(Dumper);
32 use vars
qw(@ISA @EXPORT);
48 &recordpayment_selectaccts
50 &purge_zero_balance_fees
56 C4::Accounts - Functions for dealing with Koha accounts
64 The functions in this module deal with the monetary aspect of Koha,
65 including looking up and modifying the amount of money owed by a
72 &makepayment($accountlines_id, $borrowernumber, $acctnumber, $amount, $branchcode);
74 Records the fact that a patron has paid off the entire amount he or
77 C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is
78 the account that was credited. C<$amount> is the amount paid (this is
79 only used to record the payment. It is assumed to be equal to the
80 amount owed). C<$branchcode> is the code of the branch where payment
86 # FIXME - I'm not at all sure about the above, because I don't
87 # understand what the acct* tables in the Koha database are for.
89 my ( $accountlines_id, $borrowernumber, $accountno, $amount, $user, $branch, $payment_note ) = @_;
91 my $line = Koha
::Account
::Lines
->find( $accountlines_id );
93 return Koha
::Account
->new( { patron_id
=> $borrowernumber } )
94 ->pay( { lines
=> [ $line ], amount
=> $amount, library_id
=> $branch, note
=> $payment_note } );
99 $nextacct = &getnextacctno($borrowernumber);
101 Returns the next unused account number for the patron with the given
107 # FIXME - Okay, so what does the above actually _mean_?
109 my ($borrowernumber) = shift or return;
110 my $sth = C4
::Context
->dbh->prepare(
111 "SELECT accountno+1 FROM accountlines
112 WHERE (borrowernumber = ?)
113 ORDER BY accountno DESC
116 $sth->execute($borrowernumber);
117 return ($sth->fetchrow || 1);
120 =head2 fixaccounts (removed)
122 &fixaccounts($accountlines_id, $borrowernumber, $accountnumber, $amount);
125 # FIXME - I don't understand what this function does.
127 my ( $accountlines_id, $borrowernumber, $accountno, $amount ) = @_;
128 my $dbh = C4::Context->dbh;
129 my $sth = $dbh->prepare(
130 "SELECT * FROM accountlines WHERE accountlines_id=?"
132 $sth->execute( $accountlines_id );
133 my $data = $sth->fetchrow_hashref;
135 # FIXME - Error-checking
136 my $diff = $amount - $data->{'amount'};
137 my $outstanding = $data->{'amountoutstanding'} + $diff;
142 SET amount = '$amount',
143 amountoutstanding = '$outstanding'
144 WHERE accountlines_id = $accountlines_id
146 # FIXME: exceedingly bad form. Use prepare with placholders ("?") in query and execute args.
152 # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for
153 # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that
154 # a charge has been added
155 # FIXME : if no replacement price, borrower just doesn't get charged?
156 my $dbh = C4
::Context
->dbh();
157 my ($borrowernumber, $itemnumber, $amount, $description) = @_;
159 # first make sure the borrower hasn't already been charged for this item
160 my $sth1=$dbh->prepare("SELECT * from accountlines
161 WHERE borrowernumber=? AND itemnumber=? and accounttype='L'");
162 $sth1->execute($borrowernumber,$itemnumber);
163 my $existing_charge_hashref=$sth1->fetchrow_hashref();
166 unless ($existing_charge_hashref) {
168 $manager_id = C4
::Context
->userenv->{'number'} if C4
::Context
->userenv;
169 # This item is on issue ... add replacement cost to the borrower's record and mark it returned
170 # Note that we add this to the account even if there's no replacement price, allowing some other
171 # process (or person) to update it, since we don't handle any defaults for replacement prices.
172 my $accountno = getnextacctno
($borrowernumber);
173 my $sth2=$dbh->prepare("INSERT INTO accountlines
174 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber,manager_id)
175 VALUES (?,?,now(),?,?,'L',?,?,?)");
176 $sth2->execute($borrowernumber,$accountno,$amount,
177 $description,$amount,$itemnumber,$manager_id);
179 if ( C4
::Context
->preference("FinesLog") ) {
180 logaction
("FINES", 'CREATE', $borrowernumber, Dumper
({
181 action
=> 'create_fee',
182 borrowernumber
=> $borrowernumber,
183 accountno
=> $accountno,
185 amountoutstanding
=> $amount,
186 description
=> $description,
188 itemnumber
=> $itemnumber,
189 manager_id
=> $manager_id,
198 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
201 C<$borrowernumber> is the patron's borrower number.
202 C<$description> is a description of the transaction.
203 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
205 C<$itemnumber> is the item involved, if pertinent; otherwise, it
206 should be the empty string.
211 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
214 # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
217 # 'A' = Account Management fee
223 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_;
225 $manager_id = C4
::Context
->userenv->{'number'} if C4
::Context
->userenv;
226 my $dbh = C4
::Context
->dbh;
229 my $accountno = getnextacctno
($borrowernumber);
230 my $amountleft = $amount;
232 if ( ( $type eq 'L' )
236 or ( $type eq 'M' ) )
242 $desc .= ' ' . $itemnum;
243 my $sth = $dbh->prepare(
244 'INSERT INTO accountlines
245 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id)
246 VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)');
247 $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr;
249 my $sth=$dbh->prepare("INSERT INTO accountlines
250 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id)
251 VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)"
253 $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
254 $amountleft, $notifyid, $note, $manager_id );
257 if ( C4
::Context
->preference("FinesLog") ) {
258 logaction
("FINES", 'CREATE',$borrowernumber,Dumper
({
259 action
=> 'create_fee',
260 borrowernumber
=> $borrowernumber,
261 accountno
=> $accountno,
263 description
=> $desc,
264 accounttype
=> $type,
265 amountoutstanding
=> $amountleft,
266 notify_id
=> $notifyid,
268 itemnumber
=> $itemnum,
269 manager_id
=> $manager_id,
277 my ( $borrowerno, $timestamp, $accountno ) = @_;
278 my $dbh = C4
::Context
->dbh;
279 my $timestamp2 = $timestamp - 1;
281 my $sth = $dbh->prepare(
282 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
284 $sth->execute( $borrowerno, $accountno );
287 while ( my $data = $sth->fetchrow_hashref ) {
294 my ( $accountlines_id, $note ) = @_;
295 my $dbh = C4
::Context
->dbh;
296 my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE accountlines_id = ?');
297 $sth->execute( $note, $accountlines_id );
301 my ( $date, $date2 ) = @_;
302 my $dbh = C4
::Context
->dbh;
303 my $sth = $dbh->prepare(
304 "SELECT * FROM accountlines,borrowers
305 WHERE amount < 0 AND accounttype not like 'Pay%' AND accountlines.borrowernumber = borrowers.borrowernumber
306 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
309 $sth->execute( $date, $date2 );
311 while ( my $data = $sth->fetchrow_hashref ) {
312 $data->{'date'} = $data->{'timestamp'};
320 my ( $date, $date2 ) = @_;
321 my $dbh = C4
::Context
->dbh;
323 my $sth = $dbh->prepare(
324 "SELECT *,timestamp AS datetime
325 FROM accountlines,borrowers
326 WHERE (accounttype = 'REF'
327 AND accountlines.borrowernumber = borrowers.borrowernumber
328 AND date >=? AND date <?)"
331 $sth->execute( $date, $date2 );
334 while ( my $data = $sth->fetchrow_hashref ) {
342 my ( $accountlines_id ) = @_;
343 my $dbh = C4
::Context
->dbh;
345 my $sth = $dbh->prepare('SELECT * FROM accountlines WHERE accountlines_id = ?');
346 $sth->execute( $accountlines_id );
347 my $row = $sth->fetchrow_hashref();
348 my $amount_outstanding = $row->{'amountoutstanding'};
350 if ( $amount_outstanding <= 0 ) {
351 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE accountlines_id = ?');
352 $sth->execute( $accountlines_id );
354 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE accountlines_id = ?');
355 $sth->execute( $accountlines_id );
358 if ( C4
::Context
->preference("FinesLog") ) {
360 $manager_id = C4
::Context
->userenv->{'number'} if C4
::Context
->userenv;
362 if ( $amount_outstanding <= 0 ) {
363 $row->{'amountoutstanding'} *= -1;
365 $row->{'amountoutstanding'} = '0';
367 $row->{'description'} .= ' Reversed -';
368 logaction
("FINES", 'MODIFY', $row->{'borrowernumber'}, Dumper
({
369 action
=> 'reverse_fee_payment',
370 borrowernumber
=> $row->{'borrowernumber'},
371 old_amountoutstanding
=> $row->{'amountoutstanding'},
372 new_amountoutstanding
=> 0 - $amount_outstanding,,
373 accountlines_id
=> $row->{'accountlines_id'},
374 accountno
=> $row->{'accountno'},
375 manager_id
=> $manager_id,
382 =head2 recordpayment_selectaccts
384 recordpayment_selectaccts($borrowernumber, $payment,$accts);
386 Record payment by a patron. C<$borrowernumber> is the patron's
387 borrower number. C<$payment> is a floating-point number, giving the
388 amount that was paid. C<$accts> is an array ref to a list of
389 accountnos which the payment can be recorded against
391 Amounts owed are paid off oldest first. That is, if the patron has a
392 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
393 of $1.50, then the oldest fine will be paid off in full, and $0.50
394 will be credited to the next one.
398 sub recordpayment_selectaccts
{
399 my ( $borrowernumber, $amount, $accts, $note ) = @_;
401 my @lines = Koha
::Account
::Lines
->search(
403 borrowernumber
=> $borrowernumber,
404 amountoutstanding
=> { '<>' => 0 },
405 accountno
=> { 'IN' => $accts },
407 { order_by
=> 'date' }
410 return Koha
::Account
->new(
412 patron_id
=> $borrowernumber,
423 # makepayment needs to be fixed to handle partials till then this separate subroutine
425 sub makepartialpayment
{
426 my ( $accountlines_id, $borrowernumber, $accountno, $amount, $user, $branch, $payment_note ) = @_;
428 $manager_id = C4
::Context
->userenv->{'number'} if C4
::Context
->userenv;
429 if (!$amount || $amount < 0) {
432 $payment_note //= "";
433 my $dbh = C4
::Context
->dbh;
435 my $nextaccntno = getnextacctno
($borrowernumber);
438 my $data = $dbh->selectrow_hashref(
439 'SELECT * FROM accountlines WHERE accountlines_id=?',undef,$accountlines_id);
440 my $new_outstanding = $data->{amountoutstanding
} - $amount;
442 my $update = 'UPDATE accountlines SET amountoutstanding = ? WHERE accountlines_id = ? ';
443 $dbh->do( $update, undef, $new_outstanding, $accountlines_id);
445 if ( C4
::Context
->preference("FinesLog") ) {
446 logaction
("FINES", 'MODIFY', $borrowernumber, Dumper
({
447 action
=> 'fee_payment',
448 borrowernumber
=> $borrowernumber,
449 old_amountoutstanding
=> $data->{'amountoutstanding'},
450 new_amountoutstanding
=> $new_outstanding,
451 amount_paid
=> $data->{'amountoutstanding'} - $new_outstanding,
452 accountlines_id
=> $data->{'accountlines_id'},
453 accountno
=> $data->{'accountno'},
454 manager_id
=> $manager_id,
459 my $insert = 'INSERT INTO accountlines (borrowernumber, accountno, date, amount, '
460 . 'description, accounttype, amountoutstanding, itemnumber, manager_id, note) '
461 . ' VALUES (?, ?, now(), ?, ?, ?, 0, ?, ?, ?)';
463 $dbh->do( $insert, undef, $borrowernumber, $nextaccntno, -$amount,
464 '', 'Pay', $data->{'itemnumber'}, $manager_id, $payment_note);
470 borrowernumber
=> $borrowernumber,
471 accountno
=> $accountno
474 if ( C4
::Context
->preference("FinesLog") ) {
475 logaction
("FINES", 'CREATE',$borrowernumber,Dumper
({
476 action
=> 'create_payment',
477 borrowernumber
=> $user,
478 accountno
=> $nextaccntno,
479 amount
=> 0 - $amount,
480 accounttype
=> 'Pay',
481 itemnumber
=> $data->{'itemnumber'},
482 accountlines_paid
=> [ $data->{'accountlines_id'} ],
483 manager_id
=> $manager_id,
492 WriteOffFee( $borrowernumber, $accountline_id, $itemnum, $accounttype, $amount, $branch, $payment_note );
494 Write off a fine for a patron.
495 C<$borrowernumber> is the patron's borrower number.
496 C<$accountline_id> is the accountline_id of the fee to write off.
497 C<$itemnum> is the itemnumber of of item whose fine is being written off.
498 C<$accounttype> is the account type of the fine being written off.
499 C<$amount> is a floating-point number, giving the amount that is being written off.
500 C<$branch> is the branchcode of the library where the writeoff occurred.
501 C<$payment_note> is the note to attach to this payment
506 my ( $borrowernumber, $accountlines_id, $itemnum, $accounttype, $amount, $branch, $payment_note ) = @_;
507 $payment_note //= "";
508 $branch ||= C4
::Context
->userenv->{branch
};
510 $manager_id = C4
::Context
->userenv->{'number'} if C4
::Context
->userenv;
512 # if no item is attached to fine, make sure to store it as a NULL
516 my $dbh = C4
::Context
->dbh();
519 UPDATE accountlines SET amountoutstanding = 0
520 WHERE accountlines_id = ? AND borrowernumber = ?
522 $sth = $dbh->prepare( $query );
523 $sth->execute( $accountlines_id, $borrowernumber );
525 if ( C4
::Context
->preference("FinesLog") ) {
526 logaction
("FINES", 'MODIFY', $borrowernumber, Dumper
({
527 action
=> 'fee_writeoff',
528 borrowernumber
=> $borrowernumber,
529 accountlines_id
=> $accountlines_id,
530 manager_id
=> $manager_id,
535 INSERT INTO accountlines
536 ( borrowernumber, accountno, itemnumber, date, amount, description, accounttype, manager_id, note )
537 VALUES ( ?, ?, ?, NOW(), ?, 'Writeoff', 'W', ?, ? )
539 $sth = $dbh->prepare( $query );
540 my $acct = getnextacctno
($borrowernumber);
541 $sth->execute( $borrowernumber, $acct, $itemnum, $amount, $manager_id, $payment_note );
543 if ( C4
::Context
->preference("FinesLog") ) {
544 logaction
("FINES", 'CREATE',$borrowernumber,Dumper
({
545 action
=> 'create_writeoff',
546 borrowernumber
=> $borrowernumber,
548 amount
=> 0 - $amount,
550 itemnumber
=> $itemnum,
551 accountlines_paid
=> [ $accountlines_id ],
552 manager_id
=> $manager_id,
560 borrowernumber
=> $borrowernumber}
565 =head2 purge_zero_balance_fees
567 purge_zero_balance_fees( $days );
569 Delete accountlines entries where amountoutstanding is 0 or NULL which are more than a given number of days old.
571 B<$days> -- Zero balance fees older than B<$days> days old will be deleted.
573 B<Warning:> Because fines and payments are not linked in accountlines, it is
574 possible for a fine to be deleted without the accompanying payment,
575 or vise versa. This won't affect the account balance, but might be
580 sub purge_zero_balance_fees
{
584 my $dbh = C4
::Context
->dbh;
585 my $sth = $dbh->prepare(
587 DELETE FROM accountlines
588 WHERE date < date_sub(curdate(), INTERVAL ? DAY)
589 AND ( amountoutstanding = 0 or amountoutstanding IS NULL );
592 $sth->execute($days) or die $dbh->errstr;
595 END { } # module clean-up code here (global destructor)