agent commission schedules for consecutive invoices, #71217
[freeside.git] / FS / FS / cust_credit.pm
index 2f2338e..e4b1fc0 100644 (file)
@@ -3,7 +3,7 @@ use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::reason_Mixin
              FS::Record );
 
 use strict;
-use vars qw( $conf $unsuspendauto $me $DEBUG
+use vars qw( $conf $me $DEBUG
              $otaker_upgrade_kludge $ignore_empty_reasonnum
            );
 use List::Util qw( min );
@@ -34,7 +34,6 @@ $ignore_empty_reasonnum = 0;
 $FS::UID::callback{'FS::cust_credit'} = sub { 
 
   $conf = new FS::Conf;
-  $unsuspendauto = $conf->exists('unsuspendauto');
 
 };
 
@@ -210,16 +209,8 @@ sub insert {
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
-  #false laziness w/ cust_pay::insert
-  if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
-    my @errors = $cust_main->unsuspend;
-    #return 
-    # side-fx with nested transactions?  upstack rolls back?
-    warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
-         join(' / ', @errors)
-      if @errors;
-  }
-  #eslaf
+  # possibly trigger package unsuspend, doesn't abort transaction on failure
+  $self->unsuspend_balance if $old_balance;
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
@@ -324,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;
 
@@ -377,7 +369,7 @@ sub void {
   my $cust_credit_void = new FS::cust_credit_void ( {
       map { $_ => $self->get($_) } $self->fields
     } );
-  $cust_credit_void->set('void_reasonnum', $reason->reasonnum);
+  $cust_credit_void->set('void_reasonnum', $reason->reasonnum) if $reason;
   my $error = $cust_credit_void->insert;
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
@@ -723,19 +715,31 @@ sub calculate_tax_adjustment {
     $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;
+    # tax_Xlocation records don't distinguish setup and recur, so calculate
+    # the fraction of setup+recur (after deducting credits) that's setup. This
+    # will also be the fraction of tax (after deducting credits) that's tax on
+    # setup.
+    my ($setup, $recur);
+    $setup = $cust_bill_pkg->get('setup') || 0;
+    if ($setup) {
+      $setup -= $cust_bill_pkg->credited('', '', setuprecur => 'setup') || 0;
+    }
+    $recur = $cust_bill_pkg->get('recur') || 0;
+    if ($recur) {
+      $recur -= $cust_bill_pkg->credited('', '', setuprecur => '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.
+    my $charged = ($setuprecur eq 'setup') ? $setup : $recur;
+    next if $charged == 0; # shouldn't happen, but still...
 
-    $charged -= $previously_credited;
     if ($charged < $amount) {
       $error = "invoice #$invnum: tried to credit $amount, but only $charged was charged";
       last;
     }
-    my $ratio = $amount / $charged;
+    my $credit_ratio = $amount / $charged;
 
     # gather taxes that apply to the selected item
     foreach my $table (
@@ -750,7 +754,16 @@ sub calculate_tax_adjustment {
         foreach ($tax_link->cust_credit_bill_pkg) {
           $tax_amount -= $_->amount;
         }
-        my $tax_credit = sprintf('%.2f', $tax_amount * $ratio);
+        # split tax amount based on setuprecur
+        # (this method ensures that, if you credit both setup and recur tax,
+        # it always equals the entire tax despite any rounding)
+        my $setup_tax = sprintf('%.2f', $tax_amount * $setup_ratio);
+        if ( $setuprecur eq 'setup' ) {
+          $tax_amount = $setup_tax;
+        } else {
+          $tax_amount = $tax_amount - $setup_tax;
+        }
+        my $tax_credit = sprintf('%.2f', $tax_amount * $credit_ratio);
         my $pkey = $tax_link->get($tax_link->primary_key);
         push @taxlines, {
           table   => $table,
@@ -1007,6 +1020,58 @@ sub credit_lineitems {
 
 }
 
+### refund_to_unapply/unapply_refund false laziness with FS::cust_pay
+
+=item refund_to_unapply
+
+Returns L<FS::cust_credit_refund> objects that will be deleted by L</unapply_refund>
+(all currently applied refunds that aren't closed.)
+Returns empty list if credit itself is closed.
+
+=cut
+
+sub refund_to_unapply {
+  my $self = shift;
+  return () if $self->closed;
+  qsearch({
+    'table'   => 'cust_credit_refund',
+    'hashref' => { 'crednum' => $self->crednum },
+    'addl_from' => 'LEFT JOIN cust_refund USING (refundnum)',
+    'extra_sql' => "AND cust_refund.closed IS NULL AND cust_refund.source_paynum IS NULL",
+  });
+}
+
+=item unapply_refund
+
+Deletes all objects returned by L</refund_to_unapply>.
+
+=cut
+
+sub unapply_refund {
+  my $self = shift;
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+
+  foreach my $cust_credit_refund ($self->refund_to_unapply) {
+    my $error = $cust_credit_refund->delete;
+    if ($error) {
+      dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  dbh->commit or die dbh->errstr if $oldAutoCommit;
+  return '';
+}
+
 =back
 
 =head1 SUBROUTINES
@@ -1023,12 +1088,47 @@ use FS::cust_credit_bill;
 sub process_batch_import {
   my $job = shift;
 
+  # some false laziness with FS::cust_pay::process_batch_import
+  my $hashcb = sub {
+    my %hash = @_;
+    my $custnum = $hash{'custnum'};
+    my $agent_custid = $hash{'agent_custid'};
+    # translate agent_custid into regular custnum
+    if ($custnum && $agent_custid) {
+      die "can't specify both custnum and agent_custid\n";
+    } elsif ($agent_custid) {
+      # here is the agent virtualization
+      my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
+      my %search;
+      $search{'agent_custid'} = $agent_custid
+        if $agent_custid;
+      $search{'custnum'} = $custnum
+        if $custnum;
+      my $cust_main = qsearchs({
+        'table'     => 'cust_main',
+        'hashref'   => \%search,
+        'extra_sql' => $extra_sql,
+      });
+      die "can't find customer with" .
+        ($custnum  ? " custnum $custnum" : '') .
+        ($agent_custid ? " agent_custid $agent_custid" : '') . "\n"
+        unless $cust_main;
+      die "mismatched customer number\n"
+        if $custnum && ($custnum ne $cust_main->custnum);
+      $custnum = $cust_main->custnum;
+    }
+    $hash{'custnum'} = $custnum;
+    delete($hash{'agent_custid'});
+    return %hash;
+  };
+
   my $opt = { 'table'   => 'cust_credit',
               'params'  => [ '_date', 'credbatch' ],
               'formats' => { 'simple' =>
-                               [ 'custnum', 'amount', 'reasonnum', 'invnum' ],
+                               [ 'custnum', 'amount', 'reasonnum', 'invnum', 'agent_custid' ],
                            },
               'default_csv' => 1,
+              'format_hash_callbacks' => { 'simple' => $hashcb },
               'postinsert_callback' => sub {
                 my $cust_credit = shift; #my ($cust_credit, $param ) = @_;