correctly unapply payments when applying a lineitem credit with tax, #18676

[freeside.git] / FS / FS / cust_credit.pm

diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm
index 1f54777..560be20 100644 (file)
--- a/FS/FS/cust_credit.pm
+++ b/FS/FS/cust_credit.pm
@@ -5,6 +5,7 @@ use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Record );
 use vars qw( $conf $unsuspendauto $me $DEBUG
              $otaker_upgrade_kludge $ignore_empty_reasonnum
            );
+use List::Util qw( min );
 use Date::Format;
 use FS::UID qw( dbh getotaker );
 use FS::Misc qw(send_email);
@@ -628,6 +629,7 @@ Example:
     'billpkgnums'       => \@billpkgnums,
     'setuprecurs'       => \@setuprecurs,
     'amounts'           => \@amounts,
+    'apply'             => 1, #0 leaves the credit unapplied
 
     #the credit
     'newreasonnum'      => scalar($cgi->param('newreasonnum')),
@@ -704,12 +706,19 @@ sub credit_lineitems {
     return "Error inserting credit: $error";
   }
 
+  unless ( $arg{'apply'} ) {
+    $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+    return '';
+  }
+
   #my $subtotal = 0;
   # keys in all of these are invoice numbers
   my %taxlisthash = ();
   my %cust_credit_bill = ();
   my %cust_bill_pkg = ();
   my %cust_credit_bill_pkg = ();
+  # except here they're billpaynums
+  my %unapplied_payments;
   foreach my $billpkgnum ( @{$arg{billpkgnums}} ) {
     my $setuprecur = shift @{$arg{setuprecurs}};
     my $amount = shift @{$arg{amounts}};
@@ -737,7 +746,6 @@ sub credit_lineitems {
 
     push @{$cust_bill_pkg{$invnum}}, $cust_bill_pkg;
 
-    my %unapplied_payments; # billpaynum => amount
     #unapply any payments applied to this line item (other credits too?)
     foreach my $cust_bill_pay_pkg ( $cust_bill_pkg->cust_bill_pay_pkg($setuprecur) ) {
       $error = $cust_bill_pay_pkg->delete;
@@ -748,25 +756,6 @@ sub credit_lineitems {
       $unapplied_payments{$cust_bill_pay_pkg->billpaynum}
         += $cust_bill_pay_pkg->amount;
     }
-    # also unapply that amount from the invoice so it doesn't screw up 
-    # application of the credit
-    foreach my $billpaynum (keys %unapplied_payments) {
-      my $cust_bill_pay = FS::cust_bill_pay->by_key($billpaynum)
-        or die "broken payment application $billpaynum";
-      $cust_bill_pay->set('amount',
-        sprintf('%.2f',
-          $cust_bill_pay->get('amount') - $unapplied_payments{$billpaynum})
-      );
-      if ( $cust_bill_pay->amount >= 0.005 ) {
-        $error = $cust_bill_pay->replace;
-      } else {
-        $error = $cust_bill_pay->delete;
-      }
-      if ( $error ) {
-        $dbh->rollback if $oldAutoCommit;
-        return "Error unapplying payment: $error";
-      }
-    }
 
     #$subtotal += $amount;
     $cust_credit_bill{$invnum} += $amount;
@@ -878,13 +867,19 @@ sub credit_lineitems {
           my $old_loc = $xlocation_map{$taxid};
           if ( $old_loc ) {
             # then apply the amount of $new_loc to it
-            $amount -= $new_loc->amount;
 
-            $cust_credit_bill{$invnum} += $new_loc->amount;
+            #support partial credits: use $amount if smaller
+            # (so just distribute to the first location?   perhaps should
+            #  do so evenly...)
+            my $loc_amount = min( $amount, $new_loc->amount);
+
+            $amount -= $loc_amount;
+
+            $cust_credit_bill{$invnum} += $loc_amount;
             push @{ $cust_credit_bill_pkg{$invnum} },
               new FS::cust_credit_bill_pkg {
                 'billpkgnum'                => $tax_cust_bill_pkg->billpkgnum,
-                'amount'                    => $new_loc->amount,
+                'amount'                    => $loc_amount,
                 'setuprecur'                => 'setup',
                 'billpkgtaxlocationnum'     => $old_loc->billpkgtaxlocationnum,
                 'billpkgtaxratelocationnum' => $old_loc->billpkgtaxratelocationnum,
@@ -908,11 +903,47 @@ sub credit_lineitems {
             };
 
         } # if $amount > 0
+
+        #unapply any payments applied to the tax
+        foreach my $cust_bill_pay_pkg 
+          ( $tax_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{$cust_bill_pay_pkg->billpaynum}
+            += $cust_bill_pay_pkg->amount;
+        }
       } #foreach $taxline
 
     } # if @{ $cust_bill_pkg{$invnum} }
 
-    #insert cust_credit_bill
+    # if we unapplied any payments from line items, also unapply that
+    # amount from the invoice
+    foreach my $billpaynum (keys %unapplied_payments) {
+      my $cust_bill_pay = FS::cust_bill_pay->by_key($billpaynum)
+        or die "broken payment application $billpaynum";
+      $error = $cust_bill_pay->delete; # can't replace
+
+      my $new_cust_bill_pay = FS::cust_bill_pay->new({
+          $cust_bill_pay->hash,
+          billpaynum => '',
+          amount => sprintf('%.2f',
+              $cust_bill_pay->get('amount') - $unapplied_payments{$billpaynum})
+      });
+
+      if ( $new_cust_bill_pay->amount > 0 ) {
+        $error ||= $new_cust_bill_pay->insert;
+      }
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "Error unapplying payment: $error";
+      }
+    }
+
+    #NOW insert cust_credit_bill
 
     my $cust_credit_bill = new FS::cust_credit_bill {
       'crednum' => $cust_credit->crednum,