bug 4802 add missing order search help file
[koha.git] / C4 / Accounts.pm
blobff2188b4db38af02d89d4b55db3868b98f232137
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 &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 # http://wiki.koha.org/doku.php?id=en:development:kohastatuses
280 # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for
281 # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that
282 # a charge has been added
283 # FIXME : if no replacement price, borrower just doesn't get charged?
285 my $dbh = C4::Context->dbh();
286 my ($itemnumber) = @_;
287 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
288 FROM issues
289 JOIN items USING (itemnumber)
290 JOIN biblio USING (biblionumber)
291 WHERE issues.itemnumber=?");
292 $sth->execute($itemnumber);
293 my $issues=$sth->fetchrow_hashref();
295 # if a borrower lost the item, add a replacement cost to the their record
296 if ( $issues->{borrowernumber} ){
298 # first make sure the borrower hasn't already been charged for this item
299 my $sth1=$dbh->prepare("SELECT * from accountlines
300 WHERE borrowernumber=? AND itemnumber=? and accounttype='L'");
301 $sth1->execute($issues->{'borrowernumber'},$itemnumber);
302 my $existing_charge_hashref=$sth1->fetchrow_hashref();
304 # OK, they haven't
305 unless ($existing_charge_hashref) {
306 # This item is on issue ... add replacement cost to the borrower's record and mark it returned
307 # Note that we add this to the account even if there's no replacement price, allowing some other
308 # process (or person) to update it, since we don't handle any defaults for replacement prices.
309 my $accountno = getnextacctno($issues->{'borrowernumber'});
310 my $sth2=$dbh->prepare("INSERT INTO accountlines
311 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber)
312 VALUES (?,?,now(),?,?,'L',?,?)");
313 $sth2->execute($issues->{'borrowernumber'},$accountno,$issues->{'replacementprice'},
314 "Lost Item $issues->{'title'} $issues->{'barcode'}",
315 $issues->{'replacementprice'},$itemnumber);
316 $sth2->finish;
317 # FIXME: Log this ?
319 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
320 warn " $issues->{'borrowernumber'} / $itemnumber ";
321 C4::Circulation::MarkIssueReturned($issues->{borrowernumber},$itemnumber);
322 # Shouldn't MarkIssueReturned do this?
323 ModItem({ onloan => undef }, undef, $itemnumber);
325 $sth->finish;
328 =head2 manualinvoice
330 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
331 $amount, $user);
333 C<$borrowernumber> is the patron's borrower number.
334 C<$description> is a description of the transaction.
335 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
336 or C<REF>.
337 C<$itemnumber> is the item involved, if pertinent; otherwise, it
338 should be the empty string.
340 =cut
343 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
344 # are :
345 # 'C' = CREDIT
346 # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
347 # 'N' = New Card fee
348 # 'F' = Fine
349 # 'A' = Account Management fee
350 # 'M' = Sundry
351 # 'L' = Lost Item
354 sub manualinvoice {
355 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $user ) = @_;
356 my $dbh = C4::Context->dbh;
357 my $notifyid = 0;
358 my $insert;
359 $itemnum =~ s/ //g;
360 my $accountno = getnextacctno($borrowernumber);
361 my $amountleft = $amount;
363 # if ( $type eq 'CS'
364 # || $type eq 'CB'
365 # || $type eq 'CW'
366 # || $type eq 'CF'
367 # || $type eq 'CL' )
369 # my $amount2 = $amount * -1; # FIXME - $amount2 = -$amount
370 # $amountleft =
371 # fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user );
373 if ( $type eq 'N' ) {
374 $desc .= " New Card";
376 if ( $type eq 'F' ) {
377 $desc .= " Fine";
379 if ( $type eq 'A' ) {
380 $desc .= " Account Management fee";
382 if ( $type eq 'M' ) {
383 $desc .= " Sundry";
386 if ( $type eq 'L' && $desc eq '' ) {
388 $desc = " Lost Item";
390 # if ( $type eq 'REF' ) {
391 # $desc .= " Cash Refund";
392 # $amountleft = refund( '', $borrowernumber, $amount );
394 if ( ( $type eq 'L' )
395 or ( $type eq 'F' )
396 or ( $type eq 'A' )
397 or ( $type eq 'N' )
398 or ( $type eq 'M' ) )
400 $notifyid = 1;
403 if ( $itemnum ne '' ) {
404 $desc .= " " . $itemnum;
405 my $sth = $dbh->prepare(
406 "INSERT INTO accountlines
407 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id)
408 VALUES (?, ?, now(), ?,?, ?,?,?,?)");
409 $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid) || return $sth->errstr;
410 } else {
411 my $sth=$dbh->prepare("INSERT INTO accountlines
412 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id)
413 VALUES (?, ?, now(), ?, ?, ?, ?,?)"
415 $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
416 $amountleft, $notifyid );
418 return 0;
421 =head2 fixcredit #### DEPRECATED
423 $amountleft = &fixcredit($borrowernumber, $data, $barcode, $type, $user);
425 This function is only used internally, not exported.
427 =cut
429 # This function is deprecated in 3.0
431 sub fixcredit {
433 #here we update both the accountoffsets and the account lines
434 my ( $borrowernumber, $data, $barcode, $type, $user ) = @_;
435 my $dbh = C4::Context->dbh;
436 my $newamtos = 0;
437 my $accdata = "";
438 my $amountleft = $data;
439 if ( $barcode ne '' ) {
440 my $item = GetBiblioFromItemNumber( '', $barcode );
441 my $nextaccntno = getnextacctno($borrowernumber);
442 my $query = "SELECT * FROM accountlines WHERE (borrowernumber=?
443 AND itemnumber=? AND amountoutstanding > 0)";
444 if ( $type eq 'CL' ) {
445 $query .= " AND (accounttype = 'L' OR accounttype = 'Rep')";
447 elsif ( $type eq 'CF' ) {
448 $query .= " AND (accounttype = 'F' OR accounttype = 'FU' OR
449 accounttype='Res' OR accounttype='Rent')";
451 elsif ( $type eq 'CB' ) {
452 $query .= " and accounttype='A'";
455 # print $query;
456 my $sth = $dbh->prepare($query);
457 $sth->execute( $borrowernumber, $item->{'itemnumber'} );
458 $accdata = $sth->fetchrow_hashref;
459 $sth->finish;
460 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
461 $newamtos = 0;
462 $amountleft -= $accdata->{'amountoutstanding'};
464 else {
465 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
466 $amountleft = 0;
468 my $thisacct = $accdata->{accountno};
469 my $usth = $dbh->prepare(
470 "UPDATE accountlines SET amountoutstanding= ?
471 WHERE (borrowernumber = ?) AND (accountno=?)"
473 $usth->execute( $newamtos, $borrowernumber, $thisacct );
474 $usth->finish;
475 $usth = $dbh->prepare(
476 "INSERT INTO accountoffsets
477 (borrowernumber, accountno, offsetaccount, offsetamount)
478 VALUES (?,?,?,?)"
480 $usth->execute( $borrowernumber, $accdata->{'accountno'},
481 $nextaccntno, $newamtos );
482 $usth->finish;
485 # begin transaction
486 my $nextaccntno = getnextacctno($borrowernumber);
488 # get lines with outstanding amounts to offset
489 my $sth = $dbh->prepare(
490 "SELECT * FROM accountlines
491 WHERE (borrowernumber = ?) AND (amountoutstanding >0)
492 ORDER BY date"
494 $sth->execute($borrowernumber);
496 # print $query;
497 # offset transactions
498 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
499 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
500 $newamtos = 0;
501 $amountleft -= $accdata->{'amountoutstanding'};
503 else {
504 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
505 $amountleft = 0;
507 my $thisacct = $accdata->{accountno};
508 my $usth = $dbh->prepare(
509 "UPDATE accountlines SET amountoutstanding= ?
510 WHERE (borrowernumber = ?) AND (accountno=?)"
512 $usth->execute( $newamtos, $borrowernumber, $thisacct );
513 $usth->finish;
514 $usth = $dbh->prepare(
515 "INSERT INTO accountoffsets
516 (borrowernumber, accountno, offsetaccount, offsetamount)
517 VALUE (?,?,?,?)"
519 $usth->execute( $borrowernumber, $accdata->{'accountno'},
520 $nextaccntno, $newamtos );
521 $usth->finish;
523 $sth->finish;
524 $type = "Credit " . $type;
525 UpdateStats( $user, $type, $data, $user, '', '', $borrowernumber );
526 $amountleft *= -1;
527 return ($amountleft);
531 =head2 refund
533 #FIXME : DEPRECATED SUB
534 This subroutine tracks payments and/or credits against fines/charges
535 using the accountoffsets table, which is not used consistently in
536 Koha's fines management, and so is not used in 3.0
538 =cut
540 sub refund {
542 #here we update both the accountoffsets and the account lines
543 my ( $borrowernumber, $data ) = @_;
544 my $dbh = C4::Context->dbh;
545 my $newamtos = 0;
546 my $accdata = "";
547 my $amountleft = $data * -1;
549 # begin transaction
550 my $nextaccntno = getnextacctno($borrowernumber);
552 # get lines with outstanding amounts to offset
553 my $sth = $dbh->prepare(
554 "SELECT * FROM accountlines
555 WHERE (borrowernumber = ?) AND (amountoutstanding<0)
556 ORDER BY date"
558 $sth->execute($borrowernumber);
560 # print $amountleft;
561 # offset transactions
562 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) {
563 if ( $accdata->{'amountoutstanding'} > $amountleft ) {
564 $newamtos = 0;
565 $amountleft -= $accdata->{'amountoutstanding'};
567 else {
568 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
569 $amountleft = 0;
572 # print $amountleft;
573 my $thisacct = $accdata->{accountno};
574 my $usth = $dbh->prepare(
575 "UPDATE accountlines SET amountoutstanding= ?
576 WHERE (borrowernumber = ?) AND (accountno=?)"
578 $usth->execute( $newamtos, $borrowernumber, $thisacct );
579 $usth->finish;
580 $usth = $dbh->prepare(
581 "INSERT INTO accountoffsets
582 (borrowernumber, accountno, offsetaccount, offsetamount)
583 VALUES (?,?,?,?)"
585 $usth->execute( $borrowernumber, $accdata->{'accountno'},
586 $nextaccntno, $newamtos );
587 $usth->finish;
589 $sth->finish;
590 return ($amountleft);
593 sub getcharges {
594 my ( $borrowerno, $timestamp, $accountno ) = @_;
595 my $dbh = C4::Context->dbh;
596 my $timestamp2 = $timestamp - 1;
597 my $query = "";
598 my $sth = $dbh->prepare(
599 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
601 $sth->execute( $borrowerno, $accountno );
603 my @results;
604 while ( my $data = $sth->fetchrow_hashref ) {
605 push @results,$data;
607 return (@results);
611 sub getcredits {
612 my ( $date, $date2 ) = @_;
613 my $dbh = C4::Context->dbh;
614 my $sth = $dbh->prepare(
615 "SELECT * FROM accountlines,borrowers
616 WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber
617 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
620 $sth->execute( $date, $date2 );
621 my @results;
622 while ( my $data = $sth->fetchrow_hashref ) {
623 $data->{'date'} = $data->{'timestamp'};
624 push @results,$data;
626 return (@results);
630 sub getrefunds {
631 my ( $date, $date2 ) = @_;
632 my $dbh = C4::Context->dbh;
634 my $sth = $dbh->prepare(
635 "SELECT *,timestamp AS datetime
636 FROM accountlines,borrowers
637 WHERE (accounttype = 'REF'
638 AND accountlines.borrowernumber = borrowers.borrowernumber
639 AND date >=? AND date <?)"
642 $sth->execute( $date, $date2 );
644 my @results;
645 while ( my $data = $sth->fetchrow_hashref ) {
646 push @results,$data;
649 return (@results);
652 sub ReversePayment {
653 my ( $borrowernumber, $accountno ) = @_;
654 my $dbh = C4::Context->dbh;
656 my $sth = $dbh->prepare('SELECT amountoutstanding FROM accountlines WHERE borrowernumber = ? AND accountno = ?');
657 $sth->execute( $borrowernumber, $accountno );
658 my $row = $sth->fetchrow_hashref();
659 my $amount_outstanding = $row->{'amountoutstanding'};
661 if ( $amount_outstanding <= 0 ) {
662 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
663 $sth->execute( $borrowernumber, $accountno );
664 } else {
665 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
666 $sth->execute( $borrowernumber, $accountno );
670 END { } # module clean-up code here (global destructor)
673 __END__
675 =head1 SEE ALSO
677 DBI(3)
679 =cut