X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_credit.pm;h=f8c13f9f016db31d78f194ed49a5732775913e13;hb=b4647550d33068067925f7f3fe8d6fe4f02a67e4;hp=4286d3490eb07b8067d956fad4dbcfabbff25c71;hpb=dc8a15535f28e96097a4f0fbf51b0aec2c7a7a5b;p=freeside.git

diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm
index 4286d3490..f8c13f9f0 100644
--- a/FS/FS/cust_credit.pm
+++ b/FS/FS/cust_credit.pm
@@ -154,6 +154,10 @@ sub insert {
   my $dbh = dbh;
 
   my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+  unless ( $cust_main ) {
+    $dbh->rollback if $oldAutoCommit;
+    return "Unknown custnum ". $self->custnum;
+  }
   my $old_balance = $cust_main->balance;
 
   if (!$self->reasonnum) {
@@ -743,10 +747,12 @@ sub calculate_tax_adjustment {
     if ($recur) {
       $recur -= $cust_bill_pkg->credited('', '', setuprecur => 'recur') || 0;
     }
+    # Skip line items that have been completely credited.
+    next if ($setup + $recur) == 0;
     my $setup_ratio = $setup / ($setup + $recur);
 
-    # Calculate the fraction of tax to credit: it's the fraction of this charge
-    # (either setup or recur) that's being credited.
+    # Calculate the fraction of tax to credit: it's the fraction of this
+    # charge (either setup or recur) that's being credited.
     my $charged = ($setuprecur eq 'setup') ? $setup : $recur;
     next if $charged == 0; # shouldn't happen, but still...
 
@@ -798,7 +804,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:
 
@@ -817,6 +827,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
@@ -856,10 +876,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 ) {
@@ -879,8 +907,48 @@ 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);
+  # 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);
+    return 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}};
@@ -906,17 +974,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";
     }
   }
 
@@ -949,17 +1013,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";
     }
   }