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 &purge_zero_balance_fees
54 C4::Accounts - Functions for dealing with Koha accounts
62 The functions in this module deal with the monetary aspect of Koha,
63 including looking up and modifying the amount of money owed by a
70 &makepayment($accountlines_id, $borrowernumber, $acctnumber, $amount, $branchcode);
72 Records the fact that a patron has paid off the entire amount he or
75 C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is
76 the account that was credited. C<$amount> is the amount paid (this is
77 only used to record the payment. It is assumed to be equal to the
78 amount owed). C<$branchcode> is the code of the branch where payment
84 # FIXME - I'm not at all sure about the above, because I don't
85 # understand what the acct* tables in the Koha database are for.
87 my ( $accountlines_id, $borrowernumber, $accountno, $amount, $user, $branch, $payment_note ) = @_;
89 my $line = Koha::Account::Lines->find( $accountlines_id );
91 return Koha::Account->new( { patron_id => $borrowernumber } )
92 ->pay( { lines => [ $line ], amount => $amount, library_id => $branch, note => $payment_note } );
97 $nextacct = &getnextacctno($borrowernumber);
99 Returns the next unused account number for the patron with the given
105 # FIXME - Okay, so what does the above actually _mean_?
107 my ($borrowernumber) = shift or return;
108 my $sth = C4::Context->dbh->prepare(
109 "SELECT accountno+1 FROM accountlines
110 WHERE (borrowernumber = ?)
111 ORDER BY accountno DESC
114 $sth->execute($borrowernumber);
115 return ($sth->fetchrow || 1);
118 =head2 fixaccounts (removed)
120 &fixaccounts($accountlines_id, $borrowernumber, $accountnumber, $amount);
123 # FIXME - I don't understand what this function does.
125 my ( $accountlines_id, $borrowernumber, $accountno, $amount ) = @_;
126 my $dbh = C4::Context->dbh;
127 my $sth = $dbh->prepare(
128 "SELECT * FROM accountlines WHERE accountlines_id=?"
130 $sth->execute( $accountlines_id );
131 my $data = $sth->fetchrow_hashref;
133 # FIXME - Error-checking
134 my $diff = $amount - $data->{'amount'};
135 my $outstanding = $data->{'amountoutstanding'} + $diff;
140 SET amount = '$amount',
141 amountoutstanding = '$outstanding'
142 WHERE accountlines_id = $accountlines_id
144 # FIXME: exceedingly bad form. Use prepare with placholders ("?") in query and execute args.
150 # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for
151 # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that
152 # a charge has been added
153 # FIXME : if no replacement price, borrower just doesn't get charged?
154 my $dbh = C4::Context->dbh();
155 my ($borrowernumber, $itemnumber, $amount, $description) = @_;
157 # first make sure the borrower hasn't already been charged for this item
158 my $sth1=$dbh->prepare("SELECT * from accountlines
159 WHERE borrowernumber=? AND itemnumber=? and accounttype='L'");
160 $sth1->execute($borrowernumber,$itemnumber);
161 my $existing_charge_hashref=$sth1->fetchrow_hashref();
164 unless ($existing_charge_hashref) {
166 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
167 # This item is on issue ... add replacement cost to the borrower's record and mark it returned
168 # Note that we add this to the account even if there's no replacement price, allowing some other
169 # process (or person) to update it, since we don't handle any defaults for replacement prices.
170 my $accountno = getnextacctno($borrowernumber);
171 my $sth2=$dbh->prepare("INSERT INTO accountlines
172 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber,manager_id)
173 VALUES (?,?,now(),?,?,'L',?,?,?)");
174 $sth2->execute($borrowernumber,$accountno,$amount,
175 $description,$amount,$itemnumber,$manager_id);
177 if ( C4::Context->preference("FinesLog") ) {
178 logaction("FINES", 'CREATE', $borrowernumber, Dumper({
179 action => 'create_fee',
180 borrowernumber => $borrowernumber,
181 accountno => $accountno,
183 amountoutstanding => $amount,
184 description => $description,
186 itemnumber => $itemnumber,
187 manager_id => $manager_id,
196 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
199 C<$borrowernumber> is the patron's borrower number.
200 C<$description> is a description of the transaction.
201 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
203 C<$itemnumber> is the item involved, if pertinent; otherwise, it
204 should be the empty string.
209 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
212 # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
215 # 'A' = Account Management fee
221 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_;
223 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
224 my $dbh = C4::Context->dbh;
227 my $accountno = getnextacctno($borrowernumber);
228 my $amountleft = $amount;
230 if ( ( $type eq 'L' )
234 or ( $type eq 'M' ) )
240 $desc .= ' ' . $itemnum;
241 my $sth = $dbh->prepare(
242 'INSERT INTO accountlines
243 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id)
244 VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)');
245 $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr;
247 my $sth=$dbh->prepare("INSERT INTO accountlines
248 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id)
249 VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)"
251 $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
252 $amountleft, $notifyid, $note, $manager_id );
255 if ( C4::Context->preference("FinesLog") ) {
256 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
257 action => 'create_fee',
258 borrowernumber => $borrowernumber,
259 accountno => $accountno,
261 description => $desc,
262 accounttype => $type,
263 amountoutstanding => $amountleft,
264 notify_id => $notifyid,
266 itemnumber => $itemnum,
267 manager_id => $manager_id,
275 my ( $borrowerno, $timestamp, $accountno ) = @_;
276 my $dbh = C4::Context->dbh;
277 my $timestamp2 = $timestamp - 1;
279 my $sth = $dbh->prepare(
280 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
282 $sth->execute( $borrowerno, $accountno );
285 while ( my $data = $sth->fetchrow_hashref ) {
292 my ( $accountlines_id, $note ) = @_;
293 my $dbh = C4::Context->dbh;
294 my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE accountlines_id = ?');
295 $sth->execute( $note, $accountlines_id );
299 my ( $date, $date2 ) = @_;
300 my $dbh = C4::Context->dbh;
301 my $sth = $dbh->prepare(
302 "SELECT * FROM accountlines,borrowers
303 WHERE amount < 0 AND accounttype not like 'Pay%' AND accountlines.borrowernumber = borrowers.borrowernumber
304 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
307 $sth->execute( $date, $date2 );
309 while ( my $data = $sth->fetchrow_hashref ) {
310 $data->{'date'} = $data->{'timestamp'};
318 my ( $date, $date2 ) = @_;
319 my $dbh = C4::Context->dbh;
321 my $sth = $dbh->prepare(
322 "SELECT *,timestamp AS datetime
323 FROM accountlines,borrowers
324 WHERE (accounttype = 'REF'
325 AND accountlines.borrowernumber = borrowers.borrowernumber
326 AND date >=? AND date <?)"
329 $sth->execute( $date, $date2 );
332 while ( my $data = $sth->fetchrow_hashref ) {
340 my ( $accountlines_id ) = @_;
341 my $dbh = C4::Context->dbh;
343 my $sth = $dbh->prepare('SELECT * FROM accountlines WHERE accountlines_id = ?');
344 $sth->execute( $accountlines_id );
345 my $row = $sth->fetchrow_hashref();
346 my $amount_outstanding = $row->{'amountoutstanding'};
348 if ( $amount_outstanding <= 0 ) {
349 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE accountlines_id = ?');
350 $sth->execute( $accountlines_id );
352 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE accountlines_id = ?');
353 $sth->execute( $accountlines_id );
356 if ( C4::Context->preference("FinesLog") ) {
358 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
360 if ( $amount_outstanding <= 0 ) {
361 $row->{'amountoutstanding'} *= -1;
363 $row->{'amountoutstanding'} = '0';
365 $row->{'description'} .= ' Reversed -';
366 logaction("FINES", 'MODIFY', $row->{'borrowernumber'}, Dumper({
367 action => 'reverse_fee_payment',
368 borrowernumber => $row->{'borrowernumber'},
369 old_amountoutstanding => $row->{'amountoutstanding'},
370 new_amountoutstanding => 0 - $amount_outstanding,,
371 accountlines_id => $row->{'accountlines_id'},
372 accountno => $row->{'accountno'},
373 manager_id => $manager_id,
382 WriteOffFee( $borrowernumber, $accountline_id, $itemnum, $accounttype, $amount, $branch, $payment_note );
384 Write off a fine for a patron.
385 C<$borrowernumber> is the patron's borrower number.
386 C<$accountline_id> is the accountline_id of the fee to write off.
387 C<$itemnum> is the itemnumber of of item whose fine is being written off.
388 C<$accounttype> is the account type of the fine being written off.
389 C<$amount> is a floating-point number, giving the amount that is being written off.
390 C<$branch> is the branchcode of the library where the writeoff occurred.
391 C<$payment_note> is the note to attach to this payment
396 my ( $borrowernumber, $accountlines_id, $itemnum, $accounttype, $amount, $branch, $payment_note ) = @_;
397 $payment_note //= "";
398 $branch ||= C4::Context->userenv->{branch};
400 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
402 # if no item is attached to fine, make sure to store it as a NULL
406 my $dbh = C4::Context->dbh();
409 UPDATE accountlines SET amountoutstanding = 0
410 WHERE accountlines_id = ? AND borrowernumber = ?
412 $sth = $dbh->prepare( $query );
413 $sth->execute( $accountlines_id, $borrowernumber );
415 if ( C4::Context->preference("FinesLog") ) {
416 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
417 action => 'fee_writeoff',
418 borrowernumber => $borrowernumber,
419 accountlines_id => $accountlines_id,
420 manager_id => $manager_id,
425 INSERT INTO accountlines
426 ( borrowernumber, accountno, itemnumber, date, amount, description, accounttype, manager_id, note )
427 VALUES ( ?, ?, ?, NOW(), ?, 'Writeoff', 'W', ?, ? )
429 $sth = $dbh->prepare( $query );
430 my $acct = getnextacctno($borrowernumber);
431 $sth->execute( $borrowernumber, $acct, $itemnum, $amount, $manager_id, $payment_note );
433 if ( C4::Context->preference("FinesLog") ) {
434 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
435 action => 'create_writeoff',
436 borrowernumber => $borrowernumber,
438 amount => 0 - $amount,
440 itemnumber => $itemnum,
441 accountlines_paid => [ $accountlines_id ],
442 manager_id => $manager_id,
450 borrowernumber => $borrowernumber}
455 =head2 purge_zero_balance_fees
457 purge_zero_balance_fees( $days );
459 Delete accountlines entries where amountoutstanding is 0 or NULL which are more than a given number of days old.
461 B<$days> -- Zero balance fees older than B<$days> days old will be deleted.
463 B<Warning:> Because fines and payments are not linked in accountlines, it is
464 possible for a fine to be deleted without the accompanying payment,
465 or vise versa. This won't affect the account balance, but might be
470 sub purge_zero_balance_fees {
474 my $dbh = C4::Context->dbh;
475 my $sth = $dbh->prepare(
477 DELETE FROM accountlines
478 WHERE date < date_sub(curdate(), INTERVAL ? DAY)
479 AND ( amountoutstanding = 0 or amountoutstanding IS NULL );
482 $sth->execute($days) or die $dbh->errstr;
485 END { } # module clean-up code here (global destructor)