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) {
160 if ($processfee && $processfee > 0){
161 my $accountline = Koha::Account::Line->new(
163 borrowernumber => $borrowernumber,
164 accountno => getnextacctno($borrowernumber),
166 amount => $processfee,
167 description => $description,
169 amountoutstanding => $processfee,
170 itemnumber => $itemnumber,
171 note => $processingfeenote,
172 manager_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : 0,
176 my $account_offset = Koha::Account::Offset->new(
178 debit_id => $accountline->id,
179 type => 'Processing Fee',
180 amount => $accountline->amount,
184 if ( C4::Context->preference("FinesLog") ) {
185 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
186 action => 'create_fee',
187 borrowernumber => $accountline->borrowernumber,,
188 accountno => $accountline->accountno,
189 amount => $accountline->amount,
190 description => $accountline->description,
191 accounttype => $accountline->accounttype,
192 amountoutstanding => $accountline->amountoutstanding,
193 note => $accountline->note,
194 itemnumber => $accountline->itemnumber,
195 manager_id => $accountline->manager_id,
200 if ($replacementprice > 0){
201 my $accountline = Koha::Account::Line->new(
203 borrowernumber => $borrowernumber,
204 accountno => getnextacctno($borrowernumber),
206 amount => $replacementprice,
207 description => $description,
209 amountoutstanding => $replacementprice,
210 itemnumber => $itemnumber,
211 manager_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : 0,
215 my $account_offset = Koha::Account::Offset->new(
217 debit_id => $accountline->id,
219 amount => $accountline->amount,
223 if ( C4::Context->preference("FinesLog") ) {
224 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
225 action => 'create_fee',
226 borrowernumber => $accountline->borrowernumber,,
227 accountno => $accountline->accountno,
228 amount => $accountline->amount,
229 description => $accountline->description,
230 accounttype => $accountline->accounttype,
231 amountoutstanding => $accountline->amountoutstanding,
232 note => $accountline->note,
233 itemnumber => $accountline->itemnumber,
234 manager_id => $accountline->manager_id,
243 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
246 C<$borrowernumber> is the patron's borrower number.
247 C<$description> is a description of the transaction.
248 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
250 C<$itemnumber> is the item involved, if pertinent; otherwise, it
251 should be the empty string.
256 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
259 # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
262 # 'A' = Account Management fee
268 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note, $skip_notify ) = @_;
270 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
271 my $dbh = C4::Context->dbh;
274 my $accountno = getnextacctno($borrowernumber);
275 my $amountleft = $amount;
278 if ( ( $type eq 'L' )
282 or ( $type eq 'M' ) )
284 $notifyid = 1 unless $skip_notify;
287 my $accountline = Koha::Account::Line->new(
289 borrowernumber => $borrowernumber,
290 accountno => $accountno,
293 description => $desc,
294 accounttype => $type,
295 amountoutstanding => $amountleft,
296 itemnumber => $itemnum || undef,
297 notify_id => $notifyid,
299 manager_id => $manager_id,
303 my $account_offset = Koha::Account::Offset->new(
305 debit_id => $accountline->id,
306 type => 'Manual Debit',
311 if ( C4::Context->preference("FinesLog") ) {
312 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
313 action => 'create_fee',
314 borrowernumber => $borrowernumber,
315 accountno => $accountno,
317 description => $desc,
318 accounttype => $type,
319 amountoutstanding => $amountleft,
320 notify_id => $notifyid,
322 itemnumber => $itemnum,
323 manager_id => $manager_id,
331 my ( $borrowerno, $timestamp, $accountno ) = @_;
332 my $dbh = C4::Context->dbh;
333 my $timestamp2 = $timestamp - 1;
335 my $sth = $dbh->prepare(
336 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
338 $sth->execute( $borrowerno, $accountno );
341 while ( my $data = $sth->fetchrow_hashref ) {
348 my ( $accountlines_id, $note ) = @_;
349 my $dbh = C4::Context->dbh;
350 my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE accountlines_id = ?');
351 $sth->execute( $note, $accountlines_id );
355 my ( $date, $date2 ) = @_;
356 my $dbh = C4::Context->dbh;
357 my $sth = $dbh->prepare(
358 "SELECT * FROM accountlines,borrowers
359 WHERE amount < 0 AND accounttype not like 'Pay%' AND accountlines.borrowernumber = borrowers.borrowernumber
360 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
363 $sth->execute( $date, $date2 );
365 while ( my $data = $sth->fetchrow_hashref ) {
366 $data->{'date'} = $data->{'timestamp'};
374 my ( $date, $date2 ) = @_;
375 my $dbh = C4::Context->dbh;
377 my $sth = $dbh->prepare(
378 "SELECT *,timestamp AS datetime
379 FROM accountlines,borrowers
380 WHERE (accounttype = 'REF'
381 AND accountlines.borrowernumber = borrowers.borrowernumber
382 AND date >=? AND date <?)"
385 $sth->execute( $date, $date2 );
388 while ( my $data = $sth->fetchrow_hashref ) {
395 #FIXME: ReversePayment should be replaced with a Void Payment feature
397 my ($accountlines_id) = @_;
398 my $dbh = C4::Context->dbh;
400 my $accountline = Koha::Account::Lines->find($accountlines_id);
401 my $amount_outstanding = $accountline->amountoutstanding;
403 my $new_amountoutstanding =
404 $amount_outstanding <= 0 ? $accountline->amount * -1 : 0;
406 $accountline->description( $accountline->description . " Reversed -" );
407 $accountline->amountoutstanding($new_amountoutstanding);
408 $accountline->store();
410 my $account_offset = Koha::Account::Offset->new(
412 credit_id => $accountline->id,
413 type => 'Reverse Payment',
414 amount => $amount_outstanding - $new_amountoutstanding,
418 if ( C4::Context->preference("FinesLog") ) {
420 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
424 $accountline->borrowernumber,
427 action => 'reverse_fee_payment',
428 borrowernumber => $accountline->borrowernumber,
429 old_amountoutstanding => $amount_outstanding,
430 new_amountoutstanding => $new_amountoutstanding,
432 accountlines_id => $accountline->id,
433 accountno => $accountline->accountno,
434 manager_id => $manager_id,
441 =head2 purge_zero_balance_fees
443 purge_zero_balance_fees( $days );
445 Delete accountlines entries where amountoutstanding is 0 or NULL which are more than a given number of days old.
447 B<$days> -- Zero balance fees older than B<$days> days old will be deleted.
449 B<Warning:> Because fines and payments are not linked in accountlines, it is
450 possible for a fine to be deleted without the accompanying payment,
451 or vise versa. This won't affect the account balance, but might be
456 sub purge_zero_balance_fees {
460 my $dbh = C4::Context->dbh;
461 my $sth = $dbh->prepare(
463 DELETE a1 FROM accountlines a1
465 LEFT JOIN account_offsets credit_offset ON ( a1.accountlines_id = credit_offset.credit_id )
466 LEFT JOIN accountlines a2 ON ( credit_offset.debit_id = a2.accountlines_id )
468 LEFT JOIN account_offsets debit_offset ON ( a1.accountlines_id = debit_offset.debit_id )
469 LEFT JOIN accountlines a3 ON ( debit_offset.credit_id = a3.accountlines_id )
471 WHERE a1.date < date_sub(curdate(), INTERVAL ? DAY)
472 AND ( a1.amountoutstanding = 0 OR a1.amountoutstanding IS NULL )
473 AND ( a2.amountoutstanding = 0 OR a2.amountoutstanding IS NULL )
474 AND ( a3.amountoutstanding = 0 OR a3.amountoutstanding IS NULL )
477 $sth->execute($days) or die $dbh->errstr;
480 END { } # module clean-up code here (global destructor)