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
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  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 use C4::Log qw(logaction);
  28
  29 use Data::Dumper qw(Dumper);
  30
  31 use vars qw(@ISA @EXPORT);
  32
  33 BEGIN {
  34         require Exporter;
  35         @ISA    = qw(Exporter);
  36         @EXPORT = qw(
  37                 &recordpayment
  38                 &makepayment
  39                 &manualinvoice
  40                 &getnextacctno
  41                 &getcharges
  42                 &ModNote
  43                 &getcredits
  44                 &getrefunds
  45                 &chargelostitem
  46                 &ReversePayment
  47         &makepartialpayment
  48         &recordpayment_selectaccts
  49         &WriteOffFee
  50         &purge_zero_balance_fees
  51         );
  52 }
  53
  54 =head1 NAME
  55
  56 C4::Accounts - Functions for dealing with Koha accounts
  57
  58 =head1 SYNOPSIS
  59
  60 use C4::Accounts;
  61
  62 =head1 DESCRIPTION
  63
  64 The functions in this module deal with the monetary aspect of Koha,
  65 including looking up and modifying the amount of money owed by a
  66 patron.
  67
  68 =head1 FUNCTIONS
  69
  70 =head2 recordpayment
  71
  72   &recordpayment($borrowernumber, $payment, $sip_paytype, $note);
  73
  74 Record payment by a patron. C<$borrowernumber> is the patron's
  75 borrower number. C<$payment> is a floating-point number, giving the
  76 amount that was paid. C<$sip_paytype> is an optional flag to indicate this
  77 payment was made over a SIP2 interface, rather than the staff client. The
  78 value passed is the SIP2 payment type value (message 37, characters 21-22)
  79
  80 Amounts owed are paid off oldest first. That is, if the patron has a
  81 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
  82 of $1.50, then the oldest fine will be paid off in full, and $0.50
  83 will be credited to the next one.
  84
  85 =cut
  86
  87 #'
  88 sub recordpayment {
  89
  90     #here we update the account lines
  91     my ( $borrowernumber, $data, $sip_paytype, $payment_note ) = @_;
  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     $payment_note //= "";
 101
 102     # begin transaction
 103     my $nextaccntno = getnextacctno($borrowernumber);
 104
 105     # get lines with outstanding amounts to offset
 106     my $sth = $dbh->prepare(
 107         "SELECT * FROM accountlines
 108   WHERE (borrowernumber = ?) AND (amountoutstanding<>0)
 109   ORDER BY date"
 110     );
 111     $sth->execute($borrowernumber);
 112
 113     # offset transactions
 114     my @ids;
 115     while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
 116         if ( $accdata->{'amountoutstanding'} < $amountleft ) {
 117             $newamtos = 0;
 118             $amountleft -= $accdata->{'amountoutstanding'};
 119         }
 120         else {
 121             $newamtos   = $accdata->{'amountoutstanding'} - $amountleft;
 122             $amountleft = 0;
 123         }
 124         my $thisacct = $accdata->{accountlines_id};
 125         my $usth     = $dbh->prepare(
 126             "UPDATE accountlines SET amountoutstanding= ?
 127      WHERE (accountlines_id = ?)"
 128         );
 129         $usth->execute( $newamtos, $thisacct );
 130
 131         if ( C4::Context->preference("FinesLog") ) {
 132             $accdata->{'amountoutstanding_new'} = $newamtos;
 133             logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
 134                 action                => 'fee_payment',
 135                 borrowernumber        => $accdata->{'borrowernumber'},
 136                 old_amountoutstanding => $accdata->{'amountoutstanding'},
 137                 new_amountoutstanding => $newamtos,
 138                 amount_paid           => $accdata->{'amountoutstanding'} - $newamtos,
 139                 accountlines_id       => $accdata->{'accountlines_id'},
 140                 accountno             => $accdata->{'accountno'},
 141                 manager_id            => $manager_id,
 142                 note                  => $payment_note,
 143             }));
 144             push( @ids, $accdata->{'accountlines_id'} );
 145         }
 146     }
 147
 148     # create new line
 149     my $usth = $dbh->prepare(
 150         "INSERT INTO accountlines
 151   (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id, note)
 152   VALUES (?,?,now(),?,'',?,?,?,?)"
 153     );
 154
 155     my $paytype = "Pay";
 156     $paytype .= $sip_paytype if defined $sip_paytype;
 157     $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, $paytype, 0 - $amountleft, $manager_id, $payment_note );
 158     $usth->finish;
 159
 160     UpdateStats({
 161                 branch => $branch,
 162                 type =>'payment',
 163                 amount => $data,
 164                 borrowernumber => $borrowernumber,
 165                 accountno => $nextaccntno }
 166     );
 167
 168     if ( C4::Context->preference("FinesLog") ) {
 169         $accdata->{'amountoutstanding_new'} = $newamtos;
 170         logaction("FINES", 'CREATE',$borrowernumber,Dumper({
 171             action            => 'create_payment',
 172             borrowernumber    => $borrowernumber,
 173             accountno         => $nextaccntno,
 174             amount            => $data * -1,
 175             amountoutstanding => $amountleft * -1,
 176             accounttype       => 'Pay',
 177             accountlines_paid => \@ids,
 178             manager_id        => $manager_id,
 179         }));
 180     }
 181
 182 }
 183
 184 =head2 makepayment
 185
 186   &makepayment($accountlines_id, $borrowernumber, $acctnumber, $amount, $branchcode);
 187
 188 Records the fact that a patron has paid off the entire amount he or
 189 she owes.
 190
 191 C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is
 192 the account that was credited. C<$amount> is the amount paid (this is
 193 only used to record the payment. It is assumed to be equal to the
 194 amount owed). C<$branchcode> is the code of the branch where payment
 195 was made.
 196
 197 =cut
 198
 199 #'
 200 # FIXME - I'm not at all sure about the above, because I don't
 201 # understand what the acct* tables in the Koha database are for.
 202 sub makepayment {
 203
 204     #here we update both the accountoffsets and the account lines
 205     #updated to check, if they are paying off a lost item, we return the item
 206     # from their card, and put a note on the item record
 207     my ( $accountlines_id, $borrowernumber, $accountno, $amount, $user, $branch, $payment_note ) = @_;
 208     my $dbh = C4::Context->dbh;
 209     my $manager_id = 0;
 210     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
 211
 212     # begin transaction
 213     my $nextaccntno = getnextacctno($borrowernumber);
 214     my $newamtos    = 0;
 215     my $sth         = $dbh->prepare("SELECT * FROM accountlines WHERE accountlines_id=?");
 216     $sth->execute( $accountlines_id );
 217     my $data = $sth->fetchrow_hashref;
 218
 219     my $payment;
 220     if ( $data->{'accounttype'} eq "Pay" ){
 221         my $udp =
 222             $dbh->prepare(
 223                 "UPDATE accountlines
 224                     SET amountoutstanding = 0
 225                     WHERE accountlines_id = ?
 226                 "
 227             );
 228         $udp->execute($accountlines_id);
 229     }else{
 230         my $udp =
 231             $dbh->prepare(
 232                 "UPDATE accountlines
 233                     SET amountoutstanding = 0
 234                     WHERE accountlines_id = ?
 235                 "
 236             );
 237         $udp->execute($accountlines_id);
 238
 239          # create new line
 240         my $payment = 0 - $amount;
 241         $payment_note //= "";
 242
 243         my $ins =
 244             $dbh->prepare(
 245                 "INSERT
 246                     INTO accountlines (borrowernumber, accountno, date, amount, itemnumber, description, accounttype, amountoutstanding, manager_id, note)
 247                     VALUES ( ?, ?, now(), ?, ?, '', 'Pay', 0, ?, ?)"
 248             );
 249         $ins->execute($borrowernumber, $nextaccntno, $payment, $data->{'itemnumber'}, $manager_id, $payment_note);
 250     }
 251
 252     if ( C4::Context->preference("FinesLog") ) {
 253         logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
 254             action                => 'fee_payment',
 255             borrowernumber        => $borrowernumber,
 256             old_amountoutstanding => $data->{'amountoutstanding'},
 257             new_amountoutstanding => 0,
 258             amount_paid           => $data->{'amountoutstanding'},
 259             accountlines_id       => $data->{'accountlines_id'},
 260             accountno             => $data->{'accountno'},
 261             manager_id            => $manager_id,
 262         }));
 263
 264
 265         logaction("FINES", 'CREATE',$borrowernumber,Dumper({
 266             action            => 'create_payment',
 267             borrowernumber    => $borrowernumber,
 268             accountno         => $nextaccntno,
 269             amount            => $payment,
 270             amountoutstanding => 0,,
 271             accounttype       => 'Pay',
 272             accountlines_paid => [$data->{'accountlines_id'}],
 273             manager_id        => $manager_id,
 274         }));
 275     }
 276
 277     UpdateStats({
 278         branch => $branch,
 279         type   => 'payment',
 280         amount => $amount,
 281         borrowernumber => $borrowernumber,
 282         accountno => $accountno
 283     });
 284
 285     #check to see what accounttype
 286     if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
 287         C4::Circulation::ReturnLostItem( $borrowernumber, $data->{'itemnumber'} );
 288     }
 289     my $sthr = $dbh->prepare("SELECT max(accountlines_id) AS lastinsertid FROM accountlines");
 290     $sthr->execute();
 291     my $datalastinsertid = $sthr->fetchrow_hashref;
 292     return $datalastinsertid->{'lastinsertid'};
 293 }
 294
 295 =head2 getnextacctno
 296
 297   $nextacct = &getnextacctno($borrowernumber);
 298
 299 Returns the next unused account number for the patron with the given
 300 borrower number.
 301
 302 =cut
 303
 304 #'
 305 # FIXME - Okay, so what does the above actually _mean_?
 306 sub getnextacctno {
 307     my ($borrowernumber) = shift or return;
 308     my $sth = C4::Context->dbh->prepare(
 309         "SELECT accountno+1 FROM accountlines
 310             WHERE    (borrowernumber = ?)
 311             ORDER BY accountno DESC
 312             LIMIT 1"
 313     );
 314     $sth->execute($borrowernumber);
 315     return ($sth->fetchrow || 1);
 316 }
 317
 318 =head2 fixaccounts (removed)
 319
 320   &fixaccounts($accountlines_id, $borrowernumber, $accountnumber, $amount);
 321
 322 #'
 323 # FIXME - I don't understand what this function does.
 324 sub fixaccounts {
 325     my ( $accountlines_id, $borrowernumber, $accountno, $amount ) = @_;
 326     my $dbh = C4::Context->dbh;
 327     my $sth = $dbh->prepare(
 328         "SELECT * FROM accountlines WHERE accountlines_id=?"
 329     );
 330     $sth->execute( $accountlines_id );
 331     my $data = $sth->fetchrow_hashref;
 332
 333     # FIXME - Error-checking
 334     my $diff        = $amount - $data->{'amount'};
 335     my $outstanding = $data->{'amountoutstanding'} + $diff;
 336     $sth->finish;
 337
 338     $dbh->do(<<EOT);
 339         UPDATE  accountlines
 340         SET     amount = '$amount',
 341                 amountoutstanding = '$outstanding'
 342         WHERE   accountlines_id = $accountlines_id
 343 EOT
 344         # FIXME: exceedingly bad form.  Use prepare with placholders ("?") in query and execute args.
 345 }
 346
 347 =cut
 348
 349 sub chargelostitem{
 350 # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for
 351 # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that
 352 # a charge has been added
 353 # FIXME : if no replacement price, borrower just doesn't get charged?
 354     my $dbh = C4::Context->dbh();
 355     my ($borrowernumber, $itemnumber, $amount, $description) = @_;
 356
 357     # first make sure the borrower hasn't already been charged for this item
 358     my $sth1=$dbh->prepare("SELECT * from accountlines
 359     WHERE borrowernumber=? AND itemnumber=? and accounttype='L'");
 360     $sth1->execute($borrowernumber,$itemnumber);
 361     my $existing_charge_hashref=$sth1->fetchrow_hashref();
 362
 363     # OK, they haven't
 364     unless ($existing_charge_hashref) {
 365         my $manager_id = 0;
 366         $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
 367         # This item is on issue ... add replacement cost to the borrower's record and mark it returned
 368         #  Note that we add this to the account even if there's no replacement price, allowing some other
 369         #  process (or person) to update it, since we don't handle any defaults for replacement prices.
 370         my $accountno = getnextacctno($borrowernumber);
 371         my $sth2=$dbh->prepare("INSERT INTO accountlines
 372         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber,manager_id)
 373         VALUES (?,?,now(),?,?,'L',?,?,?)");
 374         $sth2->execute($borrowernumber,$accountno,$amount,
 375         $description,$amount,$itemnumber,$manager_id);
 376
 377         if ( C4::Context->preference("FinesLog") ) {
 378             logaction("FINES", 'CREATE', $borrowernumber, Dumper({
 379                 action            => 'create_fee',
 380                 borrowernumber    => $borrowernumber,
 381                 accountno         => $accountno,
 382                 amount            => $amount,
 383                 amountoutstanding => $amount,
 384                 description       => $description,
 385                 accounttype       => 'L',
 386                 itemnumber        => $itemnumber,
 387                 manager_id        => $manager_id,
 388             }));
 389         }
 390
 391     }
 392 }
 393
 394 =head2 manualinvoice
 395
 396   &manualinvoice($borrowernumber, $itemnumber, $description, $type,
 397                  $amount, $note);
 398
 399 C<$borrowernumber> is the patron's borrower number.
 400 C<$description> is a description of the transaction.
 401 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
 402 or C<REF>.
 403 C<$itemnumber> is the item involved, if pertinent; otherwise, it
 404 should be the empty string.
 405
 406 =cut
 407
 408 #'
 409 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
 410 # are :
 411 #               'C' = CREDIT
 412 #               'FOR' = FORGIVEN  (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
 413 #               'N' = New Card fee
 414 #               'F' = Fine
 415 #               'A' = Account Management fee
 416 #               'M' = Sundry
 417 #               'L' = Lost Item
 418 #
 419
 420 sub manualinvoice {
 421     my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_;
 422     my $manager_id = 0;
 423     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
 424     my $dbh      = C4::Context->dbh;
 425     my $notifyid = 0;
 426     my $insert;
 427     my $accountno  = getnextacctno($borrowernumber);
 428     my $amountleft = $amount;
 429
 430     if (   ( $type eq 'L' )
 431         or ( $type eq 'F' )
 432         or ( $type eq 'A' )
 433         or ( $type eq 'N' )
 434         or ( $type eq 'M' ) )
 435     {
 436         $notifyid = 1;
 437     }
 438
 439     if ( $itemnum ) {
 440         $desc .= ' ' . $itemnum;
 441         my $sth = $dbh->prepare(
 442             'INSERT INTO  accountlines
 443                         (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id)
 444         VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)');
 445      $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr;
 446   } else {
 447     my $sth=$dbh->prepare("INSERT INTO  accountlines
 448             (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id)
 449             VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)"
 450         );
 451         $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
 452             $amountleft, $notifyid, $note, $manager_id );
 453     }
 454
 455     if ( C4::Context->preference("FinesLog") ) {
 456         logaction("FINES", 'CREATE',$borrowernumber,Dumper({
 457             action            => 'create_fee',
 458             borrowernumber    => $borrowernumber,
 459             accountno         => $accountno,
 460             amount            => $amount,
 461             description       => $desc,
 462             accounttype       => $type,
 463             amountoutstanding => $amountleft,
 464             notify_id         => $notifyid,
 465             note              => $note,
 466             itemnumber        => $itemnum,
 467             manager_id        => $manager_id,
 468         }));
 469     }
 470
 471     return 0;
 472 }
 473
 474 sub getcharges {
 475         my ( $borrowerno, $timestamp, $accountno ) = @_;
 476         my $dbh        = C4::Context->dbh;
 477         my $timestamp2 = $timestamp - 1;
 478         my $query      = "";
 479         my $sth = $dbh->prepare(
 480                         "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
 481           );
 482         $sth->execute( $borrowerno, $accountno );
 483
 484     my @results;
 485     while ( my $data = $sth->fetchrow_hashref ) {
 486                 push @results,$data;
 487         }
 488     return (@results);
 489 }
 490
 491 sub ModNote {
 492     my ( $accountlines_id, $note ) = @_;
 493     my $dbh = C4::Context->dbh;
 494     my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE accountlines_id = ?');
 495     $sth->execute( $note, $accountlines_id );
 496 }
 497
 498 sub getcredits {
 499         my ( $date, $date2 ) = @_;
 500         my $dbh = C4::Context->dbh;
 501         my $sth = $dbh->prepare(
 502                                 "SELECT * FROM accountlines,borrowers
 503       WHERE amount < 0 AND accounttype not like 'Pay%' AND accountlines.borrowernumber = borrowers.borrowernumber
 504           AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
 505       );
 506
 507     $sth->execute( $date, $date2 );
 508     my @results;
 509     while ( my $data = $sth->fetchrow_hashref ) {
 510                 $data->{'date'} = $data->{'timestamp'};
 511                 push @results,$data;
 512         }
 513     return (@results);
 514 }
 515
 516
 517 sub getrefunds {
 518         my ( $date, $date2 ) = @_;
 519         my $dbh = C4::Context->dbh;
 520
 521         my $sth = $dbh->prepare(
 522                                 "SELECT *,timestamp AS datetime
 523                   FROM accountlines,borrowers
 524                   WHERE (accounttype = 'REF'
 525                                           AND accountlines.borrowernumber = borrowers.borrowernumber
 526                                                           AND date  >=?  AND date  <?)"
 527     );
 528
 529     $sth->execute( $date, $date2 );
 530
 531     my @results;
 532     while ( my $data = $sth->fetchrow_hashref ) {
 533                 push @results,$data;
 534
 535         }
 536     return (@results);
 537 }
 538
 539 sub ReversePayment {
 540     my ( $accountlines_id ) = @_;
 541     my $dbh = C4::Context->dbh;
 542
 543     my $sth = $dbh->prepare('SELECT * FROM accountlines WHERE accountlines_id = ?');
 544     $sth->execute( $accountlines_id );
 545     my $row = $sth->fetchrow_hashref();
 546     my $amount_outstanding = $row->{'amountoutstanding'};
 547
 548     if ( $amount_outstanding <= 0 ) {
 549         $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE accountlines_id = ?');
 550         $sth->execute( $accountlines_id );
 551     } else {
 552         $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE accountlines_id = ?');
 553         $sth->execute( $accountlines_id );
 554     }
 555
 556     if ( C4::Context->preference("FinesLog") ) {
 557         my $manager_id = 0;
 558         $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
 559
 560         if ( $amount_outstanding <= 0 ) {
 561             $row->{'amountoutstanding'} *= -1;
 562         } else {
 563             $row->{'amountoutstanding'} = '0';
 564         }
 565         $row->{'description'} .= ' Reversed -';
 566         logaction("FINES", 'MODIFY', $row->{'borrowernumber'}, Dumper({
 567             action                => 'reverse_fee_payment',
 568             borrowernumber        => $row->{'borrowernumber'},
 569             old_amountoutstanding => $row->{'amountoutstanding'},
 570             new_amountoutstanding => 0 - $amount_outstanding,,
 571             accountlines_id       => $row->{'accountlines_id'},
 572             accountno             => $row->{'accountno'},
 573             manager_id            => $manager_id,
 574         }));
 575
 576     }
 577
 578 }
 579
 580 =head2 recordpayment_selectaccts
 581
 582   recordpayment_selectaccts($borrowernumber, $payment,$accts);
 583
 584 Record payment by a patron. C<$borrowernumber> is the patron's
 585 borrower number. C<$payment> is a floating-point number, giving the
 586 amount that was paid. C<$accts> is an array ref to a list of
 587 accountnos which the payment can be recorded against
 588
 589 Amounts owed are paid off oldest first. That is, if the patron has a
 590 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
 591 of $1.50, then the oldest fine will be paid off in full, and $0.50
 592 will be credited to the next one.
 593
 594 =cut
 595
 596 sub recordpayment_selectaccts {
 597     my ( $borrowernumber, $amount, $accts, $note ) = @_;
 598
 599     my $dbh        = C4::Context->dbh;
 600     my $newamtos   = 0;
 601     my $accdata    = q{};
 602     my $branch     = C4::Context->userenv->{branch};
 603     my $amountleft = $amount;
 604     my $manager_id = 0;
 605     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
 606     my $sql = 'SELECT * FROM accountlines WHERE (borrowernumber = ?) ' .
 607     'AND (amountoutstanding<>0) ';
 608     if (@{$accts} ) {
 609         $sql .= ' AND accountno IN ( ' .  join ',', @{$accts};
 610         $sql .= ' ) ';
 611     }
 612     $sql .= ' ORDER BY date';
 613     # begin transaction
 614     my $nextaccntno = getnextacctno($borrowernumber);
 615
 616     # get lines with outstanding amounts to offset
 617     my $rows = $dbh->selectall_arrayref($sql, { Slice => {} }, $borrowernumber);
 618
 619     # offset transactions
 620     my $sth     = $dbh->prepare('UPDATE accountlines SET amountoutstanding= ? ' .
 621         'WHERE accountlines_id=?');
 622
 623     my @ids;
 624     for my $accdata ( @{$rows} ) {
 625         if ($amountleft == 0) {
 626             last;
 627         }
 628         if ( $accdata->{amountoutstanding} < $amountleft ) {
 629             $newamtos = 0;
 630             $amountleft -= $accdata->{amountoutstanding};
 631         }
 632         else {
 633             $newamtos   = $accdata->{amountoutstanding} - $amountleft;
 634             $amountleft = 0;
 635         }
 636         my $thisacct = $accdata->{accountlines_id};
 637         $sth->execute( $newamtos, $thisacct );
 638
 639         if ( C4::Context->preference("FinesLog") ) {
 640             logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
 641                 action                => 'fee_payment',
 642                 borrowernumber        => $borrowernumber,
 643                 old_amountoutstanding => $accdata->{'amountoutstanding'},
 644                 new_amountoutstanding => $newamtos,
 645                 amount_paid           => $accdata->{'amountoutstanding'} - $newamtos,
 646                 accountlines_id       => $accdata->{'accountlines_id'},
 647                 accountno             => $accdata->{'accountno'},
 648                 manager_id            => $manager_id,
 649             }));
 650             push( @ids, $accdata->{'accountlines_id'} );
 651         }
 652
 653     }
 654
 655     # create new line
 656     $sql = 'INSERT INTO accountlines ' .
 657     '(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding,manager_id,note) ' .
 658     q|VALUES (?,?,now(),?,'','Pay',?,?,?)|;
 659     $dbh->do($sql,{},$borrowernumber, $nextaccntno, 0 - $amount, 0 - $amountleft, $manager_id, $note );
 660     UpdateStats({
 661                 branch => $branch,
 662                 type => 'payment',
 663                 amount => $amount,
 664                 borrowernumber => $borrowernumber,
 665                 accountno => $nextaccntno}
 666     );
 667
 668     if ( C4::Context->preference("FinesLog") ) {
 669         logaction("FINES", 'CREATE',$borrowernumber,Dumper({
 670             action            => 'create_payment',
 671             borrowernumber    => $borrowernumber,
 672             accountno         => $nextaccntno,
 673             amount            => 0 - $amount,
 674             amountoutstanding => 0 - $amountleft,
 675             accounttype       => 'Pay',
 676             accountlines_paid => \@ids,
 677             manager_id        => $manager_id,
 678         }));
 679     }
 680
 681     return;
 682 }
 683
 684 # makepayment needs to be fixed to handle partials till then this separate subroutine
 685 # fills in
 686 sub makepartialpayment {
 687     my ( $accountlines_id, $borrowernumber, $accountno, $amount, $user, $branch, $payment_note ) = @_;
 688     my $manager_id = 0;
 689     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
 690     if (!$amount || $amount < 0) {
 691         return;
 692     }
 693     $payment_note //= "";
 694     my $dbh = C4::Context->dbh;
 695
 696     my $nextaccntno = getnextacctno($borrowernumber);
 697     my $newamtos    = 0;
 698
 699     my $data = $dbh->selectrow_hashref(
 700         'SELECT * FROM accountlines WHERE  accountlines_id=?',undef,$accountlines_id);
 701     my $new_outstanding = $data->{amountoutstanding} - $amount;
 702
 703     my $update = 'UPDATE  accountlines SET amountoutstanding = ?  WHERE   accountlines_id = ? ';
 704     $dbh->do( $update, undef, $new_outstanding, $accountlines_id);
 705
 706     if ( C4::Context->preference("FinesLog") ) {
 707         logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
 708             action                => 'fee_payment',
 709             borrowernumber        => $borrowernumber,
 710             old_amountoutstanding => $data->{'amountoutstanding'},
 711             new_amountoutstanding => $new_outstanding,
 712             amount_paid           => $data->{'amountoutstanding'} - $new_outstanding,
 713             accountlines_id       => $data->{'accountlines_id'},
 714             accountno             => $data->{'accountno'},
 715             manager_id            => $manager_id,
 716         }));
 717     }
 718
 719     # create new line
 720     my $insert = 'INSERT INTO accountlines (borrowernumber, accountno, date, amount, '
 721     .  'description, accounttype, amountoutstanding, itemnumber, manager_id, note) '
 722     . ' VALUES (?, ?, now(), ?, ?, ?, 0, ?, ?, ?)';
 723
 724     $dbh->do(  $insert, undef, $borrowernumber, $nextaccntno, $amount,
 725         '', 'Pay', $data->{'itemnumber'}, $manager_id, $payment_note);
 726
 727     UpdateStats({
 728         branch => $branch,
 729         type   => 'payment',
 730         amount => $amount,
 731         borrowernumber => $borrowernumber,
 732         accountno => $accountno
 733     });
 734
 735     if ( C4::Context->preference("FinesLog") ) {
 736         logaction("FINES", 'CREATE',$borrowernumber,Dumper({
 737             action            => 'create_payment',
 738             borrowernumber    => $user,
 739             accountno         => $nextaccntno,
 740             amount            => 0 - $amount,
 741             accounttype       => 'Pay',
 742             itemnumber        => $data->{'itemnumber'},
 743             accountlines_paid => [ $data->{'accountlines_id'} ],
 744             manager_id        => $manager_id,
 745         }));
 746     }
 747
 748     return;
 749 }
 750
 751 =head2 WriteOffFee
 752
 753   WriteOffFee( $borrowernumber, $accountline_id, $itemnum, $accounttype, $amount, $branch, $payment_note );
 754
 755 Write off a fine for a patron.
 756 C<$borrowernumber> is the patron's borrower number.
 757 C<$accountline_id> is the accountline_id of the fee to write off.
 758 C<$itemnum> is the itemnumber of of item whose fine is being written off.
 759 C<$accounttype> is the account type of the fine being written off.
 760 C<$amount> is a floating-point number, giving the amount that is being written off.
 761 C<$branch> is the branchcode of the library where the writeoff occurred.
 762 C<$payment_note> is the note to attach to this payment
 763
 764 =cut
 765
 766 sub WriteOffFee {
 767     my ( $borrowernumber, $accountlines_id, $itemnum, $accounttype, $amount, $branch, $payment_note ) = @_;
 768     $payment_note //= "";
 769     $branch ||= C4::Context->userenv->{branch};
 770     my $manager_id = 0;
 771     $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
 772
 773     # if no item is attached to fine, make sure to store it as a NULL
 774     $itemnum ||= undef;
 775
 776     my ( $sth, $query );
 777     my $dbh = C4::Context->dbh();
 778
 779     $query = "
 780         UPDATE accountlines SET amountoutstanding = 0
 781         WHERE accountlines_id = ? AND borrowernumber = ?
 782     ";
 783     $sth = $dbh->prepare( $query );
 784     $sth->execute( $accountlines_id, $borrowernumber );
 785
 786     if ( C4::Context->preference("FinesLog") ) {
 787         logaction("FINES", 'MODIFY', $borrowernumber, Dumper({
 788             action                => 'fee_writeoff',
 789             borrowernumber        => $borrowernumber,
 790             accountlines_id       => $accountlines_id,
 791             manager_id            => $manager_id,
 792         }));
 793     }
 794
 795     $query ="
 796         INSERT INTO accountlines
 797         ( borrowernumber, accountno, itemnumber, date, amount, description, accounttype, manager_id, note )
 798         VALUES ( ?, ?, ?, NOW(), ?, 'Writeoff', 'W', ?, ? )
 799     ";
 800     $sth = $dbh->prepare( $query );
 801     my $acct = getnextacctno($borrowernumber);
 802     $sth->execute( $borrowernumber, $acct, $itemnum, $amount, $manager_id, $payment_note );
 803
 804     if ( C4::Context->preference("FinesLog") ) {
 805         logaction("FINES", 'CREATE',$borrowernumber,Dumper({
 806             action            => 'create_writeoff',
 807             borrowernumber    => $borrowernumber,
 808             accountno         => $acct,
 809             amount            => 0 - $amount,
 810             accounttype       => 'W',
 811             itemnumber        => $itemnum,
 812             accountlines_paid => [ $accountlines_id ],
 813             manager_id        => $manager_id,
 814         }));
 815     }
 816
 817     UpdateStats({
 818                 branch => $branch,
 819                 type => 'writeoff',
 820                 amount => $amount,
 821                 borrowernumber => $borrowernumber}
 822     );
 823
 824 }
 825
 826 =head2 purge_zero_balance_fees
 827
 828   purge_zero_balance_fees( $days );
 829
 830 Delete accountlines entries where amountoutstanding is 0 or NULL which are more than a given number of days old.
 831
 832 B<$days> -- Zero balance fees older than B<$days> days old will be deleted.
 833
 834 B<Warning:> Because fines and payments are not linked in accountlines, it is
 835 possible for a fine to be deleted without the accompanying payment,
 836 or vise versa. This won't affect the account balance, but might be
 837 confusing to staff.
 838
 839 =cut
 840
 841 sub purge_zero_balance_fees {
 842     my $days  = shift;
 843     my $count = 0;
 844
 845     my $dbh = C4::Context->dbh;
 846     my $sth = $dbh->prepare(
 847         q{
 848             DELETE FROM accountlines
 849             WHERE date < date_sub(curdate(), INTERVAL ? DAY)
 850               AND ( amountoutstanding = 0 or amountoutstanding IS NULL );
 851         }
 852     );
 853     $sth->execute($days) or die $dbh->errstr;
 854 }
 855
 856 END { }    # module clean-up code here (global destructor)
 857
 858 1;
 859 __END__
 860
 861 =head1 SEE ALSO
 862
 863 DBI(3)
 864
 865 =cut
 866