and still create credit source records on 4.x+, #42729
[freeside.git] / FS / FS / cust_credit.pm
index dfe55fb..aebf259 100644 (file)
@@ -1,16 +1,16 @@
 package FS::cust_credit;
 package FS::cust_credit;
+use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::reason_Mixin
+             FS::Record );
 
 use strict;
 
 use strict;
-use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Record );
-use vars qw( $conf $unsuspendauto $me $DEBUG
+use vars qw( $conf $me $DEBUG
              $otaker_upgrade_kludge $ignore_empty_reasonnum
            );
              $otaker_upgrade_kludge $ignore_empty_reasonnum
            );
+use List::Util qw( min );
 use Date::Format;
 use Date::Format;
-use FS::UID qw( dbh getotaker );
-use FS::Misc qw(send_email);
+use FS::UID qw( dbh );
 use FS::Record qw( qsearch qsearchs dbdef );
 use FS::CurrentUser;
 use FS::Record qw( qsearch qsearchs dbdef );
 use FS::CurrentUser;
-use FS::cust_main;
 use FS::cust_pkg;
 use FS::cust_refund;
 use FS::cust_credit_bill;
 use FS::cust_pkg;
 use FS::cust_refund;
 use FS::cust_credit_bill;
@@ -18,6 +18,11 @@ use FS::part_pkg;
 use FS::reason_type;
 use FS::reason;
 use FS::cust_event;
 use FS::reason_type;
 use FS::reason;
 use FS::cust_event;
+use FS::agent;
+use FS::sales;
+use FS::cust_credit_void;
+use FS::cust_bill_pkg;
+use FS::upgrade_journal;
 
 $me = '[ FS::cust_credit ]';
 $DEBUG = 0;
 
 $me = '[ FS::cust_credit ]';
 $DEBUG = 0;
@@ -29,13 +34,11 @@ $ignore_empty_reasonnum = 0;
 $FS::UID::callback{'FS::cust_credit'} = sub { 
 
   $conf = new FS::Conf;
 $FS::UID::callback{'FS::cust_credit'} = sub { 
 
   $conf = new FS::Conf;
-  $unsuspendauto = $conf->exists('unsuspendauto');
 
 };
 
 our %reasontype_map = ( 'referral_credit_type' => 'Referral Credit',
                         'cancel_credit_type'   => 'Cancellation Credit',
 
 };
 
 our %reasontype_map = ( 'referral_credit_type' => 'Referral Credit',
                         'cancel_credit_type'   => 'Cancellation Credit',
-                        'signup_credit_type'   => 'Self-Service Credit',
                       );
 
 =head1 NAME
                       );
 
 =head1 NAME
@@ -119,18 +122,34 @@ Creates a new credit.  To add the credit to the database, see L<"insert">.
 =cut
 
 sub table { 'cust_credit'; }
 =cut
 
 sub table { 'cust_credit'; }
-sub cust_linked { $_[0]->cust_main_custnum; } 
+sub cust_linked { $_[0]->cust_main_custnum || $_[0]->custnum } 
 sub cust_unlinked_msg {
   my $self = shift;
   "WARNING: can't find cust_main.custnum ". $self->custnum.
   ' (cust_credit.crednum '. $self->crednum. ')';
 }
 
 sub cust_unlinked_msg {
   my $self = shift;
   "WARNING: can't find cust_main.custnum ". $self->custnum.
   ' (cust_credit.crednum '. $self->crednum. ')';
 }
 
-=item insert
+=item insert [ OPTION => VALUE ... ]
 
 Adds this credit to the database ("Posts" the credit).  If there is an error,
 returns the error, otherwise returns false.
 
 
 Adds this credit to the database ("Posts" the credit).  If there is an error,
 returns the error, otherwise returns false.
 
