File Coverage

File:C4/Accounts.pm
Coverage:8.1%

linestmtbrancondsubtimecode
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
21
13
13
13
2468
126
446
use strict;
22#use warnings; FIXME - Bug 2505
23
13
13
13
159
78
193
use C4::Context;
24
13
13
13
286
57
2481
use C4::Stats;
25
13
13
13
245
114
1139
use C4::Members;
26
13
13
13
150
149
716
use C4::Circulation qw(ReturnLostItem);
27
28
13
13
13
138
96
1627
use vars qw($VERSION @ISA @EXPORT);
29
30BEGIN {
31        # set the version for version checking
32
13
88
        $VERSION = 3.03;
33
13
97
        require Exporter;
34
13
250
        @ISA = qw(Exporter);
35
13
45342
        @EXPORT = qw(
36                &recordpayment &makepayment &manualinvoice
37                &getnextacctno &reconcileaccount &getcharges &ModNote &getcredits
38                &getrefunds &chargelostitem
39                &ReversePayment
40        makepartialpayment
41        recordpayment_selectaccts
42        );
43}
44
45 - 74
=head1 NAME

C4::Accounts - Functions for dealing with Koha accounts

=head1 SYNOPSIS

use C4::Accounts;

=head1 DESCRIPTION

The functions in this module deal with the monetary aspect of Koha,
including looking up and modifying the amount of money owed by a
patron.

=head1 FUNCTIONS

=head2 recordpayment

  &recordpayment($borrowernumber, $payment);

Record payment by a patron. C<$borrowernumber> is the patron's
borrower number. C<$payment> is a floating-point number, giving the
amount that was paid. 

Amounts owed are paid off oldest first. That is, if the patron has a
$1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
of $1.50, then the oldest fine will be paid off in full, and $0.50
will be credited to the next one.

=cut
75
76#'
77sub recordpayment {
78
79    #here we update the account lines
80
0
    my ( $borrowernumber, $data ) = @_;
81
0
    my $dbh = C4::Context->dbh;
82
0
    my $newamtos = 0;
83
0
    my $accdata = "";
84
0
    my $branch = C4::Context->userenv->{'branch'};
85
0
    my $amountleft = $data;
86
87    # begin transaction
88
0
    my $nextaccntno = getnextacctno($borrowernumber);
89
90    # get lines with outstanding amounts to offset
91
0
    my $sth = $dbh->prepare(
92        "SELECT * FROM accountlines
93  WHERE (borrowernumber = ?) AND (amountoutstanding<>0)
94  ORDER BY date"
95    );
96
0
    $sth->execute($borrowernumber);
97
98    # offset transactions
99
0
    while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
100
0
        if ( $accdata->{'amountoutstanding'} < $amountleft ) {
101
0
            $newamtos = 0;
102
0
            $amountleft -= $accdata->{'amountoutstanding'};
103        }
104        else {
105
0
            $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
106
0
            $amountleft = 0;
107        }
108
0
        my $thisacct = $accdata->{accountno};
109
0
        my $usth = $dbh->prepare(
110            "UPDATE accountlines SET amountoutstanding= ?
111     WHERE (borrowernumber = ?) AND (accountno=?)"
112        );
113
0
        $usth->execute( $newamtos, $borrowernumber, $thisacct );
114
0
        $usth->finish;
115# $usth = $dbh->prepare(
116# "INSERT INTO accountoffsets
117# (borrowernumber, accountno, offsetaccount, offsetamount)
118# VALUES (?,?,?,?)"
119# );
120# $usth->execute( $borrowernumber, $accdata->{'accountno'},
121# $nextaccntno, $newamtos );
122
0
        $usth->finish;
123    }
124
125    # create new line
126
0
    my $usth = $dbh->prepare(
127        "INSERT INTO accountlines
128  (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding)
129  VALUES (?,?,now(),?,'Payment,thanks','Pay',?)"
130    );
131
0
    $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft );
