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);
29 use Koha::Account::Lines;
31 use Data::Dumper qw(Dumper);
33 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 $nextacct = &getnextacctno($borrowernumber);
72 Returns the next unused account number for the patron with the given
78 # FIXME - Okay, so what does the above actually _mean_?
80 my ($borrowernumber) = shift or return;
81 my $sth = C4::Context->dbh->prepare(
82 "SELECT accountno+1 FROM accountlines
83 WHERE (borrowernumber = ?)
84 ORDER BY accountno DESC
87 $sth->execute($borrowernumber);
88 return ($sth->fetchrow || 1);
91 =head2 fixaccounts (removed)
93 &fixaccounts($accountlines_id, $borrowernumber, $accountnumber, $amount);
96 # FIXME - I don't understand what this function does.
98 my ( $accountlines_id, $borrowernumber, $accountno, $amount ) = @_;
99 my $dbh = C4::Context->dbh;
100 my $sth = $dbh->prepare(
101 "SELECT * FROM accountlines WHERE accountlines_id=?"
103 $sth->execute( $accountlines_id );
104 my $data = $sth->fetchrow_hashref;
106 # FIXME - Error-checking
107 my $diff = $amount - $data->{'amount'};
108 my $outstanding = $data->{'amountoutstanding'} + $diff;
113 SET amount = '$amount',
114 amountoutstanding = '$outstanding'
115 WHERE accountlines_id = $accountlines_id
117 # FIXME: exceedingly bad form. Use prepare with placholders ("?") in query and execute args.
123 # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for
124 # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that
125 # a charge has been added
126 # FIXME : if no replacement price, borrower just doesn't get charged?
127 my $dbh = C4::Context->dbh();
128 my ($borrowernumber, $itemnumber, $amount, $description) = @_;
130 # first make sure the borrower hasn't already been charged for this item
131 my $sth1=$dbh->prepare("SELECT * from accountlines
132 WHERE borrowernumber=? AND itemnumber=? and accounttype='L'");
133 $sth1->execute($borrowernumber,$itemnumber);
134 my $existing_charge_hashref=$sth1->fetchrow_hashref();
137 unless ($existing_charge_hashref) {
139 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
140 # This item is on issue ... add replacement cost to the borrower's record and mark it returned
141 # Note that we add this to the account even if there's no replacement price, allowing some other
142 # process (or person) to update it, since we don't handle any defaults for replacement prices.
143 my $accountno = getnextacctno($borrowernumber);
144 my $sth2=$dbh->prepare("INSERT INTO accountlines
145 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber,manager_id)
146 VALUES (?,?,now(),?,?,'L',?,?,?)");
147 $sth2->execute($borrowernumber,$accountno,$amount,
148 $description,$amount,$itemnumber,$manager_id);
150 if ( C4::Context->preference("FinesLog") ) {
151 logaction("FINES", 'CREATE', $borrowernumber, Dumper({
152 action => 'create_fee',
153 borrowernumber => $borrowernumber,
154 accountno => $accountno,
156 amountoutstanding => $amount,
157 description => $description,
159 itemnumber => $itemnumber,
160 manager_id => $manager_id,
169 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
172 C<$borrowernumber> is the patron's borrower number.
173 C<$description> is a description of the transaction.
174 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
176 C<$itemnumber> is the item involved, if pertinent; otherwise, it
177 should be the empty string.
182 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
185 # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
188 # 'A' = Account Management fee
194 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_;
196 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
197 my $dbh = C4::Context->dbh;
200 my $accountno = getnextacctno($borrowernumber);
201 my $amountleft = $amount;
203 if ( ( $type eq 'L' )
207 or ( $type eq 'M' ) )
213 $desc .= ' ' . $itemnum;
214 my $sth = $dbh->prepare(
215 'INSERT INTO accountlines
216 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id)
217 VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)');
218 $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr;
220 my $sth=$dbh->prepare("INSERT INTO accountlines
221 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id)
222 VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)"
224 $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
225 $amountleft, $notifyid, $note, $manager_id );
228 if ( C4::Context->preference("FinesLog") ) {
229 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
230 action => 'create_fee',
231 borrowernumber => $borrowernumber,
232 accountno => $accountno,
234 description => $desc,
235 accounttype => $type,
236 amountoutstanding => $amountleft,
237 notify_id => $notifyid,
239 itemnumber => $itemnum,
240 manager_id => $manager_id,
248 my ( $borrowerno, $timestamp, $accountno ) = @_;
249 my $dbh = C4::Context->dbh;
250 my $timestamp2 = $timestamp - 1;
252 my $sth = $dbh->prepare(
253 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
255 $sth->execute( $borrowerno, $accountno );
258 while ( my $data = $sth->fetchrow_hashref ) {
265 my ( $accountlines_id, $note ) = @_;
266 my $dbh = C4::Context->dbh;
267 my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE accountlines_id = ?');
268 $sth->execute( $note, $accountlines_id );
272 my ( $date, $date2 ) = @_;
273 my $dbh = C4::Context->dbh;
274 my $sth = $dbh->prepare(
275 "SELECT * FROM accountlines,borrowers
276 WHERE amount < 0 AND accounttype not like 'Pay%' AND accountlines.borrowernumber = borrowers.borrowernumber
277 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
280 $sth->execute( $date, $date2 );
282 while ( my $data = $sth->fetchrow_hashref ) {
283 $data->{'date'} = $data->{'timestamp'};
291 my ( $date, $date2 ) = @_;
292 my $dbh = C4::Context->dbh;
294 my $sth = $dbh->prepare(
295 "SELECT *,timestamp AS datetime
296 FROM accountlines,borrowers
297 WHERE (accounttype = 'REF'
298 AND accountlines.borrowernumber = borrowers.borrowernumber
299 AND date >=? AND date <?)"
302 $sth->execute( $date, $date2 );
305 while ( my $data = $sth->fetchrow_hashref ) {
313 my ( $accountlines_id ) = @_;
314 my $dbh = C4::Context->dbh;
316 my $sth = $dbh->prepare('SELECT * FROM accountlines WHERE accountlines_id = ?');
317 $sth->execute( $accountlines_id );
318 my $row = $sth->fetchrow_hashref();
319 my $amount_outstanding = $row->{'amountoutstanding'};
321 if ( $amount_outstanding <= 0 ) {
322 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE accountlines_id = ?');
323 $sth->execute( $accountlines_id );
325 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE accountlines_id = ?');
326 $sth->execute( $accountlines_id );
329 if ( C4::Context->preference("FinesLog") ) {
331 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
333 if ( $amount_outstanding <= 0 ) {
334 $row->{'amountoutstanding'} *= -1;
336 $row->{'amountoutstanding'} = '0';
338 $row->{'description'} .= ' Reversed -';
339 logaction("FINES", 'MODIFY', $row->{'borrowernumber'}, Dumper({
340 action => 'reverse_fee_payment',
341 borrowernumber => $row->{'borrowernumber'},
342 old_amountoutstanding => $row->{'amountoutstanding'},
343 new_amountoutstanding => 0 - $amount_outstanding,,
344 accountlines_id => $row->{'accountlines_id'},
345 accountno => $row->{'accountno'},
346 manager_id => $manager_id,
355 WriteOffFee( $borrowernumber, $accountline_id, $itemnum, $accounttype, $amount, $branch, $payment_note );
357 Write off a fine for a patron.
358 C<$borrowernumber> is the patron's borrower number.
359 C<$accountline_id> is the accountline_id of the fee to write off.
360 C<$itemnum> is the itemnumber of of item whose fine is being written off.
361 C<$accounttype> is the account type of the fine being written off.
362 C<$amount> is a floating-point number, giving the amount that is being written off.
363 C<$branch> is the branchcode of the library where the writeoff occurred.
364 C<$payment_note> is the note to attach to this payment
369 my ( $borrowernumber, $accountlines_id, $itemnum, $accounttype, $amount, $branch, $payment_note ) = @_;
371 my $line = Koha::Account::Lines->find($accountlines_id);
372 return Koha::Account->new( { patron_id => $borrowernumber } )->pay(
377 note => $payment_note,
378 library_id => $branch,
383 =head2 purge_zero_balance_fees
385 purge_zero_balance_fees( $days );
387 Delete accountlines entries where amountoutstanding is 0 or NULL which are more than a given number of days old.
389 B<$days> -- Zero balance fees older than B<$days> days old will be deleted.
391 B<Warning:> Because fines and payments are not linked in accountlines, it is
392 possible for a fine to be deleted without the accompanying payment,
393 or vise versa. This won't affect the account balance, but might be
398 sub purge_zero_balance_fees {
402 my $dbh = C4::Context->dbh;
403 my $sth = $dbh->prepare(
405 DELETE FROM accountlines
406 WHERE date < date_sub(curdate(), INTERVAL ? DAY)
407 AND ( amountoutstanding = 0 or amountoutstanding IS NULL );
410 $sth->execute($days) or die $dbh->errstr;
413 END { } # module clean-up code here (global destructor)