+Ooptions are passed as a list of keys and values.  Available options:
+
+=over 4
+
+=item reason_type
+
+L<FS::reason_type|Reason> type for newly-inserted reason
+
+=item cust_credit_source_bill_pkg
+
+An arrayref of
+L<FS::cust_credit_source_bill_pkg|FS::cust_credit_source_bilL_pkg> objects.
+They will have their crednum set and will be inserted along with this credit.
+
+=back
+
 =cut
 
 sub insert {
 =cut
 
 sub insert {
@@ -150,16 +169,23 @@ sub insert {
   my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
   my $old_balance = $cust_main->balance;
 
   my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
   my $old_balance = $cust_main->balance;
 
-  unless ($self->reasonnum) {
-    my $result = $self->reason( $self->getfield('reason'),
-                                exists($options{ 'reason_type' })
-                                  ? ('reason_type' => $options{ 'reason_type' })
-                                  : (),
-                              );
-    unless($result) {
+  if (!$self->reasonnum) {
+    my $reason_text = $self->get('reason')
+      or return "reason text or existing reason required";
+    my $reason_type = $options{'reason_type'}
+      or return "reason type required";
+
+    local $@;
+    my $reason = FS::reason->new_or_existing(
+      reason => $reason_text,
+      type   => $reason_type,
+      class  => 'R',
+    );
+    if ($@) {
       $dbh->rollback if $oldAutoCommit;
       $dbh->rollback if $oldAutoCommit;
-      return "failed to set reason for $me"; #: ". $dbh->errstr;
+      return "failed to set credit reason: $@";
     }
     }
+    $self->set('reasonnum', $reason->reasonnum);
   }
 
   $self->setfield('reason', '');
   }
 
   $self->setfield('reason', '');
@@ -170,18 +196,21 @@ sub insert {
     return "error inserting $self: $error";
   }
 
     return "error inserting $self: $error";
   }
 
+  if ( $options{'cust_credit_source_bill_pkg'} ) {
+    foreach my $ccsbr ( @{ $options{'cust_credit_source_bill_pkg'} } ) {
+      $ccsbr->crednum( $self->crednum );
+      $error = $ccsbr->insert;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "error inserting $ccsbr: $error";
+      }
+    }
+  }
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   $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;
 
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
@@ -200,6 +229,8 @@ the void method instead to leave a record of the deleted credit.
 # very similar to FS::cust_pay::delete
 sub delete {
   my $self = shift;
 # very similar to FS::cust_pay::delete
 sub delete {
   my $self = shift;
+  my %opt = @_;
+
   return "Can't delete closed credit" if $self->closed =~ /^Y/i;
 
   local $SIG{HUP} = 'IGNORE';
   return "Can't delete closed credit" if $self->closed =~ /^Y/i;
 
   local $SIG{HUP} = 'IGNORE';
@@ -235,35 +266,6 @@ sub delete {
     return $error;
   }
 
     return $error;
   }
 
-  if ( $conf->config('deletecredits') ne '' ) {
-
-    my $cust_main = $self->cust_main;
-
-    my $error = send_email(
-      'from'    => $conf->config('invoice_from', $self->cust_main->agentnum),
-                                 #invoice_from??? well as good as any
-      'to'      => $conf->config('deletecredits'),
-      'subject' => 'FREESIDE NOTIFICATION: Credit deleted',
-      'body'    => [
-        "This is an automatic message from your Freeside installation\n",
-        "informing you that the following credit has been deleted:\n",
-        "\n",
-        'crednum: '. $self->crednum. "\n",
-        'custnum: '. $self->custnum.
-          " (". $cust_main->last. ", ". $cust_main->first. ")\n",
-        'amount: $'. sprintf("%.2f", $self->amount). "\n",
-        'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
-        'reason: '. $self->reason. "\n",
-      ],
-    );
-
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return "can't send credit deletion notification: $error";
-    }
-
-  }
-
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   '';
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   '';
@@ -310,6 +312,10 @@ sub check {
     || $self->ut_enum('closed', [ '', 'Y' ])
     || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
     || $self->ut_foreign_keyn('eventnum', 'cust_event', 'eventnum')
     || $self->ut_enum('closed', [ '', 'Y' ])
     || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
     || $self->ut_foreign_keyn('eventnum', 'cust_event', 'eventnum')
+    || $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;
 
   ;
   return $error if $error;
 
@@ -330,6 +336,58 @@ sub check {
   $self->SUPER::check;
 }
 
   $self->SUPER::check;
 }
 
+=item void [ REASON ]
+
+Voids this credit: deletes the credit and all associated applications and 
+adds a record of the voided credit to the cust_credit_void table.
+
+=cut
+
+sub void {
+  my $self = shift;
+  my $reason = shift;
+
+  unless (ref($reason) || !$reason) {
+    $reason = FS::reason->new_or_existing(
+      'class'  => 'X',
+      'type'   => 'Void credit',
+      'reason' => $reason
+    );
+  }
+
+  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;
+  my $dbh = dbh;
+
+  my $cust_credit_void = new FS::cust_credit_void ( {
+      map { $_ => $self->get($_) } $self->fields
+    } );
+  $cust_credit_void->set('void_reasonnum', $reason->reasonnum) if $reason;
+  my $error = $cust_credit_void->insert;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  $error = $self->delete();
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+  '';
+
+}
+
 =item cust_credit_refund
 
 Returns all refund applications (see L<FS::cust_credit_refund>) for this credit.
 =item cust_credit_refund
 
 Returns all refund applications (see L<FS::cust_credit_refund>) for this credit.
@@ -393,63 +451,6 @@ Returns the customer (see L<FS::cust_main>) for this credit.
 
 =cut
 
 
 =cut
 
-sub cust_main {
-  my $self = shift;
-  qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
-}
-
-
-=item reason
-
-Returns the text of the associated reason (see L<FS::reason>) for this credit.
-
-=cut
-
-sub reason {
-  my ($self, $value, %options) = @_;
-  my $dbh = dbh;
-  my $reason;
-  my $typenum = $options{'reason_type'};
-
-  my $oldAutoCommit = $FS::UID::AutoCommit;  # this should already be in
-  local $FS::UID::AutoCommit = 0;            # a transaction if it matters
-
-  if ( defined( $value ) ) {
-    my $hashref = { 'reason' => $value };
-    $hashref->{'reason_type'} = $typenum if $typenum;
-    my $addl_from = "LEFT JOIN reason_type ON ( reason_type = typenum ) ";
-    my $extra_sql = " AND reason_type.class='R'"; 
-
-    $reason = qsearchs( { 'table'     => 'reason',
-                          'hashref'   => $hashref,
-                          'addl_from' => $addl_from,
-                          'extra_sql' => $extra_sql,
-                       } );
-
-    if (!$reason && $typenum) {
-      $reason = new FS::reason( { 'reason_type' => $typenum,
-                                  'reason' => $value,
-                                  'disabled' => 'Y', 
-                              } );
-      my $error = $reason->insert;
-      if ( $error ) {
-        warn "error inserting reason: $error\n";
-        $reason = undef;
-      }
-    }
-
-    $self->reasonnum($reason ? $reason->reasonnum : '') ;
-    warn "$me reason used in set mode with non-existant reason -- clearing"
-      unless $reason;
-  }
-  $reason = qsearchs( 'reason', { 'reasonnum' => $self->reasonnum } );
-
-  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
-  ( $reason ? $reason->reason : '' ).
-  ( $self->addlinfo ? ' '.$self->addlinfo : '' );
-}
-
 # _upgrade_data
 #
 # Used by FS::Upgrade to migrate to a new database.
 # _upgrade_data
 #
 # Used by FS::Upgrade to migrate to a new database.
@@ -459,56 +460,9 @@ sub _upgrade_data {  # class method
 
   warn "$me upgrading $class\n" if $DEBUG;
 
 
   warn "$me upgrading $class\n" if $DEBUG;
 
-  if (defined dbdef->table($class->table)->column('reason')) {
-
-    warn "$me Checking for unmigrated reasons\n" if $DEBUG;
-
-    my @cust_credits = qsearch({ 'table'     => $class->table,
-                                 'hashref'   => {},
-                                 'extra_sql' => 'WHERE reason IS NOT NULL',
-                              });
-
-    if (scalar(grep { $_->getfield('reason') =~ /\S/ } @cust_credits)) {
-      warn "$me Found unmigrated reasons\n" if $DEBUG;
-      my $hashref = { 'class' => 'R', 'type' => 'Legacy' };
-      my $reason_type = qsearchs( 'reason_type', $hashref );
-      unless ($reason_type) {
-        $reason_type  = new FS::reason_type( $hashref );
-        my $error   = $reason_type->insert();
-        die "$class had error inserting FS::reason_type into database: $error\n"
-          if $error;
-      }
-
-      $hashref = { 'reason_type' => $reason_type->typenum,
-                   'reason' => '(none)'
-                 };
-      my $noreason = qsearchs( 'reason', $hashref );
-      unless ($noreason) {
-        $hashref->{'disabled'} = 'Y';
-        $noreason = new FS::reason( $hashref );
-        my $error  = $noreason->insert();
-        die "can't insert legacy reason '(none)' into database: $error\n"
-          if $error;
-      }
-
-      foreach my $cust_credit ( @cust_credits ) {
-        my $reason = $cust_credit->getfield('reason');
-        warn "Contemplating reason $reason\n" if $DEBUG > 1;
-        if ($reason =~ /\S/) {
-          $cust_credit->reason($reason, 'reason_type' => $reason_type->typenum)
-            or die "can't insert legacy reason $reason into database\n";
-        }else{
-          $cust_credit->reasonnum($noreason->reasonnum);
-        }
-
-        $cust_credit->setfield('reason', '');
-        my $error = $cust_credit->replace;
+  $class->_upgrade_reasonnum(%opts);
 
 
-        warn "*** WARNING: error replacing reason in $class ".
-             $cust_credit->crednum. ": $error ***\n"
-          if $error;
-      }
-    }
+  if (defined dbdef->table($class->table)->column('reason')) {
 
     warn "$me Ensuring existance of auto reasons\n" if $DEBUG;
 
 
     warn "$me Ensuring existance of auto reasons\n" if $DEBUG;
 
@@ -564,6 +518,100 @@ sub _upgrade_data {  # class method
   local($ignore_empty_reasonnum) = 1;
   $class->_upgrade_otaker(%opts);
 
   local($ignore_empty_reasonnum) = 1;
   $class->_upgrade_otaker(%opts);
 
+  if ( !FS::upgrade_journal->is_done('cust_credit__tax_link')
+      and !$conf->config('tax_data_vendor') ) {
+    # RT#25458: fix credit line item applications that should refer to a 
+    # specific tax allocation
+    my @cust_credit_bill_pkg = qsearch({
+        table     => 'cust_credit_bill_pkg',
+        select    => 'cust_credit_bill_pkg.*',
+        addl_from => ' LEFT JOIN cust_bill_pkg USING (billpkgnum)',
+        extra_sql =>
+          'WHERE cust_credit_bill_pkg.billpkgtaxlocationnum IS NULL '.
+          'AND cust_bill_pkg.pkgnum = 0', # is a tax
+    });
+    my %tax_items;
+    my %credits;
+    foreach (@cust_credit_bill_pkg) {
+      my $billpkgnum = $_->billpkgnum;
+      $tax_items{$billpkgnum} ||= FS::cust_bill_pkg->by_key($billpkgnum);
+      $credits{$billpkgnum} ||= [];
+      push @{ $credits{$billpkgnum} }, $_;
+    }
+    TAX_ITEM: foreach my $tax_item (values %tax_items) {
+      my $billpkgnum = $tax_item->billpkgnum;
+      # get all pkg/location/taxrate allocations of this tax line item
+      my @allocations = sort {$b->amount <=> $a->amount}
+                        qsearch('cust_bill_pkg_tax_location', {
+                            billpkgnum => $billpkgnum
+                        });
+      # and these are all credit applications to it
+      my @credits = sort {$b->amount <=> $a->amount}
+                    @{ $credits{$billpkgnum} };
+      my $c = shift @credits;
+      my $a = shift @allocations; # we will NOT modify these
+      while ($c and $a) {
+        if ( abs($c->amount - $a->amount) < 0.005 ) {
+          # by far the most common case: the tax line item is for a single
+          # tax, so we just fill in the billpkgtaxlocationnum
+          $c->set('billpkgtaxlocationnum', $a->billpkgtaxlocationnum);
+          my $error = $c->replace;
+          if ($error) {
+            warn "error fixing credit application to tax item #$billpkgnum:\n$error\n";
+            next TAX_ITEM;
+          }
+          $c = shift @credits;
+          $a = shift @allocations;
+        } elsif ( $c->amount > $a->amount ) {
+          # fairly common: the tax line contains tax for multiple packages
+          # (or multiple taxes) but the credit isn't divided up
+          my $new_link = FS::cust_credit_bill_pkg->new({
+              creditbillnum         => $c->creditbillnum,
+              billpkgnum            => $c->billpkgnum,
+              billpkgtaxlocationnum => $a->billpkgtaxlocationnum,
+              amount                => $a->amount,
+              setuprecur            => 'setup',
+          });
+          my $error = $new_link->insert;
+          if ($error) {
+            warn "error fixing credit application to tax item #$billpkgnum:\n$error\n";
+            next TAX_ITEM;
+          }
+          $c->set(amount => sprintf('%.2f', $c->amount - $a->amount));
+          $a = shift @allocations;
+        } elsif ( $c->amount < 0.005 ) {
+          # also fairly common; we can delete these with no harm
+          my $error = $c->delete;
+          warn "error removing zero-amount credit application (probably harmless):\n$error\n" if $error;
+          $c = shift @credits;
+        } elsif ( $c->amount < $a->amount ) {
+          # should never happen, but if it does, handle it gracefully
+          $c->set('billpkgtaxlocationnum', $a->billpkgtaxlocationnum);
+          my $error = $c->replace;
+          if ($error) {
+            warn "error fixing credit application to tax item #$billpkgnum:\n$error\n";
+            next TAX_ITEM;
+          }
+          $a->set(amount => $a->amount - $c->amount);
+          $c = shift @credits;
+        }
+      } # while $c and $a
+      if ( $c ) {
+        if ( $c->amount < 0.005 ) {
+          my $error = $c->delete;
+          warn "error removing zero-amount credit application (probably harmless):\n$error\n" if $error;
+        } elsif ( $c->modified ) {
+          # then we've allocated part of it, so reduce the nonspecific 
+          # application by that much
+          my $error = $c->replace;
+          warn "error fixing credit application to tax item #$billpkgnum:\n$error\n" if $error;
+        }
+        # else there are probably no allocations, i.e. this is a pre-3.x 
+        # record that was never migrated over, so leave it alone
+      } # if $c
+    } # foreach $tax_item
+    FS::upgrade_journal->set_done('cust_credit__tax_link');
+  }
 }
 
 =back
 }
 
 =back
@@ -618,7 +666,128 @@ sub credited_sql {
   unapplied_sql();
 }
 
   unapplied_sql();
 }
 
-=item credit_lineitems
+=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";
+
+    # 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...
+
+    if ($charged < $amount) {
+      $error = "invoice #$invnum: tried to credit $amount, but only $charged was charged";
+      last;
+    }
+    my $credit_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;
+        }
+        # 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,
+          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 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:
 
 
 Example:
 
@@ -628,23 +797,31 @@ Example:
     'billpkgnums'       => \@billpkgnums,
     'setuprecurs'       => \@setuprecurs,
     'amounts'           => \@amounts,
     'billpkgnums'       => \@billpkgnums,
     'setuprecurs'       => \@setuprecurs,
     'amounts'           => \@amounts,
+    'apply'             => 1, #0 leaves the credit unapplied
+    'set_source'        => 1, #creates credit source records for the line items
 
     #the credit
 
     #the credit
-    'newreasonnum'      => scalar($cgi->param('newreasonnum')),
-    'newreasonnum_type' => scalar($cgi->param('newreasonnumT')),
     map { $_ => scalar($cgi->param($_)) }
       #fields('cust_credit')  
     map { $_ => scalar($cgi->param($_)) }
       #fields('cust_credit')  
-      qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum
+      qw( custnum _date amount reasonnum addlinfo ), #pkgnum eventnum
 
   );
 
 
   );
 
