RT# 81961 Repair broken links in POD documentation
[freeside.git] / FS / FS / cust_pkg.pm
index fbecd8d..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
@@ -389,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)
@@ -426,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;
@@ -436,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 
@@ -512,6 +540,7 @@ sub delete {
   # 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
   # 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
 
   # cust_svc is handled by canceling the package before deleting it
   # cust_pkg_option is handled via option_Common
@@ -594,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
 
@@ -690,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;
   '';
 
@@ -747,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;
 }
 
@@ -829,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.
@@ -960,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 ) {
@@ -1046,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?
   }
 
@@ -1092,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,
@@ -1104,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.
 
@@ -1142,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
     ),
   };
@@ -1160,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;
@@ -1209,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
@@ -1268,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;
@@ -1305,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
@@ -1320,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>
@@ -1601,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,
+  );
+
   '';
 }
 
   '';
 }
 
@@ -1912,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;
@@ -1956,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
@@ -2096,69 +2361,138 @@ 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'} ) {
+    $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;
+  }
+
+  # 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 
   # 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 services, transfer usage pools, copy invoice
-  # details, or change any dates.
+  # 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} ) {
   if ( ! $self->setup and ! $opt->{cust_pkg} and ! $opt->{cust_main} ) {
-    foreach ( qw( locationnum pkgpart quantity refnum salesnum ) ) {
+    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 ( length($opt->{$_}) ) {
         $self->set($_, $opt->{$_});
       }
     }
     # almost. if the new pkgpart specifies start/adjourn/expire timers, 
     # apply those.
-    if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) {
+    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->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";
     $error ||= $self->replace;
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
       return "modifying package: $error";
-    } else {
-      $dbh->commit if $oldAutoCommit;
-      return $self;
     }
     }
+
+    # 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;
 
   }
 
   my %hash = (); 
 
   my $time = time;
 
-  $hash{'setup'} = $time if $self->setup;
+  $hash{'setup'} = $time if $self->get('setup');
 
   $hash{'change_date'} = $time;
   $hash{"change_$_"}  = $self->$_()
     foreach qw( pkgnum pkgpart locationnum );
 
 
   $hash{'change_date'} = $time;
   $hash{"change_$_"}  = $self->$_()
     foreach qw( pkgnum pkgpart locationnum );
 
-  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;
-  }
-
-  # whether to override pkgpart checking on the new package
-  my $same_pkgpart = 1;
-  if ( $opt->{'pkgpart'} and ( $opt->{'pkgpart'} != $self->pkgpart ) ) {
-    $same_pkgpart = 0;
-  }
-
   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 ) {
@@ -2296,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,
@@ -2312,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 ) {
@@ -2340,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;
 
@@ -2420,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( 
@@ -2492,6 +2870,30 @@ sub change_later {
     return "start_date $date is in the past";
   }
 
     return "start_date $date is in the past";
   }
 
+  # 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);
     my $new_pkgpart = $opt->{'pkgpart'}
   if ( $self->change_to_pkgnum ) {
     my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
     my $new_pkgpart = $opt->{'pkgpart'}
@@ -2529,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;
@@ -2562,11 +2974,17 @@ sub change_later {
   } );
   $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 {
@@ -2576,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>.
@@ -2697,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;
@@ -2851,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
 
@@ -2871,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 ) {
@@ -3251,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) ];
 
@@ -3389,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 ... ]
@@ -3750,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
@@ -3779,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
 
@@ -3795,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 );
 
@@ -4072,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 = ();
@@ -4107,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];
@@ -4136,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;
 }
@@ -4251,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
 
@@ -4318,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.
 
@@ -4334,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);
+    }
+
+  }
 
 
-  $cust_pkg_discount->insert;
+  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;
+
+  # 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 
@@ -4743,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.
@@ -4788,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
@@ -4921,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)
 
@@ -4945,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;
 
@@ -4992,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) {
 
@@ -5196,6 +5908,23 @@ sub forward_emails {
 }
 
 # Used by FS::Upgrade to migrate to a new database.
 }
 
 # 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) = @_;
   $class->_upgrade_otaker(%opts);
 sub _upgrade_data {  # class method
   my ($class, %opts) = @_;
   $class->_upgrade_otaker(%opts);
@@ -5235,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
@@ -5266,4 +6021,3 @@ L<FS::pkg_svc>, schema.html from the base documentation
 =cut
 
 1;
 =cut
 
 1;
-