X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_credit.pm;h=67c7d91f78015388bb05761e854f570e1690d5ea;hp=25bd482c662778262255354ea223e339ea6d303c;hb=90ad6d3446bec1bf5031a665e735015ccf2ca4de;hpb=54154157d137c102f0d6aea76fce7c7b6f9610ff

diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm
index 25bd482c6..67c7d91f7 100644
--- a/FS/FS/cust_credit.pm
+++ b/FS/FS/cust_credit.pm
@@ -690,6 +690,102 @@ sub credited_sql {
   unapplied_sql();
 }
 
+=item calculate_tax_adjustment PARAMS
+
+Calculate the amount of tax that needs to be credited as part of a lineitem
+credit.
+
+PARAMS must include:
+
+- billpkgnums: arrayref identifying the line items to credit
+- setuprecurs: arrayref of 'setup' or 'recur', indicating which part of
+  the lineitem charge is being credited
+- amounts: arrayref of the amounts to credit on each line item
+- custnum: the customer all of these invoices belong to, for error checking
+
+Returns a hash containing:
+- subtotal: the total non-tax amount to be credited (the sum of the 'amounts')
+- taxtotal: the total tax amount to be credited
+- taxlines: an arrayref of hashrefs for each tax line to be credited, each with:
+  - table: "cust_bill_pkg_tax_location" or "cust_bill_pkg_tax_rate_location"
+  - num: the key within that table
+  - credit: the credit amount to apply to that line
+
+=cut
+
+sub calculate_tax_adjustment {
+  my ($class, %arg) = @_;
+
+  my $error;
+  my @taxlines;
+  my $subtotal = 0;
+  my $taxtotal = 0;
+
+  my (%cust_bill_pkg, %cust_bill);
+
+  for (my $i = 0; ; $i++) {
+    my $billpkgnum = $arg{billpkgnums}[$i]
+      or last;
+    my $setuprecur = $arg{setuprecurs}[$i];
+    my $amount = $arg{amounts}[$i];
+    next if $amount == 0;
+    $subtotal += $amount;
+    my $cust_bill_pkg = $cust_bill_pkg{$billpkgnum}
+                    ||= FS::cust_bill_pkg->by_key($billpkgnum)
+      or die "lineitem #$billpkgnum not found\n";
+
+    my $invnum = $cust_bill_pkg->invnum;
+    $cust_bill{ $invnum } ||= FS::cust_bill->by_key($invnum);
+    $cust_bill{ $invnum}->custnum == $arg{custnum}
+      or die "lineitem #$billpkgnum not found\n";
+
+    # calculate credit ratio.
+    # (First deduct any existing credits applied to this line item, to avoid
+    # rounding errors.)
+    my $charged = $cust_bill_pkg->get($setuprecur);
+    my $previously_credited =
+      $cust_bill_pkg->credited( '', '', setuprecur => $setuprecur) || 0;
+
+    $charged -= $previously_credited;
+    if ($charged < $amount) {
+      $error = "invoice #$invnum: tried to credit $amount, but only $charged was charged";
+      last;
+    }
+    my $ratio = $amount / $charged;
+
+    # gather taxes that apply to the selected item
+    foreach my $table (
+      qw(cust_bill_pkg_tax_location cust_bill_pkg_tax_rate_location)
+    ) {
+      foreach my $tax_link (
+        qsearch($table, { taxable_billpkgnum => $billpkgnum })
+      ) {
+        my $tax_amount = $tax_link->amount;
+        # deduct existing credits applied to the tax, for the same reason as
+        # above
+        foreach ($tax_link->cust_credit_bill_pkg) {
+          $tax_amount -= $_->amount;
+        }
+        my $tax_credit = sprintf('%.2f', $tax_amount * $ratio);
+        my $pkey = $tax_link->get($tax_link->primary_key);
+        push @taxlines, {
+          table   => $table,
+          num     => $pkey,
+          credit  => $tax_credit,
+        };
+        $taxtotal += $tax_credit;
+
+      } #foreach cust_bill_pkg_tax_(rate_)?location
+    }
+  } # foreach $billpkgnum
+
+  return (
+    subtotal => sprintf('%.2f', $subtotal),
+    taxtotal => sprintf('%.2f', $taxtotal),
+    taxlines => \@taxlines,
+  );
+}
+
 =item credit_lineitems
 
 Example:
