RT# 81961 Repair broken links in POD documentation
[freeside.git] / FS / FS / cust_pkg.pm
index 4def528..ba5016e 100644 (file)
@@ -6,14 +6,13 @@ use base qw( FS::cust_pkg::Search FS::cust_pkg::API
            );
 
 use strict;
            );
 
 use strict;
-use Carp qw(cluck);
+use Carp qw(cluck croak);
 use Scalar::Util qw( blessed );
 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 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;
 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;
 
 # 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)
 # 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 $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 ) = @_;
 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});
   if ( exists $hashref->{'svcnum'} ) {
     #@{ $self->{'_pkgnum'} } = ();
     my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
@@ -132,7 +147,7 @@ Billing item definition (see L<FS::part_pkg>)
 
 =item locationnum
 
 
 =item locationnum
 
-Optional link to package location (see L<FS::location>)
+Optional link to package location (see L<FS::cust_location>)
 
 =item order_date
 
 
 =item order_date
 
@@ -178,11 +193,6 @@ date
 
 order taker (see L<FS::access_user>)
 
 
 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
 =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.
 
 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;
 =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) ) {
   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)) {
     if($months and !$self->get($action)) {
-      my $start = $self->start_date || $self->setup || time;
       $self->set($action, $part_pkg->add_freq($start, $months) );
     }
   }
 
       $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)
   # 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 );
   }
   {
     $self->start_date( $part_pkg->default_start_date );
   }
+
   '';
 }
 
   '';
 }
 
@@ -332,9 +377,12 @@ a location change).
 sub insert {
   my( $self, %options ) = @_;
 
 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'};
   my $error;
   $error = $self->check_pkgpart unless $options{'allow_pkgpart'};
-  return $error if $error;
 
   my $part_pkg = $self->part_pkg;
 
 
   my $part_pkg = $self->part_pkg;
 
@@ -351,7 +399,10 @@ sub insert {
       $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
     }
 
       $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)
       # 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('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
 
     }
   } # 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;
   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;
     my $error = $self->insert_discount();
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
@@ -401,6 +449,21 @@ sub insert {
 
   my $conf = new FS::Conf;
 
 
   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 
   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
 
 
 =cut
 
+# this is still used internally to abort future package changes, so it 
+# does need to work
+
 sub delete {
   my $self = shift;
 
 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;
   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 ) {
 
   my $error = $self->SUPER::delete(@_);
   if ( $error ) {
@@ -536,7 +623,7 @@ Available options are:
 
 =item reason
 
 
 =item reason
 
-can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason.  The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
+can be set to a cancellation reason (see L<FS::reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason.  The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
 
 =item reason_otaker
 
 
 =item reason_otaker
 
@@ -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;
   '';
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
 
@@ -689,13 +794,6 @@ sub check {
 
   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
 
 
   $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;
 }
 
   $self->SUPER::check;
 }
 
@@ -771,7 +869,7 @@ correctly.  Note however that this is an immediate cancel and just changes
 the date.  You are PROBABLY looking to expire the account instead of using 
 this.
 
 the date.  You are PROBABLY looking to expire the account instead of using 
 this.
 
-=item reason - can be set to a cancellation reason (see L<FS:reason>), 
+=item reason - can be set to a cancellation reason (see L<FS::reason>),
 either a reasonnum of an existing reason, or passing a hashref will create 
 a new reason.  The hashref should have the following keys: typenum - Reason 
 type (see L<FS::reason_type>, reason - Text of the new reason.
 either a reasonnum of an existing reason, or passing a hashref will create 
 a new reason.  The hashref should have the following keys: typenum - Reason 
 type (see L<FS::reason_type>, reason - Text of the new reason.
@@ -807,12 +905,15 @@ sub cancel {
   my( $self, %options ) = @_;
   my $error;
 
   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;
 
 
   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) {
   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'};
     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 ) {
       $do_credit = $self->part_pkg->option('unused_credit_cancel', 1);
     }
     if ( $do_credit ) {
@@ -936,8 +1052,14 @@ sub cancel {
     $hash{main_pkgnum} = '';
   }
 
     $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 } );
   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;
   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
 
   $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?
   }
 
     #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,
 =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
 
 
 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.
 
 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
       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
     ),
   };
       recur_show_zero setup_show_zero
     ),
   };
