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 my $line = Koha::Account::Lines->find( $accountlines_id );
430 return Koha::Account->new(
432 patron_id => $borrowernumber,
438 note => $payment_note,
439 library_id => $branch,
447 WriteOffFee( $borrowernumber, $accountline_id, $itemnum, $accounttype, $amount, $branch, $payment_note );
449 Write off a fine for a patron.
450 C<$borrowernumber> is the patron's borrower number.
451 C<$accountline_id> is the accountline_id of the fee to write off.
452 C<$itemnum> is the itemnumber of of item whose fine is being written off.
453 C<$accounttype> is the account type of the fine being written off.
454 C<$amount> is a floating-point number, giving the amount that is being written off.
455 C<$branch> is the branchcode of the library where the writeoff occurred.
456 C<$payment_note> is the note to attach to this payment
461 my ( $borrowernumber, $accountlines_id, $itemnum, $accounttype, $amount, $branch, $payment_note ) = @_;
462 $payment_note //= "";
463 $branch ||= C4::Context->userenv->{branch};
465 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
467 # if no item is attached to fine, make sure to store it as a NULL
471 my $dbh = C4::Context->dbh();
474 UPDATE accountlines SET amountoutstanding = 0
475 WHERE accountlines_id = ? AND borrowernumber = ?
477 $sth = $dbh->prepare( $query );
478 $sth->execute( $accountlines_id, $borrowernumber );
480 if ( C4::Context->preference("FinesLog") ) {
481 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
482 action => 'fee_writeoff',
483 borrowernumber => $borrowernumber,
484 accountlines_id => $accountlines_id,
485 manager_id => $manager_id,
490 INSERT INTO accountlines
491 ( borrowernumber, accountno, itemnumber, date, amount, description, accounttype, manager_id, note )
492 VALUES ( ?, ?, ?, NOW(), ?, 'Writeoff', 'W', ?, ? )
494 $sth = $dbh->prepare( $query );
495 my $acct = getnextacctno($borrowernumber);
496 $sth->execute( $borrowernumber, $acct, $itemnum, $amount, $manager_id, $payment_note );
498 if ( C4::Context->preference("FinesLog") ) {
499 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
500 action => 'create_writeoff',
501 borrowernumber => $borrowernumber,
503 amount => 0 - $amount,
505 itemnumber => $itemnum,
506 accountlines_paid => [ $accountlines_id ],
507 manager_id => $manager_id,
515 borrowernumber => $borrowernumber}
520 =head2 purge_zero_balance_fees
522 purge_zero_balance_fees( $days );
524 Delete accountlines entries where amountoutstanding is 0 or NULL which are more than a given number of days old.
526 B<$days> -- Zero balance fees older than B<$days> days old will be deleted.
528 B<Warning:> Because fines and payments are not linked in accountlines, it is
529 possible for a fine to be deleted without the accompanying payment,
530 or vise versa. This won't affect the account balance, but might be
535 sub purge_zero_balance_fees {
539 my $dbh = C4::Context->dbh;
540 my $sth = $dbh->prepare(
542 DELETE FROM accountlines
543 WHERE date < date_sub(curdate(), INTERVAL ? DAY)
544 AND ( amountoutstanding = 0 or amountoutstanding IS NULL );
547 $sth->execute($days) or die $dbh->errstr;
550 END { } # module clean-up code here (global destructor)