@@ -769,8 +865,11 @@ sub credit_lineitems {
   my %cust_credit_bill = ();
   my %cust_bill_pkg = ();
   my %cust_credit_bill_pkg = ();
-  my %taxlisthash = ();
   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}};
@@ -784,22 +883,21 @@ sub credit_lineitems {
   
     my $invnum = $cust_bill_pkg->invnum;
 
-    if ( $setuprecur eq 'setup' ) {
-      $cust_bill_pkg->setup($amount);
-      $cust_bill_pkg->recur(0);
-      $cust_bill_pkg->unitrecur(0);
-      $cust_bill_pkg->type('');
-    } else {
-      $setuprecur = 'recur'; #in case its a usage classnum?
-      $cust_bill_pkg->recur($amount);
-      $cust_bill_pkg->setup(0);
-      $cust_bill_pkg->unitsetup(0);
-    }
-
     push @{$cust_bill_pkg{$invnum}}, $cust_bill_pkg;
 
-    #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) ) {
+    $cust_credit_bill{$invnum} += $amount;
+    push @{ $cust_credit_bill_pkg{$invnum} },
+      new FS::cust_credit_bill_pkg {
+        'billpkgnum' => $billpkgnum,
+        'amount'     => sprintf('%.2f',$amount),
+        'setuprecur' => $setuprecur,
+        '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;
@@ -808,24 +906,49 @@ sub credit_lineitems {
       $unapplied_payments{$invnum}{$cust_bill_pay_pkg->billpaynum}
         += $cust_bill_pay_pkg->amount;
     }
+  }
+
+  # do the same for taxes
+  foreach my $tax_credit ( @{ $tax_adjust{taxlines} } ) {
+    my $table = $tax_credit->{table};
+    my $tax_link = "FS::$table"->by_key( $tax_credit->{num} )
+      or die "tried to credit $table #$tax_credit->{num} but it doesn't exist";
+
+    my $billpkgnum = $tax_link->billpkgnum;
+    my $cust_bill_pkg = qsearchs({
+      'table'     => 'cust_bill_pkg',
+      'hashref'   => { 'billpkgnum' => $billpkgnum },
+      'addl_from' => 'LEFT JOIN cust_bill USING (invnum)',
+      'extra_sql' => 'AND custnum = '. $cust_main->custnum,
+    }) or die "unknown billpkgnum $billpkgnum";
+    
+    my $invnum = $cust_bill_pkg->invnum;
+    push @{$cust_bill_pkg{$invnum}}, $cust_bill_pkg;
 
-    #$subtotal += $amount;
+    my $amount = $tax_credit->{credit};
     $cust_credit_bill{$invnum} += $amount;
+
+    # create a credit application record to the tax line item, earmarked
+    # to the specific cust_bill_pkg_Xlocation
     push @{ $cust_credit_bill_pkg{$invnum} },
       new FS::cust_credit_bill_pkg {
-        'billpkgnum' => $cust_bill_pkg->billpkgnum,
-        'amount'     => sprintf('%.2f',$amount),
-        'setuprecur' => $setuprecur,
-        'sdate'      => $cust_bill_pkg->sdate,
-        'edate'      => $cust_bill_pkg->edate,
+        'billpkgnum' => $billpkgnum,
+        'amount'     => sprintf('%.2f', $amount),
+        'setuprecur' => 'setup',
+        $tax_link->primary_key, $tax_credit->{num}
       };
-
-    # recalculate taxes with new amounts
-    $taxlisthash{$invnum} ||= {};
-    if ( $cust_bill_pkg->pkgnum or $cust_bill_pkg->feepart ) {
-      $cust_main->_handle_taxes( $taxlisthash{$invnum}, $cust_bill_pkg );
-    } # otherwise the item itself is a tax, and assume the caller knows
-      # what they're doing
+    # 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;
+    }
   }
 
   ###
