and still create credit source records on 4.x+, #42729
[freeside.git] / FS / FS / cust_credit.pm
index 8546372..aebf259 100644 (file)
@@ -315,6 +315,7 @@ sub check {
     || $self->ut_foreign_keyn('commission_agentnum',  'agent', 'agentnum')
     || $self->ut_foreign_keyn('commission_salesnum',  'sales', 'salesnum')
     || $self->ut_foreign_keyn('commission_pkgnum', 'cust_pkg', 'pkgnum')
+    || $self->ut_foreign_keyn('commission_invnum', 'cust_bill', 'invnum')
   ;
   return $error if $error;
 
@@ -782,7 +783,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:
 
@@ -793,6 +798,7 @@ Example:
     'setuprecurs'       => \@setuprecurs,
     'amounts'           => \@amounts,
     'apply'             => 1, #0 leaves the credit unapplied
+    'set_source'        => 1, #creates credit source records for the line items
 
     #the credit
     map { $_ => scalar($cgi->param($_)) }
@@ -801,6 +807,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 +856,20 @@ 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});
+  }
+
+  my $set_source = $arg{set_source};
+
+  # 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 ) {
@@ -862,9 +888,50 @@ sub credit_lineitems {
   my %cust_bill_pkg = ();
   my %cust_credit_bill_pkg = ();
   my %unapplied_payments = (); #invoice numbers, and then billpaynums
+  my %currency;
+
+  # 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;
+  };
 
-  # determine the tax adjustments
-  my %tax_adjust = $class->calculate_tax_adjustment(%arg);
 
   foreach my $billpkgnum ( @{$arg{billpkgnums}} ) {
     my $setuprecur = shift @{$arg{setuprecurs}};
@@ -890,17 +957,24 @@ 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 ( $set_source ) {
+      $currency{$invnum} ||= $cust_bill_pkg->cust_bill->currency;
+      my $source = FS::cust_credit_source_bill_pkg->new({
+        'crednum'     => $cust_credit->crednum,
+        'billpkgnum'  => $billpkgnum,
+        'amount'      => $amount,
+        'currency'    => $currency{invnum},
+      });
+      $error ||= $source->insert;
+    }
+
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Error unapplying payment: $error";
     }
   }
 
@@ -933,17 +1007,24 @@ 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);
+
+    # I guess it's correct to do this for taxes also?
+    if ( $set_source ) {
+      $currency{$invnum} ||= $cust_bill_pkg->cust_bill->currency;
+      my $source = FS::cust_credit_source_bill_pkg->new({
+        'crednum'     => $cust_credit->crednum,
+        'billpkgnum'  => $billpkgnum,
+        'amount'      => $amount,
+        'currency'    => $currency{invnum},
+      });
+      $error ||= $source->insert;
+    }
+
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Error unapplying payment: $error";
     }
   }