132
0
    $usth->finish;
133
0
    UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno );
134
0
    $sth->finish;
135}
136
137 - 150
=head2 makepayment

  &makepayment($borrowernumber, $acctnumber, $amount, $branchcode);

Records the fact that a patron has paid off the entire amount he or
she owes.

C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is
the account that was credited. C<$amount> is the amount paid (this is
only used to record the payment. It is assumed to be equal to the
amount owed). C<$branchcode> is the code of the branch where payment
was made.

=cut
151
152#'
153# FIXME - I'm not at all sure about the above, because I don't
154# understand what the acct* tables in the Koha database are for.
155sub makepayment {
156
157    #here we update both the accountoffsets and the account lines
158    #updated to check, if they are paying off a lost item, we return the item
159    # from their card, and put a note on the item record
160
0
    my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_;
161
0
    my $dbh = C4::Context->dbh;
162
0
    my $manager_id = 0;
163
0
    $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
164
165    # begin transaction
166
0
    my $nextaccntno = getnextacctno($borrowernumber);
167
0
    my $newamtos = 0;
168
0
    my $sth =
169      $dbh->prepare(
170        "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?");
171
0
    $sth->execute( $borrowernumber, $accountno );
172
0
    my $data = $sth->fetchrow_hashref;
173
0
    $sth->finish;
174
175
0
    if($data->{'accounttype'} eq "Pay"){
176
0
        my $udp =
177            $dbh->prepare(
178                "UPDATE accountlines
179                    SET amountoutstanding = 0, description = 'Payment,thanks'
180                    WHERE borrowernumber = ?
181                    AND accountno = ?
182                "
183            );
184
0
        $udp->execute($borrowernumber, $accountno );
185
0
        $udp->finish;
186    }else{
187
0
        my $udp =
188            $dbh->prepare(
189                "UPDATE accountlines
190                    SET amountoutstanding = 0
191                    WHERE borrowernumber = ?
192                    AND accountno = ?
193                "
194            );
195
0
        $udp->execute($borrowernumber, $accountno );
196
0
        $udp->finish;
197
198         # create new line
199
0
        my $payment = 0 - $amount;
200
201
0
        my $ins =
202            $dbh->prepare(
203                "INSERT
204                    INTO accountlines (borrowernumber, accountno, date, amount, itemnumber, description, accounttype, amountoutstanding, manager_id)
205                    VALUES ( ?, ?, now(), ?, ?, 'Payment,thanks', 'Pay', 0, ?)"
206            );
207
0
        $ins->execute($borrowernumber, $nextaccntno, $payment, $data->{'itemnumber'}, $manager_id);
208
0
        $ins->finish;
209    }
210
211    # FIXME - The second argument to &UpdateStats is supposed to be the
212    # branch code.
213    # UpdateStats is now being passed $accountno too. MTJ
214
0
    UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber,
215        $accountno );
216    #from perldoc: for SELECT only #$sth->finish;
217
218    #check to see what accounttype
219
0
    if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
220
0
        C4::Circulation::ReturnLostItem( $borrowernumber, $data->{'itemnumber'} );
221    }
222}
223
224 - 231
=head2 getnextacctno

  $nextacct = &getnextacctno($borrowernumber);

Returns the next unused account number for the patron with the given
borrower number.

=cut
232
233#'
234# FIXME - Okay, so what does the above actually _mean_?
235sub getnextacctno ($) {
236
0
    my ($borrowernumber) = shift or return undef;
237
0
    my $sth = C4::Context->dbh->prepare(
238        "SELECT accountno+1 FROM accountlines
239         WHERE (borrowernumber = ?)
240         ORDER BY accountno DESC
241                 LIMIT 1"
242    );
243
0
    $sth->execute($borrowernumber);
244
0
    return ($sth->fetchrow || 1);
245}
246
247 - 278
=head2 fixaccounts (removed)

  &fixaccounts($borrowernumber, $accountnumber, $amount);

