C4/Accounts.pm

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