File: | C4/Accounts.pm |
Coverage: | 7.6% |
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 | 14 14 14 | 506 114 548 | use strict; | |||
22 | #use warnings; FIXME - Bug 2505 | |||||
23 | 14 14 14 | 151 123 277 | use C4::Context; | |||
24 | 14 14 14 | 301 79 1561 | use C4::Stats; | |||
25 | 14 14 14 | 203 120 956 | use C4::Members; | |||
26 | 14 14 14 | 143 66 995 | use C4::Circulation qw(ReturnLostItem); | |||
27 | ||||||
28 | 14 14 14 | 104 51 1793 | use vars qw($VERSION @ISA @EXPORT); | |||
29 | ||||||
30 | BEGIN { | |||||
31 | # set the version for version checking | |||||
32 | 14 | 103 | $VERSION = 3.03; | |||
33 | 14 | 165 | require Exporter; | |||
34 | 14 | 209 | @ISA = qw(Exporter); | |||
35 | 14 | 49532 | @EXPORT = qw( | |||
36 | &recordpayment | |||||
37 | &makepayment | |||||
38 | &manualinvoice | |||||
39 | &getnextacctno | |||||
40 | &reconcileaccount | |||||
41 | &getcharges | |||||
42 | &ModNote | |||||
43 | &getcredits | |||||
44 | &getrefunds | |||||
45 | &chargelostitem | |||||
46 | &ReversePayment | |||||
47 | &makepartialpayment | |||||
48 | &recordpayment_selectaccts | |||||
49 | &WriteOffFee | |||||
50 | ); | |||||
51 | } | |||||
52 | ||||||
53 - 82 | =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 | |||||
83 | ||||||
84 | #' | |||||
85 | sub recordpayment { | |||||
86 | ||||||
87 | #here we update the account lines | |||||
88 | 0 | my ( $borrowernumber, $data ) = @_; | ||||
89 | 0 | my $dbh = C4::Context->dbh; | ||||
90 | 0 | my $newamtos = 0; | ||||
91 | 0 | my $accdata = ""; | ||||
92 | 0 | my $branch = C4::Context->userenv->{'branch'}; | ||||
93 | 0 | my $amountleft = $data; | ||||
94 | ||||||
95 | # begin transaction | |||||
96 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
97 | ||||||
98 | # get lines with outstanding amounts to offset | |||||
99 | 0 | my $sth = $dbh->prepare( | ||||
100 | "SELECT * FROM accountlines | |||||
101 | WHERE (borrowernumber = ?) AND (amountoutstanding<>0) | |||||
102 | ORDER BY date" | |||||
103 | ); | |||||
104 | 0 | $sth->execute($borrowernumber); | ||||
105 | ||||||
106 | # offset transactions | |||||
107 | 0 | while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) { | ||||
108 | 0 | if ( $accdata->{'amountoutstanding'} < $amountleft ) { | ||||
109 | 0 | $newamtos = 0; | ||||
110 | 0 | $amountleft -= $accdata->{'amountoutstanding'}; | ||||
111 | } | |||||
112 | else { | |||||
113 | 0 | $newamtos = $accdata->{'amountoutstanding'} - $amountleft; | ||||
114 | 0 | $amountleft = 0; | ||||
115 | } | |||||
116 | 0 | my $thisacct = $accdata->{accountno}; | ||||
117 | 0 | my $usth = $dbh->prepare( | ||||
118 | "UPDATE accountlines SET amountoutstanding= ? | |||||
119 | WHERE (borrowernumber = ?) AND (accountno=?)" | |||||
120 | ); | |||||
121 | 0 | $usth->execute( $newamtos, $borrowernumber, $thisacct ); | ||||
122 | 0 | $usth->finish; | ||||
123 | # $usth = $dbh->prepare( | |||||
124 | # "INSERT INTO accountoffsets | |||||
125 | # (borrowernumber, accountno, offsetaccount, offsetamount) | |||||
126 | # VALUES (?,?,?,?)" | |||||
127 | # ); | |||||
128 | # $usth->execute( $borrowernumber, $accdata->{'accountno'}, | |||||
129 | # $nextaccntno, $newamtos ); | |||||
130 | 0 | $usth->finish; | ||||
131 | } | |||||
132 | ||||||
133 | # create new line | |||||
134 | 0 | my $usth = $dbh->prepare( | ||||
135 | "INSERT INTO accountlines | |||||
136 | (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding) | |||||
137 | VALUES (?,?,now(),?,'Payment,thanks','Pay',?)" | |||||
138 | ); | |||||
139 | 0 | $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft ); | ||||
140 | 0 | $usth->finish; | ||||
141 | 0 | UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno ); | ||||
142 | 0 | $sth->finish; | ||||
143 | } | |||||
144 | ||||||
145 - 158 | =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 | |||||
159 | ||||||
160 | #' | |||||
161 | # FIXME - I'm not at all sure about the above, because I don't | |||||
162 | # understand what the acct* tables in the Koha database are for. | |||||
163 | sub makepayment { | |||||
164 | ||||||
165 | #here we update both the accountoffsets and the account lines | |||||
166 | #updated to check, if they are paying off a lost item, we return the item | |||||
167 | # from their card, and put a note on the item record | |||||
168 | 0 | my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_; | ||||
169 | 0 | my $dbh = C4::Context->dbh; | ||||
170 | 0 | my $manager_id = 0; | ||||
171 | 0 | $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; | ||||
172 | ||||||
173 | # begin transaction | |||||
174 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
175 | 0 | my $newamtos = 0; | ||||
176 | 0 | my $sth = | ||||
177 | $dbh->prepare( | |||||
178 | "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?"); | |||||
179 | 0 | $sth->execute( $borrowernumber, $accountno ); | ||||
180 | 0 | my $data = $sth->fetchrow_hashref; | ||||
181 | 0 | $sth->finish; | ||||
182 | ||||||
183 | 0 | if($data->{'accounttype'} eq "Pay"){ | ||||
184 | 0 | my $udp = | ||||
185 | $dbh->prepare( | |||||
186 | "UPDATE accountlines | |||||
187 | SET amountoutstanding = 0, description = 'Payment,thanks' | |||||
188 | WHERE borrowernumber = ? | |||||
189 | AND accountno = ? | |||||
190 | " | |||||
191 | ); | |||||
192 | 0 | $udp->execute($borrowernumber, $accountno ); | ||||
193 | 0 | $udp->finish; | ||||
194 | }else{ | |||||
195 | 0 | my $udp = | ||||
196 | $dbh->prepare( | |||||
197 | "UPDATE accountlines | |||||
198 | SET amountoutstanding = 0 | |||||
199 | WHERE borrowernumber = ? | |||||
200 | AND accountno = ? | |||||
201 | " | |||||
202 | ); | |||||
203 | 0 | $udp->execute($borrowernumber, $accountno ); | ||||
204 | 0 | $udp->finish; | ||||
205 | ||||||
206 | # create new line | |||||
207 | 0 | my $payment = 0 - $amount; | ||||
208 | ||||||
209 | 0 | my $ins = | ||||
210 | $dbh->prepare( | |||||
211 | "INSERT | |||||
212 | INTO accountlines (borrowernumber, accountno, date, amount, itemnumber, description, accounttype, amountoutstanding, manager_id) | |||||
213 | VALUES ( ?, ?, now(), ?, ?, 'Payment,thanks', 'Pay', 0, ?)" | |||||
214 | ); | |||||
215 | 0 | $ins->execute($borrowernumber, $nextaccntno, $payment, $data->{'itemnumber'}, $manager_id); | ||||
216 | 0 | $ins->finish; | ||||
217 | } | |||||
218 | ||||||
219 | # FIXME - The second argument to &UpdateStats is supposed to be the | |||||
220 | # branch code. | |||||
221 | # UpdateStats is now being passed $accountno too. MTJ | |||||
222 | 0 | UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber, | ||||
223 | $accountno ); | |||||
224 | #from perldoc: for SELECT only #$sth->finish; | |||||
225 | ||||||
226 | #check to see what accounttype | |||||
227 | 0 | if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) { | ||||
228 | 0 | C4::Circulation::ReturnLostItem( $borrowernumber, $data->{'itemnumber'} ); | ||||
229 | } | |||||
230 | } | |||||
231 | ||||||
232 - 239 | =head2 getnextacctno $nextacct = &getnextacctno($borrowernumber); Returns the next unused account number for the patron with the given borrower number. =cut | |||||
240 | ||||||
241 | #' | |||||
242 | # FIXME - Okay, so what does the above actually _mean_? | |||||
243 | sub getnextacctno ($) { | |||||
244 | 0 | my ($borrowernumber) = shift or return undef; | ||||
245 | 0 | my $sth = C4::Context->dbh->prepare( | ||||
246 | "SELECT accountno+1 FROM accountlines | |||||
247 | WHERE (borrowernumber = ?) | |||||
248 | ORDER BY accountno DESC | |||||
249 | LIMIT 1" | |||||
250 | ); | |||||
251 | 0 | $sth->execute($borrowernumber); | ||||
252 | 0 | return ($sth->fetchrow || 1); | ||||
253 | } | |||||
254 | ||||||
255 - 286 | =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 | |||||
287 | ||||||
288 | sub chargelostitem{ | |||||
289 | # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for | |||||
290 | # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that | |||||
291 | # a charge has been added | |||||
292 | # FIXME : if no replacement price, borrower just doesn't get charged? | |||||
293 | 0 | my $dbh = C4::Context->dbh(); | ||||
294 | 0 | my ($borrowernumber, $itemnumber, $amount, $description) = @_; | ||||
295 | ||||||
296 | # first make sure the borrower hasn't already been charged for this item | |||||
297 | 0 | my $sth1=$dbh->prepare("SELECT * from accountlines | ||||
298 | WHERE borrowernumber=? AND itemnumber=? and accounttype='L'"); | |||||
299 | 0 | $sth1->execute($borrowernumber,$itemnumber); | ||||
300 | 0 | my $existing_charge_hashref=$sth1->fetchrow_hashref(); | ||||
301 | ||||||
302 | # OK, they haven't | |||||
303 | 0 | unless ($existing_charge_hashref) { | ||||
304 | # This item is on issue ... add replacement cost to the borrower's record and mark it returned | |||||
305 | # Note that we add this to the account even if there's no replacement price, allowing some other | |||||
306 | # process (or person) to update it, since we don't handle any defaults for replacement prices. | |||||
307 | 0 | my $accountno = getnextacctno($borrowernumber); | ||||
308 | 0 | my $sth2=$dbh->prepare("INSERT INTO accountlines | ||||
309 | (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber) | |||||
310 | VALUES (?,?,now(),?,?,'L',?,?)"); | |||||
311 | 0 | $sth2->execute($borrowernumber,$accountno,$amount, | ||||
312 | $description,$amount,$itemnumber); | |||||
313 | 0 | $sth2->finish; | ||||
314 | # FIXME: Log this ? | |||||
315 | } | |||||
316 | } | |||||
317 | ||||||
318 - 330 | =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 | |||||
331 | ||||||
332 | #' | |||||
333 | # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function | |||||
334 | # are : | |||||
335 | # 'C' = CREDIT | |||||
336 | # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere) | |||||
337 | # 'N' = New Card fee | |||||
338 | # 'F' = Fine | |||||
339 | # 'A' = Account Management fee | |||||
340 | # 'M' = Sundry | |||||
341 | # 'L' = Lost Item | |||||
342 | # | |||||
343 | ||||||
344 | sub manualinvoice { | |||||
345 | 0 | my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_; | ||||
346 | 0 | my $manager_id = 0; | ||||
347 | 0 | $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; | ||||
348 | 0 | my $dbh = C4::Context->dbh; | ||||
349 | 0 | my $notifyid = 0; | ||||
350 | 0 | my $insert; | ||||
351 | 0 | my $accountno = getnextacctno($borrowernumber); | ||||
352 | 0 | my $amountleft = $amount; | ||||
353 | ||||||
354 | # if ( $type eq 'CS' | |||||
355 | # || $type eq 'CB' | |||||
356 | # || $type eq 'CW' | |||||
357 | # || $type eq 'CF' | |||||
358 | # || $type eq 'CL' ) | |||||
359 | # { | |||||
360 | # my $amount2 = $amount * -1; # FIXME - $amount2 = -$amount | |||||
361 | # $amountleft = | |||||
362 | # fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user ); | |||||
363 | # } | |||||
364 | 0 | if ( $type eq 'N' ) { | ||||
365 | 0 | $desc .= " New Card"; | ||||
366 | } | |||||
367 | 0 | if ( $type eq 'F' ) { | ||||
368 | 0 | $desc .= " Fine"; | ||||
369 | } | |||||
370 | 0 | if ( $type eq 'A' ) { | ||||
371 | 0 | $desc .= " Account Management fee"; | ||||
372 | } | |||||
373 | 0 | if ( $type eq 'M' ) { | ||||
374 | 0 | $desc .= " Sundry"; | ||||
375 | } | |||||
376 | ||||||
377 | 0 | if ( $type eq 'L' && $desc eq '' ) { | ||||
378 | ||||||
379 | 0 | $desc = " Lost Item"; | ||||
380 | } | |||||
381 | # if ( $type eq 'REF' ) { | |||||
382 | # $desc .= " Cash Refund"; | |||||
383 | # $amountleft = refund( '', $borrowernumber, $amount ); | |||||
384 | # } | |||||
385 | 0 | if ( ( $type eq 'L' ) | ||||
386 | or ( $type eq 'F' ) | |||||
387 | or ( $type eq 'A' ) | |||||
388 | or ( $type eq 'N' ) | |||||
389 | or ( $type eq 'M' ) ) | |||||
390 | { | |||||
391 | 0 | $notifyid = 1; | ||||
392 | } | |||||
393 | ||||||
394 | 0 | if ( $itemnum ) { | ||||
395 | 0 | $desc .= ' ' . $itemnum; | ||||
396 | 0 | my $sth = $dbh->prepare( | ||||
397 | 'INSERT INTO accountlines | |||||
398 | (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id) | |||||
399 | VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)'); | |||||
400 | 0 | $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr; | ||||
401 | } else { | |||||
402 | 0 | my $sth=$dbh->prepare("INSERT INTO accountlines | ||||
403 | (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id) | |||||
404 | VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)" | |||||
405 | ); | |||||
406 | 0 | $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type, | ||||
407 | $amountleft, $notifyid, $note, $manager_id ); | |||||
408 | } | |||||
409 | 0 | return 0; | ||||
410 | } | |||||
411 | ||||||
412 - 418 | =head2 fixcredit #### DEPRECATED $amountleft = &fixcredit($borrowernumber, $data, $barcode, $type, $user); This function is only used internally, not exported. =cut | |||||
419 | ||||||
420 | # This function is deprecated in 3.0 | |||||
421 | ||||||
422 | sub fixcredit { | |||||
423 | ||||||
424 | #here we update both the accountoffsets and the account lines | |||||
425 | 0 | my ( $borrowernumber, $data, $barcode, $type, $user ) = @_; | ||||
426 | 0 | my $dbh = C4::Context->dbh; | ||||
427 | 0 | my $newamtos = 0; | ||||
428 | 0 | my $accdata = ""; | ||||
429 | 0 | my $amountleft = $data; | ||||
430 | 0 | if ( $barcode ne '' ) { | ||||
431 | 0 | my $item = GetBiblioFromItemNumber( '', $barcode ); | ||||
432 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
433 | 0 | my $query = "SELECT * FROM accountlines WHERE (borrowernumber=? | ||||
434 | AND itemnumber=? AND amountoutstanding > 0)"; | |||||
435 | 0 | if ( $type eq 'CL' ) { | ||||
436 | 0 | $query .= " AND (accounttype = 'L' OR accounttype = 'Rep')"; | ||||
437 | } | |||||
438 | elsif ( $type eq 'CF' ) { | |||||
439 | 0 | $query .= " AND (accounttype = 'F' OR accounttype = 'FU' OR | ||||
440 | accounttype='Res' OR accounttype='Rent')"; | |||||
441 | } | |||||
442 | elsif ( $type eq 'CB' ) { | |||||
443 | 0 | $query .= " and accounttype='A'"; | ||||
444 | } | |||||
445 | ||||||
446 | # print $query; | |||||
447 | 0 | my $sth = $dbh->prepare($query); | ||||
448 | 0 | $sth->execute( $borrowernumber, $item->{'itemnumber'} ); | ||||
449 | 0 | $accdata = $sth->fetchrow_hashref; | ||||
450 | 0 | $sth->finish; | ||||
451 | 0 | if ( $accdata->{'amountoutstanding'} < $amountleft ) { | ||||
452 | 0 | $newamtos = 0; | ||||
453 | 0 | $amountleft -= $accdata->{'amountoutstanding'}; | ||||
454 | } | |||||
455 | else { | |||||
456 | 0 | $newamtos = $accdata->{'amountoutstanding'} - $amountleft; | ||||
457 | 0 | $amountleft = 0; | ||||
458 | } | |||||
459 | 0 | my $thisacct = $accdata->{accountno}; | ||||
460 | 0 | my $usth = $dbh->prepare( | ||||
461 | "UPDATE accountlines SET amountoutstanding= ? | |||||
462 | WHERE (borrowernumber = ?) AND (accountno=?)" | |||||
463 | ); | |||||
464 | 0 | $usth->execute( $newamtos, $borrowernumber, $thisacct ); | ||||
465 | 0 | $usth->finish; | ||||
466 | 0 | $usth = $dbh->prepare( | ||||
467 | "INSERT INTO accountoffsets | |||||
468 | (borrowernumber, accountno, offsetaccount, offsetamount) | |||||
469 | VALUES (?,?,?,?)" | |||||
470 | ); | |||||
471 | 0 | $usth->execute( $borrowernumber, $accdata->{'accountno'}, | ||||
472 | $nextaccntno, $newamtos ); | |||||
473 | 0 | $usth->finish; | ||||
474 | } | |||||
475 | ||||||
476 | # begin transaction | |||||
477 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
478 | ||||||
479 | # get lines with outstanding amounts to offset | |||||
480 | 0 | my $sth = $dbh->prepare( | ||||
481 | "SELECT * FROM accountlines | |||||
482 | WHERE (borrowernumber = ?) AND (amountoutstanding >0) | |||||
483 | ORDER BY date" | |||||
484 | ); | |||||
485 | 0 | $sth->execute($borrowernumber); | ||||
486 | ||||||
487 | # print $query; | |||||
488 | # offset transactions | |||||
489 | 0 | while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) { | ||||
490 | 0 | if ( $accdata->{'amountoutstanding'} < $amountleft ) { | ||||
491 | 0 | $newamtos = 0; | ||||
492 | 0 | $amountleft -= $accdata->{'amountoutstanding'}; | ||||
493 | } | |||||
494 | else { | |||||
495 | 0 | $newamtos = $accdata->{'amountoutstanding'} - $amountleft; | ||||
496 | 0 | $amountleft = 0; | ||||
497 | } | |||||
498 | 0 | my $thisacct = $accdata->{accountno}; | ||||
499 | 0 | my $usth = $dbh->prepare( | ||||
500 | "UPDATE accountlines SET amountoutstanding= ? | |||||
501 | WHERE (borrowernumber = ?) AND (accountno=?)" | |||||
502 | ); | |||||
503 | 0 | $usth->execute( $newamtos, $borrowernumber, $thisacct ); | ||||
504 | 0 | $usth->finish; | ||||
505 | 0 | $usth = $dbh->prepare( | ||||
506 | "INSERT INTO accountoffsets | |||||
507 | (borrowernumber, accountno, offsetaccount, offsetamount) | |||||
508 | VALUE (?,?,?,?)" | |||||
509 | ); | |||||
510 | 0 | $usth->execute( $borrowernumber, $accdata->{'accountno'}, | ||||
511 | $nextaccntno, $newamtos ); | |||||
512 | 0 | $usth->finish; | ||||
513 | } | |||||
514 | 0 | $sth->finish; | ||||
515 | 0 | $type = "Credit " . $type; | ||||
516 | 0 | UpdateStats( $user, $type, $data, $user, '', '', $borrowernumber ); | ||||
517 | 0 | $amountleft *= -1; | ||||
518 | 0 | return ($amountleft); | ||||
519 | ||||||
520 | } | |||||
521 | ||||||
522 - 529 | =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 | |||||
530 | ||||||
531 | sub refund { | |||||
532 | ||||||
533 | #here we update both the accountoffsets and the account lines | |||||
534 | 0 | my ( $borrowernumber, $data ) = @_; | ||||
535 | 0 | my $dbh = C4::Context->dbh; | ||||
536 | 0 | my $newamtos = 0; | ||||
537 | 0 | my $accdata = ""; | ||||
538 | 0 | my $amountleft = $data * -1; | ||||
539 | ||||||
540 | # begin transaction | |||||
541 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
542 | ||||||
543 | # get lines with outstanding amounts to offset | |||||
544 | 0 | my $sth = $dbh->prepare( | ||||
545 | "SELECT * FROM accountlines | |||||
546 | WHERE (borrowernumber = ?) AND (amountoutstanding<0) | |||||
547 | ORDER BY date" | |||||
548 | ); | |||||
549 | 0 | $sth->execute($borrowernumber); | ||||
550 | ||||||
551 | # print $amountleft; | |||||
552 | # offset transactions | |||||
553 | 0 | while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) { | ||||
554 | 0 | if ( $accdata->{'amountoutstanding'} > $amountleft ) { | ||||
555 | 0 | $newamtos = 0; | ||||
556 | 0 | $amountleft -= $accdata->{'amountoutstanding'}; | ||||
557 | } | |||||
558 | else { | |||||
559 | 0 | $newamtos = $accdata->{'amountoutstanding'} - $amountleft; | ||||
560 | 0 | $amountleft = 0; | ||||
561 | } | |||||
562 | ||||||
563 | # print $amountleft; | |||||
564 | 0 | my $thisacct = $accdata->{accountno}; | ||||
565 | 0 | my $usth = $dbh->prepare( | ||||
566 | "UPDATE accountlines SET amountoutstanding= ? | |||||
567 | WHERE (borrowernumber = ?) AND (accountno=?)" | |||||
568 | ); | |||||
569 | 0 | $usth->execute( $newamtos, $borrowernumber, $thisacct ); | ||||
570 | 0 | $usth->finish; | ||||
571 | 0 | $usth = $dbh->prepare( | ||||
572 | "INSERT INTO accountoffsets | |||||
573 | (borrowernumber, accountno, offsetaccount, offsetamount) | |||||
574 | VALUES (?,?,?,?)" | |||||
575 | ); | |||||
576 | 0 | $usth->execute( $borrowernumber, $accdata->{'accountno'}, | ||||
577 | $nextaccntno, $newamtos ); | |||||
578 | 0 | $usth->finish; | ||||
579 | } | |||||
580 | 0 | $sth->finish; | ||||
581 | 0 | return ($amountleft); | ||||
582 | } | |||||
583 | ||||||
584 | sub getcharges { | |||||
585 | 0 | my ( $borrowerno, $timestamp, $accountno ) = @_; | ||||
586 | 0 | my $dbh = C4::Context->dbh; | ||||
587 | 0 | my $timestamp2 = $timestamp - 1; | ||||
588 | 0 | my $query = ""; | ||||
589 | 0 | my $sth = $dbh->prepare( | ||||
590 | "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?" | |||||
591 | ); | |||||
592 | 0 | $sth->execute( $borrowerno, $accountno ); | ||||
593 | ||||||
594 | 0 | my @results; | ||||
595 | 0 | while ( my $data = $sth->fetchrow_hashref ) { | ||||
596 | 0 | push @results,$data; | ||||
597 | } | |||||
598 | 0 | return (@results); | ||||
599 | } | |||||
600 | ||||||
601 | sub ModNote { | |||||
602 | 0 | my ( $borrowernumber, $accountno, $note ) = @_; | ||||
603 | 0 | my $dbh = C4::Context->dbh; | ||||
604 | 0 | my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE borrowernumber = ? AND accountno = ?'); | ||||
605 | 0 | $sth->execute( $note, $borrowernumber, $accountno ); | ||||
606 | } | |||||
607 | ||||||
608 | sub getcredits { | |||||
609 | 0 | my ( $date, $date2 ) = @_; | ||||
610 | 0 | my $dbh = C4::Context->dbh; | ||||
611 | 0 | my $sth = $dbh->prepare( | ||||
612 | "SELECT * FROM accountlines,borrowers | |||||
613 | WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber | |||||
614 | AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)" | |||||
615 | ); | |||||
616 | ||||||
617 | 0 | $sth->execute( $date, $date2 ); | ||||
618 | 0 | my @results; | ||||
619 | 0 | while ( my $data = $sth->fetchrow_hashref ) { | ||||
620 | 0 | $data->{'date'} = $data->{'timestamp'}; | ||||
621 | 0 | push @results,$data; | ||||
622 | } | |||||
623 | 0 | return (@results); | ||||
624 | } | |||||
625 | ||||||
626 | ||||||
627 | sub getrefunds { | |||||
628 | 0 | my ( $date, $date2 ) = @_; | ||||
629 | 0 | my $dbh = C4::Context->dbh; | ||||
630 | ||||||
631 | 0 | my $sth = $dbh->prepare( | ||||
632 | "SELECT *,timestamp AS datetime | |||||
633 | FROM accountlines,borrowers | |||||
634 | WHERE (accounttype = 'REF' | |||||
635 | AND accountlines.borrowernumber = borrowers.borrowernumber | |||||
636 | AND date >=? AND date <?)" | |||||
637 | ); | |||||
638 | ||||||
639 | 0 | $sth->execute( $date, $date2 ); | ||||
640 | ||||||
641 | 0 | my @results; | ||||
642 | 0 | while ( my $data = $sth->fetchrow_hashref ) { | ||||
643 | 0 | push @results,$data; | ||||
644 | ||||||
645 | } | |||||
646 | 0 | return (@results); | ||||
647 | } | |||||
648 | ||||||
649 | sub ReversePayment { | |||||
650 | 0 | my ( $borrowernumber, $accountno ) = @_; | ||||
651 | 0 | my $dbh = C4::Context->dbh; | ||||
652 | ||||||
653 | 0 | my $sth = $dbh->prepare('SELECT amountoutstanding FROM accountlines WHERE borrowernumber = ? AND accountno = ?'); | ||||
654 | 0 | $sth->execute( $borrowernumber, $accountno ); | ||||
655 | 0 | my $row = $sth->fetchrow_hashref(); | ||||
656 | 0 | my $amount_outstanding = $row->{'amountoutstanding'}; | ||||
657 | ||||||
658 | 0 | if ( $amount_outstanding <= 0 ) { | ||||
659 | 0 | $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?'); | ||||
660 | 0 | $sth->execute( $borrowernumber, $accountno ); | ||||
661 | } else { | |||||
662 | 0 | $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?'); | ||||
663 | 0 | $sth->execute( $borrowernumber, $accountno ); | ||||
664 | } | |||||
665 | } | |||||
666 | ||||||
667 - 681 | =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 | |||||
682 | ||||||
683 | sub recordpayment_selectaccts { | |||||
684 | 0 | my ( $borrowernumber, $amount, $accts ) = @_; | ||||
685 | ||||||
686 | 0 | my $dbh = C4::Context->dbh; | ||||
687 | 0 | my $newamtos = 0; | ||||
688 | 0 | my $accdata = q{}; | ||||
689 | 0 | my $branch = C4::Context->userenv->{branch}; | ||||
690 | 0 | my $amountleft = $amount; | ||||
691 | 0 | my $sql = 'SELECT * FROM accountlines WHERE (borrowernumber = ?) ' . | ||||
692 | 'AND (amountoutstanding<>0) '; | |||||
693 | 0 0 | if (@{$accts} ) { | ||||
694 | 0 0 | $sql .= ' AND accountno IN ( ' . join ',', @{$accts}; | ||||
695 | 0 | $sql .= ' ) '; | ||||
696 | } | |||||
697 | 0 | $sql .= ' ORDER BY date'; | ||||
698 | # begin transaction | |||||
699 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
700 | ||||||
701 | # get lines with outstanding amounts to offset | |||||
702 | 0 | my $rows = $dbh->selectall_arrayref($sql, { Slice => {} }, $borrowernumber); | ||||
703 | ||||||
704 | # offset transactions | |||||
705 | 0 | my $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding= ? ' . | ||||
706 | 'WHERE (borrowernumber = ?) AND (accountno=?)'); | |||||
707 | 0 0 | for my $accdata ( @{$rows} ) { | ||||
708 | 0 | if ($amountleft == 0) { | ||||
709 | 0 | last; | ||||
710 | } | |||||
711 | 0 | if ( $accdata->{amountoutstanding} < $amountleft ) { | ||||
712 | 0 | $newamtos = 0; | ||||
713 | 0 | $amountleft -= $accdata->{amountoutstanding}; | ||||
714 | } | |||||
715 | else { | |||||
716 | 0 | $newamtos = $accdata->{amountoutstanding} - $amountleft; | ||||
717 | 0 | $amountleft = 0; | ||||
718 | } | |||||
719 | 0 | my $thisacct = $accdata->{accountno}; | ||||
720 | 0 | $sth->execute( $newamtos, $borrowernumber, $thisacct ); | ||||
721 | } | |||||
722 | ||||||
723 | # create new line | |||||
724 | 0 | $sql = 'INSERT INTO accountlines ' . | ||||
725 | '(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding) ' . | |||||
726 | q|VALUES (?,?,now(),?,'Payment,thanks','Pay',?)|; | |||||
727 | 0 | $dbh->do($sql,{},$borrowernumber, $nextaccntno, 0 - $amount, 0 - $amountleft ); | ||||
728 | 0 | UpdateStats( $branch, 'payment', $amount, '', '', '', $borrowernumber, $nextaccntno ); | ||||
729 | 0 | return; | ||||
730 | } | |||||
731 | ||||||
732 | # makepayment needs to be fixed to handle partials till then this separate subroutine | |||||
733 | # fills in | |||||
734 | sub makepartialpayment { | |||||
735 | 0 | my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_; | ||||
736 | 0 | my $manager_id = 0; | ||||
737 | 0 | $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; | ||||
738 | 0 | if (!$amount || $amount < 0) { | ||||
739 | 0 | return; | ||||
740 | } | |||||
741 | 0 | my $dbh = C4::Context->dbh; | ||||
742 | ||||||
743 | 0 | my $nextaccntno = getnextacctno($borrowernumber); | ||||
744 | 0 | my $newamtos = 0; | ||||
745 | ||||||
746 | 0 | my $data = $dbh->selectrow_hashref( | ||||
747 | 'SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?',undef,$borrowernumber,$accountno); | |||||
748 | 0 | my $new_outstanding = $data->{amountoutstanding} - $amount; | ||||
749 | ||||||
750 | 0 | my $update = 'UPDATE accountlines SET amountoutstanding = ? WHERE borrowernumber = ? ' | ||||
751 | . ' AND accountno = ?'; | |||||
752 | 0 | $dbh->do( $update, undef, $new_outstanding, $borrowernumber, $accountno); | ||||
753 | ||||||
754 | # create new line | |||||
755 | 0 | my $insert = 'INSERT INTO accountlines (borrowernumber, accountno, date, amount, ' | ||||
756 | . 'description, accounttype, amountoutstanding, itemnumber, manager_id) ' | |||||
757 | . ' VALUES (?, ?, now(), ?, ?, ?, 0, ?, ?)'; | |||||
758 | ||||||
759 | 0 | $dbh->do( $insert, undef, $borrowernumber, $nextaccntno, $amount, | ||||
760 | "Payment, thanks - $user", 'Pay', $data->{'itemnumber'}, $manager_id); | |||||
761 | ||||||
762 | 0 | UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber, $accountno ); | ||||
763 | ||||||
764 | 0 | return; | ||||
765 | } | |||||
766 | ||||||
767 - 779 | =head2 WriteOff WriteOff( $borrowernumber, $accountnum, $itemnum, $accounttype, $amount, $branch ); Write off a fine for a patron. C<$borrowernumber> is the patron's borrower number. C<$accountnum> is the accountnumber of the fee to write off. C<$itemnum> is the itemnumber of of item whose fine is being written off. C<$accounttype> is the account type of the fine being written off. C<$amount> is a floating-point number, giving the amount that is being written off. C<$branch> is the branchcode of the library where the writeoff occurred. =cut | |||||
780 | ||||||
781 | sub WriteOffFee { | |||||
782 | 0 | my ( $borrowernumber, $accountnum, $itemnum, $accounttype, $amount, $branch ) = @_; | ||||
783 | 0 | $branch ||= C4::Context->userenv->{branch}; | ||||
784 | 0 | my $manager_id = 0; | ||||
785 | 0 | $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; | ||||
786 | ||||||
787 | # if no item is attached to fine, make sure to store it as a NULL | |||||
788 | 0 | $itemnum ||= undef; | ||||
789 | ||||||
790 | 0 | my ( $sth, $query ); | ||||
791 | 0 | my $dbh = C4::Context->dbh(); | ||||
792 | ||||||
793 | 0 | $query = " | ||||
794 | UPDATE accountlines SET amountoutstanding = 0 | |||||
795 | WHERE accountno = ? AND borrowernumber = ? | |||||
796 | "; | |||||
797 | 0 | $sth = $dbh->prepare( $query ); | ||||
798 | 0 | $sth->execute( $accountnum, $borrowernumber ); | ||||
799 | ||||||
800 | 0 | $query =" | ||||
801 | INSERT INTO accountlines | |||||
802 | ( borrowernumber, accountno, itemnumber, date, amount, description, accounttype, manager_id ) | |||||
803 | VALUES ( ?, ?, ?, NOW(), ?, 'Writeoff', 'W', ? ) | |||||
804 | "; | |||||
805 | 0 | $sth = $dbh->prepare( $query ); | ||||
806 | 0 | my $acct = getnextacctno($borrowernumber); | ||||
807 | 0 | $sth->execute( $borrowernumber, $acct, $itemnum, $amount, $manager_id ); | ||||
808 | ||||||
809 | 0 | UpdateStats( $branch, 'writeoff', $amount, q{}, q{}, q{}, $borrowernumber ); | ||||
810 | ||||||
811 | } | |||||
812 | ||||||
813 | 14 | 1234 | END { } # module clean-up code here (global destructor) | |||
814 | ||||||
815 | 1; |