@@ -837,115 +960,6 @@ sub credit_lineitems {
 
   foreach my $invnum ( sort { $a <=> $b } keys %cust_credit_bill ) {
 
-    my $arrayref_or_error =
-      $cust_main->calculate_taxes(
-        $cust_bill_pkg{$invnum}, # list of taxable items that we're crediting
-        $taxlisthash{$invnum},   # list of tax-item bindings
-        $cust_bill_pkg{$invnum}->[0]->cust_bill->_date, # invoice time
-      );
-
-    unless ( ref( $arrayref_or_error ) ) {
-      $dbh->rollback if $oldAutoCommit;
-      return "Error calculating taxes: $arrayref_or_error";
-    }
-    
-    my %tax_links; # {tax billpkgnum}{nontax billpkgnum}
-
-    #taxes
-    foreach my $cust_bill_pkg ( @{ $cust_bill_pkg{$invnum} } ) {
-      my $billpkgnum = $cust_bill_pkg->billpkgnum;
-      my %hash = ( 'taxable_billpkgnum' => $billpkgnum );
-      # gather up existing tax links (we need their billpkgtaxlocationnums)
-      my @tax_links = qsearch('cust_bill_pkg_tax_location', \%hash),
-                      qsearch('cust_bill_pkg_tax_rate_location', \%hash);
-
-      foreach ( @tax_links ) {
-        $tax_links{$_->billpkgnum} ||= {};
-        $tax_links{$_->billpkgnum}{$_->taxable_billpkgnum} = $_;
-      }
-    }
-
-    foreach my $taxline ( @$arrayref_or_error ) {
-
-      my $amount = $taxline->setup;
-
-      # find equivalent tax line item on the existing invoice
-      my $tax_item = qsearchs('cust_bill_pkg', {
-          'invnum'    => $invnum,
-          'pkgnum'    => 0,
-          'itemdesc'  => $taxline->desc,
-      });
-      if (!$tax_item) {
-        # or should we just exit if this happens?
-        $cust_credit->set('amount', 
-          sprintf('%.2f', $cust_credit->get('amount') - $amount)
-        );
-        my $error = $cust_credit->replace;
-        if ( $error ) {
-          $dbh->rollback if $oldAutoCommit;
-          return "error correcting credit for missing tax line: $error";
-        }
-      }
-
-      # but in the new era, we no longer have the problem of uniquely
-      # identifying the tax_Xlocation record.  The billpkgnums of the 
-      # tax and the taxed item are known.
-      foreach my $new_loc
-        ( @{ $taxline->get('cust_bill_pkg_tax_location') },
-          @{ $taxline->get('cust_bill_pkg_tax_rate_location') } )
-      {
-        # the existing tax_Xlocation object
-        my $old_loc =
-          $tax_links{$tax_item->billpkgnum}{$new_loc->taxable_cust_bill_pkg->billpkgnum};
-
-        next if !$old_loc; # apply the leftover amount nonspecifically
-
-        #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_item->billpkgnum,
-            'amount'                    => $loc_amount,
-            'setuprecur'                => 'setup',
-            'billpkgtaxlocationnum'     => $old_loc->billpkgtaxlocationnum,
-            'billpkgtaxratelocationnum' => $old_loc->billpkgtaxratelocationnum,
-          };
-
-      } #foreach my $new_loc
-
-      # we still have to deal with the possibility that the tax links don't
-      # cover the whole amount of tax because of an incomplete upgrade...
-      if ($amount > 0.005) {
-        $cust_credit_bill{$invnum} += $amount;
-        push @{ $cust_credit_bill_pkg{$invnum} },
-          new FS::cust_credit_bill_pkg {
-            'billpkgnum' => $tax_item->billpkgnum,
-            'amount'     => sprintf('%.2f', $amount),
-            'setuprecur' => 'setup',
-          };
-
-      } # if $amount > 0
-
-      #unapply any payments applied to the tax
-      foreach my $cust_bill_pay_pkg
-        ( $tax_item->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;
-      }
-    } #foreach $taxline
-
     # if we unapplied any payments from line items, also unapply that 
     # amount from the invoice
     foreach my $billpaynum (keys %{$unapplied_payments{$invnum}}) {