← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:50 2015

Filename/mnt/catalyst/koha/C4/Accounts.pm
StatementsExecuted 22 statements in 2.63ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111462µs476µsC4::Accounts::::BEGIN@21C4::Accounts::BEGIN@21
11110µs10µsC4::Accounts::::BEGIN@33C4::Accounts::BEGIN@33
11110µs92µsC4::Accounts::::BEGIN@24C4::Accounts::BEGIN@24
1119µs12µsC4::Accounts::::BEGIN@23C4::Accounts::BEGIN@23
1118µs43µsC4::Accounts::::BEGIN@31C4::Accounts::BEGIN@31
1118µs48µsC4::Accounts::::BEGIN@27C4::Accounts::BEGIN@27
1118µs26µsC4::Accounts::::BEGIN@29C4::Accounts::BEGIN@29
1116µs6µsC4::Accounts::::BEGIN@25C4::Accounts::BEGIN@25
1114µs4µsC4::Accounts::::BEGIN@26C4::Accounts::BEGIN@26
1113µs3µsC4::Accounts::::ENDC4::Accounts::END
0000s0sC4::Accounts::::ModNoteC4::Accounts::ModNote
0000s0sC4::Accounts::::ReversePaymentC4::Accounts::ReversePayment
0000s0sC4::Accounts::::WriteOffFeeC4::Accounts::WriteOffFee
0000s0sC4::Accounts::::chargelostitemC4::Accounts::chargelostitem
0000s0sC4::Accounts::::getchargesC4::Accounts::getcharges
0000s0sC4::Accounts::::getcreditsC4::Accounts::getcredits
0000s0sC4::Accounts::::getnextacctnoC4::Accounts::getnextacctno
0000s0sC4::Accounts::::getrefundsC4::Accounts::getrefunds
0000s0sC4::Accounts::::makepartialpaymentC4::Accounts::makepartialpayment
0000s0sC4::Accounts::::makepaymentC4::Accounts::makepayment
0000s0sC4::Accounts::::manualinvoiceC4::Accounts::manualinvoice
0000s0sC4::Accounts::::recordpaymentC4::Accounts::recordpayment
0000s0sC4::Accounts::::recordpayment_selectacctsC4::Accounts::recordpayment_selectaccts
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package 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
21232µs2490µs
# spent 476µs (462+14) within C4::Accounts::BEGIN@21 which was called: # once (462µs+14µs) by C4::Reserves::BEGIN@31 at line 21
use strict;
# spent 476µs making 1 call to C4::Accounts::BEGIN@21 # spent 14µs making 1 call to strict::import
22#use warnings; FIXME - Bug 2505
23221µs214µs
# spent 12µs (9+3) within C4::Accounts::BEGIN@23 which was called: # once (9µs+3µs) by C4::Reserves::BEGIN@31 at line 23
use C4::Context;
# spent 12µs making 1 call to C4::Accounts::BEGIN@23 # spent 3µs making 1 call to C4::Context::import
24226µs2175µs
# spent 92µs (10+83) within C4::Accounts::BEGIN@24 which was called: # once (10µs+83µs) by C4::Reserves::BEGIN@31 at line 24
use C4::Stats;
# spent 92µs making 1 call to C4::Accounts::BEGIN@24 # spent 83µs making 1 call to Exporter::import
25223µs16µs
# spent 6µs within C4::Accounts::BEGIN@25 which was called: # once (6µs+0s) by C4::Reserves::BEGIN@31 at line 25
use C4::Members;
# spent 6µs making 1 call to C4::Accounts::BEGIN@25
26220µs14µs
# spent 4µs within C4::Accounts::BEGIN@26 which was called: # once (4µs+0s) by C4::Reserves::BEGIN@31 at line 26
use C4::Circulation qw(ReturnLostItem);
# spent 4µs making 1 call to C4::Accounts::BEGIN@26
27223µs289µs
# spent 48µs (8+41) within C4::Accounts::BEGIN@27 which was called: # once (8µs+41µs) by C4::Reserves::BEGIN@31 at line 27
use C4::Log qw(logaction);
# spent 48µs making 1 call to C4::Accounts::BEGIN@27 # spent 41µs making 1 call to Exporter::import
28
29224µs244µs
# spent 26µs (8+18) within C4::Accounts::BEGIN@29 which was called: # once (8µs+18µs) by C4::Reserves::BEGIN@31 at line 29
use Data::Dumper qw(Dumper);
# spent 26µs making 1 call to C4::Accounts::BEGIN@29 # spent 18µs making 1 call to Exporter::import
30
31260µs278µs
# spent 43µs (8+35) within C4::Accounts::BEGIN@31 which was called: # once (8µs+35µs) by C4::Reserves::BEGIN@31 at line 31
use vars qw($VERSION @ISA @EXPORT);
# spent 43µs making 1 call to C4::Accounts::BEGIN@31 # spent 35µs making 1 call to vars::import
32
33
# spent 10µs within C4::Accounts::BEGIN@33 which was called: # once (10µs+0s) by C4::Reserves::BEGIN@31 at line 53
BEGIN {
34 # set the version for version checking
351800ns $VERSION = 3.07.00.049;
361400ns require Exporter;
3715µs @ISA = qw(Exporter);
3814µs @EXPORT = qw(
39 &recordpayment
40 &makepayment
41 &manualinvoice
42 &getnextacctno
43 &getcharges
44 &ModNote
45 &getcredits
46 &getrefunds
47 &chargelostitem
48 &ReversePayment
49 &makepartialpayment
50 &recordpayment_selectaccts
51 &WriteOffFee
52 );
5312.38ms110µs}
# spent 10µs making 1 call to C4::Accounts::BEGIN@33
54
55=head1 NAME
56
57C4::Accounts - Functions for dealing with Koha accounts
58
59=head1 SYNOPSIS
60
61use C4::Accounts;
62
63=head1 DESCRIPTION
64
65The functions in this module deal with the monetary aspect of Koha,
66including looking up and modifying the amount of money owed by a
67patron.
68
69=head1 FUNCTIONS
70
71=head2 recordpayment
72
73 &recordpayment($borrowernumber, $payment);
74
75Record payment by a patron. C<$borrowernumber> is the patron's
76borrower number. C<$payment> is a floating-point number, giving the
77amount that was paid.
78
79Amounts owed are paid off oldest first. That is, if the patron has a
80$1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
81of $1.50, then the oldest fine will be paid off in full, and $0.50
82will be credited to the next one.
83
84=cut
85
86#'
87sub recordpayment {
88
89 #here we update the account lines
90 my ( $borrowernumber, $data ) = @_;
91 my $dbh = C4::Context->dbh;
92 my $newamtos = 0;
93 my $accdata = "";
94 my $branch = C4::Context->userenv->{'branch'};
95 my $amountleft = $data;
96 my $manager_id = 0;
97 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
98
99 # begin transaction
100 my $nextaccntno = getnextacctno($borrowernumber);
101
102 # get lines with outstanding amounts to offset
103 my $sth = $dbh->prepare(
104 "SELECT * FROM accountlines
105 WHERE (borrowernumber = ?) AND (amountoutstanding<>0)
106 ORDER BY date"
107 );
108 $sth->execute($borrowernumber);
109
110 # offset transactions
111 my @ids;
112 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
113 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
114 $newamtos = 0;
115 $amountleft -= $accdata->{'amountoutstanding'};
116 }
117 else {
118 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
119 $amountleft = 0;
120 }
121 my $thisacct = $accdata->{accountlines_id};
122 my $usth = $dbh->prepare(
123 "UPDATE accountlines SET amountoutstanding= ?
124 WHERE (accountlines_id = ?)"
125 );
126 $usth->execute( $newamtos, $thisacct );
127
128 if ( C4::Context->preference("FinesLog") ) {
129 $accdata->{'amountoutstanding_new'} = $newamtos;
130 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
131 action => 'fee_payment',
132 borrowernumber => $accdata->{'borrowernumber'},
133 old_amountoutstanding => $accdata->{'amountoutstanding'},
134 new_amountoutstanding => $newamtos,
135 amount_paid => $accdata->{'amountoutstanding'} - $newamtos,
136 accountlines_id => $accdata->{'accountlines_id'},
137 accountno => $accdata->{'accountno'},
138 manager_id => $manager_id,
139 }));
140 push( @ids, $accdata->{'accountlines_id'} );
141 }
142 }
143
144 # create new line
145 my $usth = $dbh->prepare(
146 "INSERT INTO accountlines
147 (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id)
148 VALUES (?,?,now(),?,'','Pay',?,?)"
149 );
150 $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft, $manager_id );
151
152 UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno );
153
154 if ( C4::Context->preference("FinesLog") ) {
155 $accdata->{'amountoutstanding_new'} = $newamtos;
156 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
157 action => 'create_payment',
158 borrowernumber => $borrowernumber,
159 accountno => $nextaccntno,
160 amount => $data * -1,
161 amountoutstanding => $amountleft * -1,
162 accounttype => 'Pay',
163 accountlines_paid => \@ids,
164 manager_id => $manager_id,
165 }));
166 }
167
168}
169
170=head2 makepayment
171
172 &makepayment($accountlines_id, $borrowernumber, $acctnumber, $amount, $branchcode);
173
174Records the fact that a patron has paid off the entire amount he or
175she owes.
176
177C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is
178the account that was credited. C<$amount> is the amount paid (this is
179only used to record the payment. It is assumed to be equal to the
180amount owed). C<$branchcode> is the code of the branch where payment
181was made.
182
183=cut
184
185#'
186# FIXME - I'm not at all sure about the above, because I don't
187# understand what the acct* tables in the Koha database are for.
188sub makepayment {
189
190 #here we update both the accountoffsets and the account lines
191 #updated to check, if they are paying off a lost item, we return the item
192 # from their card, and put a note on the item record
193 my ( $accountlines_id, $borrowernumber, $accountno, $amount, $user, $branch, $payment_note ) = @_;
194 my $dbh = C4::Context->dbh;
195 my $manager_id = 0;
196 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
197
198 # begin transaction
199 my $nextaccntno = getnextacctno($borrowernumber);
200 my $newamtos = 0;
201 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE accountlines_id=?");
202 $sth->execute( $accountlines_id );
203 my $data = $sth->fetchrow_hashref;
204
205 my $payment;
206 if ( $data->{'accounttype'} eq "Pay" ){
207 my $udp =
208 $dbh->prepare(
209 "UPDATE accountlines
210 SET amountoutstanding = 0
211 WHERE accountlines_id = ?
212 "
213 );
214 $udp->execute($accountlines_id);
215 }else{
216 my $udp =
217 $dbh->prepare(
218 "UPDATE accountlines
219 SET amountoutstanding = 0
220 WHERE accountlines_id = ?
221 "
222 );
223 $udp->execute($accountlines_id);
224
225 # create new line
226 my $payment = 0 - $amount;
227 $payment_note //= "";
228
229 my $ins =
230 $dbh->prepare(
231 "INSERT
232 INTO accountlines (borrowernumber, accountno, date, amount, itemnumber, description, accounttype, amountoutstanding, manager_id, note)
233 VALUES ( ?, ?, now(), ?, ?, '', 'Pay', 0, ?, ?)"
234 );
235 $ins->execute($borrowernumber, $nextaccntno, $payment, $data->{'itemnumber'}, $manager_id, $payment_note);
236 }
237
238 if ( C4::Context->preference("FinesLog") ) {
239 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
240 action => 'fee_payment',
241 borrowernumber => $borrowernumber,
242 old_amountoutstanding => $data->{'amountoutstanding'},
243 new_amountoutstanding => 0,
244 amount_paid => $data->{'amountoutstanding'},
245 accountlines_id => $data->{'accountlines_id'},
246 accountno => $data->{'accountno'},
247 manager_id => $manager_id,
248 }));
249
250
251 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
252 action => 'create_payment',
253 borrowernumber => $borrowernumber,
254 accountno => $nextaccntno,
255 amount => $payment,
256 amountoutstanding => 0,,
257 accounttype => 'Pay',
258 accountlines_paid => [$data->{'accountlines_id'}],
259 manager_id => $manager_id,
260 }));
261 }
262
263
264 # FIXME - The second argument to &UpdateStats is supposed to be the
265 # branch code.
266 # UpdateStats is now being passed $accountno too. MTJ
267 UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber,
268 $accountno );
269
270 #check to see what accounttype
271 if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
272 C4::Circulation::ReturnLostItem( $borrowernumber, $data->{'itemnumber'} );
273 }
274 my $sthr = $dbh->prepare("SELECT max(accountlines_id) AS lastinsertid FROM accountlines");
275 $sthr->execute();
276 my $datalastinsertid = $sthr->fetchrow_hashref;
277 return $datalastinsertid->{'lastinsertid'};
278}
279
280=head2 getnextacctno
281
282 $nextacct = &getnextacctno($borrowernumber);
283
284Returns the next unused account number for the patron with the given
285borrower number.
286
287=cut
288
289#'
290# FIXME - Okay, so what does the above actually _mean_?
291sub getnextacctno {
292 my ($borrowernumber) = shift or return;
293 my $sth = C4::Context->dbh->prepare(
294 "SELECT accountno+1 FROM accountlines
295 WHERE (borrowernumber = ?)
296 ORDER BY accountno DESC
297 LIMIT 1"
298 );
299 $sth->execute($borrowernumber);
300 return ($sth->fetchrow || 1);
301}
302
303=head2 fixaccounts (removed)
304
305 &fixaccounts($accountlines_id, $borrowernumber, $accountnumber, $amount);
306
307#'
308# FIXME - I don't understand what this function does.
309sub fixaccounts {
310 my ( $accountlines_id, $borrowernumber, $accountno, $amount ) = @_;
311 my $dbh = C4::Context->dbh;
312 my $sth = $dbh->prepare(
313 "SELECT * FROM accountlines WHERE accountlines_id=?"
314 );
315 $sth->execute( $accountlines_id );
316 my $data = $sth->fetchrow_hashref;
317
318 # FIXME - Error-checking
319 my $diff = $amount - $data->{'amount'};
320 my $outstanding = $data->{'amountoutstanding'} + $diff;
321 $sth->finish;
322
323 $dbh->do(<<EOT);
324 UPDATE accountlines
325 SET amount = '$amount',
326 amountoutstanding = '$outstanding'
327 WHERE accountlines_id = $accountlines_id
328EOT
329 # FIXME: exceedingly bad form. Use prepare with placholders ("?") in query and execute args.
330}
331
332=cut
333
334sub chargelostitem{
335# lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for
336# FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that
337# a charge has been added
338# FIXME : if no replacement price, borrower just doesn't get charged?
339 my $dbh = C4::Context->dbh();
340 my ($borrowernumber, $itemnumber, $amount, $description) = @_;
341
342 # first make sure the borrower hasn't already been charged for this item
343 my $sth1=$dbh->prepare("SELECT * from accountlines
344 WHERE borrowernumber=? AND itemnumber=? and accounttype='L'");
345 $sth1->execute($borrowernumber,$itemnumber);
346 my $existing_charge_hashref=$sth1->fetchrow_hashref();
347
348 # OK, they haven't
349 unless ($existing_charge_hashref) {
350 my $manager_id = 0;
351 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
352 # This item is on issue ... add replacement cost to the borrower's record and mark it returned
353 # Note that we add this to the account even if there's no replacement price, allowing some other
354 # process (or person) to update it, since we don't handle any defaults for replacement prices.
355 my $accountno = getnextacctno($borrowernumber);
356 my $sth2=$dbh->prepare("INSERT INTO accountlines
357 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber,manager_id)
358 VALUES (?,?,now(),?,?,'L',?,?,?)");
359 $sth2->execute($borrowernumber,$accountno,$amount,
360 $description,$amount,$itemnumber,$manager_id);
361
362 if ( C4::Context->preference("FinesLog") ) {
363 logaction("FINES", 'CREATE', $borrowernumber, Dumper({
364 action => 'create_fee',
365 borrowernumber => $borrowernumber,
366 accountno => $accountno,
367 amount => $amount,
368 amountoutstanding => $amount,
369 description => $description,
370 accounttype => 'L',
371 itemnumber => $itemnumber,
372 manager_id => $manager_id,
373 }));
374 }
375
376 }
377}
378
379=head2 manualinvoice
380
381 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
382 $amount, $note);
383
384C<$borrowernumber> is the patron's borrower number.
385C<$description> is a description of the transaction.
386C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
387or C<REF>.
388C<$itemnumber> is the item involved, if pertinent; otherwise, it
389should be the empty string.
390
391=cut
392
393#'
394# FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
395# are :
396# 'C' = CREDIT
397# 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
398# 'N' = New Card fee
399# 'F' = Fine
400# 'A' = Account Management fee
401# 'M' = Sundry
402# 'L' = Lost Item
403#
404
405sub manualinvoice {
406 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_;
407 my $manager_id = 0;
408 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
409 my $dbh = C4::Context->dbh;
410 my $notifyid = 0;
411 my $insert;
412 my $accountno = getnextacctno($borrowernumber);
413 my $amountleft = $amount;
414
415 if ( ( $type eq 'L' )
416 or ( $type eq 'F' )
417 or ( $type eq 'A' )
418 or ( $type eq 'N' )
419 or ( $type eq 'M' ) )
420 {
421 $notifyid = 1;
422 }
423
424 if ( $itemnum ) {
425 $desc .= ' ' . $itemnum;
426 my $sth = $dbh->prepare(
427 'INSERT INTO accountlines
428 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id)
429 VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)');
430 $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr;
431 } else {
432 my $sth=$dbh->prepare("INSERT INTO accountlines
433 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id)
434 VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)"
435 );
436 $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
437 $amountleft, $notifyid, $note, $manager_id );
438 }
439
440 if ( C4::Context->preference("FinesLog") ) {
441 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
442 action => 'create_fee',
443 borrowernumber => $borrowernumber,
444 accountno => $accountno,
445 amount => $amount,
446 description => $desc,
447 accounttype => $type,
448 amountoutstanding => $amountleft,
449 notify_id => $notifyid,
450 note => $note,
451 itemnumber => $itemnum,
452 manager_id => $manager_id,
453 }));
454 }
455
456 return 0;
457}
458
459sub getcharges {
460 my ( $borrowerno, $timestamp, $accountno ) = @_;
461 my $dbh = C4::Context->dbh;
462 my $timestamp2 = $timestamp - 1;
463 my $query = "";
464 my $sth = $dbh->prepare(
465 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
466 );
467 $sth->execute( $borrowerno, $accountno );
468
469 my @results;
470 while ( my $data = $sth->fetchrow_hashref ) {
471 push @results,$data;
472 }
473 return (@results);
474}
475
476sub ModNote {
477 my ( $accountlines_id, $note ) = @_;
478 my $dbh = C4::Context->dbh;
479 my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE accountlines_id = ?');
480 $sth->execute( $note, $accountlines_id );
481}
482
483sub getcredits {
484 my ( $date, $date2 ) = @_;
485 my $dbh = C4::Context->dbh;
486 my $sth = $dbh->prepare(
487 "SELECT * FROM accountlines,borrowers
488 WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber
489 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
490 );
491
492 $sth->execute( $date, $date2 );
493 my @results;
494 while ( my $data = $sth->fetchrow_hashref ) {
495 $data->{'date'} = $data->{'timestamp'};
496 push @results,$data;
497 }
498 return (@results);
499}
500
501
502sub getrefunds {
503 my ( $date, $date2 ) = @_;
504 my $dbh = C4::Context->dbh;
505
506 my $sth = $dbh->prepare(
507 "SELECT *,timestamp AS datetime
508 FROM accountlines,borrowers
509 WHERE (accounttype = 'REF'
510 AND accountlines.borrowernumber = borrowers.borrowernumber
511 AND date >=? AND date <?)"
512 );
513
514 $sth->execute( $date, $date2 );
515
516 my @results;
517 while ( my $data = $sth->fetchrow_hashref ) {
518 push @results,$data;
519
520 }
521 return (@results);
522}
523
524sub ReversePayment {
525 my ( $accountlines_id ) = @_;
526 my $dbh = C4::Context->dbh;
527
528 my $sth = $dbh->prepare('SELECT * FROM accountlines WHERE accountlines_id = ?');
529 $sth->execute( $accountlines_id );
530 my $row = $sth->fetchrow_hashref();
531 my $amount_outstanding = $row->{'amountoutstanding'};
532
533 if ( $amount_outstanding <= 0 ) {
534 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE accountlines_id = ?');
535 $sth->execute( $accountlines_id );
536 } else {
537 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE accountlines_id = ?');
538 $sth->execute( $accountlines_id );
539 }
540
541 if ( C4::Context->preference("FinesLog") ) {
542 my $manager_id = 0;
543 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
544
545 if ( $amount_outstanding <= 0 ) {
546 $row->{'amountoutstanding'} *= -1;
547 } else {
548 $row->{'amountoutstanding'} = '0';
549 }
550 $row->{'description'} .= ' Reversed -';
551 logaction("FINES", 'MODIFY', $row->{'borrowernumber'}, Dumper({
552 action => 'reverse_fee_payment',
553 borrowernumber => $row->{'borrowernumber'},
554 old_amountoutstanding => $row->{'amountoutstanding'},
555 new_amountoutstanding => 0 - $amount_outstanding,,
556 accountlines_id => $row->{'accountlines_id'},
557 accountno => $row->{'accountno'},
558 manager_id => $manager_id,
559 }));
560
561 }
562
563}
564
565=head2 recordpayment_selectaccts
566
567 recordpayment_selectaccts($borrowernumber, $payment,$accts);
568
569Record payment by a patron. C<$borrowernumber> is the patron's
570borrower number. C<$payment> is a floating-point number, giving the
571amount that was paid. C<$accts> is an array ref to a list of
572accountnos which the payment can be recorded against
573
574Amounts owed are paid off oldest first. That is, if the patron has a
575$1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
576of $1.50, then the oldest fine will be paid off in full, and $0.50
577will be credited to the next one.
578
579=cut
580
581sub recordpayment_selectaccts {
582 my ( $borrowernumber, $amount, $accts, $note ) = @_;
583
584 my $dbh = C4::Context->dbh;
585 my $newamtos = 0;
586 my $accdata = q{};
587 my $branch = C4::Context->userenv->{branch};
588 my $amountleft = $amount;
589 my $manager_id = 0;
590 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
591 my $sql = 'SELECT * FROM accountlines WHERE (borrowernumber = ?) ' .
592 'AND (amountoutstanding<>0) ';
593 if (@{$accts} ) {
594 $sql .= ' AND accountno IN ( ' . join ',', @{$accts};
595 $sql .= ' ) ';
596 }
597 $sql .= ' ORDER BY date';
598 # begin transaction
599 my $nextaccntno = getnextacctno($borrowernumber);
600
601 # get lines with outstanding amounts to offset
602 my $rows = $dbh->selectall_arrayref($sql, { Slice => {} }, $borrowernumber);
603
604 # offset transactions
605 my $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding= ? ' .
606 'WHERE accountlines_id=?');
607
608 my @ids;
609 for my $accdata ( @{$rows} ) {
610 if ($amountleft == 0) {
611 last;
612 }
613 if ( $accdata->{amountoutstanding} < $amountleft ) {
614 $newamtos = 0;
615 $amountleft -= $accdata->{amountoutstanding};
616 }
617 else {
618 $newamtos = $accdata->{amountoutstanding} - $amountleft;
619 $amountleft = 0;
620 }
621 my $thisacct = $accdata->{accountlines_id};
622 $sth->execute( $newamtos, $thisacct );
623
624 if ( C4::Context->preference("FinesLog") ) {
625 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
626 action => 'fee_payment',
627 borrowernumber => $borrowernumber,
628 old_amountoutstanding => $accdata->{'amountoutstanding'},
629 new_amountoutstanding => $newamtos,
630 amount_paid => $accdata->{'amountoutstanding'} - $newamtos,
631 accountlines_id => $accdata->{'accountlines_id'},
632 accountno => $accdata->{'accountno'},
633 manager_id => $manager_id,
634 }));
635 push( @ids, $accdata->{'accountlines_id'} );
636 }
637
638 }
639
640 # create new line
641 $sql = 'INSERT INTO accountlines ' .
642 '(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id,note) ' .
643 q|VALUES (?,?,now(),?,'','Pay',?,?,?)|;
644 $dbh->do($sql,{},$borrowernumber, $nextaccntno, 0 - $amount, 0 - $amountleft, $manager_id, $note );
645 UpdateStats( $branch, 'payment', $amount, '', '', '', $borrowernumber, $nextaccntno );
646
647 if ( C4::Context->preference("FinesLog") ) {
648 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
649 action => 'create_payment',
650 borrowernumber => $borrowernumber,
651 accountno => $nextaccntno,
652 amount => 0 - $amount,
653 amountoutstanding => 0 - $amountleft,
654 accounttype => 'Pay',
655 accountlines_paid => \@ids,
656 manager_id => $manager_id,
657 }));
658 }
659
660 return;
661}
662
663# makepayment needs to be fixed to handle partials till then this separate subroutine
664# fills in
665sub makepartialpayment {
666 my ( $accountlines_id, $borrowernumber, $accountno, $amount, $user, $branch, $payment_note ) = @_;
667 my $manager_id = 0;
668 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
669 if (!$amount || $amount < 0) {
670 return;
671 }
672 $payment_note //= "";
673 my $dbh = C4::Context->dbh;
674
675 my $nextaccntno = getnextacctno($borrowernumber);
676 my $newamtos = 0;
677
678 my $data = $dbh->selectrow_hashref(
679 'SELECT * FROM accountlines WHERE accountlines_id=?',undef,$accountlines_id);
680 my $new_outstanding = $data->{amountoutstanding} - $amount;
681
682 my $update = 'UPDATE accountlines SET amountoutstanding = ? WHERE accountlines_id = ? ';
683 $dbh->do( $update, undef, $new_outstanding, $accountlines_id);
684
685 if ( C4::Context->preference("FinesLog") ) {
686 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
687 action => 'fee_payment',
688 borrowernumber => $borrowernumber,
689 old_amountoutstanding => $data->{'amountoutstanding'},
690 new_amountoutstanding => $new_outstanding,
691 amount_paid => $data->{'amountoutstanding'} - $new_outstanding,
692 accountlines_id => $data->{'accountlines_id'},
693 accountno => $data->{'accountno'},
694 manager_id => $manager_id,
695 }));
696 }
697
698 # create new line
699 my $insert = 'INSERT INTO accountlines (borrowernumber, accountno, date, amount, '
700 . 'description, accounttype, amountoutstanding, itemnumber, manager_id, note) '
701 . ' VALUES (?, ?, now(), ?, ?, ?, 0, ?, ?, ?)';
702
703 $dbh->do( $insert, undef, $borrowernumber, $nextaccntno, $amount,
704 "Payment, thanks - $user", 'Pay', $data->{'itemnumber'}, $manager_id, $payment_note);
705
706 UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber, $accountno );
707
708 if ( C4::Context->preference("FinesLog") ) {
709 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
710 action => 'create_payment',
711 borrowernumber => $user,
712 accountno => $nextaccntno,
713 amount => 0 - $amount,
714 accounttype => 'Pay',
715 itemnumber => $data->{'itemnumber'},
716 accountlines_paid => [ $data->{'accountlines_id'} ],
717 manager_id => $manager_id,
718 }));
719 }
720
721 return;
722}
723
724=head2 WriteOffFee
725
726 WriteOffFee( $borrowernumber, $accountline_id, $itemnum, $accounttype, $amount, $branch, $payment_note );
727
728Write off a fine for a patron.
729C<$borrowernumber> is the patron's borrower number.
730C<$accountline_id> is the accountline_id of the fee to write off.
731C<$itemnum> is the itemnumber of of item whose fine is being written off.
732C<$accounttype> is the account type of the fine being written off.
733C<$amount> is a floating-point number, giving the amount that is being written off.
734C<$branch> is the branchcode of the library where the writeoff occurred.
735C<$payment_note> is the note to attach to this payment
736
737=cut
738
739sub WriteOffFee {
740 my ( $borrowernumber, $accountlines_id, $itemnum, $accounttype, $amount, $branch, $payment_note ) = @_;
741 $payment_note //= "";
742 $branch ||= C4::Context->userenv->{branch};
743 my $manager_id = 0;
744 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
745
746 # if no item is attached to fine, make sure to store it as a NULL
747 $itemnum ||= undef;
748
749 my ( $sth, $query );
750 my $dbh = C4::Context->dbh();
751
752 $query = "
753 UPDATE accountlines SET amountoutstanding = 0
754 WHERE accountlines_id = ? AND borrowernumber = ?
755 ";
756 $sth = $dbh->prepare( $query );
757 $sth->execute( $accountlines_id, $borrowernumber );
758
759 if ( C4::Context->preference("FinesLog") ) {
760 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
761 action => 'fee_writeoff',
762 borrowernumber => $borrowernumber,
763 accountlines_id => $accountlines_id,
764 manager_id => $manager_id,
765 }));
766 }
767
768 $query ="
769 INSERT INTO accountlines
770 ( borrowernumber, accountno, itemnumber, date, amount, description, accounttype, manager_id, note )
771 VALUES ( ?, ?, ?, NOW(), ?, 'Writeoff', 'W', ?, ? )
772 ";
773 $sth = $dbh->prepare( $query );
774 my $acct = getnextacctno($borrowernumber);
775 $sth->execute( $borrowernumber, $acct, $itemnum, $amount, $manager_id, $payment_note );
776
777 if ( C4::Context->preference("FinesLog") ) {
778 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
779 action => 'create_writeoff',
780 borrowernumber => $borrowernumber,
781 accountno => $acct,
782 amount => 0 - $amount,
783 accounttype => 'W',
784 itemnumber => $itemnum,
785 accountlines_paid => [ $accountlines_id ],
786 manager_id => $manager_id,
787 }));
788 }
789
790 UpdateStats( $branch, 'writeoff', $amount, q{}, q{}, q{}, $borrowernumber );
791
792}
793
79413µs
# spent 3µs within C4::Accounts::END which was called: # once (3µs+0s) by main::RUNTIME at line 131 of C4/Service.pm
END { } # module clean-up code here (global destructor)
795
79613µs1;
797__END__
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.