#'
# FIXME - I don't understand what this function does.
sub fixaccounts {
    my ( $borrowernumber, $accountno, $amount ) = @_;
    my $dbh = C4::Context->dbh;
    my $sth = $dbh->prepare(
        "SELECT * FROM accountlines WHERE borrowernumber=?
     AND accountno=?"
    );
    $sth->execute( $borrowernumber, $accountno );
    my $data = $sth->fetchrow_hashref;

    # FIXME - Error-checking
    my $diff        = $amount - $data->{'amount'};
    my $outstanding = $data->{'amountoutstanding'} + $diff;
    $sth->finish;

    $dbh->do(<<EOT);
        UPDATE  accountlines
        SET     amount = '$amount',
                amountoutstanding = '$outstanding'
        WHERE   borrowernumber = $borrowernumber
          AND   accountno = $accountno
EOT
	# FIXME: exceedingly bad form.  Use prepare with placholders ("?") in query and execute args.
}

=cut
279
280sub chargelostitem{
281# lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for
282# FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that
283# a charge has been added
284# FIXME : if no replacement price, borrower just doesn't get charged?
285
0
    my $dbh = C4::Context->dbh();
286
0
    my ($borrowernumber, $itemnumber, $amount, $description) = @_;
287
288    # first make sure the borrower hasn't already been charged for this item
289
0
    my $sth1=$dbh->prepare("SELECT * from accountlines
290    WHERE borrowernumber=? AND itemnumber=? and accounttype='L'");
291
0
    $sth1->execute($borrowernumber,$itemnumber);
292
0
    my $existing_charge_hashref=$sth1->fetchrow_hashref();
293
294    # OK, they haven't
295
0
    unless ($existing_charge_hashref) {
296        # This item is on issue ... add replacement cost to the borrower's record and mark it returned
297        # Note that we add this to the account even if there's no replacement price, allowing some other
298        # process (or person) to update it, since we don't handle any defaults for replacement prices.
299
0
        my $accountno = getnextacctno($borrowernumber);
300
0
        my $sth2=$dbh->prepare("INSERT INTO accountlines
301        (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber)
302        VALUES (?,?,now(),?,?,'L',?,?)");
303
0
        $sth2->execute($borrowernumber,$accountno,$amount,
304        $description,$amount,$itemnumber);
305
0
        $sth2->finish;
306    # FIXME: Log this ?
307    }
308}
309
310 - 322
=head2 manualinvoice

  &manualinvoice($borrowernumber, $itemnumber, $description, $type,
                 $amount, $note);

C<$borrowernumber> is the patron's borrower number.
C<$description> is a description of the transaction.
C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
or C<REF>.
C<$itemnumber> is the item involved, if pertinent; otherwise, it
should be the empty string.

=cut
323
324#'
325# FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
326# are :
327# 'C' = CREDIT
328# 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
329# 'N' = New Card fee
330# 'F' = Fine
331# 'A' = Account Management fee
332# 'M' = Sundry
333# 'L' = Lost Item
334#
335
336sub manualinvoice {
337
0
    my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_;
338
0
    my $manager_id = 0;
339
0
    $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
340
0
    my $dbh = C4::Context->dbh;
341
0
    my $notifyid = 0;
342
0
    my $insert;
343
0
    my $accountno = getnextacctno($borrowernumber);
344
0
    my $amountleft = $amount;
345
346# if ( $type eq 'CS'
347# || $type eq 'CB'
348# || $type eq 'CW'
349# || $type eq 'CF'
350# || $type eq 'CL' )
351# {
352# my $amount2 = $amount * -1; # FIXME - $amount2 = -$amount
353# $amountleft =
354# fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user );
355# }
356
0
    if ( $type eq 'N' ) {
357
0
        $desc .= " New Card";
358    }
359
0
    if ( $type eq 'F' ) {
360
0
        $desc .= " Fine";
361    }
362
0
    if ( $type eq 'A' ) {
363
0
        $desc .= " Account Management fee";
364    }
365
0
    if ( $type eq 'M' ) {
366
0
        $desc .= " Sundry";
367    }
368
369
0
    if ( $type eq 'L' && $desc eq '' ) {
370
371
0
        $desc = " Lost Item";
372    }
373# if ( $type eq 'REF' ) {
374# $desc .= " Cash Refund";
375# $amountleft = refund( '', $borrowernumber, $amount );
376# }
377
0
    if ( ( $type eq 'L' )
378        or ( $type eq 'F' )
379        or ( $type eq 'A' )
380        or ( $type eq 'N' )
381        or ( $type eq 'M' ) )
382    {
383
0
        $notifyid = 1;
384    }
385
386
0
    if ( $itemnum ) {
387
0
        $desc .= ' ' . $itemnum;
388
0
        my $sth = $dbh->prepare(
389            'INSERT INTO accountlines
390                        (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id)
391        VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)');
392
0
     $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr;
393  } else {
394
0
    my $sth=$dbh->prepare("INSERT INTO accountlines
395            (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id)
396            VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)"
397        );
398
0
        $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
399            $amountleft, $notifyid, $note, $manager_id );
400    }
401
0
    return 0;
402}
403
404 - 410
=head2 fixcredit #### DEPRECATED

 $amountleft = &fixcredit($borrowernumber, $data, $barcode, $type, $user);

 This function is only used internally, not exported.

