Fix FSF address in directory admin/
[koha.git] / C4 / Accounts.pm
blobd43442ea6e61d84f3002f72a70b700bb8eb141ac
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 with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
21 use strict;
22 use C4::Context;
23 use C4::Stats;
24 use C4::Members;
25 use C4::Items;
26 use C4::Circulation qw(MarkIssueReturned);
28 use vars qw($VERSION @ISA @EXPORT);
30 BEGIN {
31 # set the version for version checking
32 $VERSION = 3.03;
33 require Exporter;
34 @ISA = qw(Exporter);
35 @EXPORT = qw(
36 &recordpayment &makepayment &manualinvoice
37 &getnextacctno &reconcileaccount &getcharges &getcredits
38 &getrefunds &chargelostitem
39 &ReversePayment
40 ); # removed &fixaccounts
43 =head1 NAME
45 C4::Accounts - Functions for dealing with Koha accounts
47 =head1 SYNOPSIS
49 use C4::Accounts;
51 =head1 DESCRIPTION
53 The functions in this module deal with the monetary aspect of Koha,
54 including looking up and modifying the amount of money owed by a
55 patron.
57 =head1 FUNCTIONS
59 =head2 recordpayment
61 &recordpayment($borrowernumber, $payment);
63 Record payment by a patron. C<$borrowernumber> is the patron's
64 borrower number. C<$payment> is a floating-point number, giving the
65 amount that was paid.
67 Amounts owed are paid off oldest first. That is, if the patron has a
68 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
69 of $1.50, then the oldest fine will be paid off in full, and $0.50
70 will be credited to the next one.
72 =cut
75 sub recordpayment {
77 #here we update the account lines
78 my ( $borrowernumber, $data ) = @_;
79 my $dbh = C4::Context->dbh;
80 my $newamtos = 0;
81 my $accdata = "";
82 my $branch = C4::Context->userenv->{'branch'};
83 my $amountleft = $data;
85 # begin transaction
86 my $nextaccntno = getnextacctno($borrowernumber);
88 # get lines with outstanding amounts to offset
89 my $sth = $dbh->prepare(
90 "SELECT * FROM accountlines
91 WHERE (borrowernumber = ?) AND (amountoutstanding<>0)
92 ORDER BY date"
94 $sth->execute($borrowernumber);
96 # offset transactions
97 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
98 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
99 $newamtos = 0;
100 $amountleft -= $accdata->{'amountoutstanding'};
102 else {
103 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
104 $amountleft = 0;
106 my $thisacct = $accdata->{accountno};
107 my $usth = $dbh->prepare(
108 "UPDATE accountlines SET amountoutstanding= ?
109 WHERE (borrowernumber = ?) AND (accountno=?)"
111 $usth->execute( $newamtos, $borrowernumber, $thisacct );
112 $usth->finish;
113 # $usth = $dbh->prepare(
114 # "INSERT INTO accountoffsets
115 # (borrowernumber, accountno, offsetaccount, offsetamount)
116 # VALUES (?,?,?,?)"
117 # );
118 # $usth->execute( $borrowernumber, $accdata->{'accountno'},
119 # $nextaccntno, $newamtos );
120 $usth->finish;
123 # create new line
124 my $usth = $dbh->prepare(
125 "INSERT INTO accountlines
126 (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding)
127 VALUES (?,?,now(),?,'Payment,thanks','Pay',?)"
129 $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft );
130 $usth->finish;
131 UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno );
132 $sth->finish;
135 =head2 makepayment
137 &makepayment($borrowernumber, $acctnumber, $amount, $branchcode);
139 Records the fact that a patron has paid off the entire amount he or
140 she owes.
142 C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is
143 the account that was credited. C<$amount> is the amount paid (this is
144 only used to record the payment. It is assumed to be equal to the
145 amount owed). C<$branchcode> is the code of the branch where payment
146 was made.
148 =cut
151 # FIXME - I'm not at all sure about the above, because I don't
152 # understand what the acct* tables in the Koha database are for.
153 sub makepayment {
155 #here we update both the accountoffsets and the account lines
156 #updated to check, if they are paying off a lost item, we return the item
157 # from their card, and put a note on the item record
158 my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_;
159 my $dbh = C4::Context->dbh;
161 # begin transaction
162 my $nextaccntno = getnextacctno($borrowernumber);
163 my $newamtos = 0;
164 my $sth =
165 $dbh->prepare(
166 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?");
167 $sth->execute( $borrowernumber, $accountno );
168 my $data = $sth->fetchrow_hashref;
169 $sth->finish;
171 $dbh->do(
172 "UPDATE accountlines
173 SET amountoutstanding = 0
174 WHERE borrowernumber = $borrowernumber
175 AND accountno = $accountno
179 # print $updquery;
180 # $dbh->do( "
181 # INSERT INTO accountoffsets
182 # (borrowernumber, accountno, offsetaccount,
183 # offsetamount)
184 # VALUES ($borrowernumber, $accountno, $nextaccntno, $newamtos)
185 # " );
187 # create new line
188 my $payment = 0 - $amount;
189 $dbh->do( "
190 INSERT INTO accountlines
191 (borrowernumber, accountno, date, amount,
192 description, accounttype, amountoutstanding)
193 VALUES ($borrowernumber, $nextaccntno, now(), $payment,
194 'Payment,thanks - $user', 'Pay', 0)
195 " );
197 # FIXME - The second argument to &UpdateStats is supposed to be the
198 # branch code.
199 # UpdateStats is now being passed $accountno too. MTJ
200 UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber,
201 $accountno );
202 $sth->finish;
204 #check to see what accounttype
205 if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
206 returnlost( $borrowernumber, $data->{'itemnumber'} );
210 =head2 getnextacctno
212 $nextacct = &getnextacctno($borrowernumber);
214 Returns the next unused account number for the patron with the given
215 borrower number.
217 =cut
220 # FIXME - Okay, so what does the above actually _mean_?
221 sub getnextacctno ($) {
222 my ($borrowernumber) = shift or return undef;
223 my $sth = C4::Context->dbh->prepare(
224 "SELECT accountno+1 FROM accountlines
225 WHERE (borrowernumber = ?)
226 ORDER BY accountno DESC
227 LIMIT 1"
229 $sth->execute($borrowernumber);
230 return ($sth->fetchrow || 1);
233 =head2 fixaccounts (removed)
235 &fixaccounts($borrowernumber, $accountnumber, $amount);
238 # FIXME - I don't understand what this function does.
239 sub fixaccounts {
240 my ( $borrowernumber, $accountno, $amount ) = @_;
241 my $dbh = C4::Context->dbh;
242 my $sth = $dbh->prepare(
243 "SELECT * FROM accountlines WHERE borrowernumber=?
244 AND accountno=?"
246 $sth->execute( $borrowernumber, $accountno );
247 my $data = $sth->fetchrow_hashref;
249 # FIXME - Error-checking
250 my $diff = $amount - $data->{'amount'};
251 my $outstanding = $data->{'amountoutstanding'} + $diff;
252 $sth->finish;
254 $dbh->do(<<EOT);
255 UPDATE accountlines
256 SET amount = '$amount',
257 amountoutstanding = '$outstanding'
258 WHERE borrowernumber = $borrowernumber
259 AND accountno = $accountno
261 # FIXME: exceedingly bad form. Use prepare with placholders ("?") in query and execute args.
264 =cut
266 sub returnlost{
267 my ( $borrowernumber, $itemnum ) = @_;
268 C4::Circulation::MarkIssueReturned( $borrowernumber, $itemnum );
269 my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
270 my @datearr = localtime(time);
271 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
272 my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
273 ModItem({ paidfor => "Paid for by $bor $date" }, undef, $itemnum);
277 sub chargelostitem{
278 # http://wiki.koha.org/doku.php?id=en:development:kohastatuses
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 ModItem({ onloan => undef }, undef, $itemnumber);
324 $sth->finish;
327 =head2 manualinvoice
329 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
330 $amount, $user);
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, $user ) = @_;
355 my $dbh = C4::Context->dbh;
356 my $notifyid = 0;
357 my $insert;
358 $itemnum =~ s/ //g;
359 my $accountno = getnextacctno($borrowernumber);
360 my $amountleft = $amount;
362 # if ( $type eq 'CS'
363 # || $type eq 'CB'
364 # || $type eq 'CW'
365 # || $type eq 'CF'
366 # || $type eq 'CL' )
368 # my $amount2 = $amount * -1; # FIXME - $amount2 = -$amount
369 # $amountleft =
370 # fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user );
372 if ( $type eq 'N' ) {
373 $desc .= " New Card";
375 if ( $type eq 'F' ) {
376 $desc .= " Fine";
378 if ( $type eq 'A' ) {
379 $desc .= " Account Management fee";
381 if ( $type eq 'M' ) {
382 $desc .= " Sundry";
385 if ( $type eq 'L' && $desc eq '' ) {
387 $desc = " Lost Item";
389 # if ( $type eq 'REF' ) {
390 # $desc .= " Cash Refund";
391 # $amountleft = refund( '', $borrowernumber, $amount );
393 if ( ( $type eq 'L' )
394 or ( $type eq 'F' )
395 or ( $type eq 'A' )
396 or ( $type eq 'N' )
397 or ( $type eq 'M' ) )
399 $notifyid = 1;
402 if ( $itemnum ne '' ) {
403 $desc .= " " . $itemnum;
404 my $sth = $dbh->prepare(
405 "INSERT INTO accountlines
406 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id)
407 VALUES (?, ?, now(), ?,?, ?,?,?,?)");
408 $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid) || return $sth->errstr;
409 } else {
410 my $sth=$dbh->prepare("INSERT INTO accountlines
411 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id)
412 VALUES (?, ?, now(), ?, ?, ?, ?,?)"
414 $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
415 $amountleft, $notifyid );
417 return 0;
420 =head2 fixcredit #### DEPRECATED
422 $amountleft = &fixcredit($borrowernumber, $data, $barcode, $type, $user);
424 This function is only used internally, not exported.
426 =cut
428 # This function is deprecated in 3.0
430 sub fixcredit {
432 #here we update both the accountoffsets and the account lines
433 my ( $borrowernumber, $data, $barcode, $type, $user ) = @_;
434 my $dbh = C4::Context->dbh;
435 my $newamtos = 0;
436 my $accdata = "";
437 my $amountleft = $data;
438 if ( $barcode ne '' ) {
439 my $item = GetBiblioFromItemNumber( '', $barcode );
440 my $nextaccntno = getnextacctno($borrowernumber);
441 my $query = "SELECT * FROM accountlines WHERE (borrowernumber=?
442 AND itemnumber=? AND amountoutstanding > 0)";
443 if ( $type eq 'CL' ) {
444 $query .= " AND (accounttype = 'L' OR accounttype = 'Rep')";
446 elsif ( $type eq 'CF' ) {
447 $query .= " AND (accounttype = 'F' OR accounttype = 'FU' OR
448 accounttype='Res' OR accounttype='Rent')";
450 elsif ( $type eq 'CB' ) {
451 $query .= " and accounttype='A'";
454 # print $query;
455 my $sth = $dbh->prepare($query);
456 $sth->execute( $borrowernumber, $item->{'itemnumber'} );
457 $accdata = $sth->fetchrow_hashref;
458 $sth->finish;
459 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
460 $newamtos = 0;
461 $amountleft -= $accdata->{'amountoutstanding'};
463 else {
464 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
465 $amountleft = 0;
467 my $thisacct = $accdata->{accountno};
468 my $usth = $dbh->prepare(
469 "UPDATE accountlines SET amountoutstanding= ?
470 WHERE (borrowernumber = ?) AND (accountno=?)"
472 $usth->execute( $newamtos, $borrowernumber, $thisacct );
473 $usth->finish;
474 $usth = $dbh->prepare(
475 "INSERT INTO accountoffsets
476 (borrowernumber, accountno, offsetaccount, offsetamount)
477 VALUES (?,?,?,?)"
479 $usth->execute( $borrowernumber, $accdata->{'accountno'},
480 $nextaccntno, $newamtos );
481 $usth->finish;
484 # begin transaction
485 my $nextaccntno = getnextacctno($borrowernumber);
487 # get lines with outstanding amounts to offset
488 my $sth = $dbh->prepare(
489 "SELECT * FROM accountlines
490 WHERE (borrowernumber = ?) AND (amountoutstanding >0)
491 ORDER BY date"
493 $sth->execute($borrowernumber);
495 # print $query;
496 # offset transactions
497 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
498 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
499 $newamtos = 0;
500 $amountleft -= $accdata->{'amountoutstanding'};
502 else {
503 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
504 $amountleft = 0;
506 my $thisacct = $accdata->{accountno};
507 my $usth = $dbh->prepare(
508 "UPDATE accountlines SET amountoutstanding= ?
509 WHERE (borrowernumber = ?) AND (accountno=?)"
511 $usth->execute( $newamtos, $borrowernumber, $thisacct );
512 $usth->finish;
513 $usth = $dbh->prepare(
514 "INSERT INTO accountoffsets
515 (borrowernumber, accountno, offsetaccount, offsetamount)
516 VALUE (?,?,?,?)"
518 $usth->execute( $borrowernumber, $accdata->{'accountno'},
519 $nextaccntno, $newamtos );
520 $usth->finish;
522 $sth->finish;
523 $type = "Credit " . $type;
524 UpdateStats( $user, $type, $data, $user, '', '', $borrowernumber );
525 $amountleft *= -1;
526 return ($amountleft);
530 =head2 refund
532 #FIXME : DEPRECATED SUB
533 This subroutine tracks payments and/or credits against fines/charges
534 using the accountoffsets table, which is not used consistently in
535 Koha's fines management, and so is not used in 3.0
537 =cut
539 sub refund {
541 #here we update both the accountoffsets and the account lines
542 my ( $borrowernumber, $data ) = @_;
543 my $dbh = C4::Context->dbh;
544 my $newamtos = 0;
545 my $accdata = "";
546 my $amountleft = $data * -1;
548 # begin transaction
549 my $nextaccntno = getnextacctno($borrowernumber);
551 # get lines with outstanding amounts to offset
552 my $sth = $dbh->prepare(
553 "SELECT * FROM accountlines
554 WHERE (borrowernumber = ?) AND (amountoutstanding<0)
555 ORDER BY date"
557 $sth->execute($borrowernumber);
559 # print $amountleft;
560 # offset transactions
561 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) {
562 if ( $accdata->{'amountoutstanding'} > $amountleft ) {
563 $newamtos = 0;
564 $amountleft -= $accdata->{'amountoutstanding'};
566 else {
567 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
568 $amountleft = 0;
571 # print $amountleft;
572 my $thisacct = $accdata->{accountno};
573 my $usth = $dbh->prepare(
574 "UPDATE accountlines SET amountoutstanding= ?
575 WHERE (borrowernumber = ?) AND (accountno=?)"
577 $usth->execute( $newamtos, $borrowernumber, $thisacct );
578 $usth->finish;
579 $usth = $dbh->prepare(
580 "INSERT INTO accountoffsets
581 (borrowernumber, accountno, offsetaccount, offsetamount)
582 VALUES (?,?,?,?)"
584 $usth->execute( $borrowernumber, $accdata->{'accountno'},
585 $nextaccntno, $newamtos );
586 $usth->finish;
588 $sth->finish;
589 return ($amountleft);
592 sub getcharges {
593 my ( $borrowerno, $timestamp, $accountno ) = @_;
594 my $dbh = C4::Context->dbh;
595 my $timestamp2 = $timestamp - 1;
596 my $query = "";
597 my $sth = $dbh->prepare(
598 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
600 $sth->execute( $borrowerno, $accountno );
602 my @results;
603 while ( my $data = $sth->fetchrow_hashref ) {
604 push @results,$data;
606 return (@results);
610 sub getcredits {
611 my ( $date, $date2 ) = @_;
612 my $dbh = C4::Context->dbh;
613 my $sth = $dbh->prepare(
614 "SELECT * FROM accountlines,borrowers
615 WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber
616 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
619 $sth->execute( $date, $date2 );
620 my @results;
621 while ( my $data = $sth->fetchrow_hashref ) {
622 $data->{'date'} = $data->{'timestamp'};
623 push @results,$data;
625 return (@results);
629 sub getrefunds {
630 my ( $date, $date2 ) = @_;
631 my $dbh = C4::Context->dbh;
633 my $sth = $dbh->prepare(
634 "SELECT *,timestamp AS datetime
635 FROM accountlines,borrowers
636 WHERE (accounttype = 'REF'
637 AND accountlines.borrowernumber = borrowers.borrowernumber
638 AND date >=? AND date <?)"
641 $sth->execute( $date, $date2 );
643 my @results;
644 while ( my $data = $sth->fetchrow_hashref ) {
645 push @results,$data;
648 return (@results);
651 sub ReversePayment {
652 my ( $borrowernumber, $accountno ) = @_;
653 my $dbh = C4::Context->dbh;
655 my $sth = $dbh->prepare('SELECT amountoutstanding FROM accountlines WHERE borrowernumber = ? AND accountno = ?');
656 $sth->execute( $borrowernumber, $accountno );
657 my $row = $sth->fetchrow_hashref();
658 my $amount_outstanding = $row->{'amountoutstanding'};
660 if ( $amount_outstanding <= 0 ) {
661 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
662 $sth->execute( $borrowernumber, $accountno );
663 } else {
664 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
665 $sth->execute( $borrowernumber, $accountno );
669 END { } # module clean-up code here (global destructor)
672 __END__
674 =head1 SEE ALSO
676 DBI(3)
678 =cut