use credit_lineitems logic for unused-time credits, #42729

2 files changed, 107 insertions, 45 deletions

diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm
index 85463724c..564cbb401 100644
--- a/FS/FS/cust_credit.pm
+++ b/FS/FS/cust_credit.pm
@@ -782,7 +782,11 @@ sub calculate_tax_adjustment {
   );
 }
 
-=item credit_lineitems
+=item credit_lineitems OPTIONS
+
+Creates a credit to a group of line items, with a specified amount applied
+to each. This will also calculate the tax adjustments for those amounts and
+credit the appropriate tax line items.
 
 Example:
 
@@ -801,6 +805,16 @@ Example:
 
   );
 
+C<billpkgnums>, C<setuprecurs>, C<amounts> are required and are parallel
+arrays. Each one indicates an amount of credit to be applied to either the
+setup or recur portion of a (non-tax) line item.
+
+C<custnum>, C<_date>, C<reasonnum>, and C<addlinfo> will be set on the
+credit before it's inserted.
+
+C<amount> is the total amount. If unspecified, the credit will be the sum
+of the per-line-item amounts and their tax adjustments.
+
 =cut
 
 #maybe i should just be an insert with extra args instead of a class method
@@ -840,10 +854,18 @@ sub credit_lineitems {
 
   my $error = '';
 
+  # first, determine the tax adjustments
+  my %tax_adjust = $class->calculate_tax_adjustment(%arg);
+  # and determine the amount automatically if it wasn't specified
+  if ( !exists( $arg{amount} ) ) {
+    $arg{amount} = sprintf('%.2f', $tax_adjust{subtotal} + $tax_adjust{taxtotal});
+  }
+
+  # create the credit
   my $cust_credit = new FS::cust_credit ( {
     map { $_ => $arg{$_} }
       #fields('cust_credit')
-      qw( custnum _date amount reasonnum addlinfo ), #pkgnum eventnum
+      qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum
   } );
   $error = $cust_credit->insert;
   if ( $error ) {
@@ -863,9 +885,6 @@ sub credit_lineitems {
   my %cust_credit_bill_pkg = ();
   my %unapplied_payments = (); #invoice numbers, and then billpaynums
 
-  # determine the tax adjustments
-  my %tax_adjust = $class->calculate_tax_adjustment(%arg);
-
   foreach my $billpkgnum ( @{$arg{billpkgnums}} ) {
     my $setuprecur = shift @{$arg{setuprecurs}};
     my $amount = shift @{$arg{amounts}};
diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index df66e7438..c8f337f15 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -8,7 +8,7 @@ use base qw( FS::cust_pkg::Search FS::cust_pkg::API
 use strict;
 use Carp qw(cluck);
 use Scalar::Util qw( blessed );
-use List::Util qw(min max);
+use List::Util qw(min max sum);
 use Tie::IxHash;
 use Time::Local qw( timelocal timelocal_nocheck );
 use MIME::Entity;
@@ -1781,50 +1781,93 @@ sub credit_remaining {
   my $conf = FS::Conf->new;
   my $reason_type = $conf->config($mode.'_credit_type');
 
-  my $last_bill = $self->getfield('last_bill') || 0;
-  my $next_bill = $self->getfield('bill') || 0;
-  if ( $last_bill > 0         # the package has been billed
-      and $next_bill > 0      # the package has a next bill date
-      and $next_bill >= $time # which is in the future
-  ) {
-    my @cust_credit_source_bill_pkg = ();
-    my $remaining_value = 0;
+  $time ||= time;
 
-    my $remain_pkg = $self;
-    $remaining_value = $remain_pkg->calc_remain(
-      'time' => $time, 
-      'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
-    );
+  my $remain_pkg = $self;
+  my (@billpkgnums, @amounts, @setuprecurs);
+  
+  # we may have to walk back past some package changes to get to the 
+  # one that actually has unused time. loop until that happens, or we
+  # reach the first package in the chain.
+  while (1) {
+    my $last_bill = $remain_pkg->get('last_bill') || 0;
+    my $next_bill = $remain_pkg->get('bill') || 0;
+    if ( $last_bill > 0         # the package has been billed
+        and $next_bill > 0      # the package has a next bill date
+        and $next_bill >= $time # which is in the future
+    ) {
+
+      # Find actual charges for the period ending on or after the cancel
+      # date.
+      my @charges = qsearch('cust_bill_pkg', {
+        pkgnum => $remain_pkg->pkgnum,
+        edate => {op => '>=', value => $time},
+        recur => {op => '>' , value => 0},
+      });
+
+      foreach my $cust_bill_pkg (@charges) {
+        # hack to deal with the weird behavior of edate on package
+        # cancellation
+        my $edate = $cust_bill_pkg->edate;
+        if ( $self->recur_temporality eq 'preceding' ) {
+          $edate = $self->add_freq($cust_bill_pkg->sdate);
+        }
+
+        # this will also get any package charges that are _entirely_ after
+        # the cancellation date (can happen with advance billing). in that
+        # case, use the entire recurring charge:
+        my $amount = $cust_bill_pkg->recur - $cust_bill_pkg->usage;
+
+        # but if the cancellation happens during the interval, prorate it:
+        # (XXX obey prorate_round_day here?)
+        if ( $cust_bill_pkg->sdate < $time ) {
+          $amount = $amount *
+                      ($edate - $time) / ($edate - $cust_bill_pkg->sdate);
+        }
+
+        $amount = sprintf('%.2f', $amount);
+
+        push @billpkgnums, $cust_bill_pkg->billpkgnum;
+        push @amounts,     $amount;
+        push @setuprecurs, 'recur';
+
+        warn "Crediting for $amount on package ".$remain_pkg->pkgnum."\n"
+          if $DEBUG;
 
-    # we may have to walk back past some package changes to get to the 
-    # one that actually has unused time
-    while ( $remaining_value == 0 ) {
-      if ( $remain_pkg->change_pkgnum ) {
-        $remain_pkg = FS::cust_pkg->by_key($remain_pkg->change_pkgnum);
-      } else {
-        # the package has really never been billed
-        return;
       }
-      $remaining_value = $remain_pkg->calc_remain(
-        'time' => $time, 
-        'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
-      );
+
+      last if @charges;
     }
 
-    if ( $remaining_value > 0 ) {
-      warn "Crediting for $remaining_value on package ".$self->pkgnum."\n"
-        if $DEBUG;
-      my $error = $self->cust_main->credit(
-        $remaining_value,
-        'Credit for unused time on '. $self->part_pkg->pkg,
-        'reason_type' => $reason_type,
-        'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
-      );
-      return "Error crediting customer \$$remaining_value for unused time".
-        " on ". $self->part_pkg->pkg. ": $error"
-        if $error;
-    } #if $remaining_value
-  } #if $last_bill, etc.
+    if ( my $changed_from_pkgnum = $remain_pkg->change_pkgnum ) {
+      $remain_pkg = FS::cust_pkg->by_key($changed_from_pkgnum);
+    } else {
+      # the package has really never been billed
+      return;
+    }
+  }
+
+  # keep traditional behavior here. 
+  local $@;
+  my $reason = FS::reason->new_or_existing(
+    reason  => 'Credit for unused time on '. $self->part_pkg->pkg,
+    type    => $reason_type,
+    class   => 'R',
+  );
+  if ( $@ ) {
+    return "failed to set credit reason: $@";
+  }
+
+  my $error = FS::cust_credit->credit_lineitems(
+    'billpkgnums' => \@billpkgnums,
+    'setuprecurs' => \@setuprecurs,
+    'amounts'     => \@amounts,
+    'custnum'     => $self->custnum,
+    'date'        => time,
+    'reasonnum'   => $reason->reasonnum,
+    'apply'       => 1,
+  );
+
   '';
 }