=cut
411
412# This function is deprecated in 3.0
413
414sub fixcredit {
415
416    #here we update both the accountoffsets and the account lines
417
0
    my ( $borrowernumber, $data, $barcode, $type, $user ) = @_;
418
0
    my $dbh = C4::Context->dbh;
419
0
    my $newamtos = 0;
420
0
    my $accdata = "";
421
0
    my $amountleft = $data;
422
0
    if ( $barcode ne '' ) {
423
0
        my $item = GetBiblioFromItemNumber( '', $barcode );
424
0
        my $nextaccntno = getnextacctno($borrowernumber);
425
0
        my $query = "SELECT * FROM accountlines WHERE (borrowernumber=?
426    AND itemnumber=? AND amountoutstanding > 0)";
427
0
        if ( $type eq 'CL' ) {
428
0
            $query .= " AND (accounttype = 'L' OR accounttype = 'Rep')";
429        }
430        elsif ( $type eq 'CF' ) {
431
0
            $query .= " AND (accounttype = 'F' OR accounttype = 'FU' OR
432      accounttype='Res' OR accounttype='Rent')";
433        }
434        elsif ( $type eq 'CB' ) {
435
0
            $query .= " and accounttype='A'";
436        }
437
438        # print $query;
439
0
        my $sth = $dbh->prepare($query);
440
0
        $sth->execute( $borrowernumber, $item->{'itemnumber'} );
441
0
        $accdata = $sth->fetchrow_hashref;
442
0
        $sth->finish;
443
0
        if ( $accdata->{'amountoutstanding'} < $amountleft ) {
444
0
            $newamtos = 0;
445
0
            $amountleft -= $accdata->{'amountoutstanding'};
446        }
447        else {
448
0
            $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
449
0
            $amountleft = 0;
450        }
451
0
        my $thisacct = $accdata->{accountno};
452
0
        my $usth = $dbh->prepare(
453            "UPDATE accountlines SET amountoutstanding= ?
454     WHERE (borrowernumber = ?) AND (accountno=?)"
455        );
456
0
        $usth->execute( $newamtos, $borrowernumber, $thisacct );
457
0
        $usth->finish;