@@ -1093,32 +1388,12 @@ sub uncancel {
   # insert services
   ##
 
   # 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;
   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;
     my $svc_error = $svc_x->insert;
+
     if ( $svc_error ) {
       if ( $options{svc_fatal} ) {
         $dbh->rollback if $oldAutoCommit;
     if ( $svc_error ) {
       if ( $options{svc_fatal} ) {
         $dbh->rollback if $oldAutoCommit;
@@ -1142,23 +1417,7 @@ sub uncancel {
         }
       } # svc_fatal
     } # svc_error
         }
       } # 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
 
   ##
   # also move over any services that didn't unprovision at cancellation
@@ -1201,14 +1460,15 @@ sub uncancel {
 
 =item unexpire
 
 
 =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 {
 
 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;
   my $error;
 
   my $oldAutoCommit = $FS::UID::AutoCommit;
@@ -1238,6 +1498,14 @@ sub unexpire {
     return $error;
   }
 
     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
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   ''; #no errors
@@ -1253,7 +1521,7 @@ Available options are:
 
 =over 4
 
 
 =over 4
 
-=item reason - can be set to a cancellation reason (see L<FS:reason>),
+=item reason - can be set to a cancellation reason (see L<FS::reason>),
 either a reasonnum of an existing reason, or passing a hashref will create 
 a new reason.  The hashref should have the following keys: 
 - typenum - Reason type (see L<FS::reason_type>
 either a reasonnum of an existing reason, or passing a hashref will create 
 a new reason.  The hashref should have the following keys: 
 - typenum - Reason type (see L<FS::reason_type>
@@ -1285,9 +1553,13 @@ sub suspend {
   my( $self, %options ) = @_;
   my $error;
 
   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'} ) {
   if ( $self->main_pkgnum and !$options{'from_main'} ) {
-    return $self->main_pkg->suspend(%options);
+    return;
   }
 
   my $oldAutoCommit = $FS::UID::AutoCommit;
   }
 
   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
 
     # 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 $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
 
   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 = ();
   }
 
   my @labels = ();
@@ -1750,7 +2084,7 @@ sub unsuspend {
 
   if ( $reason ) {
     if ( $reason->unsuspend_pkgpart ) {
 
   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.";
       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
 
 
 =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 {
 
 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;
   my $error;
 
   my $oldAutoCommit = $FS::UID::AutoCommit;
@@ -1878,6 +2213,14 @@ sub unadjourn {
     return $error;
   }
 
     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
   $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.
 
 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
 =back
 
 At least one of locationnum, cust_location, pkgpart, refnum, cust_main, or
@@ -1953,6 +2303,33 @@ For example:
 
 =cut
 
 
 =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;
 #some false laziness w/order
 sub change {
   my $self = shift;
@@ -1960,23 +2337,21 @@ sub change {
 
   my $conf = new FS::Conf;
 
 
   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;
 
   # 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 ) {
   if ( $opt->{'cust_location'} ) {
     $error = $opt->{'cust_location'}->find_or_insert;
     if ( $error ) {
@@ -1986,41 +2361,153 @@ sub change {
     $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
   }
 
     $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
   }
 
+  # figure out if we're changing pkgpart
   if ( $opt->{'cust_pkg'} ) {
   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;
   }
 
     $opt->{'pkgpart'} = $opt->{'cust_pkg'}->pkgpart;
   }
 
-  # whether to override pkgpart checking on the new package
-  my $same_pkgpart = 1;
-  if ( $opt->{'pkgpart'} and ( $opt->{'pkgpart'} != $self->pkgpart ) ) {
-    $same_pkgpart = 0;
-  }
+  # whether to override pkgpart checking on the new package
+  my $same_pkgpart = 1;
+  if ( $opt->{'pkgpart'} and ( $opt->{'pkgpart'} != $self->pkgpart ) ) {
+    $same_pkgpart = 0;
+  }
+
+  # Discounts:
+  #   When a new discount level is specified in $opt:
+  #     If new discountnum matches old discountnum, months_used/end_date are
+  #       carried over as the discount is applied to the new cust_pkg
+  #
+  #   Legacy behavior:
+  #     Unless discount-related fields have been set within $opt, change()
+  #     sets no discounts on the changed packages unless the new pkgpart is the
+  #     same as the old pkgpart.  In that case, discounts from the old cust_pkg
+  #     are copied onto the new cust_pkg
+
+  # Read discount fields from $opt
+  my %new_discount = $self->_parse_new_discounts($opt);
+  $self->set(waive_setup => $opt->{waive_setup} ? $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
+
+    # Set waive_setup as directed
+    if ( !$error && exists $opt->{waive_setup} ) {
+      $self->set(waive_setup => $opt->{waive_setup});
+      $error = $self->replace;
+    }
+
+    # Set discounts if explicitly specified in $opt
+    if ( !$error && %new_discount ) {
+      $error = $self->change_discount(%new_discount);
+    }
+
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+
+    $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'};
 
   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;
   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'} = '';
+
+    # Optionally, carry over the next bill date from the changed cust_pkg
+    # so an invoice isn't generated until the customer's usual billing date
+    if ( $self->part_pkg->option('prorate_defer_change_bill', 1) ) {
+      $hash{bill} = $self->bill;
+    }
   }
 
   if ( $keep_dates ) {
   }
 
   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);
     }
   }
       $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)
 
   # allow $opt->{'locationnum'} = '' to specifically set it to null
   # (i.e. customer default location)
@@ -2032,6 +2519,9 @@ sub change {
   # 2. (more importantly) changing a package before it's billed
   $hash{'waive_setup'} = $self->waive_setup;
 
   # 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};
   my $custnum = $self->custnum;
   if ( $opt->{cust_main} ) {
     my $cust_main = $opt->{cust_main};
@@ -2053,10 +2543,15 @@ sub change {
     # changed from this package.
     $cust_pkg = $opt->{'cust_pkg'};
 
     # 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 {
     $error = $cust_pkg->replace;
 
   } else {
@@ -2135,9 +2630,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,
       my $new_cust_pkg_usageprice = new FS::cust_pkg_usageprice {
         'pkgnum'         => $cust_pkg->pkgnum,
         'usagepricepart' => $old_cust_pkg_usageprice->usagepricepart,
@@ -2151,14 +2652,24 @@ sub change {
     }
   }
 
     }
   }
 
-  # transfer discounts, if we're not changing pkgpart
-  if ( $same_pkgpart ) {
+  if (%new_discount && !$error) {
+
+    # If discounts were explicitly specified in $opt
+    $error = $cust_pkg->change_discount(%new_discount);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "applying discounts: $error";
+    }
+
+  } elsif ( $same_pkgpart ) {
+
+    # transfer discounts, if we're not changing pkgpart
     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 {
     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 ) {
       };
       $error = $new_discount->insert;
       if ( $error ) {
@@ -2179,6 +2690,21 @@ sub change {
       return "transferring package notes: $error";
     }
   }
       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;
 
   
   my @new_supp_pkgs;
 
@@ -2259,6 +2785,19 @@ sub change {
     return "canceling old package: $error";
   }
 
     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( 
   if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
     #$self->cust_main
     my $error = $cust_pkg->cust_main->bill( 
@@ -2301,8 +2840,10 @@ The date for the package change.  Required, and must be in the future.
 
 =item quantity
 
 
 =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
 
 
 =back
 
@@ -2312,6 +2853,10 @@ sub change_later {
   my $self = shift;
   my $opt = ref($_[0]) ? shift : { @_ };
 
   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;
   my $oldAutoCommit = $FS::UID::AutoCommit;
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
@@ -2325,7 +2870,29 @@ sub change_later {
     return "start_date $date is in the past";
   }
 
     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;
+  }
+
+  # Discounts:
+  #   Applies discounts to the newly created future_change package
+  #
+  #   If a new discount is the same as the old discount, carry over the
+  #     old discount's months_used/end_date fields too
+  #
+  #   Legacy behavior:
+  #     Legacy behavior was to create the next package with no discount.
+  #     This behavior is preserved.  Without the discount fields in $opt,
+  #     the new package will be created with no discounts.
+
+  # parse discount information from $opt
+  my %new_discount = $self->_parse_new_discounts($opt);
 
   if ( $self->change_to_pkgnum ) {
     my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
 
   if ( $self->change_to_pkgnum ) {
     my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
@@ -2335,7 +2902,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 $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...
       # 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 +2919,10 @@ sub change_later {
 
         $error = $self->replace       ||
                  $err_or_pkg->replace ||
 
         $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;
       }
       } else {
         $error = $err_or_pkg;
       }
@@ -2360,6 +2931,16 @@ sub change_later {
       $change_to->set('start_date', $date);
       $error = $self->replace || $change_to->replace;
     }
       $change_to->set('start_date', $date);
       $error = $self->replace || $change_to->replace;
     }
+
+    if ( !$error && exists $opt->{waive_setup} ) {
+      $change_to->set(waive_setup => $opt->{waive_setup} );
+      $error = $change_to->insert();
+    }
+
+    if ( !$error && %new_discount ) {
+      $error = $change_to->change_discount(%new_discount);
+    }
+
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
       return $error;
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
       return $error;
@@ -2375,8 +2956,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;
       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)
 
   # allow $opt->{'locationnum'} = '' to specifically set it to null
   # (i.e. customer default location)
@@ -2387,15 +2970,21 @@ sub change_later {
     locationnum => $opt->{'locationnum'},
     start_date  => $date,
     map   {  $_ => ( $opt->{$_} || $self->$_() )  }
     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));
   } );
   $error = $new->insert('change' => 1, 
                         'allow_pkgpart' => ($new_pkgpart ? 0 : 1));
+
+  if ( !$error && %new_discount ) {
+    $error = $new->change_discount(%new_discount);
+  }
+
   if ( !$error ) {
     $self->set('change_to_pkgnum', $new->pkgnum);
     $self->set('expire', $date);
     $error = $self->replace;
   }
   if ( !$error ) {
     $self->set('change_to_pkgnum', $new->pkgnum);
     $self->set('expire', $date);
     $error = $self->replace;
   }
+
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
   } else {
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
   } else {
@@ -2405,6 +2994,67 @@ sub change_later {
   $error;
 }
 
   $error;
 }
 
+# Helper method reads $opt hashref from change() and change_later()
+# Returns a hash of %new_discount suitable for passing to change_discount()
+sub _parse_new_discounts {
+  my ($self, $opt) = @_;
+
+  croak "Bad parameter list" unless ref $opt;
+
+  my %old_discount =
+    map { $_->setuprecur => $_ }
+    qsearch('cust_pkg_discount', {
+      pkgnum   => $self->pkgnum,
+      disabled => '',
+    });
+
+  my %new_discount;
+  for my $type(qw|setup recur|) {
+
+    if (exists $opt->{"${type}_discountnum"}) {
+      $new_discount{$type} = {
+        discountnum => $opt->{"${type}_discountnum"},
+        amount      => $opt->{"${type}_discountnum_amount"},
+        percent     => $opt->{"${type}_discountnum_percent"},
+        months      => $opt->{"${type}_discountnum_months"},
+      };
+    }
+
+    # Specified discountnum same as old discountnum, carry over addl fields
+    if (
+      exists $opt->{"${type}_discountnum"}
+      && exists $old_discount{$type}
+      && $opt->{"${type}_discountnum"} eq $old_discount{$type}->discountnum
+    ){
+      $new_discount{$type}->{months}   = $old_discount{$type}->months;
+      $new_discount{$type}->{end_date} = $old_discount{$type}->end_date;
+    }
+
+    # No new discount specified, carryover old discount
+    #   If we wanted to abandon legacy behavior, and always carry old discounts
+    #   uncomment this:
+
+    # if (!exists $new_discount{$type} && $old_discount{$type}) {
+    #   $new_discount{$type} = {
+    #     discountnum => $old_discount{$type}->discountnum,
+    #     amount      => $old_discount{$type}->amount,
+    #     percent     => $old_discount{$type}->percent,
+    #     months      => $old_discount{$type}->months,
+    #     end_date    => $old_discount{$type}->end_date,
+    #   };
+    # }
+  }
+
+  if ($DEBUG) {
+    warn "_parse_new_discounts(), pkgnum: ".$self->pkgnum." \n";
+    warn "Determine \%old_discount, \%new_discount: \n";
+    warn Dumper(\%old_discount);
+    warn Dumper(\%new_discount);
+  }
+
+  %new_discount;
+}
+
 =item abort_change
 
 Cancels a future package change scheduled by C<change_later>.
 =item abort_change
 
 Cancels a future package change scheduled by C<change_later>.
@@ -2413,16 +3063,28 @@ Cancels a future package change scheduled by C<change_later>.
 
 sub abort_change {
   my $self = shift;
 
 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;
   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->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
 }
 
 =item set_quantity QUANTITY
@@ -2514,7 +3176,7 @@ sub modify_charge {
       $pkg_opt_modified = 1;
     }
   }
       $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;
   $pkg_opt{'additional_count'} = $i if $i > 0;
 
   my $old_classnum;
@@ -2668,19 +3330,15 @@ sub modify_charge {
   '';
 }
 
   '';
 }
 
-
-
-use Data::Dumper;
 sub process_bulk_cust_pkg {
   my $job = shift;
   my $param = shift;
   warn Dumper($param) if $DEBUG;
 
 sub process_bulk_cust_pkg {
   my $job = shift;
   my $param = shift;
   warn Dumper($param) if $DEBUG;
 
-  my $old_part_pkg = qsearchs('part_pkg', 
-                              { pkgpart => $param->{'old_pkgpart'} });
   my $new_part_pkg = qsearchs('part_pkg',
                               { pkgpart => $param->{'new_pkgpart'} });
   my $new_part_pkg = qsearchs('part_pkg',
                               { pkgpart => $param->{'new_pkgpart'} });
-  die "Must select a new package type\n" unless $new_part_pkg;
+  die "Must select a new package definition\n" unless $new_part_pkg;
+
   #my $keep_dates = $param->{'keep_dates'} || 0;
   my $keep_dates = 1; # there is no good reason to turn this off
 
   #my $keep_dates = $param->{'keep_dates'} || 0;
   my $keep_dates = 1; # there is no good reason to turn this off
 
@@ -2688,7 +3346,14 @@ sub process_bulk_cust_pkg {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  my @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } );
+  my @old_pkgpart = ref($param->{'old_pkgpart'}) ? @{ $param->{'old_pkgpart'} }
+                                                 : $param->{'old_pkgpart'};
+
+  my @cust_pkgs = qsearch({
+                    'table' => 'cust_pkg',
+                    'extra_sql' => ' WHERE pkgpart IN ('.
+                                       join(',', @old_pkgpart). ')',
+                  });
 
   my $i = 0;
   foreach my $old_cust_pkg ( @cust_pkgs ) {
 
   my $i = 0;
   foreach my $old_cust_pkg ( @cust_pkgs ) {
@@ -3068,16 +3733,15 @@ sub cust_svc_unsorted_arrayref {
   }
 
   my %search = (
   }
 
   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) ];
 
 
   [ qsearch(\%search) ];
 
@@ -3206,28 +3870,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.
 
 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;
 =cut
 
 sub available_part_svc {
   my $self = shift;
+  my %opt  = @_;
 
   my $pkg_quantity = $self->quantity || 1;
 
   grep { $_->num_avail > 0 }
 
   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 ... ]
 }
 
 =item part_svc [ OPTION => VALUE ... ]
@@ -3460,6 +4129,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.
 
 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.
 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 +4139,18 @@ really the whole point of the delay_cancel option.
 =cut
 
 sub is_status_delay_cancel {
 =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;
   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;
   my $expsecs = 60*60*24*$expdays;
   return 0 unless $self->expire < time + $expsecs;
   return 1;
@@ -3561,23 +4236,27 @@ sub labels {
   map { [ $_->label ] } $self->cust_svc;
 }
 
   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.
 
 
 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;
 
 =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;
     if $DEBUG;
-  map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
+  map { [ $_->label($end, $start, $locale) ] }
+        $self->h_cust_svc($end, $start, $mode);
 }
 
 =item labels_short
 }
 
 =item labels_short
@@ -3590,15 +4269,15 @@ individual services rather than individual items.
 =cut
 
 sub labels_short {
 =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
 
 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
 
 
 =cut
 
@@ -3606,6 +4285,9 @@ sub h_labels_short {
   shift->_labels_short( 'h_labels', @_ );
 }
 
   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 );
 
 sub _labels_short {
   my( $self, $method ) = ( shift, shift );
 
@@ -3883,8 +4565,10 @@ sub transfer {
     $target{$pkg_svc->svcpart} = $pkg_svc->quantity * ( $dest->quantity || 1 );
   }
 
     $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 = ();
   }
 
   my %svcpart2svcparts = ();
@@ -3918,24 +4602,42 @@ sub transfer {
   my $error;
   foreach my $cust_svc ($self->cust_svc) {
     my $svcnum = $cust_svc->svcnum;
   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}--;
       $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);
       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'} ) {
     } 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";
       }
       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}};
       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];
       if ( @alternate ) {
         warn "alternate(s) found\n" if $DEBUG;
         my $change_svcpart = $alternate[0];
@@ -3947,13 +4649,16 @@ sub transfer {
       } else {
         $remaining++;
       }
       } else {
         $remaining++;
       }