+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
 =cut
 
 #maybe i should just be an insert with extra args instead of a class method
-use FS::cust_bill_pkg;
 sub credit_lineitems {
   my( $class, %arg ) = @_;
 sub credit_lineitems {
   my( $class, %arg ) = @_;
-
   my $curuser = $FS::CurrentUser::CurrentUser;
 
   #some false laziness w/misc/xmlhttp-cust_bill_pkg-calculate_taxes.html
   my $curuser = $FS::CurrentUser::CurrentUser;
 
   #some false laziness w/misc/xmlhttp-cust_bill_pkg-calculate_taxes.html
@@ -678,22 +855,17 @@ sub credit_lineitems {
   #});
 
   my $error = '';
   #});
 
   my $error = '';
-  if ($arg{reasonnum} == -1) {
-
-    $error = 'Enter a new reason (or select an existing one)'
-      unless $arg{newreasonnum} !~ /^\s*$/;
-    my $reason = new FS::reason {
-                   'reason'      => $arg{newreasonnum},
-                   'reason_type' => $arg{newreasonnum_type},
-                 };
-    $error ||= $reason->insert;
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return "Error inserting reason: $error";
-    }
-    $arg{reasonnum} = $reason->reasonnum;
+
+  # 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')
   my $cust_credit = new FS::cust_credit ( {
     map { $_ => $arg{$_} }
       #fields('cust_credit')
@@ -705,11 +877,62 @@ sub credit_lineitems {
     return "Error inserting credit: $error";
   }
 
     return "Error inserting credit: $error";
   }
 
+  unless ( $arg{'apply'} ) {
+    $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+    return '';
+  }
+
   #my $subtotal = 0;
   #my $subtotal = 0;
-  my $taxlisthash = {};
+  # keys in all of these are invoice numbers
   my %cust_credit_bill = ();
   my %cust_bill_pkg = ();
   my %cust_credit_bill_pkg = ();
   my %cust_credit_bill = ();
   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;
+  };
+
+
   foreach my $billpkgnum ( @{$arg{billpkgnums}} ) {
     my $setuprecur = shift @{$arg{setuprecurs}};
     my $amount = shift @{$arg{amounts}};
   foreach my $billpkgnum ( @{$arg{billpkgnums}} ) {
     my $setuprecur = shift @{$arg{setuprecurs}};
     my $amount = shift @{$arg{amounts}};
@@ -720,135 +943,138 @@ sub credit_lineitems {
       'addl_from' => 'LEFT JOIN cust_bill USING (invnum)',
       'extra_sql' => 'AND custnum = '. $cust_main->custnum,
     }) or die "unknown 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;
 
 
-    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{$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) ) {
-      $error = $cust_bill_pay_pkg->delete;
-      if ( $error ) {
-        $dbh->rollback if $oldAutoCommit;
-        return "Error unapplying payment: $error";
-      }
-    }
+    push @{$cust_bill_pkg{$invnum}}, $cust_bill_pkg;
 
 
-    #$subtotal += $amount;
-    $cust_credit_bill{$cust_bill_pkg->invnum} += $amount;
-    push @{ $cust_credit_bill_pkg{$cust_bill_pkg->invnum} },
+    $cust_credit_bill{$invnum} += $amount;
+    push @{ $cust_credit_bill_pkg{$invnum} },
       new FS::cust_credit_bill_pkg {
       new FS::cust_credit_bill_pkg {
-        'billpkgnum' => $cust_bill_pkg->billpkgnum,
-        'amount'     => $amount,
+        'billpkgnum' => $billpkgnum,
+        'amount'     => sprintf('%.2f',$amount),
         'setuprecur' => $setuprecur,
         'sdate'      => $cust_bill_pkg->sdate,
         'edate'      => $cust_bill_pkg->edate,
       };
 
         'setuprecur' => $setuprecur,
         'sdate'      => $cust_bill_pkg->sdate,
         'edate'      => $cust_bill_pkg->edate,
       };
 
-    my $part_pkg = $cust_bill_pkg->part_pkg;
-    $cust_main->_handle_taxes( $part_pkg,
-                               $taxlisthash,
-                               $cust_bill_pkg,
-                               $cust_bill_pkg->cust_pkg,
-                               $cust_bill_pkg->cust_bill->_date,
-                               $cust_bill_pkg->cust_pkg->pkgpart,
-                             );
+    # 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";
+    }
   }
 
   }
 