458
0
        $usth = $dbh->prepare(
459            "INSERT INTO accountoffsets
460     (borrowernumber, accountno, offsetaccount, offsetamount)
461     VALUES (?,?,?,?)"
462        );
463
0
        $usth->execute( $borrowernumber, $accdata->{'accountno'},
464            $nextaccntno, $newamtos );
465
0
        $usth->finish;
466    }
467
468    # begin transaction
469
0
    my $nextaccntno = getnextacctno($borrowernumber);
470
471    # get lines with outstanding amounts to offset
472
0
    my $sth = $dbh->prepare(
473        "SELECT * FROM accountlines
474  WHERE (borrowernumber = ?) AND (amountoutstanding >0)
475  ORDER BY date"
476    );
477
0
    $sth->execute($borrowernumber);
478
479    # print $query;
480    # offset transactions
481
0
    while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
482
0
        if ( $accdata->{'amountoutstanding'} < $amountleft ) {
483
0
            $newamtos = 0;
484
0
            $amountleft -= $accdata->{'amountoutstanding'};
485        }
486        else {
487
0
            $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
488
0
            $amountleft = 0;
489        }
490
0
        my $thisacct = $accdata->{accountno};
491
0
        my $usth = $dbh->prepare(
492            "UPDATE accountlines SET amountoutstanding= ?
493     WHERE (borrowernumber = ?) AND (accountno=?)"
494        );
495
0
        $usth->execute( $newamtos, $borrowernumber, $thisacct );
496
0
        $usth->finish;
497
0
        $usth = $dbh->prepare(
498            "INSERT INTO accountoffsets
499     (borrowernumber, accountno, offsetaccount, offsetamount)
500     VALUE (?,?,?,?)"
501        );
502
0
        $usth->execute( $borrowernumber, $accdata->{'accountno'},
503            $nextaccntno, $newamtos );
504
0
        $usth->finish;
505    }
506
0
    $sth->finish;
507
0
    $type = "Credit " . $type;
508
0
    UpdateStats( $user, $type, $data, $user, '', '', $borrowernumber );
509
0
    $amountleft *= -1;
510
0
    return ($amountleft);
511
512}
513
514 - 521
=head2 refund

#FIXME : DEPRECATED SUB
 This subroutine tracks payments and/or credits against fines/charges
   using the accountoffsets table, which is not used consistently in
   Koha's fines management, and so is not used in 3.0 

=cut 
522
523sub refund {
524
525    #here we update both the accountoffsets and the account lines
526
0
    my ( $borrowernumber, $data ) = @_;
527
0
    my $dbh = C4::Context->dbh;
528
0
    my $newamtos = 0;
529
0
    my $accdata = "";
530
0
    my $amountleft = $data * -1;
531
532    # begin transaction
533
0
    my $nextaccntno = getnextacctno($borrowernumber);
534
535    # get lines with outstanding amounts to offset
536
0
    my $sth = $dbh->prepare(
537        "SELECT * FROM accountlines
538  WHERE (borrowernumber = ?) AND (amountoutstanding<0)
539  ORDER BY date"
540    );
541
0
    $sth->execute($borrowernumber);
542
543    # print $amountleft;
544    # offset transactions
545
0
    while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) {
546
0
        if ( $accdata->{'amountoutstanding'} > $amountleft ) {
547
0
            $newamtos = 0;
548
0
            $amountleft -= $accdata->{'amountoutstanding'};
549        }
550        else {
551
0
            $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
552
0
            $amountleft = 0;
553        }
554
555        # print $amountleft;
556
0
        my $thisacct = $accdata->{accountno};
557
0
        my $usth = $dbh->prepare(
558            "UPDATE accountlines SET amountoutstanding= ?
559     WHERE (borrowernumber = ?) AND (accountno=?)"
560        );
561
0
        $usth->execute( $newamtos, $borrowernumber, $thisacct );
562
0
        $usth->finish;
563
0
        $usth = $dbh->prepare(
564            "INSERT INTO accountoffsets
565     (borrowernumber, accountno, offsetaccount, offsetamount)
566     VALUES (?,?,?,?)"
567        );
568
0
        $usth->execute( $borrowernumber, $accdata->{'accountno'},
569            $nextaccntno, $newamtos );
570
0
        $usth->finish;
571    }
572
0
    $sth->finish;
