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::Log qw(logaction);
28 use Koha::Account::Lines;
29 use Koha::Account::Offsets;
32 use Data::Dumper qw(Dumper);
34 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.
122 =head2 chargelostitem
124 In a default install of Koha the following lost values are set
127 3 = Lost and paid for
129 FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that a charge has been added
130 FIXME : if no replacement price, borrower just doesn't get charged?
135 my $dbh = C4::Context->dbh();
136 my ($borrowernumber, $itemnumber, $amount, $description) = @_;
137 my $itype = Koha::ItemTypes->find({ itemtype => Koha::Items->find($itemnumber)->effective_itemtype() });
138 my $replacementprice = $amount;
139 my $defaultreplacecost = $itype->defaultreplacecost;
140 my $processfee = $itype->processfee;
141 my $usedefaultreplacementcost = C4::Context->preference("useDefaultReplacementCost");
142 my $processingfeenote = C4::Context->preference("ProcessingFeeNote");
143 if ($usedefaultreplacementcost && $amount == 0 && $defaultreplacecost){
144 $replacementprice = $defaultreplacecost;
146 # first make sure the borrower hasn't already been charged for this item
147 # FIXME this should be more exact
148 # there is no reason a user can't lose an item, find and return it, and lost it again
149 my $existing_charges = Koha::Account::Lines->search(
151 borrowernumber => $borrowernumber,
152 itemnumber => $itemnumber,
158 unless ($existing_charges) {
159 my $checkout = Koha::Checkouts->find({ itemnumber => $itemnumber });
160 my $issue_id = $checkout ? $checkout->issue_id : undef;
162 if ($processfee && $processfee > 0){
163 my $accountline = Koha::Account::Line->new(
165 borrowernumber => $borrowernumber,
166 issue_id => $issue_id,
167 accountno => getnextacctno($borrowernumber),
169 amount => $processfee,
170 description => $description,
172 amountoutstanding => $processfee,
173 itemnumber => $itemnumber,
174 note => $processingfeenote,
175 manager_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : 0,
179 my $account_offset = Koha::Account::Offset->new(
181 debit_id => $accountline->id,
182 type => 'Processing Fee',
183 amount => $accountline->amount,
187 if ( C4::Context->preference("FinesLog") ) {
188 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
189 action => 'create_fee',
190 borrowernumber => $accountline->borrowernumber,,
191 accountno => $accountline->accountno,
192 amount => $accountline->amount,
193 description => $accountline->description,
194 accounttype => $accountline->accounttype,
195 amountoutstanding => $accountline->amountoutstanding,
196 note => $accountline->note,
197 itemnumber => $accountline->itemnumber,
198 manager_id => $accountline->manager_id,
203 if ($replacementprice > 0){
204 my $accountline = Koha::Account::Line->new(
206 borrowernumber => $borrowernumber,
207 issue_id => $issue_id,
208 accountno => getnextacctno($borrowernumber),
210 amount => $replacementprice,
211 description => $description,
213 amountoutstanding => $replacementprice,
214 itemnumber => $itemnumber,
215 manager_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : 0,
219 my $account_offset = Koha::Account::Offset->new(
221 debit_id => $accountline->id,
223 amount => $accountline->amount,
227 if ( C4::Context->preference("FinesLog") ) {
228 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
229 action => 'create_fee',
230 borrowernumber => $accountline->borrowernumber,,
231 accountno => $accountline->accountno,
232 amount => $accountline->amount,
233 description => $accountline->description,
234 accounttype => $accountline->accounttype,
235 amountoutstanding => $accountline->amountoutstanding,
236 note => $accountline->note,
237 itemnumber => $accountline->itemnumber,
238 manager_id => $accountline->manager_id,
247 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
250 C<$borrowernumber> is the patron's borrower number.
251 C<$description> is a description of the transaction.
252 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
254 C<$itemnumber> is the item involved, if pertinent; otherwise, it
255 should be the empty string.
260 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
263 # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
266 # 'A' = Account Management fee
272 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note, $skip_notify ) = @_;
274 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
275 my $dbh = C4::Context->dbh;
278 my $accountno = getnextacctno($borrowernumber);
279 my $amountleft = $amount;
282 if ( ( $type eq 'L' )
286 or ( $type eq 'M' ) )
288 $notifyid = 1 unless $skip_notify;
291 my $accountline = Koha::Account::Line->new(
293 borrowernumber => $borrowernumber,
294 accountno => $accountno,
297 description => $desc,
298 accounttype => $type,
299 amountoutstanding => $amountleft,
300 itemnumber => $itemnum || undef,
301 notify_id => $notifyid,
303 manager_id => $manager_id,
307 my $account_offset = Koha::Account::Offset->new(
309 debit_id => $accountline->id,
310 type => 'Manual Debit',
315 if ( C4::Context->preference("FinesLog") ) {
316 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
317 action => 'create_fee',
318 borrowernumber => $borrowernumber,
319 accountno => $accountno,
321 description => $desc,
322 accounttype => $type,
323 amountoutstanding => $amountleft,
324 notify_id => $notifyid,
326 itemnumber => $itemnum,
327 manager_id => $manager_id,
335 my ( $borrowerno, $timestamp, $accountno ) = @_;
336 my $dbh = C4::Context->dbh;
337 my $timestamp2 = $timestamp - 1;
339 my $sth = $dbh->prepare(
340 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
342 $sth->execute( $borrowerno, $accountno );
345 while ( my $data = $sth->fetchrow_hashref ) {
352 my ( $accountlines_id, $note ) = @_;
353 my $dbh = C4::Context->dbh;
354 my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE accountlines_id = ?');
355 $sth->execute( $note, $accountlines_id );
359 my ( $date, $date2 ) = @_;
360 my $dbh = C4::Context->dbh;
361 my $sth = $dbh->prepare(
362 "SELECT * FROM accountlines,borrowers
363 WHERE amount < 0 AND accounttype not like 'Pay%' AND accountlines.borrowernumber = borrowers.borrowernumber
364 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
367 $sth->execute( $date, $date2 );
369 while ( my $data = $sth->fetchrow_hashref ) {
370 $data->{'date'} = $data->{'timestamp'};
378 my ( $date, $date2 ) = @_;
379 my $dbh = C4::Context->dbh;
381 my $sth = $dbh->prepare(
382 "SELECT *,timestamp AS datetime
383 FROM accountlines,borrowers
384 WHERE (accounttype = 'REF'
385 AND accountlines.borrowernumber = borrowers.borrowernumber
386 AND date >=? AND date <?)"
389 $sth->execute( $date, $date2 );
392 while ( my $data = $sth->fetchrow_hashref ) {
399 #FIXME: ReversePayment should be replaced with a Void Payment feature
401 my ($accountlines_id) = @_;
402 my $dbh = C4::Context->dbh;
404 my $accountline = Koha::Account::Lines->find($accountlines_id);
405 my $amount_outstanding = $accountline->amountoutstanding;
407 my $new_amountoutstanding =
408 $amount_outstanding <= 0 ? $accountline->amount * -1 : 0;
410 $accountline->description( $accountline->description . " Reversed -" );
411 $accountline->amountoutstanding($new_amountoutstanding);
412 $accountline->store();
414 my $account_offset = Koha::Account::Offset->new(
416 credit_id => $accountline->id,
417 type => 'Reverse Payment',
418 amount => $amount_outstanding - $new_amountoutstanding,
422 if ( C4::Context->preference("FinesLog") ) {
424 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
428 $accountline->borrowernumber,
431 action => 'reverse_fee_payment',
432 borrowernumber => $accountline->borrowernumber,
433 old_amountoutstanding => $amount_outstanding,
434 new_amountoutstanding => $new_amountoutstanding,
436 accountlines_id => $accountline->id,
437 accountno => $accountline->accountno,
438 manager_id => $manager_id,
445 =head2 purge_zero_balance_fees
447 purge_zero_balance_fees( $days );
449 Delete accountlines entries where amountoutstanding is 0 or NULL which are more than a given number of days old.
451 B<$days> -- Zero balance fees older than B<$days> days old will be deleted.
453 B<Warning:> Because fines and payments are not linked in accountlines, it is
454 possible for a fine to be deleted without the accompanying payment,
455 or vise versa. This won't affect the account balance, but might be
460 sub purge_zero_balance_fees {
464 my $dbh = C4::Context->dbh;
465 my $sth = $dbh->prepare(
467 DELETE a1 FROM accountlines a1
469 LEFT JOIN account_offsets credit_offset ON ( a1.accountlines_id = credit_offset.credit_id )
470 LEFT JOIN accountlines a2 ON ( credit_offset.debit_id = a2.accountlines_id )
472 LEFT JOIN account_offsets debit_offset ON ( a1.accountlines_id = debit_offset.debit_id )
473 LEFT JOIN accountlines a3 ON ( debit_offset.credit_id = a3.accountlines_id )
475 WHERE a1.date < date_sub(curdate(), INTERVAL ? DAY)
476 AND ( a1.amountoutstanding = 0 OR a1.amountoutstanding IS NULL )
477 AND ( a2.amountoutstanding = 0 OR a2.amountoutstanding IS NULL )
478 AND ( a3.amountoutstanding = 0 OR a3.amountoutstanding IS NULL )
481 $sth->execute($days) or die $dbh->errstr;
484 END { } # module clean-up code here (global destructor)