← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 17:10:45 2013
Reported on Tue Oct 15 17:11:57 2013

Filename/usr/share/koha/lib/C4/Accounts.pm
StatementsExecuted 30 statements in 4.17ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11127µs36µsC4::Accounts::::BEGIN@21C4::Accounts::BEGIN@21
11120µs24µsC4::Accounts::::BEGIN@23C4::Accounts::BEGIN@23
11120µs24µsC4::Accounts::::BEGIN@26C4::Accounts::BEGIN@26
11118µs18µsC4::Accounts::::BEGIN@33C4::Accounts::BEGIN@33
11116µs167µsC4::Accounts::::BEGIN@24C4::Accounts::BEGIN@24
11115µs18µsC4::Accounts::::BEGIN@25C4::Accounts::BEGIN@25
11114µs51µsC4::Accounts::::BEGIN@29C4::Accounts::BEGIN@29
11112µs72µsC4::Accounts::::BEGIN@31C4::Accounts::BEGIN@31
11112µs75µsC4::Accounts::::BEGIN@27C4::Accounts::BEGIN@27
1114µs4µ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::::fixcreditC4::Accounts::fixcredit
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
0000s0sC4::Accounts::::refundC4::Accounts::refund
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
21359µs244µs
# spent 36µs (27+8) within C4::Accounts::BEGIN@21 which was called: # once (27µs+8µs) by C4::Reserves::BEGIN@31 at line 21
use strict;
# spent 36µs making 1 call to C4::Accounts::BEGIN@21 # spent 8µs making 1 call to strict::import
22#use warnings; FIXME - Bug 2505
23335µs229µs
# spent 24µs (20+4) within C4::Accounts::BEGIN@23 which was called: # once (20µs+4µs) by C4::Reserves::BEGIN@31 at line 23
use C4::Context;
# spent 24µs making 1 call to C4::Accounts::BEGIN@23 # spent 4µs making 1 call to C4::Context::import
24357µs2318µs
# spent 167µs (16+151) within C4::Accounts::BEGIN@24 which was called: # once (16µs+151µs) by C4::Reserves::BEGIN@31 at line 24
use C4::Stats;
# spent 167µs making 1 call to C4::Accounts::BEGIN@24 # spent 151µs making 1 call to Exporter::import
25351µs220µs
# spent 18µs (15+3) within C4::Accounts::BEGIN@25 which was called: # once (15µs+3µs) by C4::Reserves::BEGIN@31 at line 25
use C4::Members;
# spent 18µs making 1 call to C4::Accounts::BEGIN@25 # spent 2µs making 1 call to UNIVERSAL::import
263101µs228µs
# spent 24µs (20+4) within C4::Accounts::BEGIN@26 which was called: # once (20µs+4µs) by C4::Reserves::BEGIN@31 at line 26
use C4::Circulation qw(ReturnLostItem);
# spent 24µs making 1 call to C4::Accounts::BEGIN@26 # spent 4µs making 1 call to UNIVERSAL::import
27335µs2138µs
# spent 75µs (12+63) within C4::Accounts::BEGIN@27 which was called: # once (12µs+63µs) by C4::Reserves::BEGIN@31 at line 27
use C4::Log qw(logaction);
# spent 75µs making 1 call to C4::Accounts::BEGIN@27 # spent 63µs making 1 call to Exporter::import
28
29338µs287µs
# spent 51µs (14+36) within C4::Accounts::BEGIN@29 which was called: # once (14µs+36µs) by C4::Reserves::BEGIN@31 at line 29
use Data::Dumper qw(Dumper);
# spent 51µs making 1 call to C4::Accounts::BEGIN@29 # spent 36µs making 1 call to Exporter::import
30
31379µs2133µs
# spent 72µs (12+60) within C4::Accounts::BEGIN@31 which was called: # once (12µs+60µs) by C4::Reserves::BEGIN@31 at line 31
use vars qw($VERSION @ISA @EXPORT);
# spent 72µs making 1 call to C4::Accounts::BEGIN@31 # spent 60µs making 1 call to vars::import
32
33
# spent 18µs within C4::Accounts::BEGIN@33 which was called: # once (18µs+0s) by C4::Reserves::BEGIN@31 at line 54
BEGIN {
34 # set the version for version checking
35423µs $VERSION = 3.07.00.049;
36 require Exporter;
37 @ISA = qw(Exporter);
38 @EXPORT = qw(
39 &recordpayment
40 &makepayment
41 &manualinvoice
42 &getnextacctno
43 &reconcileaccount
44 &getcharges
45 &ModNote
46 &getcredits
47 &getrefunds
48 &chargelostitem
49 &ReversePayment
50 &makepartialpayment
51 &recordpayment_selectaccts
52 &WriteOffFee
53 );
5413.68ms118µs}
# spent 18µs making 1 call to C4::Accounts::BEGIN@33
55
56=head1 NAME
57
- -
87#'
88sub recordpayment {
89
90 #here we update the account lines
91 my ( $borrowernumber, $data ) = @_;
92 my $dbh = C4::Context->dbh;
93 my $newamtos = 0;
94 my $accdata = "";
95 my $branch = C4::Context->userenv->{'branch'};
96 my $amountleft = $data;
97 my $manager_id = 0;
98 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
99
100 # begin transaction
101 my $nextaccntno = getnextacctno($borrowernumber);
102
103 # get lines with outstanding amounts to offset
104 my $sth = $dbh->prepare(
105 "SELECT * FROM accountlines
106 WHERE (borrowernumber = ?) AND (amountoutstanding<>0)
107 ORDER BY date"
108 );
109 $sth->execute($borrowernumber);
110
111 # offset transactions
112 my @ids;
113 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
114 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
115 $newamtos = 0;
116 $amountleft -= $accdata->{'amountoutstanding'};
117 }
118 else {
119 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
120 $amountleft = 0;
121 }
122 my $thisacct = $accdata->{accountlines_id};
123 my $usth = $dbh->prepare(
124 "UPDATE accountlines SET amountoutstanding= ?
125 WHERE (accountlines_id = ?)"
126 );
127 $usth->execute( $newamtos, $thisacct );
128
129 if ( C4::Context->preference("FinesLog") ) {
130 $accdata->{'amountoutstanding_new'} = $newamtos;
131 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
132 action => 'fee_payment',
133 borrowernumber => $accdata->{'borrowernumber'},
134 old_amountoutstanding => $accdata->{'amountoutstanding'},
135 new_amountoutstanding => $newamtos,
136 amount_paid => $accdata->{'amountoutstanding'} - $newamtos,
137 accountlines_id => $accdata->{'accountlines_id'},
138 accountno => $accdata->{'accountno'},
139 manager_id => $manager_id,
140 }));
141 push( @ids, $accdata->{'accountlines_id'} );
142 }
143 }
144
145 # create new line
146 my $usth = $dbh->prepare(
147 "INSERT INTO accountlines
148 (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id)
149 VALUES (?,?,now(),?,'Payment,thanks','Pay',?,?)"
150 );
151 $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft, $manager_id );
152
153 UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno );
154
155 if ( C4::Context->preference("FinesLog") ) {
156 $accdata->{'amountoutstanding_new'} = $newamtos;
157 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
158 action => 'create_payment',
159 borrowernumber => $borrowernumber,
160 accountno => $nextaccntno,
161 amount => $data * -1,
162 amountoutstanding => $amountleft * -1,
163 accounttype => 'Pay',
164 accountlines_paid => \@ids,
165 manager_id => $manager_id,
166 }));
167 }
168
169}
170
171=head2 makepayment
172
- -
186#'
187# FIXME - I'm not at all sure about the above, because I don't
188# understand what the acct* tables in the Koha database are for.
189sub makepayment {
190
191 #here we update both the accountoffsets and the account lines
192 #updated to check, if they are paying off a lost item, we return the item
193 # from their card, and put a note on the item record
194 my ( $accountlines_id, $borrowernumber, $accountno, $amount, $user, $branch ) = @_;
195 my $dbh = C4::Context->dbh;
196 my $manager_id = 0;
197 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
198
199 # begin transaction
200 my $nextaccntno = getnextacctno($borrowernumber);
201 my $newamtos = 0;
202 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE accountlines_id=?");
203 $sth->execute( $accountlines_id );
204 my $data = $sth->fetchrow_hashref;
205 $sth->finish;
206
207 my $payment;
208 if ( $data->{'accounttype'} eq "Pay" ){
209 my $udp =
210 $dbh->prepare(
211 "UPDATE accountlines
212 SET amountoutstanding = 0, description = 'Payment,thanks'
213 WHERE accountlines_id = ?
214 "
215 );
216 $udp->execute($accountlines_id);
217 $udp->finish;
218 }else{
219 my $udp =
220 $dbh->prepare(
221 "UPDATE accountlines
222 SET amountoutstanding = 0
223 WHERE accountlines_id = ?
224 "
225 );
226 $udp->execute($accountlines_id);
227 $udp->finish;
228
229 # create new line
230 $payment = 0 - $amount;
231
232 my $ins =
233 $dbh->prepare(
234 "INSERT
235 INTO accountlines (borrowernumber, accountno, date, amount, itemnumber, description, accounttype, amountoutstanding, manager_id)
236 VALUES ( ?, ?, now(), ?, ?, 'Payment,thanks', 'Pay', 0, ?)"
237 );
238 $ins->execute($borrowernumber, $nextaccntno, $payment, $data->{'itemnumber'}, $manager_id);
239 $ins->finish;
240 }
241
242 if ( C4::Context->preference("FinesLog") ) {
243 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
244 action => 'fee_payment',
245 borrowernumber => $borrowernumber,
246 old_amountoutstanding => $data->{'amountoutstanding'},
247 new_amountoutstanding => 0,
248 amount_paid => $data->{'amountoutstanding'},
249 accountlines_id => $data->{'accountlines_id'},
250 accountno => $data->{'accountno'},
251 manager_id => $manager_id,
252 }));
253
254
255 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
256 action => 'create_payment',
257 borrowernumber => $borrowernumber,
258 accountno => $nextaccntno,
259 amount => $payment,
260 amountoutstanding => 0,,
261 accounttype => 'Pay',
262 accountlines_paid => [$data->{'accountlines_id'}],
263 manager_id => $manager_id,
264 }));
265 }
266
267
268 # FIXME - The second argument to &UpdateStats is supposed to be the
269 # branch code.
270 # UpdateStats is now being passed $accountno too. MTJ
271 UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber,
272 $accountno );
273
274 #check to see what accounttype
275 if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
276 C4::Circulation::ReturnLostItem( $borrowernumber, $data->{'itemnumber'} );
277 }
278 my $sthr = $dbh->prepare("SELECT max(accountlines_id) AS lastinsertid FROM accountlines");
279 $sthr->execute();
280 my $datalastinsertid = $sthr->fetchrow_hashref;
281 $sthr->finish;
282 return $datalastinsertid->{'lastinsertid'};
283}
284
285=head2 getnextacctno
286
- -
294#'
295# FIXME - Okay, so what does the above actually _mean_?
296sub getnextacctno {
297 my ($borrowernumber) = shift or return;
298 my $sth = C4::Context->dbh->prepare(
299 "SELECT accountno+1 FROM accountlines
300 WHERE (borrowernumber = ?)
301 ORDER BY accountno DESC
302 LIMIT 1"
303 );
304 $sth->execute($borrowernumber);
305 return ($sth->fetchrow || 1);
306}
307
308=head2 fixaccounts (removed)
309
- -
339sub chargelostitem{
340# lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for
341# FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that
342# a charge has been added
343# FIXME : if no replacement price, borrower just doesn't get charged?
344 my $dbh = C4::Context->dbh();
345 my ($borrowernumber, $itemnumber, $amount, $description) = @_;
346
347 # first make sure the borrower hasn't already been charged for this item
348 my $sth1=$dbh->prepare("SELECT * from accountlines
349 WHERE borrowernumber=? AND itemnumber=? and accounttype='L'");
350 $sth1->execute($borrowernumber,$itemnumber);
351 my $existing_charge_hashref=$sth1->fetchrow_hashref();
352
353 # OK, they haven't
354 unless ($existing_charge_hashref) {
355 my $manager_id = 0;
356 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
357 # This item is on issue ... add replacement cost to the borrower's record and mark it returned
358 # Note that we add this to the account even if there's no replacement price, allowing some other
359 # process (or person) to update it, since we don't handle any defaults for replacement prices.
360 my $accountno = getnextacctno($borrowernumber);
361 my $sth2=$dbh->prepare("INSERT INTO accountlines
362 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber,manager_id)
363 VALUES (?,?,now(),?,?,'L',?,?,?)");
364 $sth2->execute($borrowernumber,$accountno,$amount,
365 $description,$amount,$itemnumber,$manager_id);
366 $sth2->finish;
367
368 if ( C4::Context->preference("FinesLog") ) {
369 logaction("FINES", 'CREATE', $borrowernumber, Dumper({
370 action => 'create_fee',
371 borrowernumber => $borrowernumber,
372 accountno => $accountno,
373 amount => $amount,
374 amountoutstanding => $amount,
375 description => $description,
376 accounttype => 'L',
377 itemnumber => $itemnumber,
378 manager_id => $manager_id,
379 }));
380 }
381
382 }
383}
384
385=head2 manualinvoice
386
- -
399#'
400# FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
401# are :
402# 'C' = CREDIT
403# 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
404# 'N' = New Card fee
405# 'F' = Fine
406# 'A' = Account Management fee
407# 'M' = Sundry
408# 'L' = Lost Item
409#
410
411sub manualinvoice {
412 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_;
413 my $manager_id = 0;
414 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
415 my $dbh = C4::Context->dbh;
416 my $notifyid = 0;
417 my $insert;
418 my $accountno = getnextacctno($borrowernumber);
419 my $amountleft = $amount;
420
421# if ( $type eq 'CS'
422# || $type eq 'CB'
423# || $type eq 'CW'
424# || $type eq 'CF'
425# || $type eq 'CL' )
426# {
427# my $amount2 = $amount * -1; # FIXME - $amount2 = -$amount
428# $amountleft =
429# fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user );
430# }
431 if ( $type eq 'N' ) {
432 $desc .= " New Card";
433 }
434 if ( $type eq 'F' ) {
435 $desc .= " Fine";
436 }
437 if ( $type eq 'A' ) {
438 $desc .= " Account Management fee";
439 }
440 if ( $type eq 'M' ) {
441 $desc .= " Sundry";
442 }
443
444 if ( $type eq 'L' && $desc eq '' ) {
445
446 $desc = " Lost Item";
447 }
448# if ( $type eq 'REF' ) {
449# $desc .= " Cash Refund";
450# $amountleft = refund( '', $borrowernumber, $amount );
451# }
452 if ( ( $type eq 'L' )
453 or ( $type eq 'F' )
454 or ( $type eq 'A' )
455 or ( $type eq 'N' )
456 or ( $type eq 'M' ) )
457 {
458 $notifyid = 1;
459 }
460
461 if ( $itemnum ) {
462 $desc .= ' ' . $itemnum;
463 my $sth = $dbh->prepare(
464 'INSERT INTO accountlines
465 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id)
466 VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)');
467 $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr;
468 } else {
469 my $sth=$dbh->prepare("INSERT INTO accountlines
470 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id)
471 VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)"
472 );
473 $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
474 $amountleft, $notifyid, $note, $manager_id );
475 }
476
477 if ( C4::Context->preference("FinesLog") ) {
478 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
479 action => 'create_fee',
480 borrowernumber => $borrowernumber,
481 accountno => $accountno,
482 amount => $amount,
483 description => $desc,
484 accounttype => $type,
485 amountoutstanding => $amountleft,
486 notify_id => $notifyid,
487 note => $note,
488 itemnumber => $itemnum,
489 manager_id => $manager_id,
490 }));
491 }
492
493 return 0;
494}
495
496=head2 fixcredit #### DEPRECATED
497
- -
504# This function is deprecated in 3.0
505
506sub fixcredit {
507
508 #here we update both the accountoffsets and the account lines
509 my ( $borrowernumber, $data, $barcode, $type, $user ) = @_;
510 my $dbh = C4::Context->dbh;
511 my $newamtos = 0;
512 my $accdata = "";
513 my $amountleft = $data;
514 if ( $barcode ne '' ) {
515 my $item = GetBiblioFromItemNumber( '', $barcode );
516 my $nextaccntno = getnextacctno($borrowernumber);
517 my $query = "SELECT * FROM accountlines WHERE (borrowernumber=?
518 AND itemnumber=? AND amountoutstanding > 0)";
519 if ( $type eq 'CL' ) {
520 $query .= " AND (accounttype = 'L' OR accounttype = 'Rep')";
521 }
522 elsif ( $type eq 'CF' ) {
523 $query .= " AND (accounttype = 'F' OR accounttype = 'FU' OR
524 accounttype='Res' OR accounttype='Rent')";
525 }
526 elsif ( $type eq 'CB' ) {
527 $query .= " and accounttype='A'";
528 }
529
530 # print $query;
531 my $sth = $dbh->prepare($query);
532 $sth->execute( $borrowernumber, $item->{'itemnumber'} );
533 $accdata = $sth->fetchrow_hashref;
534 $sth->finish;
535 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
536 $newamtos = 0;
537 $amountleft -= $accdata->{'amountoutstanding'};
538 }
539 else {
540 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
541 $amountleft = 0;
542 }
543 my $thisacct = $accdata->{accountlines_id};
544 my $usth = $dbh->prepare(
545 "UPDATE accountlines SET amountoutstanding= ?
546 WHERE (accountlines_id = ?)"
547 );
548 $usth->execute( $newamtos, $thisacct );
549 $usth->finish;
550 $usth = $dbh->prepare(
551 "INSERT INTO accountoffsets
552 (borrowernumber, accountno, offsetaccount, offsetamount)
553 VALUES (?,?,?,?)"
554 );
555 $usth->execute( $borrowernumber, $accdata->{'accountno'},
556 $nextaccntno, $newamtos );
557 $usth->finish;
558 }
559
560 # begin transaction
561 my $nextaccntno = getnextacctno($borrowernumber);
562
563 # get lines with outstanding amounts to offset
564 my $sth = $dbh->prepare(
565 "SELECT * FROM accountlines
566 WHERE (borrowernumber = ?) AND (amountoutstanding >0)
567 ORDER BY date"
568 );
569 $sth->execute($borrowernumber);
570
571 # print $query;
572 # offset transactions
573 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
574 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
575 $newamtos = 0;
576 $amountleft -= $accdata->{'amountoutstanding'};
577 }
578 else {
579 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
580 $amountleft = 0;
581 }
582 my $thisacct = $accdata->{accountlines_id};
583 my $usth = $dbh->prepare(
584 "UPDATE accountlines SET amountoutstanding= ?
585 WHERE (accountlines_id = ?)"
586 );
587 $usth->execute( $newamtos, $thisacct );
588 $usth->finish;
589 $usth = $dbh->prepare(
590 "INSERT INTO accountoffsets
591 (borrowernumber, accountno, offsetaccount, offsetamount)
592 VALUE (?,?,?,?)"
593 );
594 $usth->execute( $borrowernumber, $accdata->{'accountno'},
595 $nextaccntno, $newamtos );
596 $usth->finish;
597 }
598 $sth->finish;
599 $type = "Credit " . $type;
600 UpdateStats( $user, $type, $data, $user, '', '', $borrowernumber );
601 $amountleft *= -1;
602 return ($amountleft);
603
604}
605
606=head2 refund
607
- -
615sub refund {
616
617 #here we update both the accountoffsets and the account lines
618 my ( $borrowernumber, $data ) = @_;
619 my $dbh = C4::Context->dbh;
620 my $newamtos = 0;
621 my $accdata = "";
622 my $amountleft = $data * -1;
623
624 # begin transaction
625 my $nextaccntno = getnextacctno($borrowernumber);
626
627 # get lines with outstanding amounts to offset
628 my $sth = $dbh->prepare(
629 "SELECT * FROM accountlines
630 WHERE (borrowernumber = ?) AND (amountoutstanding<0)
631 ORDER BY date"
632 );
633 $sth->execute($borrowernumber);
634
635 # print $amountleft;
636 # offset transactions
637 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) {
638 if ( $accdata->{'amountoutstanding'} > $amountleft ) {
639 $newamtos = 0;
640 $amountleft -= $accdata->{'amountoutstanding'};
641 }
642 else {
643 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
644 $amountleft = 0;
645 }
646
647 # print $amountleft;
648 my $thisacct = $accdata->{accountlines_id};
649 my $usth = $dbh->prepare(
650 "UPDATE accountlines SET amountoutstanding= ?
651 WHERE (accountlines_id = ?)"
652 );
653 $usth->execute( $newamtos, $thisacct );
654 $usth->finish;
655 $usth = $dbh->prepare(
656 "INSERT INTO accountoffsets
657 (borrowernumber, accountno, offsetaccount, offsetamount)
658 VALUES (?,?,?,?)"
659 );
660 $usth->execute( $borrowernumber, $accdata->{'accountno'},
661 $nextaccntno, $newamtos );
662 $usth->finish;
663 }
664 $sth->finish;
665 return ($amountleft);
666}
667
668sub getcharges {
669 my ( $borrowerno, $timestamp, $accountno ) = @_;
670 my $dbh = C4::Context->dbh;
671 my $timestamp2 = $timestamp - 1;
672 my $query = "";
673 my $sth = $dbh->prepare(
674 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
675 );
676 $sth->execute( $borrowerno, $accountno );
677
678 my @results;
679 while ( my $data = $sth->fetchrow_hashref ) {
680 push @results,$data;
681 }
682 return (@results);
683}
684
685sub ModNote {
686 my ( $accountlines_id, $note ) = @_;
687 my $dbh = C4::Context->dbh;
688 my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE accountlines_id = ?');
689 $sth->execute( $note, $accountlines_id );
690}
691
692sub getcredits {
693 my ( $date, $date2 ) = @_;
694 my $dbh = C4::Context->dbh;
695 my $sth = $dbh->prepare(
696 "SELECT * FROM accountlines,borrowers
697 WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber
698 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
699 );
700
701 $sth->execute( $date, $date2 );
702 my @results;
703 while ( my $data = $sth->fetchrow_hashref ) {
704 $data->{'date'} = $data->{'timestamp'};
705 push @results,$data;
706 }
707 return (@results);
708}
709
710
711sub getrefunds {
712 my ( $date, $date2 ) = @_;
713 my $dbh = C4::Context->dbh;
714
715 my $sth = $dbh->prepare(
716 "SELECT *,timestamp AS datetime
717 FROM accountlines,borrowers
718 WHERE (accounttype = 'REF'
719 AND accountlines.borrowernumber = borrowers.borrowernumber
720 AND date >=? AND date <?)"
721 );
722
723 $sth->execute( $date, $date2 );
724
725 my @results;
726 while ( my $data = $sth->fetchrow_hashref ) {
727 push @results,$data;
728
729 }
730 return (@results);
731}
732
733sub ReversePayment {
734 my ( $accountlines_id ) = @_;
735 my $dbh = C4::Context->dbh;
736
737 my $sth = $dbh->prepare('SELECT * FROM accountlines WHERE accountlines_id = ?');
738 $sth->execute( $accountlines_id );
739 my $row = $sth->fetchrow_hashref();
740 my $amount_outstanding = $row->{'amountoutstanding'};
741
742 if ( $amount_outstanding <= 0 ) {
743 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE accountlines_id = ?');
744 $sth->execute( $accountlines_id );
745 } else {
746 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE accountlines_id = ?');
747 $sth->execute( $accountlines_id );
748 }
749
750 if ( C4::Context->preference("FinesLog") ) {
751 my $manager_id = 0;
752 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
753
754 if ( $amount_outstanding <= 0 ) {
755 $row->{'amountoutstanding'} *= -1;
756 } else {
757 $row->{'amountoutstanding'} = '0';
758 }
759 $row->{'description'} .= ' Reversed -';
760 logaction("FINES", 'MODIFY', $row->{'borrowernumber'}, Dumper({
761 action => 'reverse_fee_payment',
762 borrowernumber => $row->{'borrowernumber'},
763 old_amountoutstanding => $row->{'amountoutstanding'},
764 new_amountoutstanding => 0 - $amount_outstanding,,
765 accountlines_id => $row->{'accountlines_id'},
766 accountno => $row->{'accountno'},
767 manager_id => $manager_id,
768 }));
769
770 }
771
772}
773
774=head2 recordpayment_selectaccts
775
- -
790sub recordpayment_selectaccts {
791 my ( $borrowernumber, $amount, $accts ) = @_;
792
793 my $dbh = C4::Context->dbh;
794 my $newamtos = 0;
795 my $accdata = q{};
796 my $branch = C4::Context->userenv->{branch};
797 my $amountleft = $amount;
798 my $manager_id = 0;
799 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
800 my $sql = 'SELECT * FROM accountlines WHERE (borrowernumber = ?) ' .
801 'AND (amountoutstanding<>0) ';
802 if (@{$accts} ) {
803 $sql .= ' AND accountno IN ( ' . join ',', @{$accts};
804 $sql .= ' ) ';
805 }
806 $sql .= ' ORDER BY date';
807 # begin transaction
808 my $nextaccntno = getnextacctno($borrowernumber);
809
810 # get lines with outstanding amounts to offset
811 my $rows = $dbh->selectall_arrayref($sql, { Slice => {} }, $borrowernumber);
812
813 # offset transactions
814 my $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding= ? ' .
815 'WHERE accountlines_id=?');
816
817 my @ids;
818 for my $accdata ( @{$rows} ) {
819 if ($amountleft == 0) {
820 last;
821 }
822 if ( $accdata->{amountoutstanding} < $amountleft ) {
823 $newamtos = 0;
824 $amountleft -= $accdata->{amountoutstanding};
825 }
826 else {
827 $newamtos = $accdata->{amountoutstanding} - $amountleft;
828 $amountleft = 0;
829 }
830 my $thisacct = $accdata->{accountlines_id};
831 $sth->execute( $newamtos, $thisacct );
832
833 if ( C4::Context->preference("FinesLog") ) {
834 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
835 action => 'fee_payment',
836 borrowernumber => $borrowernumber,
837 old_amountoutstanding => $accdata->{'amountoutstanding'},
838 new_amountoutstanding => $newamtos,
839 amount_paid => $accdata->{'amountoutstanding'} - $newamtos,
840 accountlines_id => $accdata->{'accountlines_id'},
841 accountno => $accdata->{'accountno'},
842 manager_id => $manager_id,
843 }));
844 push( @ids, $accdata->{'accountlines_id'} );
845 }
846
847 }
848
849 # create new line
850 $sql = 'INSERT INTO accountlines ' .
851 '(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id) ' .
852 q|VALUES (?,?,now(),?,'Payment,thanks','Pay',?,?)|;
853 $dbh->do($sql,{},$borrowernumber, $nextaccntno, 0 - $amount, 0 - $amountleft, $manager_id );
854 UpdateStats( $branch, 'payment', $amount, '', '', '', $borrowernumber, $nextaccntno );
855
856 if ( C4::Context->preference("FinesLog") ) {
857 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
858 action => 'create_payment',
859 borrowernumber => $borrowernumber,
860 accountno => $nextaccntno,
861 amount => 0 - $amount,
862 amountoutstanding => 0 - $amountleft,
863 accounttype => 'Pay',
864 accountlines_paid => \@ids,
865 manager_id => $manager_id,
866 }));
867 }
868
869 return;
870}
871
872# makepayment needs to be fixed to handle partials till then this separate subroutine
873# fills in
874sub makepartialpayment {
875 my ( $accountlines_id, $borrowernumber, $accountno, $amount, $user, $branch ) = @_;
876 my $manager_id = 0;
877 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
878 if (!$amount || $amount < 0) {
879 return;
880 }
881 my $dbh = C4::Context->dbh;
882
883 my $nextaccntno = getnextacctno($borrowernumber);
884 my $newamtos = 0;
885
886 my $data = $dbh->selectrow_hashref(
887 'SELECT * FROM accountlines WHERE accountlines_id=?',undef,$accountlines_id);
888 my $new_outstanding = $data->{amountoutstanding} - $amount;
889
890 my $update = 'UPDATE accountlines SET amountoutstanding = ? WHERE accountlines_id = ? ';
891 $dbh->do( $update, undef, $new_outstanding, $accountlines_id);
892
893 if ( C4::Context->preference("FinesLog") ) {
894 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
895 action => 'fee_payment',
896 borrowernumber => $borrowernumber,
897 old_amountoutstanding => $data->{'amountoutstanding'},
898 new_amountoutstanding => $new_outstanding,
899 amount_paid => $data->{'amountoutstanding'} - $new_outstanding,
900 accountlines_id => $data->{'accountlines_id'},
901 accountno => $data->{'accountno'},
902 manager_id => $manager_id,
903 }));
904 }
905
906 # create new line
907 my $insert = 'INSERT INTO accountlines (borrowernumber, accountno, date, amount, '
908 . 'description, accounttype, amountoutstanding, itemnumber, manager_id) '
909 . ' VALUES (?, ?, now(), ?, ?, ?, 0, ?, ?)';
910
911 $dbh->do( $insert, undef, $borrowernumber, $nextaccntno, 0 - $amount,
912 "Payment, thanks - $user", 'Pay', $data->{'itemnumber'}, $manager_id);
913
914 UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber, $accountno );
915
916 if ( C4::Context->preference("FinesLog") ) {
917 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
918 action => 'create_payment',
919 borrowernumber => $user,
920 accountno => $nextaccntno,
921 amount => 0 - $amount,
922 accounttype => 'Pay',
923 itemnumber => $data->{'itemnumber'},
924 accountlines_paid => [ $data->{'accountlines_id'} ],
925 manager_id => $manager_id,
926 }));
927 }
928
929 return;
930}
931
932=head2 WriteOffFee
933
- -
946sub WriteOffFee {
947 my ( $borrowernumber, $accountlines_id, $itemnum, $accounttype, $amount, $branch ) = @_;
948 $branch ||= C4::Context->userenv->{branch};
949 my $manager_id = 0;
950 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
951
952 # if no item is attached to fine, make sure to store it as a NULL
953 $itemnum ||= undef;
954
955 my ( $sth, $query );
956 my $dbh = C4::Context->dbh();
957
958 $query = "
959 UPDATE accountlines SET amountoutstanding = 0
960 WHERE accountlines_id = ? AND borrowernumber = ?
961 ";
962 $sth = $dbh->prepare( $query );
963 $sth->execute( $accountlines_id, $borrowernumber );
964
965 if ( C4::Context->preference("FinesLog") ) {
966 logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
967 action => 'fee_writeoff',
968 borrowernumber => $borrowernumber,
969 accountlines_id => $accountlines_id,
970 manager_id => $manager_id,
971 }));
972 }
973
974 $query ="
975 INSERT INTO accountlines
976 ( borrowernumber, accountno, itemnumber, date, amount, description, accounttype, manager_id )
977 VALUES ( ?, ?, ?, NOW(), ?, 'Writeoff', 'W', ? )
978 ";
979 $sth = $dbh->prepare( $query );
980 my $acct = getnextacctno($borrowernumber);
981 $sth->execute( $borrowernumber, $acct, $itemnum, $amount, $manager_id );
982
983 if ( C4::Context->preference("FinesLog") ) {
984 logaction("FINES", 'CREATE',$borrowernumber,Dumper({
985 action => 'create_writeoff',
986 borrowernumber => $borrowernumber,
987 accountno => $acct,
988 amount => 0 - $amount,
989 accounttype => 'W',
990 itemnumber => $itemnum,
991 accountlines_paid => [ $accountlines_id ],
992 manager_id => $manager_id,
993 }));
994 }
995
996 UpdateStats( $branch, 'writeoff', $amount, q{}, q{}, q{}, $borrowernumber );
997
998}
999
100016µs
# spent 4µs within C4::Accounts::END which was called: # once (4µs+0s) by main::RUNTIME at line 0 of /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
END { } # module clean-up code here (global destructor)
1001
100214µs1;
1003__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.