overdue_notices.pl send no email directly to patron
[koha.git] / C4 / Accounts.pm
blobc40fc39ded3c6114b8c859ff892429e382e8e51f
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 * FROM issues, items WHERE issues.itemnumber=items.itemnumber and issues.itemnumber=?");
287 $sth->execute($itemnumber);
288 my $issues=$sth->fetchrow_hashref();
290 # if a borrower lost the item, add a replacement cost to the their record
291 if ( $issues->{borrowernumber} ){
293 # first make sure the borrower hasn't already been charged for this item
294 my $sth1=$dbh->prepare("SELECT * from accountlines
295 WHERE borrowernumber=? AND itemnumber=? and accounttype='L'");
296 $sth1->execute($issues->{'borrowernumber'},$itemnumber);
297 my $existing_charge_hashref=$sth1->fetchrow_hashref();
299 # OK, they haven't
300 unless ($existing_charge_hashref) {
301 # This item is on issue ... add replacement cost to the borrower's record and mark it returned
302 # Note that we add this to the account even if there's no replacement price, allowing some other
303 # process (or person) to update it, since we don't handle any defaults for replacement prices.
304 my $accountno = getnextacctno($issues->{'borrowernumber'});
305 my $sth2=$dbh->prepare("INSERT INTO accountlines
306 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber)
307 VALUES (?,?,now(),?,?,'L',?,?)");
308 $sth2->execute($issues->{'borrowernumber'},$accountno,$issues->{'replacementprice'},
309 "Lost Item $issues->{'title'} $issues->{'barcode'}",
310 $issues->{'replacementprice'},$itemnumber);
311 $sth2->finish;
312 # FIXME: Log this ?
314 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
315 warn " $issues->{'borrowernumber'} / $itemnumber ";
316 C4::Circulation::MarkIssueReturned($issues->{borrowernumber},$itemnumber);
317 # Shouldn't MarkIssueReturned do this?
318 ModItem({ onloan => undef }, undef, $itemnumber);
320 $sth->finish;
323 =head2 manualinvoice
325 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
326 $amount, $user);
328 C<$borrowernumber> is the patron's borrower number.
329 C<$description> is a description of the transaction.
330 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
331 or C<REF>.
332 C<$itemnumber> is the item involved, if pertinent; otherwise, it
333 should be the empty string.
335 =cut
338 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
339 # are :
340 # 'C' = CREDIT
341 # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
342 # 'N' = New Card fee
343 # 'F' = Fine
344 # 'A' = Account Management fee
345 # 'M' = Sundry
346 # 'L' = Lost Item
349 sub manualinvoice {
350 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $user ) = @_;
351 my $dbh = C4::Context->dbh;
352 my $notifyid = 0;
353 my $insert;
354 $itemnum =~ s/ //g;
355 my $accountno = getnextacctno($borrowernumber);
356 my $amountleft = $amount;
358 # if ( $type eq 'CS'
359 # || $type eq 'CB'
360 # || $type eq 'CW'
361 # || $type eq 'CF'
362 # || $type eq 'CL' )
364 # my $amount2 = $amount * -1; # FIXME - $amount2 = -$amount
365 # $amountleft =
366 # fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user );
368 if ( $type eq 'N' ) {
369 $desc .= " New Card";
371 if ( $type eq 'F' ) {
372 $desc .= " Fine";
374 if ( $type eq 'A' ) {
375 $desc .= " Account Management fee";
377 if ( $type eq 'M' ) {
378 $desc .= " Sundry";
381 if ( $type eq 'L' && $desc eq '' ) {
383 $desc = " Lost Item";
385 # if ( $type eq 'REF' ) {
386 # $desc .= " Cash Refund";
387 # $amountleft = refund( '', $borrowernumber, $amount );
389 if ( ( $type eq 'L' )
390 or ( $type eq 'F' )
391 or ( $type eq 'A' )
392 or ( $type eq 'N' )
393 or ( $type eq 'M' ) )
395 $notifyid = 1;
398 if ( $itemnum ne '' ) {
399 $desc .= " " . $itemnum;
400 my $sth = $dbh->prepare(
401 "INSERT INTO accountlines
402 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id)
403 VALUES (?, ?, now(), ?,?, ?,?,?,?)");
404 $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid) || return $sth->errstr;
405 } else {
406 my $sth=$dbh->prepare("INSERT INTO accountlines
407 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id)
408 VALUES (?, ?, now(), ?, ?, ?, ?,?)"
410 $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
411 $amountleft, $notifyid );
413 return 0;
416 =head2 fixcredit #### DEPRECATED
418 $amountleft = &fixcredit($borrowernumber, $data, $barcode, $type, $user);
420 This function is only used internally, not exported.
422 =cut
424 # This function is deprecated in 3.0
426 sub fixcredit {
428 #here we update both the accountoffsets and the account lines
429 my ( $borrowernumber, $data, $barcode, $type, $user ) = @_;
430 my $dbh = C4::Context->dbh;
431 my $newamtos = 0;
432 my $accdata = "";
433 my $amountleft = $data;
434 if ( $barcode ne '' ) {
435 my $item = GetBiblioFromItemNumber( '', $barcode );
436 my $nextaccntno = getnextacctno($borrowernumber);
437 my $query = "SELECT * FROM accountlines WHERE (borrowernumber=?
438 AND itemnumber=? AND amountoutstanding > 0)";
439 if ( $type eq 'CL' ) {
440 $query .= " AND (accounttype = 'L' OR accounttype = 'Rep')";
442 elsif ( $type eq 'CF' ) {
443 $query .= " AND (accounttype = 'F' OR accounttype = 'FU' OR
444 accounttype='Res' OR accounttype='Rent')";
446 elsif ( $type eq 'CB' ) {
447 $query .= " and accounttype='A'";
450 # print $query;
451 my $sth = $dbh->prepare($query);
452 $sth->execute( $borrowernumber, $item->{'itemnumber'} );
453 $accdata = $sth->fetchrow_hashref;
454 $sth->finish;
455 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
456 $newamtos = 0;
457 $amountleft -= $accdata->{'amountoutstanding'};
459 else {
460 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
461 $amountleft = 0;
463 my $thisacct = $accdata->{accountno};
464 my $usth = $dbh->prepare(
465 "UPDATE accountlines SET amountoutstanding= ?
466 WHERE (borrowernumber = ?) AND (accountno=?)"
468 $usth->execute( $newamtos, $borrowernumber, $thisacct );
469 $usth->finish;
470 $usth = $dbh->prepare(
471 "INSERT INTO accountoffsets
472 (borrowernumber, accountno, offsetaccount, offsetamount)
473 VALUES (?,?,?,?)"
475 $usth->execute( $borrowernumber, $accdata->{'accountno'},
476 $nextaccntno, $newamtos );
477 $usth->finish;
480 # begin transaction
481 my $nextaccntno = getnextacctno($borrowernumber);
483 # get lines with outstanding amounts to offset
484 my $sth = $dbh->prepare(
485 "SELECT * FROM accountlines
486 WHERE (borrowernumber = ?) AND (amountoutstanding >0)
487 ORDER BY date"
489 $sth->execute($borrowernumber);
491 # print $query;
492 # offset transactions
493 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
494 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
495 $newamtos = 0;
496 $amountleft -= $accdata->{'amountoutstanding'};
498 else {
499 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
500 $amountleft = 0;
502 my $thisacct = $accdata->{accountno};
503 my $usth = $dbh->prepare(
504 "UPDATE accountlines SET amountoutstanding= ?
505 WHERE (borrowernumber = ?) AND (accountno=?)"
507 $usth->execute( $newamtos, $borrowernumber, $thisacct );
508 $usth->finish;
509 $usth = $dbh->prepare(
510 "INSERT INTO accountoffsets
511 (borrowernumber, accountno, offsetaccount, offsetamount)
512 VALUE (?,?,?,?)"
514 $usth->execute( $borrowernumber, $accdata->{'accountno'},
515 $nextaccntno, $newamtos );
516 $usth->finish;
518 $sth->finish;
519 $type = "Credit " . $type;
520 UpdateStats( $user, $type, $data, $user, '', '', $borrowernumber );
521 $amountleft *= -1;
522 return ($amountleft);
526 =head2 refund
528 #FIXME : DEPRECATED SUB
529 This subroutine tracks payments and/or credits against fines/charges
530 using the accountoffsets table, which is not used consistently in
531 Koha's fines management, and so is not used in 3.0
533 =cut
535 sub refund {
537 #here we update both the accountoffsets and the account lines
538 my ( $borrowernumber, $data ) = @_;
539 my $dbh = C4::Context->dbh;
540 my $newamtos = 0;
541 my $accdata = "";
542 my $amountleft = $data * -1;
544 # begin transaction
545 my $nextaccntno = getnextacctno($borrowernumber);
547 # get lines with outstanding amounts to offset
548 my $sth = $dbh->prepare(
549 "SELECT * FROM accountlines
550 WHERE (borrowernumber = ?) AND (amountoutstanding<0)
551 ORDER BY date"
553 $sth->execute($borrowernumber);
555 # print $amountleft;
556 # offset transactions
557 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) {
558 if ( $accdata->{'amountoutstanding'} > $amountleft ) {
559 $newamtos = 0;
560 $amountleft -= $accdata->{'amountoutstanding'};
562 else {
563 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
564 $amountleft = 0;
567 # print $amountleft;
568 my $thisacct = $accdata->{accountno};
569 my $usth = $dbh->prepare(
570 "UPDATE accountlines SET amountoutstanding= ?
571 WHERE (borrowernumber = ?) AND (accountno=?)"
573 $usth->execute( $newamtos, $borrowernumber, $thisacct );
574 $usth->finish;
575 $usth = $dbh->prepare(
576 "INSERT INTO accountoffsets
577 (borrowernumber, accountno, offsetaccount, offsetamount)
578 VALUES (?,?,?,?)"
580 $usth->execute( $borrowernumber, $accdata->{'accountno'},
581 $nextaccntno, $newamtos );
582 $usth->finish;
584 $sth->finish;
585 return ($amountleft);
588 sub getcharges {
589 my ( $borrowerno, $timestamp, $accountno ) = @_;
590 my $dbh = C4::Context->dbh;
591 my $timestamp2 = $timestamp - 1;
592 my $query = "";
593 my $sth = $dbh->prepare(
594 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
596 $sth->execute( $borrowerno, $accountno );
598 my @results;
599 while ( my $data = $sth->fetchrow_hashref ) {
600 push @results,$data;
602 return (@results);
606 sub getcredits {
607 my ( $date, $date2 ) = @_;
608 my $dbh = C4::Context->dbh;
609 my $sth = $dbh->prepare(
610 "SELECT * FROM accountlines,borrowers
611 WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber
612 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
615 $sth->execute( $date, $date2 );
616 my @results;
617 while ( my $data = $sth->fetchrow_hashref ) {
618 $data->{'date'} = $data->{'timestamp'};
619 push @results,$data;
621 return (@results);
625 sub getrefunds {
626 my ( $date, $date2 ) = @_;
627 my $dbh = C4::Context->dbh;
629 my $sth = $dbh->prepare(
630 "SELECT *,timestamp AS datetime
631 FROM accountlines,borrowers
632 WHERE (accounttype = 'REF'
633 AND accountlines.borrowernumber = borrowers.borrowernumber
634 AND date >=? AND date <?)"
637 $sth->execute( $date, $date2 );
639 my @results;
640 while ( my $data = $sth->fetchrow_hashref ) {
641 push @results,$data;
644 return (@results);
647 sub ReversePayment {
648 my ( $borrowernumber, $accountno ) = @_;
649 my $dbh = C4::Context->dbh;
651 my $sth = $dbh->prepare('SELECT amountoutstanding FROM accountlines WHERE borrowernumber = ? AND accountno = ?');
652 $sth->execute( $borrowernumber, $accountno );
653 my $row = $sth->fetchrow_hashref();
654 my $amount_outstanding = $row->{'amountoutstanding'};
656 if ( $amount_outstanding <= 0 ) {
657 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
658 $sth->execute( $borrowernumber, $accountno );
659 } else {
660 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
661 $sth->execute( $borrowernumber, $accountno );
665 END { } # module clean-up code here (global destructor)
668 __END__
670 =head1 SEE ALSO
672 DBI(3)
674 =cut