X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=c70a6795f3e2144f81bd374278d2917f82f787dd;hp=4def528b8e98b724eb22e9aebd1cedf89cb56a0a;hb=dba5666db2791c7c9694969470b452633b74d573;hpb=b7ef80d945a1d5919e6f25437cf765e6355e5cb5

diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 4def528b8..c70a6795f 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -8,12 +8,11 @@ use base qw( FS::cust_pkg::Search FS::cust_pkg::API
 use strict;
 use Carp qw(cluck);
 use Scalar::Util qw( blessed );
-use List::Util qw(min max);
+use List::Util qw(min max sum);
 use Tie::IxHash;
 use Time::Local qw( timelocal timelocal_nocheck );
 use MIME::Entity;
 use FS::UID qw( dbh driver_name );
-use FS::Misc qw( send_email );
 use FS::Record qw( qsearch qsearchs fields );
 use FS::CurrentUser;
 use FS::cust_svc;
@@ -39,6 +38,11 @@ use FS::sales;
 # for modify_charge
 use FS::cust_credit;
 
+use Data::Dumper;
+
+# temporary fix; remove this once (un)suspend admin notices are cleaned up
+use FS::Misc qw(send_email);
+
 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
 # setup }
 # because they load configuration by setting FS::UID::callback (see TODO)
@@ -54,18 +58,29 @@ our ($disable_agentcheck, $DEBUG, $me, $import) = (0, 0, '[FS::cust_pkg]', 0);
 
 our $upgrade = 0; #go away after setup+start dates cleaned up for old customers
 
+our $cache_enabled = 0;
+
+our $disable_start_on_hold = 0;
+
+sub _simplecache {
+  my( $self, $hashref ) = @_;
+  if ( $cache_enabled && $hashref->{'pkg'} && $hashref->{'plan'} ) {
+    $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
+  }
+}
+
 sub _cache {
   my $self = shift;
   my ( $hashref, $cache ) = @_;
-  #if ( $hashref->{'pkgpart'} ) {
-  if ( $hashref->{'pkg'} ) {
-    # #@{ $self->{'_pkgnum'} } = ();
-    # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
-    # $self->{'_pkgpart'} = $subcache;
-    # #push @{ $self->{'_pkgnum'} },
-    #   FS::part_pkg->new_or_cached($hashref, $subcache);
-    $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
-  }
+#  #if ( $hashref->{'pkgpart'} ) {
+#  if ( $hashref->{'pkg'} ) {
+#    # #@{ $self->{'_pkgnum'} } = ();
+#    # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
+#    # $self->{'_pkgpart'} = $subcache;
+#    # #push @{ $self->{'_pkgnum'} },
+#    #   FS::part_pkg->new_or_cached($hashref, $subcache);
+#    $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
+#  }
   if ( exists $hashref->{'svcnum'} ) {
     #@{ $self->{'_pkgnum'} } = ();
     my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
@@ -178,11 +193,6 @@ date
 
 order taker (see L<FS::access_user>)
 
-=item manual_flag
-
-If this field is set to 1, disables the automatic
-unsuspension of this package when using the B<unsuspendauto> config option.
-
 =item quantity
 
 If not set, defaults to 1
@@ -251,19 +261,53 @@ or contract_end timers to some number of months after the start date
 a delayed setup fee after a period of "free days", will also set the 
 start date to the end of that period.
 
+If the package has an automatic transfer rule (C<change_to_pkgnum>), then
+this will also order the package and set its start date.
+
 =cut
 
 sub set_initial_timers {
   my $self = shift;
   my $part_pkg = $self->part_pkg;
+  my $start = $self->start_date || $self->setup || time;
+
   foreach my $action ( qw(expire adjourn contract_end) ) {
-    my $months = $part_pkg->option("${action}_months",1);
+    my $months = $part_pkg->get("${action}_months");
     if($months and !$self->get($action)) {
-      my $start = $self->start_date || $self->setup || time;
       $self->set($action, $part_pkg->add_freq($start, $months) );
     }
   }
 
+  # if this package has an expire date and a change_to_pkgpart, set automatic
+  # package transfer
+  # (but don't call change_later, as that would call $self->replace, and we're
+  # probably in the middle of $self->insert right now)
+  if ( $part_pkg->expire_months and $part_pkg->change_to_pkgpart ) {
+    if ( $self->change_to_pkgnum ) {
+      # this can happen if a package is ordered on hold, scheduled for a 
+      # future change _while on hold_, and then released from hold, causing
+      # the automatic transfer to schedule.
+      #
+      # what's correct behavior in that case? I think it's to disallow
+      # future-changing an on-hold package that has an automatic transfer.
+      # but if we DO get into this situation, let the manual package change
+      # win.
+      warn "pkgnum ".$self->pkgnum.": manual future package change blocks ".
+           "automatic transfer.\n";
+    } else {
+      my $change_to = FS::cust_pkg->new( {
+          start_date  => $self->get('expire'),
+          pkgpart     => $part_pkg->change_to_pkgpart,
+          map { $_ => $self->get($_) }
+            qw( custnum locationnum quantity refnum salesnum contract_end )
+      } );
+      my $error = $change_to->insert;
+
+      return $error if $error;
+      $self->set('change_to_pkgnum', $change_to->pkgnum);
+    }
+  }
+
   # if this package has "free days" and delayed setup fee, then
   # set start date that many days in the future.
   # (this should have been set in the UI, but enforce it here)
@@ -273,6 +317,7 @@ sub set_initial_timers {
   {
     $self->start_date( $part_pkg->default_start_date );
   }
+
   '';
 }
 
@@ -332,9 +377,12 @@ a location change).
 sub insert {
   my( $self, %options ) = @_;
 
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
   my $error;
   $error = $self->check_pkgpart unless $options{'allow_pkgpart'};
-  return $error if $error;
 
   my $part_pkg = $self->part_pkg;
 
@@ -351,7 +399,10 @@ sub insert {
       $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
     }
 
-    if ($self->susp eq 'now' or $part_pkg->start_on_hold) {
+    if ( $self->susp eq 'now'
+           or ( $part_pkg->start_on_hold && ! $disable_start_on_hold )
+       )
+    {
       # if the package was ordered on hold:
       # - suspend it
       # - don't set the start date (it will be started manually)
@@ -359,15 +410,12 @@ sub insert {
       $self->set('start_date', '');
     } else {
       # set expire/adjourn/contract_end timers, and free days, if appropriate
-      $self->set_initial_timers;
+      # and automatic package transfer, which can fail, so capture the result
+      $error = $self->set_initial_timers;
     }
   } # else this is a package change, and shouldn't have "new package" behavior
 
-  my $oldAutoCommit = $FS::UID::AutoCommit;
-  local $FS::UID::AutoCommit = 0;
-  my $dbh = dbh;
-
-  $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
+  $error ||= $self->SUPER::insert($options{options} ? %{$options{options}} : ());
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
@@ -391,7 +439,7 @@ sub insert {
     }
   }
 
-  if ( $self->discountnum ) {
+  if ( $self->setup_discountnum || $self->recur_discountnum ) {
     my $error = $self->insert_discount();
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
@@ -401,6 +449,21 @@ sub insert {
 
   my $conf = new FS::Conf;
 
+  if ($self->locationnum) {
+    my @part_export =
+      map qsearch( 'part_export', {exportnum=>$_} ),
+        $conf->config('cust_location-exports'); #, $agentnum
+
+    foreach my $part_export ( @part_export ) {
+      my $error = $part_export->export_pkg_location($self); #, @$export_args);
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "exporting to ". $part_export->exporttype.
+               " (transaction rolled back): $error";
+      }
+    }
+  }
+
   if ( ! $import && $conf->config('ticket_system') && $options{ticket_subject} ) {
 
     #this init stuff is still inefficient, but at least its limited to 
@@ -461,9 +524,27 @@ hide cancelled packages.
 
 =cut
 
+# this is still used internally to abort future package changes, so it 
+# does need to work
+
 sub delete {
   my $self = shift;
 
+  # The following foreign keys to cust_pkg are not cleaned up here, and will
+  # cause package deletion to fail:
+  #
+  # cust_credit.pkgnum and commission_pkgnum (and cust_credit_void)
+  # cust_credit_bill.pkgnum
+  # cust_pay_pending.pkgnum
+  # cust_pay.pkgnum (and cust_pay_void)
+  # cust_bill_pay.pkgnum (wtf, shouldn't reference pkgnum)
+  # cust_pkg_usage.pkgnum
+  # cust_pkg.uncancel_pkgnum, change_pkgnum, main_pkgnum, and change_to_pkgnum
+  # rt_field_charge.pkgnum
+
+  # cust_svc is handled by canceling the package before deleting it
+  # cust_pkg_option is handled via option_Common
+
   my $oldAutoCommit = $FS::UID::AutoCommit;
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
@@ -499,7 +580,13 @@ sub delete {
     }
   }
 
-  #pkg_referral?
+  foreach my $pkg_referral ( $self->pkg_referral ) {
+    my $error = $pkg_referral->delete;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
 
   my $error = $self->SUPER::delete(@_);
   if ( $error ) {
@@ -632,6 +719,24 @@ sub replace {
     }
   }
 
+  # also run exports if removing locationnum?
+  #   doesn't seem to happen, and we don't export blank locationnum on insert...
+  if ($new->locationnum and ($new->locationnum != $old->locationnum)) {
+    my $conf = new FS::Conf;
+    my @part_export =
+      map qsearch( 'part_export', {exportnum=>$_} ),
+        $conf->config('cust_location-exports'); #, $agentnum
+
+    foreach my $part_export ( @part_export ) {
+      my $error = $part_export->export_pkg_location($new); #, @$export_args);
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "exporting to ". $part_export->exporttype.
+               " (transaction rolled back): $error";
+      }
+    }
+  }
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
 
@@ -689,13 +794,6 @@ sub check {
 
   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
 
-  if ( $self->dbdef_table->column('manual_flag') ) {
-    $self->manual_flag('') if $self->manual_flag eq ' ';
-    $self->manual_flag =~ /^([01]?)$/
-      or return "Illegal manual_flag ". $self->manual_flag;
-    $self->manual_flag($1);
-  }
-
   $self->SUPER::check;
 }
 
@@ -807,12 +905,15 @@ sub cancel {
   my( $self, %options ) = @_;
   my $error;
 
-  # pass all suspend/cancel actions to the main package
-  # (unless the pkglinknum has been removed, then the link is defunct and
-  # this package can be canceled on its own)
-  if ( $self->main_pkgnum and $self->pkglinknum and !$options{'from_main'} ) {
-    return $self->main_pkg->cancel(%options);
-  }
+  # supplemental packages can now be separately canceled, though the UI
+  # shouldn't permit it
+  #
+  ## pass all suspend/cancel actions to the main package
+  ## (unless the pkglinknum has been removed, then the link is defunct and
+  ## this package can be canceled on its own)
+  #if ( $self->main_pkgnum and $self->pkglinknum and !$options{'from_main'} ) {
+  #  return $self->main_pkg->cancel(%options);
+  #}
 
   my $conf = new FS::Conf;
 
@@ -899,13 +1000,28 @@ sub cancel {
     }
   }
 
+  # if a reasonnum was passed, get the actual reason object so we can check
+  # unused_credit
+
+  my $reason;
+  if ($options{'reason'} =~ /^\d+$/) {
+    $reason = FS::reason->by_key($options{'reason'});
+  }
+
   unless ($date) {
-    # credit remaining time if appropriate
+    # credit remaining time if any of these are true:
+    # - unused_credit => 1 was passed (this happens when canceling a package
+    #   for a package change when unused_credit_change is set)
+    # - no unused_credit option, and there is a cancel reason, and the cancel
+    #   reason says to credit the package
+    # - no unused_credit option, and the package definition says to credit the
+    #   package on cancellation
     my $do_credit;
     if ( exists($options{'unused_credit'}) ) {
       $do_credit = $options{'unused_credit'};
-    }
-    else {
+    } elsif ( defined($reason) && $reason->unused_credit ) {
+      $do_credit = 1;
+    } else {
       $do_credit = $self->part_pkg->option('unused_credit_cancel', 1);
     }
     if ( $do_credit ) {
@@ -936,8 +1052,14 @@ sub cancel {
     $hash{main_pkgnum} = '';
   }
 
+  # if there is a future package change scheduled, unlink from it (like
+  # abort_change) first, then delete it.
+  $hash{'change_to_pkgnum'} = '';
+
+  # save the package state
   my $new = new FS::cust_pkg ( \%hash );
   $error = $new->replace( $self, options => { $self->options } );
+
   if ( $self->change_to_pkgnum ) {
     my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
     $error ||= $change_to->cancel('no_delay_cancel' => 1) || $change_to->delete;
@@ -979,27 +1101,38 @@ sub cancel {
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   return '' if $date; #no errors
 
-  my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
-  if ( !$options{'quiet'} && 
-        $conf->exists('emailcancel', $self->cust_main->agentnum) && 
-        @invoicing_list ) {
-    my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum);
-    my $error = '';
-    if ( $msgnum ) {
-      my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
-      $error = $msg_template->send( 'cust_main' => $self->cust_main,
-                                    'object'    => $self );
-    }
-    else {
-      $error = send_email(
-        'from'    => $conf->invoice_from_full( $self->cust_main->agentnum ),
-        'to'      => \@invoicing_list,
-        'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
-        'body'    => [ map "$_\n", $conf->config('cancelmessage') ],
-        'custnum' => $self->custnum,
-        'msgtype' => '', #admin?
-      );
-    }
+  my $cust_main = $self->cust_main;
+
+  my @invoicing_list = $cust_main->invoicing_list_emailonly;
+  my $msgnum = $conf->config('cancel_msgnum', $cust_main->agentnum);
+  if (    !$options{'quiet'}
+       && $conf->config_bool('emailcancel', $cust_main->agentnum)
+       && @invoicing_list
+       && $msgnum
+     )
+  {
+    my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
+    my $error = $msg_template->send(
+      'cust_main' => $cust_main,
+      'object'    => $self,
+    );
+    #should this do something on errors?
+  }
+
+  my %pkg_class = map { $_=>1 }
+                    $conf->config('cancel_msgnum-referring_cust-pkg_class');
+  my $ref_msgnum = $conf->config('cancel_msgnum-referring_cust');
+  if (    !$options{'quiet'}
+       && $cust_main->referral_custnum
+       && $pkg_class{ $self->classnum } 
+       && $ref_msgnum
+     )
+  {
+    my $msg_template = qsearchs('msg_template', { msgnum => $ref_msgnum });
+    my $error = $msg_template->send( 
+      'cust_main' => $cust_main->referring_cust_main,
+      'object'    => $self,
+    );
     #should this do something on errors?
   }
 
@@ -1025,6 +1158,166 @@ sub cancel_if_expired {
   '';
 }
 
+=item uncancel_svc_x
+
+For cancelled cust_pkg, returns a list of new, uninserted FS::svc_X records 
+for services that would be inserted by L</uncancel>.  Returned objects also
+include the field _h_svc_x, which contains the service history object.
+
+Set pkgnum before inserting.
+
+Accepts the following options:
+
+only_svcnum - arrayref of svcnum, only returns objects for these svcnum 
+(and only if they would otherwise be returned by this)
+
+=cut
+
+sub uncancel_svc_x {
+  my ($self, %opt) = @_;
+
+  die 'uncancel_svc_x called on a non-cancelled cust_pkg' unless $self->get('cancel');
+
+  #find historical services within this timeframe before the package cancel
+  # (incompatible with "time" option to cust_pkg->cancel?)
+  my $fuzz = 2 * 60; #2 minutes?  too much?   (might catch separate unprovision)
+                     #            too little? (unprovisioing export delay?)
+  my($end, $start) = ( $self->get('cancel'), $self->get('cancel') - $fuzz );
+  my @h_cust_svc = $self->h_cust_svc( $end, $start );
+
+  my @svc_x;
+  foreach my $h_cust_svc (@h_cust_svc) {
+    next if $opt{'only_svcnum'} && !(grep { $_ == $h_cust_svc->svcnum } @{$opt{'only_svcnum'}});
+    # filter out services that still exist on this package (ie preserved svcs)
+    # but keep services that have since been provisioned on another package (for informational purposes)
+    next if qsearchs('cust_svc',{ 'svcnum' => $h_cust_svc->svcnum, 'pkgnum' => $self->pkgnum });
+    my $h_svc_x = $h_cust_svc->h_svc_x( $end, $start );
+    next unless $h_svc_x; # this probably doesn't happen, but just in case
+    (my $table = $h_svc_x->table) =~ s/^h_//;
+    require "FS/$table.pm";
+    my $class = "FS::$table";
+    my $svc_x = $class->new( {
+      'svcpart' => $h_cust_svc->svcpart,
+      '_h_svc_x' => $h_svc_x,
+      map { $_ => $h_svc_x->get($_) } fields($table)
+    } );
+
+    # radius_usergroup
+    if ( $h_svc_x->isa('FS::h_svc_Radius_Mixin') ) {
+      $svc_x->usergroup( [ $h_svc_x->h_usergroup($end, $start) ] );
+    }
+
+    #these are pretty rare, but should handle them
+    # - dsl_device (mac addresses)
+    # - phone_device (mac addresses)
+    # - dsl_note (ikano notes)
+    # - domain_record (i.e. restore DNS information w/domains)
+    # - inventory_item(?) (inventory w/un-cancelling service?)
+    # - nas (svc_broaband nas stuff)
+    #this stuff is unused in the wild afaik
+    # - mailinglistmember
+    # - router.svcnum?
+    # - svc_domain.parent_svcnum?
+    # - acct_snarf (ancient mail fetching config)
+    # - cgp_rule (communigate)
+    # - cust_svc_option (used by our Tron stuff)
+    # - acct_rt_transaction (used by our time worked stuff)
+
+    push @svc_x, $svc_x;
+  }
+  return @svc_x;
+}
+
+=item uncancel_svc_summary
+
+Returns an array of hashrefs, one for each service that could 
+potentially be reprovisioned by L</uncancel>, with the following keys:
+
+svcpart
+
+svc
+
+uncancel_svcnum
+
+label - from history table if not currently calculable, undefined if it can't be loaded
+
+reprovisionable - 1 if test reprovision succeeded, otherwise 0
+
+num_cust_svc - number of svcs for this svcpart, only if summarizing (see below)
+
+Cannot be run from within a transaction.  Performs inserts
+to test the results, and then rolls back the transaction.
+Does not perform exports, so does not catch if export would fail.
+
+Also accepts the following options:
+
+no_test_reprovision - skip the test inserts (reprovisionable field will not exist)
+
+summarize_size - if true, returns a single summary record for svcparts with at
+least this many svcs, will have key num_cust_svc but not uncancel_svcnum, label or reprovisionable
+
+=cut
+
+sub uncancel_svc_summary {
+  my ($self, %opt) = @_;
+
+  die 'uncancel_svc_summary called on a non-cancelled cust_pkg' unless $self->get('cancel');
+  die 'uncancel_svc_summary called from within a transaction' unless $FS::UID::AutoCommit;
+
+  local $FS::svc_Common::noexport_hack = 1; # very important not to run exports!!!
+  local $FS::UID::AutoCommit = 0;
+
+  # sort by svcpart, to check summarize_size
+  my $uncancel_svc_x = {};
+  foreach my $svc_x (sort { $a->{'svcpart'} <=> $b->{'svcpart'} } $self->uncancel_svc_x) {
+    $uncancel_svc_x->{$svc_x->svcpart} = [] unless $uncancel_svc_x->{$svc_x->svcpart};
+    push @{$uncancel_svc_x->{$svc_x->svcpart}}, $svc_x;
+  }
+
+  my @out;
+  foreach my $svcpart (keys %$uncancel_svc_x) {
+    my @svcpart_svc_x = @{$uncancel_svc_x->{$svcpart}};
+    if ($opt{'summarize_size'} && (@svcpart_svc_x >= $opt{'summarize_size'})) {
+      my $svc_x = $svcpart_svc_x[0]; #grab first one for access to $part_svc
+      my $part_svc = $svc_x->part_svc;
+      push @out, {
+        'svcpart'      => $part_svc->svcpart,
+        'svc'          => $part_svc->svc,
+        'num_cust_svc' => scalar(@svcpart_svc_x),
+      };
+    } else {
+      foreach my $svc_x (@svcpart_svc_x) {
+        my $part_svc = $svc_x->part_svc;
+        my $out = {
+          'svcpart' => $part_svc->svcpart,
+          'svc'     => $part_svc->svc,
+          'uncancel_svcnum' => $svc_x->get('_h_svc_x')->svcnum,
+        };
+        $svc_x->pkgnum($self->pkgnum); # provisioning services on a canceled package, will be rolled back
+        my $insert_error;
+        unless ($opt{'no_test_reprovision'}) {
+          # avoid possibly fatal errors from missing linked records
+          eval { $insert_error = $svc_x->insert };
+          $insert_error ||= $@;
+        }
+        if ($opt{'no_test_reprovision'} or $insert_error) {
+          # avoid possibly fatal errors from missing linked records
+          eval { $out->{'label'} = $svc_x->label };
+          eval { $out->{'label'} = $svc_x->get('_h_svc_x')->label } unless defined($out->{'label'});
+          $out->{'reprovisionable'} = 0 unless $opt{'no_test_reprovision'};
+        } else {
+          $out->{'label'} = $svc_x->label;
+          $out->{'reprovisionable'} = 1;
+        }
+        push @out, $out;
+      }
+    }
+  }
+
+  dbh->rollback;
+  return @out;
+}
+
 =item uncancel
 
 "Un-cancels" this package: Orders a new package with the same custnum, pkgpart,
@@ -1037,6 +1330,8 @@ svc_fatal: service provisioning errors are fatal
 
 svc_errors: pass an array reference, will be filled in with any provisioning errors
 
+only_svcnum: arrayref, only attempt to re-provision these cancelled services
+
 main_pkgnum: link the package as a supplemental package of this one.  For 
 internal use only.
 
@@ -1075,7 +1370,7 @@ sub uncancel {
       setup
       susp adjourn resume expire start_date contract_end dundate
       change_date change_pkgpart change_locationnum
-      manual_flag no_auto separate_bill quantity agent_pkgid 
+      no_auto separate_bill quantity agent_pkgid 
       recur_show_zero setup_show_zero
     ),
   };
@@ -1093,32 +1388,12 @@ sub uncancel {
   # insert services
   ##
 
-  #find historical services within this timeframe before the package cancel
-  # (incompatible with "time" option to cust_pkg->cancel?)
-  my $fuzz = 2 * 60; #2 minutes?  too much?   (might catch separate unprovision)
-                     #            too little? (unprovisioing export delay?)
-  my($end, $start) = ( $self->get('cancel'), $self->get('cancel') - $fuzz );
-  my @h_cust_svc = $self->h_cust_svc( $end, $start );
-
   my @svc_errors;
-  foreach my $h_cust_svc (@h_cust_svc) {
-    my $h_svc_x = $h_cust_svc->h_svc_x( $end, $start );
-    #next unless $h_svc_x; #should this happen?
-    (my $table = $h_svc_x->table) =~ s/^h_//;
-    require "FS/$table.pm";
-    my $class = "FS::$table";
-    my $svc_x = $class->new( {
-      'pkgnum'  => $cust_pkg->pkgnum,
-      'svcpart' => $h_cust_svc->svcpart,
-      map { $_ => $h_svc_x->get($_) } fields($table)
-    } );
-
-    # radius_usergroup
-    if ( $h_svc_x->isa('FS::h_svc_Radius_Mixin') ) {
-      $svc_x->usergroup( [ $h_svc_x->h_usergroup($end, $start) ] );
-    }
+  foreach my $svc_x ($self->uncancel_svc_x('only_svcnum' => $options{'only_svcnum'})) {
 
+    $svc_x->pkgnum($cust_pkg->pkgnum);
     my $svc_error = $svc_x->insert;
+
     if ( $svc_error ) {
       if ( $options{svc_fatal} ) {
         $dbh->rollback if $oldAutoCommit;
@@ -1142,23 +1417,7 @@ sub uncancel {
         }
       } # svc_fatal
     } # svc_error
-  } #foreach $h_cust_svc
-
-  #these are pretty rare, but should handle them
-  # - dsl_device (mac addresses)
-  # - phone_device (mac addresses)
-  # - dsl_note (ikano notes)
-  # - domain_record (i.e. restore DNS information w/domains)
-  # - inventory_item(?) (inventory w/un-cancelling service?)
-  # - nas (svc_broaband nas stuff)
-  #this stuff is unused in the wild afaik
-  # - mailinglistmember
-  # - router.svcnum?
-  # - svc_domain.parent_svcnum?
-  # - acct_snarf (ancient mail fetching config)
-  # - cgp_rule (communigate)
-  # - cust_svc_option (used by our Tron stuff)
-  # - acct_rt_transaction (used by our time worked stuff)
+  } #foreach uncancel_svc_x
 
   ##
   # also move over any services that didn't unprovision at cancellation
@@ -1201,14 +1460,15 @@ sub uncancel {
 
 =item unexpire
 
-Cancels any pending expiration (sets the expire field to null).
+Cancels any pending expiration (sets the expire field to null)
+for this package and any supplemental packages.
 
 If there is an error, returns the error, otherwise returns false.
 
 =cut
 
 sub unexpire {
-  my( $self, %options ) = @_;
+  my( $self ) = @_;
   my $error;
 
   my $oldAutoCommit = $FS::UID::AutoCommit;
@@ -1238,6 +1498,14 @@ sub unexpire {
     return $error;
   }
 
+  foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+    $error = $supp_pkg->unexpire;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "unexpiring supplemental pkg#".$supp_pkg->pkgnum.": $error";
+    }
+  }
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   ''; #no errors
@@ -1285,9 +1553,13 @@ sub suspend {
   my( $self, %options ) = @_;
   my $error;
 
-  # pass all suspend/cancel actions to the main package
+  # supplemental packages still can't be separately suspended, but silently
+  # exit instead of failing or passing the action to the main package (so
+  # that the "Suspend customer" action doesn't trip over the supplemental
+  # packages and die)
+
   if ( $self->main_pkgnum and !$options{'from_main'} ) {
-    return $self->main_pkg->suspend(%options);
+    return;
   }
 
   my $oldAutoCommit = $FS::UID::AutoCommit;
@@ -1404,31 +1676,34 @@ sub suspend {
       }
     }
 
-    my @labels = ();
-
-    foreach my $cust_svc (
-      qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
-    ) {
-      my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
-
-      $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
-        $dbh->rollback if $oldAutoCommit;
-        return "Illegal svcdb value in part_svc!";
-      };
-      my $svcdb = $1;
-      require "FS/$svcdb.pm";
-
-      my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
-      if ($svc) {
-        $error = $svc->suspend;
-        if ( $error ) {
-          $dbh->rollback if $oldAutoCommit;
-          return $error;
-        }
-        my( $label, $value ) = $cust_svc->label;
-        push @labels, "$label: $value";
+    my @cust_svc = qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
+
+    #attempt ordering ala cust_svc_suspend_cascade (without infinite-looping
+    # on the circular dep case)
+    #  (this is too simple for multi-level deps, we need to use something
+    #   to resolve the DAG properly when possible)
+    my %svcpart = ();
+    $svcpart{$_->svcpart} = 0 foreach @cust_svc;
+    foreach my $svcpart ( keys %svcpart ) {
+      foreach my $part_svc_link (
+        FS::part_svc_link->by_agentnum($self->cust_main->agentnum,
+                                         src_svcpart => $svcpart,
+                                         link_type => 'cust_svc_suspend_cascade'
+                                      )
+      ) {
+        $svcpart{$part_svc_link->dst_svcpart} = max(
+          $svcpart{$part_svc_link->dst_svcpart},
+          $svcpart{$part_svc_link->src_svcpart} + 1
+        );
       }
     }
+    @cust_svc = sort { $svcpart{ $a->svcpart } <=> $svcpart{ $b->svcpart } }
+                  @cust_svc;
+
+    my @labels = ();
+    foreach my $cust_svc ( @cust_svc ) {
+      $cust_svc->suspend( 'labels_arrayref' => \@labels );
+    }
 
     # suspension fees: if there is a feepart, and it's not an unsuspend fee,
     # and this is not a suspend-before-cancel
@@ -1527,50 +1802,105 @@ sub credit_remaining {
   my $conf = FS::Conf->new;
   my $reason_type = $conf->config($mode.'_credit_type');
 
-  my $last_bill = $self->getfield('last_bill') || 0;
-  my $next_bill = $self->getfield('bill') || 0;
-  if ( $last_bill > 0         # the package has been billed
-      and $next_bill > 0      # the package has a next bill date
-      and $next_bill >= $time # which is in the future
-  ) {
-    my @cust_credit_source_bill_pkg = ();
-    my $remaining_value = 0;
+  $time ||= time;
 
-    my $remain_pkg = $self;
-    $remaining_value = $remain_pkg->calc_remain(
-      'time' => $time, 
-      'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
-    );
+  my $remain_pkg = $self;
+  my (@billpkgnums, @amounts, @setuprecurs);
+  
+  # we may have to walk back past some package changes to get to the 
+  # one that actually has unused time. loop until that happens, or we
+  # reach the first package in the chain.
+  while (1) {
+    my $last_bill = $remain_pkg->get('last_bill') || 0;
+    my $next_bill = $remain_pkg->get('bill') || 0;
+    if ( $last_bill > 0         # the package has been billed
+        and $next_bill > 0      # the package has a next bill date
+        and $next_bill >= $time # which is in the future
+    ) {
+
+      # Find actual charges for the period ending on or after the cancel
+      # date.
+      my @charges = qsearch('cust_bill_pkg', {
+        pkgnum => $remain_pkg->pkgnum,
+        edate => {op => '>=', value => $time},
+        recur => {op => '>' , value => 0},
+      });
+
+      foreach my $cust_bill_pkg (@charges) {
+        # hack to deal with the weird behavior of edate on package
+        # cancellation
+        my $edate = $cust_bill_pkg->edate;
+        if ( $self->recur_temporality eq 'preceding' ) {
+          $edate = $self->add_freq($cust_bill_pkg->sdate);
+        }
+
+        # this will also get any package charges that are _entirely_ after
+        # the cancellation date (can happen with advance billing). in that
+        # case, use the entire recurring charge:
+        my $amount = $cust_bill_pkg->recur - $cust_bill_pkg->usage;
+        my $max_credit = $amount
+            - $cust_bill_pkg->credited('', '', setuprecur => 'recur') || 0;
+
+        # but if the cancellation happens during the interval, prorate it:
+        # (XXX obey prorate_round_day here?)
+        if ( $cust_bill_pkg->sdate < $time ) {
+          $amount = $amount *
+                      ($edate - $time) / ($edate - $cust_bill_pkg->sdate);
+        }
+
+        # if there are existing credits, don't let the sum of credits exceed
+        # the recurring charge
+        $amount = $max_credit if $amount > $max_credit;
+
+        $amount = sprintf('%.2f', $amount);
+
+        # if no time has been used and/or there are existing line item
+        # credits, we may end up not needing to credit anything.
+        if ( $amount > 0 ) {
+
+          push @billpkgnums, $cust_bill_pkg->billpkgnum;
+          push @amounts,     $amount;
+          push @setuprecurs, 'recur';
+
+          warn "Crediting for $amount on package ".$remain_pkg->pkgnum."\n"
+            if $DEBUG;
+        }
 
-    # we may have to walk back past some package changes to get to the 
-    # one that actually has unused time
-    while ( $remaining_value == 0 ) {
-      if ( $remain_pkg->change_pkgnum ) {
-        $remain_pkg = FS::cust_pkg->by_key($remain_pkg->change_pkgnum);
-      } else {
-        # the package has really never been billed
-        return;
       }
-      $remaining_value = $remain_pkg->calc_remain(
-        'time' => $time, 
-        'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
-      );
+
+      last if @charges;
     }
 
-    if ( $remaining_value > 0 ) {
-      warn "Crediting for $remaining_value on package ".$self->pkgnum."\n"
-        if $DEBUG;
-      my $error = $self->cust_main->credit(
-        $remaining_value,
-        'Credit for unused time on '. $self->part_pkg->pkg,
-        'reason_type' => $reason_type,
-        'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
-      );
-      return "Error crediting customer \$$remaining_value for unused time".
-        " on ". $self->part_pkg->pkg. ": $error"
-        if $error;
-    } #if $remaining_value
-  } #if $last_bill, etc.
+    if ( my $changed_from_pkgnum = $remain_pkg->change_pkgnum ) {
+      $remain_pkg = FS::cust_pkg->by_key($changed_from_pkgnum);
+    } else {
+      # the package has really never been billed
+      return;
+    }
+  }
+
+  # keep traditional behavior here. 
+  local $@;
+  my $reason = FS::reason->new_or_existing(
+    reason  => 'Credit for unused time on '. $self->part_pkg->pkg,
+    type    => $reason_type,
+    class   => 'R',
+  );
+  if ( $@ ) {
+    return "failed to set credit reason: $@";
+  }
+
+  my $error = FS::cust_credit->credit_lineitems(
+    'billpkgnums' => \@billpkgnums,
+    'setuprecurs' => \@setuprecurs,
+    'amounts'     => \@amounts,
+    'custnum'     => $self->custnum,
+    'date'        => time,
+    'reasonnum'   => $reason->reasonnum,
+    'apply'       => 1,
+    'set_source'  => 1,
+  );
+
   '';
 }
 
@@ -1656,7 +1986,11 @@ sub unsuspend {
 
   if (!$self->setup) {
     # then this package is being released from on-hold status
-    $self->set_initial_timers;
+    $error = $self->set_initial_timers;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
   }
 
   my @labels = ();
@@ -1750,7 +2084,7 @@ sub unsuspend {
 
   if ( $reason ) {
     if ( $reason->unsuspend_pkgpart ) {
-      #warn "Suspend reason '".$reason->reason."' uses deprecated unsuspend_pkgpart feature.\n"; # in 4.x
+      warn "Suspend reason '".$reason->reason."' uses deprecated unsuspend_pkgpart feature.\n";
       my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart)
         or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart.
                     " not found.";
@@ -1834,14 +2168,15 @@ sub unsuspend {
 
 =item unadjourn
 
-Cancels any pending suspension (sets the adjourn field to null).
+Cancels any pending suspension (sets the adjourn field to null)
+for this package and any supplemental packages.
 
 If there is an error, returns the error, otherwise returns false.
 
 =cut
 
 sub unadjourn {
-  my( $self, %options ) = @_;
+  my( $self ) = @_;
   my $error;
 
   my $oldAutoCommit = $FS::UID::AutoCommit;
@@ -1878,6 +2213,14 @@ sub unadjourn {
     return $error;
   }
 
+  foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+    $error = $supp_pkg->unadjourn;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "unadjourning supplemental pkg#".$supp_pkg->pkgnum.": $error";
+    }
+  }
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   ''; #no errors
@@ -1940,6 +2283,13 @@ can't be transferred (also see the I<cust_pkg-change_svcpart> config option).
 If unprotect_svcs is true, this method will transfer as many services as 
 it can and then unconditionally cancel the old package.
 
+=item contract_end
+
+If specified, sets this value for the contract_end date on the new package 
+(without regard for keep_dates or the usual date-preservation behavior.)
+Will throw an error if defined but false;  the UI doesn't allow editing 
+this unless it already exists, making removal impossible to undo.
+
 =back
 
 At least one of locationnum, cust_location, pkgpart, refnum, cust_main, or
@@ -1953,6 +2303,33 @@ For example:
 
 =cut
 
+#used by change and change_later
+#didn't put with documented check methods because it depends on change-specific opts
+#and it also possibly edits the value of opts
+sub _check_change {
+  my $self = shift;
+  my $opt = shift;
+  if ( defined($opt->{'contract_end'}) ) {
+    my $current_contract_end = $self->get('contract_end');
+    unless ($opt->{'contract_end'}) {
+      if ($current_contract_end) {
+        return "Cannot remove contract end date when changing packages";
+      } else {
+        #shouldn't even pass this option if there's not a current value
+        #but can be handled gracefully if the option is empty
+        warn "Contract end date passed unexpectedly";
+        delete $opt->{'contract_end'};
+        return '';
+      }
+    }
+    unless ($current_contract_end) {
+      #option shouldn't be passed, throw error if it's non-empty
+      return "Cannot add contract end date when changing packages " . $self->pkgnum;
+    }
+  }
+  return '';
+}
+
 #some false laziness w/order
 sub change {
   my $self = shift;
@@ -1960,23 +2337,21 @@ sub change {
 
   my $conf = new FS::Conf;
 
+  # handle contract_end on cust_pkg same as passed option
+  if ( $opt->{'cust_pkg'} ) {
+    $opt->{'contract_end'} = $opt->{'cust_pkg'}->contract_end;
+    delete $opt->{'contract_end'} unless $opt->{'contract_end'};
+  }
+
+  # check contract_end, prevent adding/removing
+  my $error = $self->_check_change($opt);
+  return $error if $error;
+
   # Transactionize this whole mess
   my $oldAutoCommit = $FS::UID::AutoCommit;
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  my $error;
-
-  my %hash = (); 
-
-  my $time = time;
-
-  $hash{'setup'} = $time if $self->setup;
-
-  $hash{'change_date'} = $time;
-  $hash{"change_$_"}  = $self->$_()
-    foreach qw( pkgnum pkgpart locationnum );
-
   if ( $opt->{'cust_location'} ) {
     $error = $opt->{'cust_location'}->find_or_insert;
     if ( $error ) {
@@ -1986,9 +2361,8 @@ sub change {
     $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
   }
 
+  # figure out if we're changing pkgpart
   if ( $opt->{'cust_pkg'} ) {
-    # treat changing to a package with a different pkgpart as a 
-    # pkgpart change (because it is)
     $opt->{'pkgpart'} = $opt->{'cust_pkg'}->pkgpart;
   }
 
@@ -1998,29 +2372,107 @@ sub change {
     $same_pkgpart = 0;
   }
 
+  $self->set('waive_setup', $opt->{'waive_setup'}) if $opt->{'waive_setup'};
+
+  # Before going any further here: if the package is still in the pre-setup
+  # state, it's safe to modify it in place. No need to charge/credit for 
+  # partial period, transfer usage pools, copy invoice details, or change any
+  # dates. We DO need to "transfer" services (from the package to itself) to
+  # check their validity on the new pkgpart.
+  if ( ! $self->setup and ! $opt->{cust_pkg} and ! $opt->{cust_main} ) {
+    foreach ( qw( locationnum pkgpart quantity refnum salesnum waive_setup ) ) {
+      if ( length($opt->{$_}) ) {
+        $self->set($_, $opt->{$_});
+      }
+    }
+    # almost. if the new pkgpart specifies start/adjourn/expire timers, 
+    # apply those.
+    if ( !$same_pkgpart ) {
+      $error ||= $self->set_initial_timers;
+    }
+    # but if contract_end was explicitly specified, that overrides all else
+    $self->set('contract_end', $opt->{'contract_end'})
+      if $opt->{'contract_end'};
+
+    $error ||= $self->replace;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "modifying package: $error";
+    }
+
+    # check/convert services (only on pkgpart change, to avoid surprises
+    # when editing locations)
+    # (maybe do this if changing quantity?)
+    if ( !$same_pkgpart ) {
+
+      $error = $self->transfer($self);
+
+      if ( $error and $error == 0 ) {
+        $error = "transferring $error";
+      } elsif ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
+        warn "trying transfer again with change_svcpart option\n" if $DEBUG;
+        $error = $self->transfer($self, 'change_svcpart'=>1 );
+        if ($error and $error == 0) {
+          $error = "converting $error";
+        }
+      }
+
+      if ($error > 0) {
+        $error = "unable to transfer all services";
+      }
+
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $error;
+      }
+
+    } # done transferring services
+
+    $dbh->commit if $oldAutoCommit;
+    return $self;
+
+  }
+
+  my %hash = (); 
+
+  my $time = time;
+
+  $hash{'setup'} = $time if $self->get('setup');
+
+  $hash{'change_date'} = $time;
+  $hash{"change_$_"}  = $self->$_()
+    foreach qw( pkgnum pkgpart locationnum );
+
   my $unused_credit = 0;
   my $keep_dates = $opt->{'keep_dates'};
-  # Special case.  If the pkgpart is changing, and the customer is
-  # going to be credited for remaining time, don't keep setup, bill, 
-  # or last_bill dates, and DO pass the flag to cancel() to credit 
-  # the customer.
+
+  # Special case.  If the pkgpart is changing, and the customer is going to be
+  # credited for remaining time, don't keep setup, bill, or last_bill dates,
+  # and DO pass the flag to cancel() to credit the customer.  If the old
+  # package had a setup date, set the new package's setup to the package
+  # change date so that it has the same status as before.
   if ( $opt->{'pkgpart'} 
        and $opt->{'pkgpart'} != $self->pkgpart
        and $self->part_pkg->option('unused_credit_change', 1) ) {
     $unused_credit = 1;
     $keep_dates = 0;
-    $hash{$_} = '' foreach qw(setup bill last_bill);
+    $hash{'last_bill'} = '';
+    $hash{'bill'} = '';
   }
 
   if ( $keep_dates ) {
-    foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire 
-                          resume start_date contract_end ) ) {
+    foreach my $date ( qw(setup bill last_bill) ) {
       $hash{$date} = $self->getfield($date);
     }
   }
-  # always keep this date, regardless of anything
-  # (the date of the package change is in a different field)
-  $hash{'order_date'} = $self->getfield('order_date');
+  # always keep the following dates
+  foreach my $date (qw(order_date susp adjourn cancel expire resume 
+                    start_date contract_end)) {
+    $hash{$date} = $self->getfield($date);
+  }
+  # but if contract_end was explicitly specified, that overrides all else
+  $hash{'contract_end'} = $opt->{'contract_end'}
+    if $opt->{'contract_end'};
 
   # allow $opt->{'locationnum'} = '' to specifically set it to null
   # (i.e. customer default location)
@@ -2032,6 +2484,9 @@ sub change {
   # 2. (more importantly) changing a package before it's billed
   $hash{'waive_setup'} = $self->waive_setup;
 
+  # if this package is scheduled for a future package change, preserve that
+  $hash{'change_to_pkgnum'} = $self->change_to_pkgnum;
+
   my $custnum = $self->custnum;
   if ( $opt->{cust_main} ) {
     my $cust_main = $opt->{cust_main};
@@ -2053,10 +2508,15 @@ sub change {
     # changed from this package.
     $cust_pkg = $opt->{'cust_pkg'};
 
-    foreach ( qw( pkgnum pkgpart locationnum ) ) {
-      $cust_pkg->set("change_$_", $self->get($_));
+    # follow all the above rules for date changes, etc.
+    foreach (keys %hash) {
+      $cust_pkg->set($_, $hash{$_});
+    }
+    # except those that implement the future package change behavior
+    foreach (qw(change_to_pkgnum start_date expire)) {
+      $cust_pkg->set($_, '');
     }
-    $cust_pkg->set('change_date', $time);
+
     $error = $cust_pkg->replace;
 
   } else {
@@ -2135,9 +2595,15 @@ sub change {
     }
   }
 
-  # transfer usage pricing add-ons, if we're not changing pkgpart
-  if ( $same_pkgpart ) {
-    foreach my $old_cust_pkg_usageprice ($self->cust_pkg_usageprice) {
+  # transfer usage pricing add-ons, if we're not changing pkgpart or if they were specified
+  if ( $same_pkgpart || $opt->{'cust_pkg_usageprice'}) {
+    my @old_cust_pkg_usageprice;
+    if ($opt->{'cust_pkg_usageprice'}) {
+      @old_cust_pkg_usageprice = @{ $opt->{'cust_pkg_usageprice'} };
+    } else {
+      @old_cust_pkg_usageprice = $self->cust_pkg_usageprice;
+    }
+    foreach my $old_cust_pkg_usageprice (@old_cust_pkg_usageprice) {
       my $new_cust_pkg_usageprice = new FS::cust_pkg_usageprice {
         'pkgnum'         => $cust_pkg->pkgnum,
         'usagepricepart' => $old_cust_pkg_usageprice->usagepricepart,
@@ -2156,9 +2622,9 @@ sub change {
     foreach my $old_discount ($self->cust_pkg_discount_active) {
       # don't remove the old discount, we may still need to bill that package.
       my $new_discount = new FS::cust_pkg_discount {
-        'pkgnum'      => $cust_pkg->pkgnum,
-        'discountnum' => $old_discount->discountnum,
-        'months_used' => $old_discount->months_used,
+        'pkgnum' => $cust_pkg->pkgnum,
+        map { $_ => $old_discount->$_() }
+          qw( discountnum months_used end_date usernum setuprecur ),
       };
       $error = $new_discount->insert;
       if ( $error ) {
@@ -2179,6 +2645,21 @@ sub change {
       return "transferring package notes: $error";
     }
   }
+
+  # transfer scheduled expire/adjourn reasons
+  foreach my $action ('expire', 'adjourn') {
+    if ( $cust_pkg->get($action) ) {
+      my $reason = $self->last_cust_pkg_reason($action);
+      if ( $reason ) {
+        $reason->set('pkgnum', $cust_pkg->pkgnum);
+        $error = $reason->replace;
+        if ( $error ) {
+          $dbh->rollback if $oldAutoCommit;
+          return "transferring $action reason: $error";
+        }
+      }
+    }
+  }
   
   my @new_supp_pkgs;
 
@@ -2259,6 +2740,19 @@ sub change {
     return "canceling old package: $error";
   }
 
+  # transfer rt_field_charge, if we're not changing pkgpart
+  # after billing of old package, before billing of new package
+  if ( $same_pkgpart ) {
+    foreach my $rt_field_charge ($self->rt_field_charge) {
+      $rt_field_charge->set('pkgnum', $cust_pkg->pkgnum);
+      $error = $rt_field_charge->replace;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "transferring rt_field_charge: $error";
+      }
+    }
+  }
+
   if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
     #$self->cust_main
     my $error = $cust_pkg->cust_main->bill( 
@@ -2301,8 +2795,10 @@ The date for the package change.  Required, and must be in the future.
 
 =item quantity
 
-The pkgpart. locationnum, and quantity of the new package, with the same 
-meaning as in C<change>.
+=item contract_end
+
+The pkgpart, locationnum, quantity and optional contract_end of the new 
+package, with the same meaning as in C<change>.
 
 =back
 
@@ -2312,6 +2808,10 @@ sub change_later {
   my $self = shift;
   my $opt = ref($_[0]) ? shift : { @_ };
 
+  # check contract_end, prevent adding/removing
+  my $error = $self->_check_change($opt);
+  return $error if $error;
+
   my $oldAutoCommit = $FS::UID::AutoCommit;
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
@@ -2325,7 +2825,15 @@ sub change_later {
     return "start_date $date is in the past";
   }
 
-  my $error;
+  # If the user entered a new location, set it up now.
+  if ( $opt->{'cust_location'} ) {
+    $error = $opt->{'cust_location'}->find_or_insert;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "creating location record: $error";
+    }
+    $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
+  }
 
   if ( $self->change_to_pkgnum ) {
     my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
@@ -2335,7 +2843,9 @@ sub change_later {
         if $opt->{'locationnum'} and $opt->{'locationnum'} != $change_to->locationnum;
     my $new_quantity = $opt->{'quantity'}
         if $opt->{'quantity'} and $opt->{'quantity'} != $change_to->quantity;
-    if ( $new_pkgpart or $new_locationnum or $new_quantity ) {
+    my $new_contract_end = $opt->{'contract_end'}
+        if $opt->{'contract_end'} and $opt->{'contract_end'} != $change_to->contract_end;
+    if ( $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end ) {
       # it hasn't been billed yet, so in principle we could just edit
       # it in place (w/o a package change), but that's bad form.
       # So change the package according to the new options...
@@ -2350,8 +2860,10 @@ sub change_later {
 
         $error = $self->replace       ||
                  $err_or_pkg->replace ||
-                 $change_to->cancel('no_delay_cancel' => 1) ||
-                 $change_to->delete;
+                 #because change() might've edited existing scheduled change in place
+                 (($err_or_pkg->pkgnum == $change_to->pkgnum) ? '' :
+                  $change_to->cancel('no_delay_cancel' => 1) ||
+                  $change_to->delete);
       } else {
         $error = $err_or_pkg;
       }
@@ -2375,8 +2887,10 @@ sub change_later {
       if $opt->{'locationnum'} and $opt->{'locationnum'} != $self->locationnum;
   my $new_quantity = $opt->{'quantity'}
       if $opt->{'quantity'} and $opt->{'quantity'} != $self->quantity;
+  my $new_contract_end = $opt->{'contract_end'}
+      if $opt->{'contract_end'} and $opt->{'contract_end'} != $self->contract_end;
 
-  return '' unless $new_pkgpart or $new_locationnum or $new_quantity; # wouldn't do anything
+  return '' unless $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end; # wouldn't do anything
 
   # allow $opt->{'locationnum'} = '' to specifically set it to null
   # (i.e. customer default location)
@@ -2387,7 +2901,7 @@ sub change_later {
     locationnum => $opt->{'locationnum'},
     start_date  => $date,
     map   {  $_ => ( $opt->{$_} || $self->$_() )  }
-      qw( pkgpart quantity refnum salesnum )
+      qw( pkgpart quantity refnum salesnum contract_end )
   } );
   $error = $new->insert('change' => 1, 
                         'allow_pkgpart' => ($new_pkgpart ? 0 : 1));
@@ -2413,16 +2927,28 @@ Cancels a future package change scheduled by C<change_later>.
 
 sub abort_change {
   my $self = shift;
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+
   my $pkgnum = $self->change_to_pkgnum;
   my $change_to = FS::cust_pkg->by_key($pkgnum) if $pkgnum;
   my $error;
-  if ( $change_to ) {
-    $error = $change_to->cancel || $change_to->delete;
-    return $error if $error;
-  }
   $self->set('change_to_pkgnum', '');
   $self->set('expire', '');
-  $self->replace;
+  $error = $self->replace;
+  if ( $change_to ) {
+    $error ||= $change_to->cancel || $change_to->delete;
+  }
+
+  if ( $oldAutoCommit ) {
+    if ( $error ) {
+      dbh->rollback;
+    } else {
+      dbh->commit;
+    }
+  }
+
+  return $error;
 }
 
 =item set_quantity QUANTITY
@@ -2514,7 +3040,7 @@ sub modify_charge {
       $pkg_opt_modified = 1;
     }
   }
-  $pkg_opt_modified = 1 if (scalar(@old_additional) - 1) != $i;
+  $pkg_opt_modified = 1 if scalar(@old_additional) != $i;
   $pkg_opt{'additional_count'} = $i if $i > 0;
 
   my $old_classnum;
@@ -2668,9 +3194,6 @@ sub modify_charge {
   '';
 }
 
-
-
-use Data::Dumper;
 sub process_bulk_cust_pkg {
   my $job = shift;
   my $param = shift;
@@ -3068,16 +3591,15 @@ sub cust_svc_unsorted_arrayref {
   }
 
   my %search = (
-    'table'   => 'cust_svc',
-    'hashref' => { 'pkgnum' => $self->pkgnum },
+    'select'    => 'cust_svc.*, part_svc.*',
+    'table'     => 'cust_svc',
+    'hashref'   => { 'pkgnum' => $self->pkgnum },
+    'addl_from' => 'LEFT JOIN part_svc USING ( svcpart )',
   );
-  if ( $opt{svcpart} ) {
-    $search{hashref}->{svcpart} = $opt{'svcpart'};
-  }
-  if ( $opt{'svcdb'} ) {
-    $search{addl_from} = ' LEFT JOIN part_svc USING ( svcpart ) ';
-    $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{'svcdb'} );
-  }
+  $search{hashref}->{svcpart} = $opt{svcpart}
+    if $opt{svcpart};
+  $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{svcdb} )
+    if $opt{svcdb};
 
   [ qsearch(\%search) ];
 
@@ -3206,28 +3728,33 @@ Returns a list of FS::part_svc objects representing services included in this
 package but not yet provisioned.  Each FS::part_svc object also has an extra
 field, I<num_avail>, which specifies the number of available services.
 
+Accepts option I<provision_hold>;  if true, only returns part_svc for which the
+associated pkg_svc has the provision_hold flag set.
+
 =cut
 
 sub available_part_svc {
   my $self = shift;
+  my %opt  = @_;
 
   my $pkg_quantity = $self->quantity || 1;
 
   grep { $_->num_avail > 0 }
-    map {
-          my $part_svc = $_->part_svc;
-          $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
-            $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart);
-
-	  # more evil encapsulation breakage
-	  if($part_svc->{'Hash'}{'num_avail'} > 0) {
-	    my @exports = $part_svc->part_export_did;
-	    $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
-	  }
-
-          $part_svc;
-        }
-      $self->part_pkg->pkg_svc;
+  map {
+    my $part_svc = $_->part_svc;
+    $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
+    $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart);
+
+    # more evil encapsulation breakage
+    if ($part_svc->{'Hash'}{'num_avail'} > 0) {
+      my @exports = $part_svc->part_export_did;
+      $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
+	}
+
+    $part_svc;
+  }
+  grep { $opt{'provision_hold'} ? $_->provision_hold : 1 }
+  $self->part_pkg->pkg_svc;
 }
 
 =item part_svc [ OPTION => VALUE ... ]
@@ -3460,6 +3987,9 @@ cust_pkg status is 'suspended' and expire is set
 to cancel package within the next day (or however
 many days are set in global config part_pkg-delay_cancel-days.
 
+Accepts option I<part_pkg-delay_cancel-days> which should be
+the value of the config setting, to avoid looking it up again.
+
 This is not a real status, this only meant for hacking display 
 values, because otherwise treating the package as suspended is 
 really the whole point of the delay_cancel option.
@@ -3467,15 +3997,18 @@ really the whole point of the delay_cancel option.
 =cut
 
 sub is_status_delay_cancel {
-  my ($self) = @_;
+  my ($self,%opt) = @_;
   if ( $self->main_pkgnum and $self->pkglinknum ) {
     return $self->main_pkg->is_status_delay_cancel;
   }
   return 0 unless $self->part_pkg->option('delay_cancel',1);
   return 0 unless $self->status eq 'suspended';
   return 0 unless $self->expire;
-  my $conf = new FS::Conf;
-  my $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
+  my $expdays = $opt{'part_pkg-delay_cancel-days'};
+  unless ($expdays) {
+    my $conf = new FS::Conf;
+    $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
+  }
   my $expsecs = 60*60*24*$expdays;
   return 0 unless $self->expire < time + $expsecs;
   return 1;
@@ -3561,23 +4094,27 @@ sub labels {
   map { [ $_->label ] } $self->cust_svc;
 }
 
-=item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
+=item h_labels END_TIMESTAMP [, START_TIMESTAMP [, MODE [, LOCALE ] ] ]
 
 Like the labels method, but returns historical information on services that
 were active as of END_TIMESTAMP and (optionally) not cancelled before
 START_TIMESTAMP.  If MODE is 'I' (for 'invoice'), services with the 
 I<pkg_svc.hidden> flag will be omitted.
 
-Returns a list of lists, calling the label method for all (historical) services
-(see L<FS::h_cust_svc>) of this billing item.
+If LOCALE is passed, service definition names will be localized.
+
+Returns a list of lists, calling the label method for all (historical)
+services (see L<FS::h_cust_svc>) of this billing item.
 
 =cut
 
 sub h_labels {
   my $self = shift;
-  warn "$me _h_labels called on $self\n"
+  my ($end, $start, $mode, $locale) = @_;
+  warn "$me h_labels\n"
     if $DEBUG;
-  map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
+  map { [ $_->label($end, $start, $locale) ] }
+        $self->h_cust_svc($end, $start, $mode);
 }
 
 =item labels_short
@@ -3590,15 +4127,15 @@ individual services rather than individual items.
 =cut
 
 sub labels_short {
-  shift->_labels_short( 'labels', @_ );
+  shift->_labels_short( 'labels' ); # 'labels' takes no further arguments
 }
 
-=item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
+=item h_labels_short END_TIMESTAMP [, START_TIMESTAMP [, MODE [, LOCALE ] ] ]
 
 Like h_labels, except returns a simple flat list, and shortens long
-(currently >5 or the cust_bill-max_same_services configuration value) lists of
-identical services to one line that lists the service label and the number of
-individual services rather than individual items.
+(currently >5 or the cust_bill-max_same_services configuration value) lists
+of identical services to one line that lists the service label and the
+number of individual services rather than individual items.
 
 =cut
 
@@ -3606,6 +4143,9 @@ sub h_labels_short {
   shift->_labels_short( 'h_labels', @_ );
 }
 
+# takes a method name ('labels' or 'h_labels') and all its arguments;
+# maybe should be "shorten($self->h_labels( ... ) )"
+
 sub _labels_short {
   my( $self, $method ) = ( shift, shift );
 
@@ -3883,8 +4423,10 @@ sub transfer {
     $target{$pkg_svc->svcpart} = $pkg_svc->quantity * ( $dest->quantity || 1 );
   }
 
-  foreach my $cust_svc ($dest->cust_svc) {
-    $target{$cust_svc->svcpart}--;
+  unless ( $self->pkgnum == $dest->pkgnum ) {
+    foreach my $cust_svc ($dest->cust_svc) {
+      $target{$cust_svc->svcpart}--;
+    }
   }
 
   my %svcpart2svcparts = ();
@@ -3918,24 +4460,42 @@ sub transfer {
   my $error;
   foreach my $cust_svc ($self->cust_svc) {
     my $svcnum = $cust_svc->svcnum;
-    if($target{$cust_svc->svcpart} > 0
-       or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option
+
+    if (    $target{$cust_svc->svcpart} > 0
+         or $FS::cust_svc::ignore_quantity # maybe should be a 'force' option
+       )
+    {
       $target{$cust_svc->svcpart}--;
+
+      local $FS::cust_svc::ignore_quantity = 1
+        if $self->pkgnum == $dest->pkgnum;
+
+      #why run replace at all in the $self->pkgnum == $dest->pkgnum case?
+      # we do want to trigger location and pkg_change exports, but 
+      # without pkgnum changing from an old to new package, cust_svc->replace
+      # doesn't know how to trigger those.  :/
+      # does this mean we scrap the whole idea of "safe to modify it in place",
+      # or do we special-case and pass the info needed to cust_svc->replace? :/
+
       my $new = new FS::cust_svc { $cust_svc->hash };
       $new->pkgnum($dest_pkgnum);
       $error = $new->replace($cust_svc);
+
     } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
+
       if ( $DEBUG ) {
         warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
         warn "alternates to consider: ".
              join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
       }
+
       my @alternate = grep {
                              warn "considering alternate svcpart $_: ".
                                   "$target{$_} available in new package\n"
                                if $DEBUG;
                              $target{$_} > 0;
                            } @{$svcpart2svcparts{$cust_svc->svcpart}};
+
       if ( @alternate ) {
         warn "alternate(s) found\n" if $DEBUG;
         my $change_svcpart = $alternate[0];
@@ -3947,13 +4507,16 @@ sub transfer {
       } else {
         $remaining++;
       }
+
     } else {
       $remaining++
     }
+
     if ( $error ) {
       my @label = $cust_svc->label;
       return "$label[0] $label[1]: $error";
     }
+
   }
   return $remaining;
 }
@@ -4129,13 +4692,10 @@ sub insert_reason {
 Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
 inserting a new discount on the fly (see L<FS::discount>).
 
-Available options are:
-
-=over 4
-
-=item discountnum
-
-=back
+This will look at the cust_pkg for a pseudo-field named "setup_discountnum",
+and if present, will create a setup discount. If the discountnum is -1,
+a new discount definition will be inserted using the value in
+"setup_discountnum_amount" or "setup_discountnum_percent". Likewise for recur.
 
 If there is an error, returns the error, otherwise returns false.
 
@@ -4145,21 +4705,29 @@ sub insert_discount {
   #my ($self, %options) = @_;
   my $self = shift;
 
-  my $cust_pkg_discount = new FS::cust_pkg_discount {
-    'pkgnum'      => $self->pkgnum,
-    'discountnum' => $self->discountnum,
-    'months_used' => 0,
-    'end_date'    => '', #XXX
-    #for the create a new discount case
-    '_type'       => $self->discountnum__type,
-    'amount'      => $self->discountnum_amount,
-    'percent'     => $self->discountnum_percent,
-    'months'      => $self->discountnum_months,
-    'setup'      => $self->discountnum_setup,
-    #'disabled'    => $self->discountnum_disabled,
-  };
+  foreach my $x (qw(setup recur)) {
+    if ( my $discountnum = $self->get("${x}_discountnum") ) {
+      my $cust_pkg_discount = FS::cust_pkg_discount->new( {
+        'pkgnum'      => $self->pkgnum,
+        'discountnum' => $discountnum,
+        'setuprecur'  => $x,
+        'months_used' => 0,
+        'end_date'    => '', #XXX
+        #for the create a new discount case
+        'amount'      => $self->get("${x}_discountnum_amount"),
+        'percent'     => $self->get("${x}_discountnum_percent"),
+        'months'      => $self->get("${x}_discountnum_months"),
+      } );
+      if ( $x eq 'setup' ) {
+        $cust_pkg_discount->setup('Y');
+        $cust_pkg_discount->months('');
+      }
+      my $error = $cust_pkg_discount->insert;
+      return $error if $error;
+    }
+  }
 
-  $cust_pkg_discount->insert;
+  '';
 }
 
 =item set_usage USAGE_VALUE_HASHREF 
@@ -4554,6 +5122,17 @@ sub cancel_sql {
   "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
 }
 
+=item ncancelled_recurring_sql
+
+Returns an SQL expression identifying un-cancelled, recurring packages.
+
+=cut
+
+sub ncancelled_recurring_sql {
+  $_[0]->recurring_sql().
+  " AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) ";
+}
+
 =item status_sql
 
 Returns an SQL expression to give the package status as a string.
@@ -4934,6 +5513,95 @@ sub bulk_change {
   '';
 }
 
+=item forward_emails
+
+Returns a hash of svcnums and corresponding email addresses
+for svc_acct services that can be used as source or dest
+for svc_forward services provisioned in this package.
+
+Accepts options I<svc_forward> OR I<svcnum> for a svc_forward
+service;  if included, will ensure the current values of the
+specified service are included in the list, even if for some
+other reason they wouldn't be.  If called as a class method
+with a specified service, returns only these current values.
+
+Caution: does not actually check if svc_forward services are
+available to be provisioned on this package.
+
+=cut
+
+sub forward_emails {
+  my $self = shift;
+  my %opt = @_;
+
+  #load optional service, thoroughly validated
+  die "Use svcnum or svc_forward, not both"
+    if $opt{'svcnum'} && $opt{'svc_forward'};
+  my $svc_forward = $opt{'svc_forward'};
+  $svc_forward ||= qsearchs('svc_forward',{ 'svcnum' => $opt{'svcnum'} })
+    if $opt{'svcnum'};
+  die "Specified service is not a forward service"
+    if $svc_forward && (ref($svc_forward) ne 'FS::svc_forward');
+  die "Specified service not found"
+    if ($opt{'svcnum'} || $opt{'svc_forward'}) && !$svc_forward;
+
+  my %email;
+
+  ## everything below was basically copied from httemplate/edit/svc_forward.cgi 
+  ## with minimal refactoring, not sure why we can't just load all svc_accts for this custnum
+
+  #add current values from specified service, if there was one
+  if ($svc_forward) {
+    foreach my $method (qw( srcsvc_acct dstsvc_acct )) {
+      my $svc_acct = $svc_forward->$method();
+      $email{$svc_acct->svcnum} = $svc_acct->email if $svc_acct;
+    }
+  }
+
+  if (ref($self) eq 'FS::cust_pkg') {
+
+    #and including the rest for this customer
+    my($u_part_svc,@u_acct_svcparts);
+    foreach $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) {
+      push @u_acct_svcparts,$u_part_svc->getfield('svcpart');
+    }
+
+    my $custnum = $self->getfield('custnum');
+    foreach my $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
+      my $cust_pkgnum = $i_cust_pkg->getfield('pkgnum');
+      #now find the corresponding record(s) in cust_svc (for this pkgnum!)
+      foreach my $acct_svcpart (@u_acct_svcparts) {
+        foreach my $i_cust_svc (
+          qsearch( 'cust_svc', { 'pkgnum'  => $cust_pkgnum,
+                                 'svcpart' => $acct_svcpart } )
+        ) {
+          my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $i_cust_svc->svcnum } );
+          $email{$svc_acct->svcnum} = $svc_acct->email;
+        }  
+      }
+    }
+  }
+
+  return %email;
+}
+
+# Used by FS::Upgrade to migrate to a new database.
+sub _upgrade_schema {  # class method
+  my ($class, %opts) = @_;
+
+  my $sql = '
+    UPDATE cust_pkg SET change_to_pkgnum = NULL
+      WHERE change_to_pkgnum IS NOT NULL
+        AND NOT EXISTS ( SELECT 1 FROM cust_pkg AS ctcp
+                           WHERE ctcp.pkgnum = cust_pkg.change_to_pkgnum
+                       )
+  ';
+
+  my $sth = dbh->prepare($sql) or die dbh->errstr;
+  $sth->execute or die $sth->errstr;
+  '';
+}
+
 # Used by FS::Upgrade to migrate to a new database.
 sub _upgrade_data {  # class method
   my ($class, %opts) = @_;
@@ -4974,6 +5642,32 @@ sub _upgrade_data {  # class method
     my $error = $part_pkg_link->remove_linked;
     die $error if $error;
   }
+
+  # RT#73607: canceling a package with billing addons sometimes changes its
+  # pkgpart.
+  # Find records where the last replace_new record for the package before it
+  # was canceled has a different pkgpart from the package itself.
+  my @cust_pkg = qsearch({
+    'table' => 'cust_pkg',
+    'select' => 'cust_pkg.*, h_cust_pkg.pkgpart AS h_pkgpart',
+    'addl_from' => ' JOIN (
+  SELECT pkgnum, MAX(historynum) AS historynum FROM h_cust_pkg
+    WHERE cancel IS NULL
+      AND history_action = \'replace_new\'
+    GROUP BY pkgnum
+  ) AS last_history USING (pkgnum)
+  JOIN h_cust_pkg USING (historynum)',
+    'extra_sql' => ' WHERE cust_pkg.cancel is not null
+                     AND cust_pkg.pkgpart != h_cust_pkg.pkgpart'
+  });
+  foreach my $cust_pkg ( @cust_pkg ) {
+    my $pkgnum = $cust_pkg->pkgnum;
+    warn "fixing pkgpart on canceled pkg#$pkgnum\n";
+    $cust_pkg->set('pkgpart', $cust_pkg->h_pkgpart);
+    my $error = $cust_pkg->replace;
+    die $error if $error;
+  }
+
 }
 
 =back