+
     } else {
       $remaining++
     }
     } else {
       $remaining++
     }
+
     if ( $error ) {
       my @label = $cust_svc->label;
       return "$label[0] $label[1]: $error";
     }
     if ( $error ) {
       my @label = $cust_svc->label;
       return "$label[0] $label[1]: $error";
     }
+
   }
   return $remaining;
 }
   }
   return $remaining;
 }
@@ -4062,7 +4767,7 @@ Available options are:
 
 =item reason
 
 
 =item reason
 
-can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason.  The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
+can be set to a cancellation reason (see L<FS::reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason.  The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
 
 =item reason_otaker
 
 
 =item reason_otaker
 
@@ -4129,13 +4834,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>).
 
 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.
 
 
 If there is an error, returns the error, otherwise returns false.
 
@@ -4145,21 +4847,172 @@ sub insert_discount {
   #my ($self, %options) = @_;
   my $self = shift;
 
   #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;
+    }
+  }
+
+  '';
+}
+
+=item change_discount %opt
+
+Method checks if the given values represent a change in either setup or
+discount level.  If so, the existing discounts are revoked, the new
+discounts are recorded.
+
+Usage:
+
+$error = change_discount(
+  setup => {
+
+    # -1: Indicates a "custom discount"
+    #  0: Indicates to remove any discount
+    # >0: discountnum to apply
+    discountnum => [-1, 0, discountnum],
+
+    # When discountnum is "-1" to indicate custom discount, include
+    # the additional fields:
+    amount      => AMOUNT_DISCOUNT
+    percent     => PERCENTAGE_DISCOUNT
+    months      => -1,
+  },
+
+  recur => {...}
+);
+
+
+=cut
+
+sub change_discount {
+  my ($self, %opt) = @_;
+  return "change_discount() called with bad \%opt"
+    unless %opt;
+
+  for (keys %opt) {
+    return "change_discount() called with unknown bad key $_"
+      unless $_ eq 'setup' || $_ eq 'recur';
+  }
+
+  my @old_discount =
+    qsearch('cust_pkg_discount',{
+      pkgnum   => $self->pkgnum,
+      disabled => '',
+    });
+
+  if ($DEBUG) {
+    warn "change_discount() pkgnum: ".$self->pkgnum." \n";
+    warn "change_discount() \%opt: \n";
+    warn Dumper(\%opt);
+  }
+
+  my @to_be_disabled;
+
+  for my $type (qw|setup recur|) {
+    next unless ref $opt{$type};
+    my %change = %{$opt{$type}};
+
+    return "change_discount() called with bad \$opt($type)"
+      unless $change{discountnum} =~ /^-?\d+$/;
+
+    if ($change{discountnum} eq 0) {
+      # Removing old discount
+
+      delete $opt{$type};
+      push @to_be_disabled, grep {$_->setuprecur eq $type} @old_discount;
+    } else {
+
+      if (
+        grep {
+          $_->discountnum   eq $change{discountnum}
+          && $_->setuprecur eq $type
+        } @old_discount
+      ){
+        # Duplicate, disregard this entry
+        delete $opt{$type};
+        next;
+      } else {
+        # Mark any discounts we're replacing
+        push @to_be_disabled, grep{ $_->setuprecur eq $type} @old_discount;
+      }
+
+    }
+  }
+
+
+  # If we still have changes queued, pass them to insert_discount()
+  # by setting values into object fields
+  for my $type (keys %opt) {
+    $self->set("${type}_discountnum", $opt{$type}->{discountnum});
+
+    if ($opt{$type}->{discountnum} eq '-1') {
+      $self->set("${type}_discountnum_${_}", $opt{$type}->{$_})
+        for qw(amount percent months);
+    }
+
+  }
+
+  if ($DEBUG) {
+    warn "change_discount() \% opt before insert \n";
+    warn Dumper \%opt;
+    warn "\@to_be_disabled \n";
+    warn Dumper \@to_be_disabled;
+  }
+
+  # Roll these updates into a transaction
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $error;
 
 
-  $cust_pkg_discount->insert;
+  # The "waive setup fee" flag has traditionally been handled by setting
+  # $cust_pkg->waive_setup_fee = Y.  This has been appropriately, and separately
+  # handled, and it operates on a differetnt table than cust_pkg_discount,
+  # so the "-2 for waive setup fee" option is not being reimplemented
+  # here.  Perhaps this may change later.
+  #
+  # When a setup discount is entered, we still need unset waive_setup
+  if ( $opt{setup} && $opt{setup} > -2 && $self->waive_setup ) {
+    $self->set(waive_setup => '');
+    $error = $self->replace();
+  }
+
+  # Create new discounts
+  $error ||= $self->insert_discount();
+
+  # Disabling old discounts
+  for my $tbd (@to_be_disabled) {
+    unless ($error) {
+      $tbd->set(disabled => 'Y');
+      $error = $tbd->replace();
+    }
+  }
+
+  if ($error) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  $dbh->commit if $oldAutoCommit;
+  return undef;
 }
 
 =item set_usage USAGE_VALUE_HASHREF 
 }
 
 =item set_usage USAGE_VALUE_HASHREF 
