be more selective when unapplying payments for a line item credit, #42729

2 files changed, 73 insertions, 34 deletions

diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm
index 610d1732d..18f4a3246 100644
--- a/FS/FS/cust_credit.pm
+++ b/FS/FS/cust_credit.pm
@@ -901,6 +901,49 @@ sub credit_lineitems {
   my %cust_credit_bill_pkg = ();
   my %unapplied_payments = (); #invoice numbers, and then billpaynums
 
+  # little private function to unapply payments from a cust_bill_pkg until
+  # there's a specified amount of unpaid balance on it.
+  # it's a separate sub because we do it for both tax and nontax items. it's
+  # private because it needs access to some local data structures.
+  my $unapply_sub = sub {
+    my ($cust_bill_pkg, $setuprecur, $need_to_unapply) = @_;
+
+    my $invnum = $cust_bill_pkg->invnum;
+
+    $need_to_unapply -= $cust_bill_pkg->owed($setuprecur);
+    next if $need_to_unapply < 0.005;
+
+    my $error;
+    # then unapply payments one at a time (partially if need be) until the
+    # unpaid balance = the credit amount.
+    foreach my $cust_bill_pay_pkg (
+      $cust_bill_pkg->cust_bill_pay_pkg($setuprecur)
+    ) {
+      my $this_amount = $cust_bill_pay_pkg->amount;
+      if ( $this_amount > $need_to_unapply ) {
+        # unapply the needed amount
+        $cust_bill_pay_pkg->set('amount',
+          sprintf('%.2f', $this_amount - $need_to_unapply));
+        $error = $cust_bill_pay_pkg->replace;
+        $unapplied_payments{$invnum}{$cust_bill_pay_pkg->billpaynum} += $need_to_unapply;
+        last; # and we're done
+
+      } else {
+        # unapply it all
+        $error = $cust_bill_pay_pkg->delete;
+        $unapplied_payments{$invnum}{$cust_bill_pay_pkg->billpaynum} += $this_amount;
+
+        $need_to_unapply -= $this_amount;
+      }
+
+    } # foreach $cust_bill_pay_pkg
+
+    # return an error if we somehow still have leftover $need_to_unapply?
+
+    return $error;
+  };
+
+
   foreach my $billpkgnum ( @{$arg{billpkgnums}} ) {
     my $setuprecur = shift @{$arg{setuprecurs}};
     my $amount = shift @{$arg{amounts}};
@@ -925,17 +968,13 @@ sub credit_lineitems {
         'sdate'      => $cust_bill_pkg->sdate,
         'edate'      => $cust_bill_pkg->edate,
       };
-    # unapply payments (but not other credits) from this line item
-    foreach my $cust_bill_pay_pkg (
-      $cust_bill_pkg->cust_bill_pay_pkg($setuprecur)
-    ) {
-      $error = $cust_bill_pay_pkg->delete;
-      if ( $error ) {
-        $dbh->rollback if $oldAutoCommit;
-        return "Error unapplying payment: $error";
-      }
-      $unapplied_payments{$invnum}{$cust_bill_pay_pkg->billpaynum}
-        += $cust_bill_pay_pkg->amount;
+
+    # unapply payments if necessary
+    $error = &{$unapply_sub}($cust_bill_pkg, $setuprecur, $amount);
+
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Error unapplying payment: $error";
     }
   }
 
@@ -968,17 +1007,11 @@ sub credit_lineitems {
         'setuprecur' => 'setup',
         $tax_link->primary_key, $tax_credit->{num}
       };
-    # unapply any payments from the tax
-    foreach my $cust_bill_pay_pkg (
-      $cust_bill_pkg->cust_bill_pay_pkg('setup')
-    ) {
-      $error = $cust_bill_pay_pkg->delete;
-      if ( $error ) {
-        $dbh->rollback if $oldAutoCommit;
-        return "Error unapplying payment: $error";
-      }
-      $unapplied_payments{$invnum}{$cust_bill_pay_pkg->billpaynum}
-        += $cust_bill_pay_pkg->amount;
+
+    $error = &{$unapply_sub}($cust_bill_pkg, 'setup', $amount);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Error unapplying payment: $error";
     }
   }
 
diff --git a/FS/t/suite/09-sales_tax_credit_change.t b/FS/t/suite/09-sales_tax_credit_change.t
index 58d9968d8..80a05c610 100755
--- a/FS/t/suite/09-sales_tax_credit_change.t
+++ b/FS/t/suite/09-sales_tax_credit_change.t
@@ -13,7 +13,7 @@ Correct: The credit amount will be $11.00.
 =cut
 
 use strict;
-use Test::More tests => 2;
+use Test::More tests => 3;
 use FS::Test;
 use Date::Parse 'str2time';
 use Date::Format 'time2str';
@@ -78,18 +78,19 @@ ok ( $tax_item && $tax_item->setup == 3.00, "Tax charged = 3.00" );
 # sync
 $pkg = $pkg->replace_old;
 
-# Pay the bill
+# Pay the bill in two parts
 set_fixed_time(str2time('2016-04-02 00:00'));
-my $cust_pay = FS::cust_pay->new({
-  custnum => $cust->custnum,
-  invnum  => $cust_bill->invnum,
-  _date   => time,
-  paid    => $cust_bill->owed,
-  payby   => 'CASH',
-});
-$error = $cust_pay->insert;
-BAIL_OUT("can't record payment: $error") if $error;
-
+foreach my $paid (10.00, 23.00) {
+  my $cust_pay = FS::cust_pay->new({
+    custnum => $cust->custnum,
+    invnum  => $cust_bill->invnum,
+    _date   => time,
+    paid    => $paid,
+    payby   => 'CASH',
+  });
+  $error = $cust_pay->insert;
+  BAIL_OUT("can't record payment: $error") if $error;
+}
 # Now cancel with 1/3 of the period left
 set_fixed_time(str2time('2016-04-21 00:00'));
 $error = $pkg->cancel();
@@ -100,3 +101,8 @@ my ($credit) = $cust->cust_credit
   or BAIL_OUT("no credit was created");
 ok ( $credit->amount == 11.00, "Credited 1/3 of package charge with tax" )
   or diag("is ". $credit->amount );
+
+# the invoice should also be fully paid after that
+ok ( $cust_bill->owed == 0, "Invoice balance is zero" )
+  or diag("is ". $cust_bill->owed);
+