-  ###
-  # now loop through %cust_credit_bill and insert those
-  ###
+  # 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";
 
 
-  # (hack to prevent cust_credit_bill_pkg insertion)
-  local($FS::cust_bill_ApplicationCommon::skip_apply_to_lineitems_hack) = 1;
+    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;
 
 
-  foreach my $invnum ( sort { $a <=> $b } keys %cust_credit_bill ) {
+    my $amount = $tax_credit->{credit};
+    $cust_credit_bill{$invnum} += $amount;
 
 
-    #taxes
+    # 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' => $billpkgnum,
+        'amount'     => sprintf('%.2f', $amount),
+        'setuprecur' => 'setup',
+        $tax_link->primary_key, $tax_credit->{num}
+      };
 
 
-    if ( @{ $cust_bill_pkg{$invnum} } ) {
+    $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;
+    }
 
 
-      my $listref_or_error = 
-        $cust_main->calculate_taxes( $cust_bill_pkg{$invnum}, $taxlisthash, $cust_bill_pkg{$invnum}->[0]->cust_bill->_date );
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Error unapplying payment: $error";
+    }
+  }
 
 
-      unless ( ref( $listref_or_error ) ) {
-        $dbh->rollback if $oldAutoCommit;
-        return "Error calculating taxes: $listref_or_error";
-      }
+  ###
+  # now loop through %cust_credit_bill and insert those
+  ###
 
 
-      # so, loop through the taxlines, apply just that amount to the tax line
-      #  item (save for later insert) & add to $
-
-      #my @taxlines = ();
-      #my $taxtotal = 0;
-      foreach my $taxline ( @$listref_or_error ) {
-
-        #find equivalent tax line items on the existing invoice
-        # (XXX need a more specific/deterministic way to find these than itemdesc..)
-        my $tax_cust_bill_pkg = qsearchs('cust_bill_pkg', {
-          'invnum'   => $invnum,
-          'pkgnum'   => 0, #$taxline->invnum
-          'itemdesc' => $taxline->desc,
-        });
-
-        my $amount = $taxline->setup;
-        my $desc = $taxline->desc;
-
-        foreach my $location ( $tax_cust_bill_pkg->cust_bill_pkg_tax_Xlocation ) {
-
-          $location->cust_bill_pkg_desc($taxline->desc); #ugh @ that kludge
-
-          #$taxtotal += $location->amount;
-          $amount -= $location->amount;
-
-          #push @taxlines,
-          #  #[ $location->desc, $taxline->setup, $taxlocnum, $taxratelocnum ];
-          #  [ $location->desc, $location->amount, $taxlocnum, $taxratelocnum ];
-          $cust_credit_bill{$invnum} += $location->amount;
-          push @{ $cust_credit_bill_pkg{$invnum} },
-            new FS::cust_credit_bill_pkg {
-              'billpkgnum'                => $tax_cust_bill_pkg->billpkgnum,
-              'amount'                    => $location->amount,
-              'setuprecur'                => 'setup',
-              'billpkgtaxlocationnum'     => $location->billpkgtaxlocationnum,
-              'billpkgtaxratelocationnum' => $location->billpkgtaxratelocationnum,
-            };
+  # (hack to prevent cust_credit_bill_pkg insertion)
+  local($FS::cust_bill_ApplicationCommon::skip_apply_to_lineitems_hack) = 1;
 
 
-        }
-        if ($amount > 0) {
-          #$taxtotal += $amount;
-          #push @taxlines,
-          #  [ $taxline->itemdesc. ' (default)', sprintf('%.2f', $amount), '', '' ];
-
-          $cust_credit_bill{$invnum} += $amount;
-          push @{ $cust_credit_bill_pkg{$invnum} },
-            new FS::cust_credit_bill_pkg {
-              'billpkgnum' => $tax_cust_bill_pkg->billpkgnum,
-              'amount'     => $amount,
-              'setuprecur' => 'setup',
-            };
+  foreach my $invnum ( sort { $a <=> $b } keys %cust_credit_bill ) {
 
 
+    # if we unapplied any payments from line items, also unapply that 
+    # amount from the invoice
+    foreach my $billpaynum (keys %{$unapplied_payments{$invnum}}) {
+      my $cust_bill_pay = FS::cust_bill_pay->by_key($billpaynum)
+        or die "broken payment application $billpaynum";
+      my @subapps = $cust_bill_pay->lineitem_applications;
+      $error = $cust_bill_pay->delete; # can't replace
+
+      my $new_cust_bill_pay = FS::cust_bill_pay->new({
+          $cust_bill_pay->hash,
+          billpaynum => '',
+          amount => sprintf('%.2f', 
+              $cust_bill_pay->amount 
+              - $unapplied_payments{$invnum}{$billpaynum}),
+      });
+
+      if ( $new_cust_bill_pay->amount > 0 ) {
+        $error ||= $new_cust_bill_pay->insert;
+        # Also reapply it to everything it was applied to before.
+        # Note that we've already deleted cust_bill_pay_pkg records for the
+        # items we're crediting, so they aren't on this list.
+        foreach my $cust_bill_pay_pkg (@subapps) {
+          $cust_bill_pay_pkg->billpaypkgnum('');
+          $cust_bill_pay_pkg->billpaynum($new_cust_bill_pay->billpaynum);
+          $error ||= $cust_bill_pay_pkg->insert;
         }
       }
         }
       }
-
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "Error unapplying payment: $error";
+      }
     }
     }
