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);
47 &recordpayment_selectaccts
49 &purge_zero_balance_fees
55 C4::Accounts - Functions for dealing with Koha accounts
63 The functions in this module deal with the monetary aspect of Koha,
64 including looking up and modifying the amount of money owed by a
71 &makepayment($accountlines_id, $borrowernumber, $acctnumber, $amount, $branchcode);
73 Records the fact that a patron has paid off the entire amount he or
76 C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is
77 the account that was credited. C<$amount> is the amount paid (this is
78 only used to record the payment. It is assumed to be equal to the
79 amount owed). C<$branchcode> is the code of the branch where payment
85 # FIXME - I'm not at all sure about the above, because I don't
86 # understand what the acct* tables in the Koha database are for.
88 my ( $accountlines_id, $borrowernumber, $accountno, $amount, $user, $branch, $payment_note ) = @_;
90 my $line = Koha::Account::Lines->find( $accountlines_id );
92 return Koha::Account->new( { patron_id => $borrowernumber } )
93 ->pay( { lines => [ $line ], amount => $amount, library_id => $branch, note => $payment_note } );
98 $nextacct = &getnextacctno($borrowernumber);
100 Returns the next unused account number for the patron with the given
106 # FIXME - Okay, so what does the above actually _mean_?
108 my ($borrowernumber) = shift or return;
109 my $sth = C4::Context->dbh->prepare(
110 "SELECT accountno+1 FROM accountlines
111 WHERE (borrowernumber = ?)
112 ORDER BY accountno DESC
115 $sth->execute($borrowernumber);
116 return ($sth->fetchrow || 1);
119 =head2 fixaccounts (removed)
121 &fixaccounts($accountlines_id, $borrowernumber, $accountnumber, $amount);
124 # FIXME - I don't understand what this function does.
126 my ( $accountlines_id, $borrowernumber, $accountno, $amount ) = @_;
127 my $dbh = C4::Context->dbh;
128 my $sth = $dbh->prepare(
129 "SELECT * FROM accountlines WHERE accountlines_id=?"
131 $sth->execute( $accountlines_id );
132 my $data = $sth->fetchrow_hashref;
134 # FIXME - Error-checking
135 my $diff = $amount - $data->{'amount'};
136 my $outstanding = $data->{'amountoutstanding'} + $diff;
141 SET amount = '$amount',
142 amountoutstanding = '$outstanding'
143 WHERE accountlines_id = $accountlines_id
145 # FIXME: exceedingly bad form. Use prepare with placholders ("?") in query and execute args.
151 # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for
152 # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that
153 # a charge has been added
154 # FIXME : if no replacement price, borrower just doesn't get charged?
155 my $dbh = C4::Context->dbh();
156 my ($borrowernumber, $itemnumber, $amount, $description) = @_;
158 # first make sure the borrower hasn't already been charged for this item
159 my $sth1=$dbh->prepare("SELECT * from accountlines
160 WHERE borrowernumber=? AND itemnumber=? and accounttype='L'");
161 $sth1->execute($borrowernumber,$itemnumber);
162 my $existing_charge_hashref=$sth1->fetchrow_hashref();
165 unless ($existing_charge_hashref) {
167 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
168 # This item is on issue ... add replacement cost to the borrower's record and mark it returned
169 # Note that we add this to the account even if there's no replacement price, allowing some other
170 # process (or person) to update it, since we don't handle any defaults for replacement prices.
171 my $accountno = getnextacctno($borrowernumber);
172 my $sth2=$dbh->prepare("INSERT INTO accountlines
173 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber,manager_id)
174 VALUES (?,?,now(),?,?,'L',?,?,?)");
175 $sth2->execute($borrowernumber,$accountno,$amount,
176 $description,$amount,$itemnumber,$manager_id);
178 if ( C4::Context->preference("FinesLog") ) {
179 logaction("FINES", 'CREATE', $borrowernumber, Dumper({
180 action => 'create_fee',
181 borrowernumber => $borrowernumber,
182 accountno => $accountno,
184 amountoutstanding => $amount,
185 description => $description,
187 itemnumber => $itemnumber,
188 manager_id => $manager_id,
197 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
200 C<$borrowernumber> is the patron's borrower number.
201 C<$description> is a description of the transaction.
202 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
204 C<$itemnumber> is the item involved, if pertinent; otherwise, it
205 should be the empty string.
210 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
213 # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
216 # 'A' = Account Management fee
222 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_;
224 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
225 my $dbh = C4::Context->dbh;
228 my $accountno = getnextacctno($borrowernumber);
229 my $amountleft = $amount;
231 if ( ( $type eq 'L' )
235 or ( $type eq 'M' ) )
241 $desc .= ' ' . $itemnum;
242 my $sth = $dbh->prepare(
243 'INSERT INTO accountlines
244 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id)
245 VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)');
246 $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr;
248 my $sth=$dbh->prepare("INSERT INTO accountlines
249 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id)
250 VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)"
252 $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
253 $amountleft, $notifyid, $note, $manager_id );
256 if ( C4::Context->preference("FinesLog") ) {
257 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
258 action => 'create_fee',
259 borrowernumber => $borrowernumber,
260 accountno => $accountno,
262 description => $desc,
263 accounttype => $type,
264 amountoutstanding => $amountleft,
265 notify_id => $notifyid,
267 itemnumber => $itemnum,
268 manager_id => $manager_id,
276 my ( $borrowerno, $timestamp, $accountno ) = @_;
277 my $dbh = C4::Context->dbh;
278 my $timestamp2 = $timestamp - 1;
280 my $sth = $dbh->prepare(
281 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
283 $sth->execute( $borrowerno, $accountno );
286 while ( my $data = $sth->fetchrow_hashref ) {
293 my ( $accountlines_id, $note ) = @_;
294 my $dbh = C4::Context->dbh;
295 my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE accountlines_id = ?');
296 $sth->execute( $note, $accountlines_id );
300 my ( $date, $date2 ) = @_;
301 my $dbh = C4::Context->dbh;
302 my $sth = $dbh->prepare(
303 "SELECT * FROM accountlines,borrowers
304 WHERE amount < 0 AND accounttype not like 'Pay%' AND accountlines.borrowernumber = borrowers.borrowernumber
305 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
308 $sth->execute( $date, $date2 );
310 while ( my $data = $sth->fetchrow_hashref ) {
311 $data->{'date'} = $data->{'timestamp'};
319 my ( $date, $date2 ) = @_;
320 my $dbh = C4::Context->dbh;
322 my $sth = $dbh->prepare(
323 "SELECT *,timestamp AS datetime
324 FROM accountlines,borrowers
325 WHERE (accounttype = 'REF'
326 AND accountlines.borrowernumber = borrowers.borrowernumber
327 AND date >=? AND date <?)"
330 $sth->execute( $date, $date2 );
333 while ( my $data = $sth->fetchrow_hashref ) {
341 my ( $accountlines_id ) = @_;
342 my $dbh = C4::Context->dbh;
344 my $sth = $dbh->prepare('SELECT * FROM accountlines WHERE accountlines_id = ?');
345 $sth->execute( $accountlines_id );
346 my $row = $sth->fetchrow_hashref();
347 my $amount_outstanding = $row->{'amountoutstanding'};
349 if ( $amount_outstanding <= 0 ) {
350 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE accountlines_id = ?');
351 $sth->execute( $accountlines_id );
353 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE accountlines_id = ?');
354 $sth->execute( $accountlines_id );
357 if ( C4::Context->preference("FinesLog") ) {
359 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
361 if ( $amount_outstanding <= 0 ) {
362 $row->{'amountoutstanding'} *= -1;
364 $row->{'amountoutstanding'} = '0';
366 $row->{'description'} .= ' Reversed -';
367 logaction("FINES", 'MODIFY', $row->{'borrowernumber'}, Dumper({
368 action => 'reverse_fee_payment',
369 borrowernumber => $row->{'borrowernumber'},
370 old_amountoutstanding => $row->{'amountoutstanding'},
371 new_amountoutstanding => 0 - $amount_outstanding,,
372 accountlines_id => $row->{'accountlines_id'},
373 accountno => $row->{'accountno'},
374 manager_id => $manager_id,
381 =head2 recordpayment_selectaccts
383 recordpayment_selectaccts($borrowernumber, $payment,$accts);
385 Record payment by a patron. C<$borrowernumber> is the patron's
386 borrower number. C<$payment> is a floating-point number, giving the
387 amount that was paid. C<$accts> is an array ref to a list of
388 accountnos which the payment can be recorded against
390 Amounts owed are paid off oldest first. That is, if the patron has a
391 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
392 of $1.50, then the oldest fine will be paid off in full, and $0.50
393 will be credited to the next one.
397 sub recordpayment_selectaccts {
398 my ( $borrowernumber, $amount, $accts, $note ) = @_;
400 my @lines = Koha::Account::Lines->search(
402 borrowernumber => $borrowernumber,
403 amountoutstanding => { '<>' => 0 },
404 accountno => { 'IN' => $accts },
406 { order_by => 'date' }
409 return Koha::Account->new(
411 patron_id => $borrowernumber,
424 WriteOffFee( $borrowernumber, $accountline_id, $itemnum, $accounttype, $amount, $branch, $payment_note );
426 Write off a fine for a patron.
427 C<$borrowernumber> is the patron's borrower number.
428 C<$accountline_id> is the accountline_id of the fee to write off.
429 C<$itemnum> is the itemnumber of of item whose fine is being written off.
430 C<$accounttype> is the account type of the fine being written off.
431 C<$amount> is a floating-point number, giving the amount that is being written off.
432 C<$branch> is the branchcode of the library where the writeoff occurred.
433 C<$payment_note> is the note to attach to this payment
438 my ( $borrowernumber, $accountlines_id, $itemnum, $accounttype, $amount, $branch, $payment_note ) = @_;
439 $payment_note //= "";
440 $branch ||= C4::Context->userenv->{branch};
442 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
444 # if no item is attached to fine, make sure to store it as a NULL
448 my $dbh = C4::Context->dbh();
451 UPDATE accountlines SET amountoutstanding = 0
452 WHERE accountlines_id = ? AND borrowernumber = ?
454 $sth = $dbh->prepare( $query );
455 $sth->execute( $accountlines_id, $borrowernumber );
457 if ( C4::Context->preference("FinesLog") ) {
458 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
459 action => 'fee_writeoff',
460 borrowernumber => $borrowernumber,
461 accountlines_id => $accountlines_id,
462 manager_id => $manager_id,
467 INSERT INTO accountlines
468 ( borrowernumber, accountno, itemnumber, date, amount, description, accounttype, manager_id, note )
469 VALUES ( ?, ?, ?, NOW(), ?, 'Writeoff', 'W', ?, ? )
471 $sth = $dbh->prepare( $query );
472 my $acct = getnextacctno($borrowernumber);
473 $sth->execute( $borrowernumber, $acct, $itemnum, $amount, $manager_id, $payment_note );
475 if ( C4::Context->preference("FinesLog") ) {
476 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
477 action => 'create_writeoff',
478 borrowernumber => $borrowernumber,
480 amount => 0 - $amount,
482 itemnumber => $itemnum,
483 accountlines_paid => [ $accountlines_id ],
484 manager_id => $manager_id,
492 borrowernumber => $borrowernumber}
497 =head2 purge_zero_balance_fees
499 purge_zero_balance_fees( $days );
501 Delete accountlines entries where amountoutstanding is 0 or NULL which are more than a given number of days old.
503 B<$days> -- Zero balance fees older than B<$days> days old will be deleted.
505 B<Warning:> Because fines and payments are not linked in accountlines, it is
506 possible for a fine to be deleted without the accompanying payment,
507 or vise versa. This won't affect the account balance, but might be
512 sub purge_zero_balance_fees {
516 my $dbh = C4::Context->dbh;
517 my $sth = $dbh->prepare(
519 DELETE FROM accountlines
520 WHERE date < date_sub(curdate(), INTERVAL ? DAY)
521 AND ( amountoutstanding = 0 or amountoutstanding IS NULL );
524 $sth->execute($days) or die $dbh->errstr;
527 END { } # module clean-up code here (global destructor)