File: | C4/Accounts.pm |
Coverage: | 8.1% |
line | stmt | bran | cond | sub | time | code |
---|---|---|---|---|---|---|
1 | package C4::Accounts; | |||||
2 | ||||||
3 | # Copyright 2000-2002 Katipo Communications | |||||
4 | # | |||||
5 | # This file is part of Koha. | |||||
6 | # | |||||
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. | |||||
11 | # | |||||
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. | |||||
15 | # | |||||
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. | |||||
19 | ||||||
20 | ||||||
21 | 24 24 24 | 5534 246 1165 | use strict; | |||
22 | #use warnings; FIXME - Bug 2505 | |||||
23 | 24 24 24 | 360 307 485 | use C4::Context; | |||
24 | 24 24 24 | 699 307 3308 | use C4::Stats; | |||
25 | 24 24 24 | 664 133 2142 | use C4::Members; | |||
26 | 24 24 24 | 178 110 1245 | use C4::Circulation qw(ReturnLostItem); | |||
27 | ||||||
28 | 24 24 24 | 162 143 2885 | use vars qw($VERSION @ISA @EXPORT); | |||
29 | ||||||
30 | BEGIN { | |||||
31 | # set the version for version checking | |||||
32 | 24 | 127 | $VERSION = 3.03; | |||
33 | 24 | 194 | require Exporter; | |||
34 | 24 | 389 | @ISA = qw(Exporter); | |||
35 | 24 | 79018 | @EXPORT = qw( | |||
36 | &recordpayment &makepayment &manualinvoice | |||||
37 | &getnextacctno &reconcileaccount &getcharges &ModNote &getcredits | |||||
38 | &getrefunds &chargelostitem | |||||
39 | &ReversePayment | |||||
40 | makepartialpayment | |||||
41 | recordpayment_selectaccts | |||||
42 | ); | |||||
43 | } | |||||
44 | ||||||
45 - 74 | =head1 NAME C4::Accounts - Functions for dealing with Koha accounts =head1 SYNOPSIS use C4::Accounts; =head1 DESCRIPTION The functions in this module deal with the monetary aspect of Koha, including looking up and modifying the amount of money owed by a patron. =head1 FUNCTIONS =head2 recordpayment &recordpayment($borrowernumber, $payment); Record payment by a patron. C<$borrowernumber> is the patron's borrower number. C<$payment> is a floating-point number, giving the amount that was paid. Amounts owed are paid off oldest first. That is, if the patron has a $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment of $1.50, then the oldest fine will be paid off in full, and $0.50 will be credited to the next one. =cut | |||||
75 | ||||||
76 | #' | |||||
77 | sub recordpayment { | |||||
78 | ||||||
79 | #here we update the account lines | |||||
80 | 0 | my ( $borrowernumber, $data ) = @_; | ||||
81 | 0 | my $dbh = C4::Context->dbh; | ||||
82 | 0 | my $newamtos = 0; | ||||
83 | 0 | my $accdata = ""; | ||||
84 | 0 | my $branch = C4::Context->userenv->{'branch'}; | ||||
85 | 0 | my $amountleft = $data; | ||||
86 | ||||||
87 | # begin transaction | |||||
88 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
89 | ||||||
90 | # get lines with outstanding amounts to offset | |||||
91 | 0 | my $sth = $dbh->prepare( | ||||
92 | "SELECT * FROM accountlines | |||||
93 | WHERE (borrowernumber = ?) AND (amountoutstanding<>0) | |||||
94 | ORDER BY date" | |||||
95 | ); | |||||
96 | 0 | $sth->execute($borrowernumber); | ||||
97 | ||||||
98 | # offset transactions | |||||
99 | 0 | while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) { | ||||
100 | 0 | if ( $accdata->{'amountoutstanding'} < $amountleft ) { | ||||
101 | 0 | $newamtos = 0; | ||||
102 | 0 | $amountleft -= $accdata->{'amountoutstanding'}; | ||||
103 | } | |||||
104 | else { | |||||
105 | 0 | $newamtos = $accdata->{'amountoutstanding'} - $amountleft; | ||||
106 | 0 | $amountleft = 0; | ||||
107 | } | |||||
108 | 0 | my $thisacct = $accdata->{accountno}; | ||||
109 | 0 | my $usth = $dbh->prepare( | ||||
110 | "UPDATE accountlines SET amountoutstanding= ? | |||||
111 | WHERE (borrowernumber = ?) AND (accountno=?)" | |||||
112 | ); | |||||
113 | 0 | $usth->execute( $newamtos, $borrowernumber, $thisacct ); | ||||
114 | 0 | $usth->finish; | ||||
115 | # $usth = $dbh->prepare( | |||||
116 | # "INSERT INTO accountoffsets | |||||
117 | # (borrowernumber, accountno, offsetaccount, offsetamount) | |||||
118 | # VALUES (?,?,?,?)" | |||||
119 | # ); | |||||
120 | # $usth->execute( $borrowernumber, $accdata->{'accountno'}, | |||||
121 | # $nextaccntno, $newamtos ); | |||||
122 | 0 | $usth->finish; | ||||
123 | } | |||||
124 | ||||||
125 | # create new line | |||||
126 | 0 | my $usth = $dbh->prepare( | ||||
127 | "INSERT INTO accountlines | |||||
128 | (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding) | |||||
129 | VALUES (?,?,now(),?,'Payment,thanks','Pay',?)" | |||||
130 | ); | |||||
131 | 0 | $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft ); | ||||
132 | 0 | $usth->finish; | ||||
133 | 0 | UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno ); | ||||
134 | 0 | $sth->finish; | ||||
135 | } | |||||
136 | ||||||
137 - 150 | =head2 makepayment &makepayment($borrowernumber, $acctnumber, $amount, $branchcode); Records the fact that a patron has paid off the entire amount he or she owes. C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is the account that was credited. C<$amount> is the amount paid (this is only used to record the payment. It is assumed to be equal to the amount owed). C<$branchcode> is the code of the branch where payment was made. =cut | |||||
151 | ||||||
152 | #' | |||||
153 | # FIXME - I'm not at all sure about the above, because I don't | |||||
154 | # understand what the acct* tables in the Koha database are for. | |||||
155 | sub makepayment { | |||||
156 | ||||||
157 | #here we update both the accountoffsets and the account lines | |||||
158 | #updated to check, if they are paying off a lost item, we return the item | |||||
159 | # from their card, and put a note on the item record | |||||
160 | 0 | my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_; | ||||
161 | 0 | my $dbh = C4::Context->dbh; | ||||
162 | 0 | my $manager_id = 0; | ||||
163 | 0 | $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; | ||||
164 | ||||||
165 | # begin transaction | |||||
166 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
167 | 0 | my $newamtos = 0; | ||||
168 | 0 | my $sth = | ||||
169 | $dbh->prepare( | |||||
170 | "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?"); | |||||
171 | 0 | $sth->execute( $borrowernumber, $accountno ); | ||||
172 | 0 | my $data = $sth->fetchrow_hashref; | ||||
173 | 0 | $sth->finish; | ||||
174 | ||||||
175 | 0 | if($data->{'accounttype'} eq "Pay"){ | ||||
176 | 0 | my $udp = | ||||
177 | $dbh->prepare( | |||||
178 | "UPDATE accountlines | |||||
179 | SET amountoutstanding = 0, description = 'Payment,thanks' | |||||
180 | WHERE borrowernumber = ? | |||||
181 | AND accountno = ? | |||||
182 | " | |||||
183 | ); | |||||
184 | 0 | $udp->execute($borrowernumber, $accountno ); | ||||
185 | 0 | $udp->finish; | ||||
186 | }else{ | |||||
187 | 0 | my $udp = | ||||
188 | $dbh->prepare( | |||||
189 | "UPDATE accountlines | |||||
190 | SET amountoutstanding = 0 | |||||
191 | WHERE borrowernumber = ? | |||||
192 | AND accountno = ? | |||||
193 | " | |||||
194 | ); | |||||
195 | 0 | $udp->execute($borrowernumber, $accountno ); | ||||
196 | 0 | $udp->finish; | ||||
197 | ||||||
198 | # create new line | |||||
199 | 0 | my $payment = 0 - $amount; | ||||
200 | ||||||
201 | 0 | my $ins = | ||||
202 | $dbh->prepare( | |||||
203 | "INSERT | |||||
204 | INTO accountlines (borrowernumber, accountno, date, amount, itemnumber, description, accounttype, amountoutstanding, manager_id) | |||||
205 | VALUES ( ?, ?, now(), ?, ?, 'Payment,thanks', 'Pay', 0, ?)" | |||||
206 | ); | |||||
207 | 0 | $ins->execute($borrowernumber, $nextaccntno, $payment, $data->{'itemnumber'}, $manager_id); | ||||
208 | 0 | $ins->finish; | ||||
209 | } | |||||
210 | ||||||
211 | # FIXME - The second argument to &UpdateStats is supposed to be the | |||||
212 | # branch code. | |||||
213 | # UpdateStats is now being passed $accountno too. MTJ | |||||
214 | 0 | UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber, | ||||
215 | $accountno ); | |||||
216 | #from perldoc: for SELECT only #$sth->finish; | |||||
217 | ||||||
218 | #check to see what accounttype | |||||
219 | 0 | if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) { | ||||
220 | 0 | C4::Circulation::ReturnLostItem( $borrowernumber, $data->{'itemnumber'} ); | ||||
221 | } | |||||
222 | } | |||||
223 | ||||||
224 - 231 | =head2 getnextacctno $nextacct = &getnextacctno($borrowernumber); Returns the next unused account number for the patron with the given borrower number. =cut | |||||
232 | ||||||
233 | #' | |||||
234 | # FIXME - Okay, so what does the above actually _mean_? | |||||
235 | sub getnextacctno ($) { | |||||
236 | 0 | my ($borrowernumber) = shift or return undef; | ||||
237 | 0 | my $sth = C4::Context->dbh->prepare( | ||||
238 | "SELECT accountno+1 FROM accountlines | |||||
239 | WHERE (borrowernumber = ?) | |||||
240 | ORDER BY accountno DESC | |||||
241 | LIMIT 1" | |||||
242 | ); | |||||
243 | 0 | $sth->execute($borrowernumber); | ||||
244 | 0 | return ($sth->fetchrow || 1); | ||||
245 | } | |||||
246 | ||||||
247 - 278 | =head2 fixaccounts (removed) &fixaccounts($borrowernumber, $accountnumber, $amount); #' # FIXME - I don't understand what this function does. sub fixaccounts { my ( $borrowernumber, $accountno, $amount ) = @_; my $dbh = C4::Context->dbh; my $sth = $dbh->prepare( "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?" ); $sth->execute( $borrowernumber, $accountno ); my $data = $sth->fetchrow_hashref; # FIXME - Error-checking my $diff = $amount - $data->{'amount'}; my $outstanding = $data->{'amountoutstanding'} + $diff; $sth->finish; $dbh->do(<<EOT); UPDATE accountlines SET amount = '$amount', amountoutstanding = '$outstanding' WHERE borrowernumber = $borrowernumber AND accountno = $accountno EOT # FIXME: exceedingly bad form. Use prepare with placholders ("?") in query and execute args. } =cut | |||||
279 | ||||||
280 | sub chargelostitem{ | |||||
281 | # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for | |||||
282 | # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that | |||||
283 | # a charge has been added | |||||
284 | # FIXME : if no replacement price, borrower just doesn't get charged? | |||||
285 | 0 | my $dbh = C4::Context->dbh(); | ||||
286 | 0 | my ($borrowernumber, $itemnumber, $amount, $description) = @_; | ||||
287 | ||||||
288 | # first make sure the borrower hasn't already been charged for this item | |||||
289 | 0 | my $sth1=$dbh->prepare("SELECT * from accountlines | ||||
290 | WHERE borrowernumber=? AND itemnumber=? and accounttype='L'"); | |||||
291 | 0 | $sth1->execute($borrowernumber,$itemnumber); | ||||
292 | 0 | my $existing_charge_hashref=$sth1->fetchrow_hashref(); | ||||
293 | ||||||
294 | # OK, they haven't | |||||
295 | 0 | unless ($existing_charge_hashref) { | ||||
296 | # This item is on issue ... add replacement cost to the borrower's record and mark it returned | |||||
297 | # Note that we add this to the account even if there's no replacement price, allowing some other | |||||
298 | # process (or person) to update it, since we don't handle any defaults for replacement prices. | |||||
299 | 0 | my $accountno = getnextacctno($borrowernumber); | ||||
300 | 0 | my $sth2=$dbh->prepare("INSERT INTO accountlines | ||||
301 | (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber) | |||||
302 | VALUES (?,?,now(),?,?,'L',?,?)"); | |||||
303 | 0 | $sth2->execute($borrowernumber,$accountno,$amount, | ||||
304 | $description,$amount,$itemnumber); | |||||
305 | 0 | $sth2->finish; | ||||
306 | # FIXME: Log this ? | |||||
307 | } | |||||
308 | } | |||||
309 | ||||||
310 - 322 | =head2 manualinvoice &manualinvoice($borrowernumber, $itemnumber, $description, $type, $amount, $note); C<$borrowernumber> is the patron's borrower number. C<$description> is a description of the transaction. C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>, or C<REF>. C<$itemnumber> is the item involved, if pertinent; otherwise, it should be the empty string. =cut | |||||
323 | ||||||
324 | #' | |||||
325 | # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function | |||||
326 | # are : | |||||
327 | # 'C' = CREDIT | |||||
328 | # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere) | |||||
329 | # 'N' = New Card fee | |||||
330 | # 'F' = Fine | |||||
331 | # 'A' = Account Management fee | |||||
332 | # 'M' = Sundry | |||||
333 | # 'L' = Lost Item | |||||
334 | # | |||||
335 | ||||||
336 | sub manualinvoice { | |||||
337 | 0 | my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_; | ||||
338 | 0 | my $manager_id = 0; | ||||
339 | 0 | $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; | ||||
340 | 0 | my $dbh = C4::Context->dbh; | ||||
341 | 0 | my $notifyid = 0; | ||||
342 | 0 | my $insert; | ||||
343 | 0 | my $accountno = getnextacctno($borrowernumber); | ||||
344 | 0 | my $amountleft = $amount; | ||||
345 | ||||||
346 | # if ( $type eq 'CS' | |||||
347 | # || $type eq 'CB' | |||||
348 | # || $type eq 'CW' | |||||
349 | # || $type eq 'CF' | |||||
350 | # || $type eq 'CL' ) | |||||
351 | # { | |||||
352 | # my $amount2 = $amount * -1; # FIXME - $amount2 = -$amount | |||||
353 | # $amountleft = | |||||
354 | # fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user ); | |||||
355 | # } | |||||
356 | 0 | if ( $type eq 'N' ) { | ||||
357 | 0 | $desc .= " New Card"; | ||||
358 | } | |||||
359 | 0 | if ( $type eq 'F' ) { | ||||
360 | 0 | $desc .= " Fine"; | ||||
361 | } | |||||
362 | 0 | if ( $type eq 'A' ) { | ||||
363 | 0 | $desc .= " Account Management fee"; | ||||
364 | } | |||||
365 | 0 | if ( $type eq 'M' ) { | ||||
366 | 0 | $desc .= " Sundry"; | ||||
367 | } | |||||
368 | ||||||
369 | 0 | if ( $type eq 'L' && $desc eq '' ) { | ||||
370 | ||||||
371 | 0 | $desc = " Lost Item"; | ||||
372 | } | |||||
373 | # if ( $type eq 'REF' ) { | |||||
374 | # $desc .= " Cash Refund"; | |||||
375 | # $amountleft = refund( '', $borrowernumber, $amount ); | |||||
376 | # } | |||||
377 | 0 | if ( ( $type eq 'L' ) | ||||
378 | or ( $type eq 'F' ) | |||||
379 | or ( $type eq 'A' ) | |||||
380 | or ( $type eq 'N' ) | |||||
381 | or ( $type eq 'M' ) ) | |||||
382 | { | |||||
383 | 0 | $notifyid = 1; | ||||
384 | } | |||||
385 | ||||||
386 | 0 | if ( $itemnum ) { | ||||
387 | 0 | $desc .= ' ' . $itemnum; | ||||
388 | 0 | my $sth = $dbh->prepare( | ||||
389 | 'INSERT INTO accountlines | |||||
390 | (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id) | |||||
391 | VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)'); | |||||
392 | 0 | $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr; | ||||
393 | } else { | |||||
394 | 0 | my $sth=$dbh->prepare("INSERT INTO accountlines | ||||
395 | (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id) | |||||
396 | VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)" | |||||
397 | ); | |||||
398 | 0 | $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type, | ||||
399 | $amountleft, $notifyid, $note, $manager_id ); | |||||
400 | } | |||||
401 | 0 | return 0; | ||||
402 | } | |||||
403 | ||||||
404 - 410 | =head2 fixcredit #### DEPRECATED $amountleft = &fixcredit($borrowernumber, $data, $barcode, $type, $user); This function is only used internally, not exported. =cut | |||||
411 | ||||||
412 | # This function is deprecated in 3.0 | |||||
413 | ||||||
414 | sub fixcredit { | |||||
415 | ||||||
416 | #here we update both the accountoffsets and the account lines | |||||
417 | 0 | my ( $borrowernumber, $data, $barcode, $type, $user ) = @_; | ||||
418 | 0 | my $dbh = C4::Context->dbh; | ||||
419 | 0 | my $newamtos = 0; | ||||
420 | 0 | my $accdata = ""; | ||||
421 | 0 | my $amountleft = $data; | ||||
422 | 0 | if ( $barcode ne '' ) { | ||||
423 | 0 | my $item = GetBiblioFromItemNumber( '', $barcode ); | ||||
424 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
425 | 0 | my $query = "SELECT * FROM accountlines WHERE (borrowernumber=? | ||||
426 | AND itemnumber=? AND amountoutstanding > 0)"; | |||||
427 | 0 | if ( $type eq 'CL' ) { | ||||
428 | 0 | $query .= " AND (accounttype = 'L' OR accounttype = 'Rep')"; | ||||
429 | } | |||||
430 | elsif ( $type eq 'CF' ) { | |||||
431 | 0 | $query .= " AND (accounttype = 'F' OR accounttype = 'FU' OR | ||||
432 | accounttype='Res' OR accounttype='Rent')"; | |||||
433 | } | |||||
434 | elsif ( $type eq 'CB' ) { | |||||
435 | 0 | $query .= " and accounttype='A'"; | ||||
436 | } | |||||
437 | ||||||
438 | # print $query; | |||||
439 | 0 | my $sth = $dbh->prepare($query); | ||||
440 | 0 | $sth->execute( $borrowernumber, $item->{'itemnumber'} ); | ||||
441 | 0 | $accdata = $sth->fetchrow_hashref; | ||||
442 | 0 | $sth->finish; | ||||
443 | 0 | if ( $accdata->{'amountoutstanding'} < $amountleft ) { | ||||
444 | 0 | $newamtos = 0; | ||||
445 | 0 | $amountleft -= $accdata->{'amountoutstanding'}; | ||||
446 | } | |||||
447 | else { | |||||
448 | 0 | $newamtos = $accdata->{'amountoutstanding'} - $amountleft; | ||||
449 | 0 | $amountleft = 0; | ||||
450 | } | |||||
451 | 0 | my $thisacct = $accdata->{accountno}; | ||||
452 | 0 | my $usth = $dbh->prepare( | ||||
453 | "UPDATE accountlines SET amountoutstanding= ? | |||||
454 | WHERE (borrowernumber = ?) AND (accountno=?)" | |||||
455 | ); | |||||
456 | 0 | $usth->execute( $newamtos, $borrowernumber, $thisacct ); | ||||
457 | 0 | $usth->finish; | ||||
458 | 0 | $usth = $dbh->prepare( | ||||
459 | "INSERT INTO accountoffsets | |||||
460 | (borrowernumber, accountno, offsetaccount, offsetamount) | |||||
461 | VALUES (?,?,?,?)" | |||||
462 | ); | |||||
463 | 0 | $usth->execute( $borrowernumber, $accdata->{'accountno'}, | ||||
464 | $nextaccntno, $newamtos ); | |||||
465 | 0 | $usth->finish; | ||||
466 | } | |||||
467 | ||||||
468 | # begin transaction | |||||
469 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
470 | ||||||
471 | # get lines with outstanding amounts to offset | |||||
472 | 0 | my $sth = $dbh->prepare( | ||||
473 | "SELECT * FROM accountlines | |||||
474 | WHERE (borrowernumber = ?) AND (amountoutstanding >0) | |||||
475 | ORDER BY date" | |||||
476 | ); | |||||
477 | 0 | $sth->execute($borrowernumber); | ||||
478 | ||||||
479 | # print $query; | |||||
480 | # offset transactions | |||||
481 | 0 | while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) { | ||||
482 | 0 | if ( $accdata->{'amountoutstanding'} < $amountleft ) { | ||||
483 | 0 | $newamtos = 0; | ||||
484 | 0 | $amountleft -= $accdata->{'amountoutstanding'}; | ||||
485 | } | |||||
486 | else { | |||||
487 | 0 | $newamtos = $accdata->{'amountoutstanding'} - $amountleft; | ||||
488 | 0 | $amountleft = 0; | ||||
489 | } | |||||
490 | 0 | my $thisacct = $accdata->{accountno}; | ||||
491 | 0 | my $usth = $dbh->prepare( | ||||
492 | "UPDATE accountlines SET amountoutstanding= ? | |||||
493 | WHERE (borrowernumber = ?) AND (accountno=?)" | |||||
494 | ); | |||||
495 | 0 | $usth->execute( $newamtos, $borrowernumber, $thisacct ); | ||||
496 | 0 | $usth->finish; | ||||
497 | 0 | $usth = $dbh->prepare( | ||||
498 | "INSERT INTO accountoffsets | |||||
499 | (borrowernumber, accountno, offsetaccount, offsetamount) | |||||
500 | VALUE (?,?,?,?)" | |||||
501 | ); | |||||
502 | 0 | $usth->execute( $borrowernumber, $accdata->{'accountno'}, | ||||
503 | $nextaccntno, $newamtos ); | |||||
504 | 0 | $usth->finish; | ||||
505 | } | |||||
506 | 0 | $sth->finish; | ||||
507 | 0 | $type = "Credit " . $type; | ||||
508 | 0 | UpdateStats( $user, $type, $data, $user, '', '', $borrowernumber ); | ||||
509 | 0 | $amountleft *= -1; | ||||
510 | 0 | return ($amountleft); | ||||
511 | ||||||
512 | } | |||||
513 | ||||||
514 - 521 | =head2 refund #FIXME : DEPRECATED SUB This subroutine tracks payments and/or credits against fines/charges using the accountoffsets table, which is not used consistently in Koha's fines management, and so is not used in 3.0 =cut | |||||
522 | ||||||
523 | sub refund { | |||||
524 | ||||||
525 | #here we update both the accountoffsets and the account lines | |||||
526 | 0 | my ( $borrowernumber, $data ) = @_; | ||||
527 | 0 | my $dbh = C4::Context->dbh; | ||||
528 | 0 | my $newamtos = 0; | ||||
529 | 0 | my $accdata = ""; | ||||
530 | 0 | my $amountleft = $data * -1; | ||||
531 | ||||||
532 | # begin transaction | |||||
533 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
534 | ||||||
535 | # get lines with outstanding amounts to offset | |||||
536 | 0 | my $sth = $dbh->prepare( | ||||
537 | "SELECT * FROM accountlines | |||||
538 | WHERE (borrowernumber = ?) AND (amountoutstanding<0) | |||||
539 | ORDER BY date" | |||||
540 | ); | |||||
541 | 0 | $sth->execute($borrowernumber); | ||||
542 | ||||||
543 | # print $amountleft; | |||||
544 | # offset transactions | |||||
545 | 0 | while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) { | ||||
546 | 0 | if ( $accdata->{'amountoutstanding'} > $amountleft ) { | ||||
547 | 0 | $newamtos = 0; | ||||
548 | 0 | $amountleft -= $accdata->{'amountoutstanding'}; | ||||
549 | } | |||||
550 | else { | |||||
551 | 0 | $newamtos = $accdata->{'amountoutstanding'} - $amountleft; | ||||
552 | 0 | $amountleft = 0; | ||||
553 | } | |||||
554 | ||||||
555 | # print $amountleft; | |||||
556 | 0 | my $thisacct = $accdata->{accountno}; | ||||
557 | 0 | my $usth = $dbh->prepare( | ||||
558 | "UPDATE accountlines SET amountoutstanding= ? | |||||
559 | WHERE (borrowernumber = ?) AND (accountno=?)" | |||||
560 | ); | |||||
561 | 0 | $usth->execute( $newamtos, $borrowernumber, $thisacct ); | ||||
562 | 0 | $usth->finish; | ||||
563 | 0 | $usth = $dbh->prepare( | ||||
564 | "INSERT INTO accountoffsets | |||||
565 | (borrowernumber, accountno, offsetaccount, offsetamount) | |||||
566 | VALUES (?,?,?,?)" | |||||
567 | ); | |||||
568 | 0 | $usth->execute( $borrowernumber, $accdata->{'accountno'}, | ||||
569 | $nextaccntno, $newamtos ); | |||||
570 | 0 | $usth->finish; | ||||
571 | } | |||||
572 | 0 | $sth->finish; | ||||
573 | 0 | return ($amountleft); | ||||
574 | } | |||||
575 | ||||||
576 | sub getcharges { | |||||
577 | 0 | my ( $borrowerno, $timestamp, $accountno ) = @_; | ||||
578 | 0 | my $dbh = C4::Context->dbh; | ||||
579 | 0 | my $timestamp2 = $timestamp - 1; | ||||
580 | 0 | my $query = ""; | ||||
581 | 0 | my $sth = $dbh->prepare( | ||||
582 | "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?" | |||||
583 | ); | |||||
584 | 0 | $sth->execute( $borrowerno, $accountno ); | ||||
585 | ||||||
586 | 0 | my @results; | ||||
587 | 0 | while ( my $data = $sth->fetchrow_hashref ) { | ||||
588 | 0 | push @results,$data; | ||||
589 | } | |||||
590 | 0 | return (@results); | ||||
591 | } | |||||
592 | ||||||
593 | sub ModNote { | |||||
594 | 0 | my ( $borrowernumber, $accountno, $note ) = @_; | ||||
595 | 0 | my $dbh = C4::Context->dbh; | ||||
596 | 0 | my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE borrowernumber = ? AND accountno = ?'); | ||||
597 | 0 | $sth->execute( $note, $borrowernumber, $accountno ); | ||||
598 | } | |||||
599 | ||||||
600 | sub getcredits { | |||||
601 | 0 | my ( $date, $date2 ) = @_; | ||||
602 | 0 | my $dbh = C4::Context->dbh; | ||||
603 | 0 | my $sth = $dbh->prepare( | ||||
604 | "SELECT * FROM accountlines,borrowers | |||||
605 | WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber | |||||
606 | AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)" | |||||
607 | ); | |||||
608 | ||||||
609 | 0 | $sth->execute( $date, $date2 ); | ||||
610 | 0 | my @results; | ||||
611 | 0 | while ( my $data = $sth->fetchrow_hashref ) { | ||||
612 | 0 | $data->{'date'} = $data->{'timestamp'}; | ||||
613 | 0 | push @results,$data; | ||||
614 | } | |||||
615 | 0 | return (@results); | ||||
616 | } | |||||
617 | ||||||
618 | ||||||
619 | sub getrefunds { | |||||
620 | 0 | my ( $date, $date2 ) = @_; | ||||
621 | 0 | my $dbh = C4::Context->dbh; | ||||
622 | ||||||
623 | 0 | my $sth = $dbh->prepare( | ||||
624 | "SELECT *,timestamp AS datetime | |||||
625 | FROM accountlines,borrowers | |||||
626 | WHERE (accounttype = 'REF' | |||||
627 | AND accountlines.borrowernumber = borrowers.borrowernumber | |||||
628 | AND date >=? AND date <?)" | |||||
629 | ); | |||||
630 | ||||||
631 | 0 | $sth->execute( $date, $date2 ); | ||||
632 | ||||||
633 | 0 | my @results; | ||||
634 | 0 | while ( my $data = $sth->fetchrow_hashref ) { | ||||
635 | 0 | push @results,$data; | ||||
636 | ||||||
637 | } | |||||
638 | 0 | return (@results); | ||||
639 | } | |||||
640 | ||||||
641 | sub ReversePayment { | |||||
642 | 0 | my ( $borrowernumber, $accountno ) = @_; | ||||
643 | 0 | my $dbh = C4::Context->dbh; | ||||
644 | ||||||
645 | 0 | my $sth = $dbh->prepare('SELECT amountoutstanding FROM accountlines WHERE borrowernumber = ? AND accountno = ?'); | ||||
646 | 0 | $sth->execute( $borrowernumber, $accountno ); | ||||
647 | 0 | my $row = $sth->fetchrow_hashref(); | ||||
648 | 0 | my $amount_outstanding = $row->{'amountoutstanding'}; | ||||
649 | ||||||
650 | 0 | if ( $amount_outstanding <= 0 ) { | ||||
651 | 0 | $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?'); | ||||
652 | 0 | $sth->execute( $borrowernumber, $accountno ); | ||||
653 | } else { | |||||
654 | 0 | $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?'); | ||||
655 | 0 | $sth->execute( $borrowernumber, $accountno ); | ||||
656 | } | |||||
657 | } | |||||
658 | ||||||
659 - 673 | =head2 recordpayment_selectaccts recordpayment_selectaccts($borrowernumber, $payment,$accts); Record payment by a patron. C<$borrowernumber> is the patron's borrower number. C<$payment> is a floating-point number, giving the amount that was paid. C<$accts> is an array ref to a list of accountnos which the payment can be recorded against Amounts owed are paid off oldest first. That is, if the patron has a $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment of $1.50, then the oldest fine will be paid off in full, and $0.50 will be credited to the next one. =cut | |||||
674 | ||||||
675 | sub recordpayment_selectaccts { | |||||
676 | 0 | my ( $borrowernumber, $amount, $accts ) = @_; | ||||
677 | ||||||
678 | 0 | my $dbh = C4::Context->dbh; | ||||
679 | 0 | my $newamtos = 0; | ||||
680 | 0 | my $accdata = q{}; | ||||
681 | 0 | my $branch = C4::Context->userenv->{branch}; | ||||
682 | 0 | my $amountleft = $amount; | ||||
683 | 0 | my $sql = 'SELECT * FROM accountlines WHERE (borrowernumber = ?) ' . | ||||
684 | 'AND (amountoutstanding<>0) '; | |||||
685 | 0 0 | if (@{$accts} ) { | ||||
686 | 0 0 | $sql .= ' AND accountno IN ( ' . join ',', @{$accts}; | ||||
687 | 0 | $sql .= ' ) '; | ||||
688 | } | |||||
689 | 0 | $sql .= ' ORDER BY date'; | ||||
690 | # begin transaction | |||||
691 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
692 | ||||||
693 | # get lines with outstanding amounts to offset | |||||
694 | 0 | my $rows = $dbh->selectall_arrayref($sql, { Slice => {} }, $borrowernumber); | ||||
695 | ||||||
696 | # offset transactions | |||||
697 | 0 | my $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding= ? ' . | ||||
698 | 'WHERE (borrowernumber = ?) AND (accountno=?)'); | |||||
699 | 0 0 | for my $accdata ( @{$rows} ) { | ||||
700 | 0 | if ($amountleft == 0) { | ||||
701 | 0 | last; | ||||
702 | } | |||||
703 | 0 | if ( $accdata->{amountoutstanding} < $amountleft ) { | ||||
704 | 0 | $newamtos = 0; | ||||
705 | 0 | $amountleft -= $accdata->{amountoutstanding}; | ||||
706 | } | |||||
707 | else { | |||||
708 | 0 | $newamtos = $accdata->{amountoutstanding} - $amountleft; | ||||
709 | 0 | $amountleft = 0; | ||||
710 | } | |||||
711 | 0 | my $thisacct = $accdata->{accountno}; | ||||
712 | 0 | $sth->execute( $newamtos, $borrowernumber, $thisacct ); | ||||
713 | } | |||||
714 | ||||||
715 | # create new line | |||||
716 | 0 | $sql = 'INSERT INTO accountlines ' . | ||||
717 | '(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding) ' . | |||||
718 | q|VALUES (?,?,now(),?,'Payment,thanks','Pay',?)|; | |||||
719 | 0 | $dbh->do($sql,{},$borrowernumber, $nextaccntno, 0 - $amount, 0 - $amountleft ); | ||||
720 | 0 | UpdateStats( $branch, 'payment', $amount, '', '', '', $borrowernumber, $nextaccntno ); | ||||
721 | 0 | return; | ||||
722 | } | |||||
723 | ||||||
724 | # makepayment needs to be fixed to handle partials till then this separate subroutine | |||||
725 | # fills in | |||||
726 | sub makepartialpayment { | |||||
727 | 0 | my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_; | ||||
728 | 0 | my $manager_id = 0; | ||||
729 | 0 | $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; | ||||
730 | 0 | if (!$amount || $amount < 0) { | ||||
731 | 0 | return; | ||||
732 | } | |||||
733 | 0 | my $dbh = C4::Context->dbh; | ||||
734 | ||||||
735 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
736 | 0 | my $newamtos = 0; | ||||
737 | ||||||
738 | 0 | my $data = $dbh->selectrow_hashref( | ||||
739 | 'SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?',undef,$borrowernumber,$accountno); | |||||
740 | 0 | my $new_outstanding = $data->{amountoutstanding} - $amount; | ||||
741 | ||||||
742 | 0 | my $update = 'UPDATE accountlines SET amountoutstanding = ? WHERE borrowernumber = ? ' | ||||
743 | . ' AND accountno = ?'; | |||||
744 | 0 | $dbh->do( $update, undef, $new_outstanding, $borrowernumber, $accountno); | ||||
745 | ||||||
746 | # create new line | |||||
747 | 0 | my $insert = 'INSERT INTO accountlines (borrowernumber, accountno, date, amount, ' | ||||
748 | . 'description, accounttype, amountoutstanding, itemnumber, manager_id) ' | |||||
749 | . ' VALUES (?, ?, now(), ?, ?, ?, 0, ?, ?)'; | |||||
750 | ||||||
751 | 0 | $dbh->do( $insert, undef, $borrowernumber, $nextaccntno, $amount, | ||||
752 | "Payment, thanks - $user", 'Pay', $data->{'itemnumber'}, $manager_id); | |||||
753 | ||||||
754 | 0 | UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber, $accountno ); | ||||
755 | ||||||
756 | 0 | return; | ||||
757 | } | |||||
758 | ||||||
759 | ||||||
760 | ||||||
761 | 24 | 2979 | END { } # module clean-up code here (global destructor) | |||
762 | ||||||
763 | 1; |