573
0
    return ($amountleft);
574}
575
576sub getcharges {
577
0
        my ( $borrowerno, $timestamp, $accountno ) = @_;
578
0
        my $dbh = C4::Context->dbh;
579
0
        my $timestamp2 = $timestamp - 1;
580
0
        my $query = "";
581
0
        my $sth = $dbh->prepare(
582                        "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
583          );
584
0
        $sth->execute( $borrowerno, $accountno );
585
586
0
    my @results;
587
0
    while ( my $data = $sth->fetchrow_hashref ) {
588
0
                push @results,$data;
589        }
590
0
    return (@results);
591}
592
593sub ModNote {
594
0
    my ( $borrowernumber, $accountno, $note ) = @_;
595
0
    my $dbh = C4::Context->dbh;
596
0
    my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE borrowernumber = ? AND accountno = ?');
597
0
    $sth->execute( $note, $borrowernumber, $accountno );
598}
599
600sub getcredits {
601
0
        my ( $date, $date2 ) = @_;
602
0
        my $dbh = C4::Context->dbh;
603
0
        my $sth = $dbh->prepare(
604                                "SELECT * FROM accountlines,borrowers
605      WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber
606          AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
607      );
608
609
0
    $sth->execute( $date, $date2 );
610
0
    my @results;
611
0
    while ( my $data = $sth->fetchrow_hashref ) {
612
0
                $data->{'date'} = $data->{'timestamp'};
613
0
                push @results,$data;
614        }
615
0
    return (@results);
616}
617
618
619sub getrefunds {
620
0
        my ( $date, $date2 ) = @_;
621
0
        my $dbh = C4::Context->dbh;
622
623
0
        my $sth = $dbh->prepare(
624                                "SELECT *,timestamp AS datetime
625                  FROM accountlines,borrowers
626                  WHERE (accounttype = 'REF'
627                                          AND accountlines.borrowernumber = borrowers.borrowernumber
628                                                          AND date >=? AND date <?)"
629    );
630
631
0
    $sth->execute( $date, $date2 );
632
633
0
    my @results;
634
0
    while ( my $data = $sth->fetchrow_hashref ) {
635
0
                push @results,$data;
636
637        }
638
0
    return (@results);
639}
640
641sub ReversePayment {
642
0
  my ( $borrowernumber, $accountno ) = @_;
643
0
  my $dbh = C4::Context->dbh;
644
645
0
  my $sth = $dbh->prepare('SELECT amountoutstanding FROM accountlines WHERE borrowernumber = ? AND accountno = ?');
646
0
  $sth->execute( $borrowernumber, $accountno );
647
0
  my $row = $sth->fetchrow_hashref();
648
0
  my $amount_outstanding = $row->{'amountoutstanding'};
649
650
0
  if ( $amount_outstanding <= 0 ) {
651
0
    $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
652
0
    $sth->execute( $borrowernumber, $accountno );
653  } else {
654
0
    $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
655
0
    $sth->execute( $borrowernumber, $accountno );
656  }
657}
658
659 - 673
=head2 recordpayment_selectaccts

  recordpayment_selectaccts($borrowernumber, $payment,$accts);

Record payment by a patron. C<$borrowernumber> is the patron's
borrower number. C<$payment> is a floating-point number, giving the
amount that was paid. C<$accts> is an array ref to a list of
accountnos which the payment can be recorded against

Amounts owed are paid off oldest first. That is, if the patron has a
$1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
of $1.50, then the oldest fine will be paid off in full, and $0.50
will be credited to the next one.

