Bug 6246: Modify/Delete links were missing from basket lines
[koha.git] / C4 / Accounts.pm
blob32054f456fd3726fe1fd86463b0f42494661318f
1 package C4::Accounts;
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 under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
10 # version.
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21 use strict;
22 #use warnings; FIXME - Bug 2505
23 use C4::Context;
24 use C4::Stats;
25 use C4::Members;
26 use C4::Items;
27 use C4::Circulation qw(MarkIssueReturned);
29 use vars qw($VERSION @ISA @EXPORT);
31 BEGIN {
32 # set the version for version checking
33 $VERSION = 3.03;
34 require Exporter;
35 @ISA = qw(Exporter);
36 @EXPORT = qw(
37 &recordpayment &makepayment &manualinvoice
38 &getnextacctno &reconcileaccount &getcharges &ModNote &getcredits
39 &getrefunds &chargelostitem
40 &ReversePayment
41 ); # removed &fixaccounts
44 =head1 NAME
46 C4::Accounts - Functions for dealing with Koha accounts
48 =head1 SYNOPSIS
50 use C4::Accounts;
52 =head1 DESCRIPTION
54 The functions in this module deal with the monetary aspect of Koha,
55 including looking up and modifying the amount of money owed by a
56 patron.
58 =head1 FUNCTIONS
60 =head2 recordpayment
62 &recordpayment($borrowernumber, $payment);
64 Record payment by a patron. C<$borrowernumber> is the patron's
65 borrower number. C<$payment> is a floating-point number, giving the
66 amount that was paid.
68 Amounts owed are paid off oldest first. That is, if the patron has a
69 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
70 of $1.50, then the oldest fine will be paid off in full, and $0.50
71 will be credited to the next one.
73 =cut
76 sub recordpayment {
78 #here we update the account lines
79 my ( $borrowernumber, $data ) = @_;
80 my $dbh = C4::Context->dbh;
81 my $newamtos = 0;
82 my $accdata = "";
83 my $branch = C4::Context->userenv->{'branch'};
84 my $amountleft = $data;
86 # begin transaction
87 my $nextaccntno = getnextacctno($borrowernumber);
89 # get lines with outstanding amounts to offset
90 my $sth = $dbh->prepare(
91 "SELECT * FROM accountlines
92 WHERE (borrowernumber = ?) AND (amountoutstanding<>0)
93 ORDER BY date"
95 $sth->execute($borrowernumber);
97 # offset transactions
98 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
99 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
100 $newamtos = 0;
101 $amountleft -= $accdata->{'amountoutstanding'};
103 else {
104 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
105 $amountleft = 0;
107 my $thisacct = $accdata->{accountno};
108 my $usth = $dbh->prepare(
109 "UPDATE accountlines SET amountoutstanding= ?
110 WHERE (borrowernumber = ?) AND (accountno=?)"
112 $usth->execute( $newamtos, $borrowernumber, $thisacct );
113 $usth->finish;
114 # $usth = $dbh->prepare(
115 # "INSERT INTO accountoffsets
116 # (borrowernumber, accountno, offsetaccount, offsetamount)
117 # VALUES (?,?,?,?)"
118 # );
119 # $usth->execute( $borrowernumber, $accdata->{'accountno'},
120 # $nextaccntno, $newamtos );
121 $usth->finish;
124 # create new line
125 my $usth = $dbh->prepare(
126 "INSERT INTO accountlines
127 (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding)
128 VALUES (?,?,now(),?,'Payment,thanks','Pay',?)"
130 $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft );
131 $usth->finish;
132 UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno );
133 $sth->finish;
136 =head2 makepayment
138 &makepayment($borrowernumber, $acctnumber, $amount, $branchcode);
140 Records the fact that a patron has paid off the entire amount he or
141 she owes.
143 C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is
144 the account that was credited. C<$amount> is the amount paid (this is
145 only used to record the payment. It is assumed to be equal to the
146 amount owed). C<$branchcode> is the code of the branch where payment
147 was made.
149 =cut
152 # FIXME - I'm not at all sure about the above, because I don't
153 # understand what the acct* tables in the Koha database are for.
154 sub makepayment {
156 #here we update both the accountoffsets and the account lines
157 #updated to check, if they are paying off a lost item, we return the item
158 # from their card, and put a note on the item record
159 my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_;
160 my $dbh = C4::Context->dbh;
162 # begin transaction
163 my $nextaccntno = getnextacctno($borrowernumber);
164 my $newamtos = 0;
165 my $sth =
166 $dbh->prepare(
167 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?");
168 $sth->execute( $borrowernumber, $accountno );
169 my $data = $sth->fetchrow_hashref;
170 $sth->finish;
172 $dbh->do(
173 "UPDATE accountlines
174 SET amountoutstanding = 0
175 WHERE borrowernumber = $borrowernumber
176 AND accountno = $accountno
180 # print $updquery;
181 # $dbh->do( "
182 # INSERT INTO accountoffsets
183 # (borrowernumber, accountno, offsetaccount,
184 # offsetamount)
185 # VALUES ($borrowernumber, $accountno, $nextaccntno, $newamtos)
186 # " );
188 # create new line
189 my $payment = 0 - $amount;
190 $dbh->do( "
191 INSERT INTO accountlines
192 (borrowernumber, accountno, date, amount,
193 description, accounttype, amountoutstanding)
194 VALUES ($borrowernumber, $nextaccntno, now(), $payment,
195 'Payment,thanks - $user', 'Pay', 0)
196 " );
198 # FIXME - The second argument to &UpdateStats is supposed to be the
199 # branch code.
200 # UpdateStats is now being passed $accountno too. MTJ
201 UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber,
202 $accountno );
203 $sth->finish;
205 #check to see what accounttype
206 if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
207 returnlost( $borrowernumber, $data->{'itemnumber'} );
211 =head2 getnextacctno
213 $nextacct = &getnextacctno($borrowernumber);
215 Returns the next unused account number for the patron with the given
216 borrower number.
218 =cut
221 # FIXME - Okay, so what does the above actually _mean_?
222 sub getnextacctno ($) {
223 my ($borrowernumber) = shift or return undef;
224 my $sth = C4::Context->dbh->prepare(
225 "SELECT accountno+1 FROM accountlines
226 WHERE (borrowernumber = ?)
227 ORDER BY accountno DESC
228 LIMIT 1"
230 $sth->execute($borrowernumber);
231 return ($sth->fetchrow || 1);
234 =head2 fixaccounts (removed)
236 &fixaccounts($borrowernumber, $accountnumber, $amount);
239 # FIXME - I don't understand what this function does.
240 sub fixaccounts {
241 my ( $borrowernumber, $accountno, $amount ) = @_;
242 my $dbh = C4::Context->dbh;
243 my $sth = $dbh->prepare(
244 "SELECT * FROM accountlines WHERE borrowernumber=?
245 AND accountno=?"
247 $sth->execute( $borrowernumber, $accountno );
248 my $data = $sth->fetchrow_hashref;
250 # FIXME - Error-checking
251 my $diff = $amount - $data->{'amount'};
252 my $outstanding = $data->{'amountoutstanding'} + $diff;
253 $sth->finish;
255 $dbh->do(<<EOT);
256 UPDATE accountlines
257 SET amount = '$amount',
258 amountoutstanding = '$outstanding'
259 WHERE borrowernumber = $borrowernumber
260 AND accountno = $accountno
262 # FIXME: exceedingly bad form. Use prepare with placholders ("?") in query and execute args.
265 =cut
267 sub returnlost{
268 my ( $borrowernumber, $itemnum ) = @_;
269 C4::Circulation::MarkIssueReturned( $borrowernumber, $itemnum );
270 my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
271 my @datearr = localtime(time);
272 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
273 my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
274 ModItem({ paidfor => "Paid for by $bor $date" }, undef, $itemnum);
278 sub chargelostitem{
279 # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for
280 # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that
281 # a charge has been added
282 # FIXME : if no replacement price, borrower just doesn't get charged?
284 my $dbh = C4::Context->dbh();
285 my ($itemnumber) = @_;
286 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
287 FROM issues
288 JOIN items USING (itemnumber)
289 JOIN biblio USING (biblionumber)
290 WHERE issues.itemnumber=?");
291 $sth->execute($itemnumber);
292 my $issues=$sth->fetchrow_hashref();
294 # if a borrower lost the item, add a replacement cost to the their record
295 if ( $issues->{borrowernumber} ){
297 # first make sure the borrower hasn't already been charged for this item
298 my $sth1=$dbh->prepare("SELECT * from accountlines
299 WHERE borrowernumber=? AND itemnumber=? and accounttype='L'");
300 $sth1->execute($issues->{'borrowernumber'},$itemnumber);
301 my $existing_charge_hashref=$sth1->fetchrow_hashref();
303 # OK, they haven't
304 unless ($existing_charge_hashref) {
305 # This item is on issue ... add replacement cost to the borrower's record and mark it returned
306 # Note that we add this to the account even if there's no replacement price, allowing some other
307 # process (or person) to update it, since we don't handle any defaults for replacement prices.
308 my $accountno = getnextacctno($issues->{'borrowernumber'});
309 my $sth2=$dbh->prepare("INSERT INTO accountlines
310 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber)
311 VALUES (?,?,now(),?,?,'L',?,?)");
312 $sth2->execute($issues->{'borrowernumber'},$accountno,$issues->{'replacementprice'},
313 "Lost Item $issues->{'title'} $issues->{'barcode'}",
314 $issues->{'replacementprice'},$itemnumber);
315 $sth2->finish;
316 # FIXME: Log this ?
318 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
319 #warn " $issues->{'borrowernumber'} / $itemnumber ";
320 C4::Circulation::MarkIssueReturned($issues->{borrowernumber},$itemnumber);
321 # Shouldn't MarkIssueReturned do this?
322 C4::Items::ModItem({ onloan => undef }, undef, $itemnumber);
324 $sth->finish;
327 =head2 manualinvoice
329 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
330 $amount, $note);
332 C<$borrowernumber> is the patron's borrower number.
333 C<$description> is a description of the transaction.
334 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
335 or C<REF>.
336 C<$itemnumber> is the item involved, if pertinent; otherwise, it
337 should be the empty string.
339 =cut
342 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
343 # are :
344 # 'C' = CREDIT
345 # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
346 # 'N' = New Card fee
347 # 'F' = Fine
348 # 'A' = Account Management fee
349 # 'M' = Sundry
350 # 'L' = Lost Item
353 sub manualinvoice {
354 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_;
355 my $manager_id = 0;
356 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
357 my $dbh = C4::Context->dbh;
358 my $notifyid = 0;
359 my $insert;
360 $itemnum =~ s/ //g;
361 my $accountno = getnextacctno($borrowernumber);
362 my $amountleft = $amount;
364 # if ( $type eq 'CS'
365 # || $type eq 'CB'
366 # || $type eq 'CW'
367 # || $type eq 'CF'
368 # || $type eq 'CL' )
370 # my $amount2 = $amount * -1; # FIXME - $amount2 = -$amount
371 # $amountleft =
372 # fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user );
374 if ( $type eq 'N' ) {
375 $desc .= " New Card";
377 if ( $type eq 'F' ) {
378 $desc .= " Fine";
380 if ( $type eq 'A' ) {
381 $desc .= " Account Management fee";
383 if ( $type eq 'M' ) {
384 $desc .= " Sundry";
387 if ( $type eq 'L' && $desc eq '' ) {
389 $desc = " Lost Item";
391 # if ( $type eq 'REF' ) {
392 # $desc .= " Cash Refund";
393 # $amountleft = refund( '', $borrowernumber, $amount );
395 if ( ( $type eq 'L' )
396 or ( $type eq 'F' )
397 or ( $type eq 'A' )
398 or ( $type eq 'N' )
399 or ( $type eq 'M' ) )
401 $notifyid = 1;
404 if ( $itemnum ne '' ) {
405 $desc .= " " . $itemnum;
406 my $sth = $dbh->prepare(
407 "INSERT INTO accountlines
408 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id)
409 VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)");
410 $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr;
411 } else {
412 my $sth=$dbh->prepare("INSERT INTO accountlines
413 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id)
414 VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)"
416 $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
417 $amountleft, $notifyid, $note, $manager_id );
419 return 0;
422 =head2 fixcredit #### DEPRECATED
424 $amountleft = &fixcredit($borrowernumber, $data, $barcode, $type, $user);
426 This function is only used internally, not exported.
428 =cut
430 # This function is deprecated in 3.0
432 sub fixcredit {
434 #here we update both the accountoffsets and the account lines
435 my ( $borrowernumber, $data, $barcode, $type, $user ) = @_;
436 my $dbh = C4::Context->dbh;
437 my $newamtos = 0;
438 my $accdata = "";
439 my $amountleft = $data;
440 if ( $barcode ne '' ) {
441 my $item = GetBiblioFromItemNumber( '', $barcode );
442 my $nextaccntno = getnextacctno($borrowernumber);
443 my $query = "SELECT * FROM accountlines WHERE (borrowernumber=?
444 AND itemnumber=? AND amountoutstanding > 0)";
445 if ( $type eq 'CL' ) {
446 $query .= " AND (accounttype = 'L' OR accounttype = 'Rep')";
448 elsif ( $type eq 'CF' ) {
449 $query .= " AND (accounttype = 'F' OR accounttype = 'FU' OR
450 accounttype='Res' OR accounttype='Rent')";
452 elsif ( $type eq 'CB' ) {
453 $query .= " and accounttype='A'";
456 # print $query;
457 my $sth = $dbh->prepare($query);
458 $sth->execute( $borrowernumber, $item->{'itemnumber'} );
459 $accdata = $sth->fetchrow_hashref;
460 $sth->finish;
461 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
462 $newamtos = 0;
463 $amountleft -= $accdata->{'amountoutstanding'};
465 else {
466 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
467 $amountleft = 0;
469 my $thisacct = $accdata->{accountno};
470 my $usth = $dbh->prepare(
471 "UPDATE accountlines SET amountoutstanding= ?
472 WHERE (borrowernumber = ?) AND (accountno=?)"
474 $usth->execute( $newamtos, $borrowernumber, $thisacct );
475 $usth->finish;
476 $usth = $dbh->prepare(
477 "INSERT INTO accountoffsets
478 (borrowernumber, accountno, offsetaccount, offsetamount)
479 VALUES (?,?,?,?)"
481 $usth->execute( $borrowernumber, $accdata->{'accountno'},
482 $nextaccntno, $newamtos );
483 $usth->finish;
486 # begin transaction
487 my $nextaccntno = getnextacctno($borrowernumber);
489 # get lines with outstanding amounts to offset
490 my $sth = $dbh->prepare(
491 "SELECT * FROM accountlines
492 WHERE (borrowernumber = ?) AND (amountoutstanding >0)
493 ORDER BY date"
495 $sth->execute($borrowernumber);
497 # print $query;
498 # offset transactions
499 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
500 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
501 $newamtos = 0;
502 $amountleft -= $accdata->{'amountoutstanding'};
504 else {
505 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
506 $amountleft = 0;
508 my $thisacct = $accdata->{accountno};
509 my $usth = $dbh->prepare(
510 "UPDATE accountlines SET amountoutstanding= ?
511 WHERE (borrowernumber = ?) AND (accountno=?)"
513 $usth->execute( $newamtos, $borrowernumber, $thisacct );
514 $usth->finish;
515 $usth = $dbh->prepare(
516 "INSERT INTO accountoffsets
517 (borrowernumber, accountno, offsetaccount, offsetamount)
518 VALUE (?,?,?,?)"
520 $usth->execute( $borrowernumber, $accdata->{'accountno'},
521 $nextaccntno, $newamtos );
522 $usth->finish;
524 $sth->finish;
525 $type = "Credit " . $type;
526 UpdateStats( $user, $type, $data, $user, '', '', $borrowernumber );
527 $amountleft *= -1;
528 return ($amountleft);
532 =head2 refund
534 #FIXME : DEPRECATED SUB
535 This subroutine tracks payments and/or credits against fines/charges
536 using the accountoffsets table, which is not used consistently in
537 Koha's fines management, and so is not used in 3.0
539 =cut
541 sub refund {
543 #here we update both the accountoffsets and the account lines
544 my ( $borrowernumber, $data ) = @_;
545 my $dbh = C4::Context->dbh;
546 my $newamtos = 0;
547 my $accdata = "";
548 my $amountleft = $data * -1;
550 # begin transaction
551 my $nextaccntno = getnextacctno($borrowernumber);
553 # get lines with outstanding amounts to offset
554 my $sth = $dbh->prepare(
555 "SELECT * FROM accountlines
556 WHERE (borrowernumber = ?) AND (amountoutstanding<0)
557 ORDER BY date"
559 $sth->execute($borrowernumber);
561 # print $amountleft;
562 # offset transactions
563 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) {
564 if ( $accdata->{'amountoutstanding'} > $amountleft ) {
565 $newamtos = 0;
566 $amountleft -= $accdata->{'amountoutstanding'};
568 else {
569 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
570 $amountleft = 0;
573 # print $amountleft;
574 my $thisacct = $accdata->{accountno};
575 my $usth = $dbh->prepare(
576 "UPDATE accountlines SET amountoutstanding= ?
577 WHERE (borrowernumber = ?) AND (accountno=?)"
579 $usth->execute( $newamtos, $borrowernumber, $thisacct );
580 $usth->finish;
581 $usth = $dbh->prepare(
582 "INSERT INTO accountoffsets
583 (borrowernumber, accountno, offsetaccount, offsetamount)
584 VALUES (?,?,?,?)"
586 $usth->execute( $borrowernumber, $accdata->{'accountno'},
587 $nextaccntno, $newamtos );
588 $usth->finish;
590 $sth->finish;
591 return ($amountleft);
594 sub getcharges {
595 my ( $borrowerno, $timestamp, $accountno ) = @_;
596 my $dbh = C4::Context->dbh;
597 my $timestamp2 = $timestamp - 1;
598 my $query = "";
599 my $sth = $dbh->prepare(
600 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
602 $sth->execute( $borrowerno, $accountno );
604 my @results;
605 while ( my $data = $sth->fetchrow_hashref ) {
606 push @results,$data;
608 return (@results);
611 sub ModNote {
612 my ( $borrowernumber, $accountno, $note ) = @_;
613 my $dbh = C4::Context->dbh;
614 my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE borrowernumber = ? AND accountno = ?');
615 $sth->execute( $note, $borrowernumber, $accountno );
618 sub getcredits {
619 my ( $date, $date2 ) = @_;
620 my $dbh = C4::Context->dbh;
621 my $sth = $dbh->prepare(
622 "SELECT * FROM accountlines,borrowers
623 WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber
624 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
627 $sth->execute( $date, $date2 );
628 my @results;
629 while ( my $data = $sth->fetchrow_hashref ) {
630 $data->{'date'} = $data->{'timestamp'};
631 push @results,$data;
633 return (@results);
637 sub getrefunds {
638 my ( $date, $date2 ) = @_;
639 my $dbh = C4::Context->dbh;
641 my $sth = $dbh->prepare(
642 "SELECT *,timestamp AS datetime
643 FROM accountlines,borrowers
644 WHERE (accounttype = 'REF'
645 AND accountlines.borrowernumber = borrowers.borrowernumber
646 AND date >=? AND date <?)"
649 $sth->execute( $date, $date2 );
651 my @results;
652 while ( my $data = $sth->fetchrow_hashref ) {
653 push @results,$data;
656 return (@results);
659 sub ReversePayment {
660 my ( $borrowernumber, $accountno ) = @_;
661 my $dbh = C4::Context->dbh;
663 my $sth = $dbh->prepare('SELECT amountoutstanding FROM accountlines WHERE borrowernumber = ? AND accountno = ?');
664 $sth->execute( $borrowernumber, $accountno );
665 my $row = $sth->fetchrow_hashref();
666 my $amount_outstanding = $row->{'amountoutstanding'};
668 if ( $amount_outstanding <= 0 ) {
669 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
670 $sth->execute( $borrowernumber, $accountno );
671 } else {
672 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
673 $sth->execute( $borrowernumber, $accountno );
677 END { } # module clean-up code here (global destructor)
680 __END__
682 =head1 SEE ALSO
684 DBI(3)
686 =cut