@@ -4554,6 +5407,17 @@ sub cancel_sql {
   "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
 }
 
   "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.
 =item status_sql
 
 Returns an SQL expression to give the package status as a string.
@@ -4599,6 +5463,24 @@ sub fcc_477_count {
 
 }
 
 
 }
 
+=item fcc_477_record
+
+Returns a fcc_477 record based on option name.
+
+=cut
+
+sub fcc_477_record {
+  my ($self, $option_name) = @_;
+
+  my $fcc_record = qsearchs({
+    'table'     => 'part_pkg_fcc_option',
+    'hashref'   => { 'pkgpart' => $self->{Hash}->{pkgpart}, 'fccoptionname' => $option_name, },
+  });
+
+  return ( $fcc_record );
+
+}
+
 =item tax_locationnum_sql
 
 Returns an SQL expression for the tax location for a package, based
 =item tax_locationnum_sql
 
 Returns an SQL expression for the tax location for a package, based
@@ -4732,6 +5614,8 @@ sub _X_show_zero {
 
 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
 
 
 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
 
+=item order \%PARAMS
+
 Bulk cancel + order subroutine.  Perhaps slightly deprecated, only used by the
 bulk cancel+order in the web UI and nowhere else (edit/process/cust_pkg.cgi)
 
 Bulk cancel + order subroutine.  Perhaps slightly deprecated, only used by the
 bulk cancel+order in the web UI and nowhere else (edit/process/cust_pkg.cgi)
 
@@ -4756,10 +5640,25 @@ setting I<refnum> to an array reference of refnums or a hash reference with
 refnums as keys.  If no I<refnum> is defined, a default FS::pkg_referral
 record will be created corresponding to cust_main.refnum.
 
 refnums as keys.  If no I<refnum> is defined, a default FS::pkg_referral
 record will be created corresponding to cust_main.refnum.
 
+LOCATIONNUM, if specified, will be set on newly created cust_pkg records
+
 =cut
 
 sub order {
 =cut
 
 sub order {
-  my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
+  my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum,
+      $locationnum);
+
+  if ( ref $_[0] ) {
+    my $args = $_[0];
+    $custnum         = $args->{custnum};
+    $pkgparts        = $args->{pkgparts};
+    $remove_pkgnum   = $args->{remove_pkgnum};
+    $return_cust_pkg = $args->{return_cust_pkg};
+    $refnum          = $args->{refnum};
+    $locationnum     = $args->{locationnum};
+  } else {
+    ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
+  }
 
   my $conf = new FS::Conf;
 
 
   my $conf = new FS::Conf;
 
@@ -4803,6 +5702,8 @@ sub order {
 
   }
 
 
   }
 
+  $hash{locationnum} = $locationnum if $locationnum;
+
   # Create the new packages.
   foreach my $pkgpart (@$pkgparts) {
 
   # Create the new packages.
   foreach my $pkgpart (@$pkgparts) {
 
@@ -4934,6 +5835,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) = @_;
 # Used by FS::Upgrade to migrate to a new database.
 sub _upgrade_data {  # class method
   my ($class, %opts) = @_;
@@ -4974,6 +5964,32 @@ sub _upgrade_data {  # class method
     my $error = $part_pkg_link->remove_linked;
     die $error if $error;
   }
     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
 }
 
 =back
@@ -5005,4 +6021,3 @@ L<FS::pkg_svc>, schema.html from the base documentation
 =cut
 
 1;
 =cut
 
 1;
-