=cut
674
675sub recordpayment_selectaccts {
676
0
    my ( $borrowernumber, $amount, $accts ) = @_;
677
678
0
    my $dbh = C4::Context->dbh;
679
0
    my $newamtos = 0;
680
0
    my $accdata = q{};
681
0
    my $branch = C4::Context->userenv->{branch};
682
0
    my $amountleft = $amount;
683
0
    my $sql = 'SELECT * FROM accountlines WHERE (borrowernumber = ?) ' .
684    'AND (amountoutstanding<>0) ';
685
0
0
    if (@{$accts} ) {
686
0
0
        $sql .= ' AND accountno IN ( ' . join ',', @{$accts};
687
0
        $sql .= ' ) ';
688    }
689
0
    $sql .= ' ORDER BY date';
690    # begin transaction
691
0
    my $nextaccntno = getnextacctno($borrowernumber);
692
693    # get lines with outstanding amounts to offset
694
0
    my $rows = $dbh->selectall_arrayref($sql, { Slice => {} }, $borrowernumber);
695
696    # offset transactions
697
0
    my $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding= ? ' .
698        'WHERE (borrowernumber = ?) AND (accountno=?)');
699
0
0
    for my $accdata ( @{$rows} ) {
700
0
        if ($amountleft == 0) {
701
0
            last;
702        }
703
0
        if ( $accdata->{amountoutstanding} < $amountleft ) {
704
0
            $newamtos = 0;
705
0
            $amountleft -= $accdata->{amountoutstanding};
706        }
707        else {
708
0
            $newamtos = $accdata->{amountoutstanding} - $amountleft;
709
0
            $amountleft = 0;
710        }
711
0
        my $thisacct = $accdata->{accountno};
712
0
        $sth->execute( $newamtos, $borrowernumber, $thisacct );
713    }
714
715    # create new line
716
0
    $sql = 'INSERT INTO accountlines ' .
717    '(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding) ' .
718    q|VALUES (?,?,now(),?,'Payment,thanks','Pay',?)|;
719
0
    $dbh->do($sql,{},$borrowernumber, $nextaccntno, 0 - $amount, 0 - $amountleft );
720
0
    UpdateStats( $branch, 'payment', $amount, '', '', '', $borrowernumber, $nextaccntno );
721
0
    return;
722}
723
724# makepayment needs to be fixed to handle partials till then this separate subroutine
725# fills in
726sub makepartialpayment {
727
0
    my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_;
728
0
    my $manager_id = 0;
729
0
    $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
730
0
    if (!$amount || $amount < 0) {
731
0
        return;
732    }
733
0
    my $dbh = C4::Context->dbh;
734
735
0
    my $nextaccntno = getnextacctno($borrowernumber);
736
0
    my $newamtos = 0;
737
738
0
    my $data = $dbh->selectrow_hashref(
739        'SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?',undef,$borrowernumber,$accountno);
740
0
    my $new_outstanding = $data->{amountoutstanding} - $amount;
741
742
0
    my $update = 'UPDATE accountlines SET amountoutstanding = ? WHERE borrowernumber = ? '
743    . ' AND accountno = ?';
744
0
    $dbh->do( $update, undef, $new_outstanding, $borrowernumber, $accountno);
745
746    # create new line
747
0
    my $insert = 'INSERT INTO accountlines (borrowernumber, accountno, date, amount, '
748    . 'description, accounttype, amountoutstanding, itemnumber, manager_id) '
749    . ' VALUES (?, ?, now(), ?, ?, ?, 0, ?, ?)';
750
751
0
    $dbh->do( $insert, undef, $borrowernumber, $nextaccntno, $amount,
752        "Payment, thanks - $user", 'Pay', $data->{'itemnumber'}, $manager_id);
753
754
0
    UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber, $accountno );
755
756
0
    return;
757}
758
759
760
761
13
1412
END { } # module clean-up code here (global destructor)
762
7631;