-
     #insert cust_credit_bill
 
     my $cust_credit_bill = new FS::cust_credit_bill {
       'crednum' => $cust_credit->crednum,
       'invnum'  => $invnum,
     #insert cust_credit_bill
 
     my $cust_credit_bill = new FS::cust_credit_bill {
       'crednum' => $cust_credit->crednum,
       'invnum'  => $invnum,
-      'amount'  => $cust_credit_bill{$invnum},
+      'amount'  => sprintf('%.2f', $cust_credit_bill{$invnum}),
     };
     $error = $cust_credit_bill->insert;
     if ( $error ) {
     };
     $error = $cust_credit_bill->insert;
     if ( $error ) {
@@ -874,6 +1100,145 @@ 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
+
+=over 4
+
+=item process_batch_import
+
+=cut
+
+use List::Util qw( min );
+use FS::cust_bill;
+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', 'agent_custid' ],
+                           },
+              'default_csv' => 1,
+              'format_hash_callbacks' => { 'simple' => $hashcb },
+              'postinsert_callback' => sub {
+                my $cust_credit = shift; #my ($cust_credit, $param ) = @_;
+
+                if ( $cust_credit->invnum ) {
+
+                  my $cust_bill = qsearchs('cust_bill', { invnum=>$cust_credit->invnum } );
+                  my $amount = min( $cust_credit->credited, $cust_bill->owed );
+    
+                  my $cust_credit_bill = new FS::cust_credit_bill ( {
+                    'crednum' => $cust_credit->crednum,
+                    'invnum'  => $cust_bill->invnum,
+                    'amount'  => $amount,
+                  } );
+                  my $error = $cust_credit_bill->insert;
+                  return '' unless $error;
+
+                }
+
+                #apply_payments_and_credits ?
+                $cust_credit->cust_main->apply_credits;
+
+                return '';
+
+              },
+            };
+
+  FS::Record::process_batch_import( $job, $opt, @_ );
+
+}
+
 =back
 
 =head1 BUGS
 =back
 
 =head1 BUGS