X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=ad530f7f3bf41c773862e36c6f5276efa8785797;hp=22a7b2c03e58b9e2868a6bcce8aba2c5e5f8ae0b;hb=69bdaccf38c8f1b7471ff13354ccbcbb6aa20096;hpb=19bdd89959b314fd22b93dc520a79d86545af014

diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 22a7b2c03..ad530f7f3 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -1,12 +1,13 @@
 package FS::cust_pkg;
+use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Sales_Mixin
+             FS::contact_Mixin FS::location_Mixin
+             FS::m2m_Common FS::option_Common );
 
 use strict;
-use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::location_Mixin
-             FS::m2m_Common FS::option_Common );
-use vars qw($disable_agentcheck $DEBUG $me);
+use vars qw( $disable_agentcheck $DEBUG $me $upgrade );
 use Carp qw(cluck);
 use Scalar::Util qw( blessed );
-use List::Util qw(max);
+use List::Util qw(min max);
 use Tie::IxHash;
 use Time::Local qw( timelocal timelocal_nocheck );
 use MIME::Entity;
@@ -17,10 +18,13 @@ use FS::CurrentUser;
 use FS::cust_svc;
 use FS::part_pkg;
 use FS::cust_main;
+use FS::contact;
 use FS::cust_location;
 use FS::pkg_svc;
 use FS::cust_bill_pkg;
 use FS::cust_pkg_detail;
+use FS::cust_pkg_usage;
+use FS::cdr_cust_pkg_usage;
 use FS::cust_event;
 use FS::h_cust_svc;
 use FS::reg_code;
@@ -30,7 +34,9 @@ use FS::reason;
 use FS::cust_pkg_discount;
 use FS::discount;
 use FS::UI::Web;
-use Data::Dumper;
+use FS::sales;
+# for modify_charge
+use FS::cust_credit;
 
 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
 # setup }
@@ -48,6 +54,8 @@ $me = '[FS::cust_pkg]';
 
 $disable_agentcheck = 0;
 
+$upgrade = 0; #go away after setup+start dates cleaned up for old customers
+
 sub _cache {
   my $self = shift;
   my ( $hashref, $cache ) = @_;
@@ -197,6 +205,20 @@ Previous locationnum
 
 =item waive_setup
 
+=item main_pkgnum
+
+The pkgnum of the package that this package is supplemental to, if any.
+
+=item pkglinknum
+
+The package link (L<FS::part_pkg_link>) that defines this supplemental
+package, if it is one.
+
+=item change_to_pkgnum
+
+The pkgnum of the package this one will be "changed to" in the future
+(on its expiration date).
+
 =back
 
 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
@@ -214,13 +236,46 @@ Create a new billing item.  To add the item to the database, see L<"insert">.
 =cut
 
 sub table { 'cust_pkg'; }
-sub cust_linked { $_[0]->cust_main_custnum; } 
+sub cust_linked { $_[0]->cust_main_custnum || $_[0]->custnum } 
 sub cust_unlinked_msg {
   my $self = shift;
   "WARNING: can't find cust_main.custnum ". $self->custnum.
   ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
 }
 
+=item set_initial_timers
+
+If required by the package definition, sets any automatic expire, adjourn,
+or contract_end timers to some number of months after the start date 
+(or setup date, if the package has already been setup). If the package has
+a delayed setup fee after a period of "free days", will also set the 
+start date to the end of that period.
+
+=cut
+
+sub set_initial_timers {
+  my $self = shift;
+  my $part_pkg = $self->part_pkg;
+  foreach my $action ( qw(expire adjourn contract_end) ) {
+    my $months = $part_pkg->option("${action}_months",1);
+    if($months and !$self->get($action)) {
+      my $start = $self->start_date || $self->setup || time;
+      $self->set($action, $part_pkg->add_freq($start, $months) );
+    }
+  }
+
+  # if this package has "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 ( $part_pkg->option('free_days',1)
+       && $part_pkg->option('delay_setup',1)
+     )
+  {
+    $self->start_date( $part_pkg->default_start_date );
+  }
+  '';
+}
+
 =item insert [ OPTION => VALUE ... ]
 
 Adds this billing item to the database ("Orders" the item).  If there is an
@@ -242,7 +297,9 @@ The following options are available:
 
 =item change
 
-If set true, supresses any referral credit to a referring customer.
+If set true, supresses actions that should only be taken for new package
+orders.  (Currently this includes: intro periods when delay_setup is on,
+auto-adding a 1st start date, auto-adding expiration/adjourn/contract_end dates)
 
 =item options
 
@@ -256,6 +313,12 @@ a ticket will be added to this customer with this subject
 
 an optional queue name for ticket additions
 
+=item allow_pkgpart
+
+Don't check the legality of the package definition.  This should be used
+when performing a package change that doesn't change the pkgpart (i.e. 
+a location change).
+
 =back
 
 =cut
@@ -263,35 +326,36 @@ an optional queue name for ticket additions
 sub insert {
   my( $self, %options ) = @_;
 
-  my $error = $self->check_pkgpart;
+  my $error;
+  $error = $self->check_pkgpart unless $options{'allow_pkgpart'};
   return $error if $error;
 
   my $part_pkg = $self->part_pkg;
 
-  if ( $part_pkg->option('start_1st', 1) && !$self->start_date ) {
-    my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
-    $mon += 1 unless $mday == 1;
-    until ( $mon < 12 ) { $mon -= 12; $year++; }
-    $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
-  }
+  if ( ! $options{'change'} ) {
 
-  foreach my $action ( qw(expire adjourn contract_end) ) {
-    my $months = $part_pkg->option("${action}_months",1);
-    if($months and !$self->$action) {
-      my $start = $self->start_date || $self->setup || time;
-      $self->$action( $part_pkg->add_freq($start, $months) );
-    }
-  }
+    # set order date to now
+    $self->order_date(time);
 
-  my $free_days = $part_pkg->option('free_days',1);
-  if ( $free_days && $part_pkg->option('delay_setup',1) ) { #&& !$self->start_date
-    my ($mday,$mon,$year) = (localtime(time) )[3,4,5];
-    #my $start_date = ($self->start_date || timelocal(0,0,0,$mday,$mon,$year)) + 86400 * $free_days;
-    my $start_date = timelocal(0,0,0,$mday,$mon,$year) + 86400 * $free_days;
-    $self->start_date($start_date);
-  }
+    # if the package def says to start only on the first of the month:
+    if ( $part_pkg->option('start_1st', 1) && !$self->start_date ) {
+      my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
+      $mon += 1 unless $mday == 1;
+      until ( $mon < 12 ) { $mon -= 12; $year++; }
+      $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
+    }
 
-  $self->order_date(time);
+    if ($self->susp eq 'now' or $part_pkg->start_on_hold) {
+      # if the package was ordered on hold:
+      # - suspend it
+      # - don't set the start date (it will be started manually)
+      $self->set('susp', $self->order_date);
+      $self->set('start_date', '');
+    } else {
+      # set expire/adjourn/contract_end timers, and free days, if appropriate
+      $self->set_initial_timers;
+    }
+  } # else this is a package change, and shouldn't have "new package" behavior
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -325,15 +389,6 @@ sub insert {
     }
   }
 
-  #if ( $self->reg_code ) {
-  #  my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
-  #  $error = $reg_code->delete;
-  #  if ( $error ) {
-  #    $dbh->rollback if $oldAutoCommit;
-  #    return $error;
-  #  }
-  #}
-
   my $conf = new FS::Conf;
 
   if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
@@ -556,9 +611,12 @@ sub replace {
 
   }
 
-  my $error = $new->SUPER::replace($old,
-                                   $options->{options} ? $options->{options} : ()
-                                  );
+  my $error =  $new->export_pkg_change($old)
+            || $new->SUPER::replace( $old,
+                                     $options->{options}
+                                       ? $options->{options}
+                                       : ()
+                                   );
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
@@ -594,14 +652,18 @@ replace methods.
 sub check {
   my $self = shift;
 
-  $self->locationnum('') if !$self->locationnum || $self->locationnum == -1;
+  if ( !$self->locationnum or $self->locationnum == -1 ) {
+    $self->set('locationnum', $self->cust_main->ship_locationnum);
+  }
 
   my $error = 
     $self->ut_numbern('pkgnum')
     || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
     || $self->ut_numbern('pkgpart')
-    || $self->check_pkgpart
+    || $self->ut_foreign_keyn('contactnum',  'contact',       'contactnum' )
     || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
+    || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
+    || $self->ut_numbern('quantity')
     || $self->ut_numbern('start_date')
     || $self->ut_numbern('setup')
     || $self->ut_numbern('bill')
@@ -613,14 +675,17 @@ sub check {
     || $self->ut_numbern('dundate')
     || $self->ut_enum('no_auto', [ '', 'Y' ])
     || $self->ut_enum('waive_setup', [ '', 'Y' ])
-    || $self->ut_numbern('agent_pkgid')
+    || $self->ut_textn('agent_pkgid')
     || $self->ut_enum('recur_show_zero', [ '', 'Y', 'N', ])
     || $self->ut_enum('setup_show_zero', [ '', 'Y', 'N', ])
+    || $self->ut_foreign_keyn('main_pkgnum', 'cust_pkg', 'pkgnum')
+    || $self->ut_foreign_keyn('pkglinknum', 'part_pkg_link', 'pkglinknum')
+    || $self->ut_foreign_keyn('change_to_pkgnum', 'cust_pkg', 'pkgnum')
   ;
   return $error if $error;
 
   return "A package with both start date (future start) and setup date (already started) will never bill"
-    if $self->start_date && $self->setup;
+    if $self->start_date && $self->setup && ! $upgrade;
 
   return "A future unsuspend date can only be set for a package with a suspend date"
     if $self->resume and !$self->susp and !$self->adjourn;
@@ -639,14 +704,19 @@ sub check {
 
 =item check_pkgpart
 
+Check the pkgpart to make sure it's allowed with the reg_code and/or
+promo_code of the package (if present) and with the customer's agent.
+Called from C<insert>, unless we are doing a package change that doesn't
+affect pkgpart.
+
 =cut
 
 sub check_pkgpart {
   my $self = shift;
 
-  my $error = $self->ut_numbern('pkgpart');
-  return $error if $error;
+  # my $error = $self->ut_numbern('pkgpart'); # already done
 
+  my $error;
   if ( $self->reg_code ) {
 
     unless ( grep { $self->pkgpart == $_->pkgpart }
@@ -730,6 +800,11 @@ sub cancel {
   my( $self, %options ) = @_;
   my $error;
 
+  # pass all suspend/cancel actions to the main package
+  if ( $self->main_pkgnum and !$options{'from_main'} ) {
+    return $self->main_pkg->cancel(%options);
+  }
+
   my $conf = new FS::Conf;
 
   warn "cust_pkg::cancel called with options".
@@ -827,14 +902,40 @@ sub cancel {
   } #unless $date
 
   my %hash = $self->hash;
-  $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
+  if ( $date ) {
+    $hash{'expire'} = $date;
+  } else {
+    $hash{'cancel'} = $cancel_time;
+  }
+  $hash{'change_custnum'} = $options{'change_custnum'};
+
   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 || $change_to->delete;
+  }
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
   }
 
+  foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+    $error = $supp_pkg->cancel(%options, 'from_main' => 1);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error";
+    }
+  }
+
+  foreach my $usage ( $self->cust_pkg_usage ) {
+    $error = $usage->delete;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "deleting usage pools: $error";
+    }
+  }
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   return '' if $date; #no errors
 
@@ -855,6 +956,8 @@ sub cancel {
         'to'      => \@invoicing_list,
         'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
         'body'    => [ map "$_\n", $conf->config('cancelmessage') ],
+        'custnum' => $self->custnum,
+        'msgtype' => '', #admin?
       );
     }
     #should this do something on errors?
@@ -894,6 +997,9 @@ svc_fatal: service provisioning errors are fatal
 
 svc_errors: pass an array reference, will be filled in with any provisioning errors
 
+main_pkgnum: link the package as a supplemental package of this one.  For 
+internal use only.
+
 =cut
 
 sub uncancel {
@@ -902,6 +1008,10 @@ sub uncancel {
   #in case you try do do $uncancel-date = $cust_pkg->uncacel 
   return '' unless $self->get('cancel');
 
+  if ( $self->main_pkgnum and !$options{'main_pkgnum'} ) {
+    return $self->main_pkg->uncancel(%options);
+  }
+
   ##
   # Transaction-alize
   ##
@@ -926,6 +1036,7 @@ sub uncancel {
     bill            => ( $options{'bill'}      || $self->get('bill')      ),
     uncancel        => time,
     uncancel_pkgnum => $self->pkgnum,
+    main_pkgnum     => ($options{'main_pkgnum'} || ''),
     map { $_ => $self->get($_) } qw(
       custnum pkgpart locationnum
       setup
@@ -937,6 +1048,7 @@ sub uncancel {
 
   my $error = $cust_pkg->insert(
     'change' => 1, #supresses any referral credit to a referring customer
+    'allow_pkgpart' => 1, # allow this even if the package def is disabled
   );
   if ($error) {
     $dbh->rollback if $oldAutoCommit;
@@ -978,15 +1090,20 @@ sub uncancel {
         $dbh->rollback if $oldAutoCommit;
         return $svc_error;
       } else {
+        # if we've failed to insert the svc_x object, svc_Common->insert 
+        # will have removed the cust_svc already.  if not, then both records
+        # were inserted but we failed for some other reason (export, most 
+        # likely).  in that case, report the error and delete the records.
         push @svc_errors, $svc_error;
-        # is this necessary? svc_Common::insert already deletes the 
-        # cust_svc if inserting svc_x fails.
         my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_x->svcnum });
         if ( $cust_svc ) {
-          my $cs_error = $cust_svc->delete;
-          if ( $cs_error ) {
+          # except if export_insert failed, export_delete probably won't be
+          # much better
+          local $FS::svc_Common::noexport_hack = 1;
+          my $cleanup_error = $svc_x->delete; # also deletes cust_svc
+          if ( $cleanup_error ) { # and if THAT fails, then run away
             $dbh->rollback if $oldAutoCommit;
-            return $cs_error;
+            return $cleanup_error;
           }
         }
       } # svc_fatal
@@ -1023,6 +1140,20 @@ sub uncancel {
   }
 
   ##
+  # Uncancel any supplemental packages, and make them supplemental to the 
+  # new one.
+  ##
+
+  foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+    my $new_pkg;
+    $error = $supp_pkg->uncancel(%options, 'main_pkgnum' => $cust_pkg->pkgnum);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error";
+    }
+  }
+
+  ##
   # Finish
   ##
 
@@ -1111,6 +1242,9 @@ of final invoices or unused-time credits
 unsuspended.  This may be more convenient than calling C<unsuspend()>
 separately.
 
+=item from_main - allows a supplemental package to be suspended, rather
+than redirecting the method call to its main package.  For internal use.
+
 =back
 
 If there is an error, returns the error, otherwise returns false.
@@ -1121,6 +1255,11 @@ sub suspend {
   my( $self, %options ) = @_;
   my $error;
 
+  # pass all suspend/cancel actions to the main package
+  if ( $self->main_pkgnum and !$options{'from_main'} ) {
+    return $self->main_pkg->suspend(%options);
+  }
+
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE'; 
@@ -1260,6 +1399,8 @@ sub suspend {
           'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
           ( map { "Service : $_\n" } @labels ),
         ],
+        'custnum' => $self->custnum,
+        'msgtype' => 'admin'
       );
 
       if ( $error ) {
@@ -1271,6 +1412,14 @@ sub suspend {
 
   }
 
+  foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+    $error = $supp_pkg->suspend(%options, 'from_main' => 1);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "suspending supplemental pkg#".$supp_pkg->pkgnum.": $error";
+    }
+  }
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   ''; #no errors
@@ -1338,10 +1487,8 @@ field).
 
 Can be set true to adjust the next bill date forward by
 the amount of time the account was inactive.  This was set true by default
-since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
-explicitly requested.  Price plans for which this makes sense (anniversary-date
-based than prorate or subscription) could have an option to enable this
-behaviour?
+in the past (from 1.4.2 and 1.5.0pre6 through 1.7.0), but now needs to be
+explicitly requested with this option or in the price plan.
 
 =back
 
@@ -1353,6 +1500,11 @@ sub unsuspend {
   my( $self, %opt ) = @_;
   my $error;
 
+  # pass all suspend/cancel actions to the main package
+  if ( $self->main_pkgnum and !$opt{'from_main'} ) {
+    return $self->main_pkg->unsuspend(%opt);
+  }
+
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE'; 
@@ -1377,6 +1529,8 @@ sub unsuspend {
     return "";  # no error                     # complain instead?
   }
 
+  # handle the case of setting a future unsuspend (resume) date
+  # and do not continue to actually unsuspend the package
   my $date = $opt{'date'};
   if ( $date and $date > time ) { # return an error if $date <= time?
 
@@ -1400,6 +1554,11 @@ sub unsuspend {
   
   } #if $date 
 
+  if (!$self->setup) {
+    # then this package is being released from on-hold status
+    $self->set_initial_timers;
+  }
+
   my @labels = ();
 
   foreach my $cust_svc (
@@ -1435,16 +1594,19 @@ sub unsuspend {
 
   my $conf = new FS::Conf;
 
-  if ( $inactive > 0 && 
-       ( $hash{'bill'} || $hash{'setup'} ) &&
-       ( $opt{'adjust_next_bill'} ||
-         $conf->exists('unsuspend-always_adjust_next_bill_date') ||
-         $self->part_pkg->option('unsuspend_adjust_bill', 1) )
-     ) {
-
-    $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive;
-  
-  }
+  $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
+    if $inactive > 0
+    && ( $hash{'bill'} || $hash{'setup'} )
+    && (    $opt{'adjust_next_bill'}
+         || $conf->exists('unsuspend-always_adjust_next_bill_date')
+         || $self->part_pkg->option('unsuspend_adjust_bill', 1)
+       )
+    && ! $self->option('suspend_bill',1)
+    && (    ! $self->part_pkg->option('suspend_bill',1)
+         || $self->option('no_suspend_bill',1)
+       )
+    && $hash{'order_date'} != $hash{'susp'}
+  ;
 
   $hash{'susp'} = '';
   $hash{'adjourn'} = '' if $hash{'adjourn'} and $hash{'adjourn'} < time;
@@ -1502,6 +1664,8 @@ sub unsuspend {
           : ''
         ),
       ],
+      'custnum' => $self->custnum,
+      'msgtype' => 'admin',
     );
 
     if ( $error ) {
@@ -1511,6 +1675,14 @@ sub unsuspend {
 
   }
 
+  foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+    $error = $supp_pkg->unsuspend(%opt, 'from_main' => 1);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "unsuspending supplemental pkg#".$supp_pkg->pkgnum.": $error";
+    }
+  }
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   ''; #no errors
@@ -1596,6 +1768,11 @@ New locationnum, to change the location for this package.
 New FS::cust_location object, to create a new location and assign it
 to this package.
 
+=item cust_main
+
+New FS::cust_main object, to create a new customer and assign the new package
+to it.
+
 =item pkgpart
 
 New pkgpart (see L<FS::part_pkg>).
@@ -1604,15 +1781,32 @@ New pkgpart (see L<FS::part_pkg>).
 
 New refnum (see L<FS::part_referral>).
 
+=item quantity
+
+New quantity; if unspecified, the new package will have the same quantity
+as the old.
+
+=item cust_pkg
+
+"New" (existing) FS::cust_pkg object.  The package's services and other 
+attributes will be transferred to this package.
+
 =item keep_dates
 
 Set to true to transfer billing dates (start_date, setup, last_bill, bill, 
 susp, adjourn, cancel, expire, and contract_end) to the new package.
 
+=item unprotect_svcs
+
+Normally, change() will rollback and return an error if some services 
+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.
+
 =back
 
-At least one of locationnum, cust_location, pkgpart, refnum must be specified 
-(otherwise, what's the point?)
+At least one of locationnum, cust_location, pkgpart, refnum, cust_main, or
+cust_pkg must be specified (otherwise, what's the point?)
 
 Returns either the new FS::cust_pkg object or a scalar error.
 
@@ -1627,9 +1821,6 @@ sub change {
   my $self = shift;
   my $opt = ref($_[0]) ? shift : { @_ };
 
-#  my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
-#    
-
   my $conf = new FS::Conf;
 
   # Transactionize this whole mess
@@ -1650,35 +1841,44 @@ sub change {
 
   my $time = time;
 
-  #$hash{$_} = $self->$_() foreach qw( last_bill bill );
-    
-  #$hash{$_} = $self->$_() foreach qw( setup );
-
   $hash{'setup'} = $time if $self->setup;
 
   $hash{'change_date'} = $time;
   $hash{"change_$_"}  = $self->$_()
     foreach qw( pkgnum pkgpart locationnum );
 
-  if ( $opt->{'cust_location'} &&
-       ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
-    $error = $opt->{'cust_location'}->insert;
+  if ( $opt->{'cust_location'} ) {
+    $error = $opt->{'cust_location'}->find_or_insert;
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
-      return "inserting cust_location (transaction rolled back): $error";
+      return "creating location record: $error";
     }
     $opt->{'locationnum'} = $opt->{'cust_location'}->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'};
   # 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 ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) {
+  if ( $opt->{'pkgpart'} 
+       and $opt->{'pkgpart'} != $self->pkgpart
+       and $self->part_pkg->option('unused_credit_change', 1) ) {
+    $unused_credit = 1;
     $keep_dates = 0;
-    $unused_credit = 1 if $self->part_pkg->option('unused_credit_change', 1);
     $hash{$_} = '' foreach qw(setup bill last_bill);
   }
 
@@ -1688,23 +1888,63 @@ sub change {
       $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');
+
   # allow $opt->{'locationnum'} = '' to specifically set it to null
   # (i.e. customer default location)
   $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
 
-  # Create the new package.
-  my $cust_pkg = new FS::cust_pkg {
-    custnum      => $self->custnum,
-    pkgpart      => ( $opt->{'pkgpart'}     || $self->pkgpart      ),
-    refnum       => ( $opt->{'refnum'}      || $self->refnum       ),
-    locationnum  => ( $opt->{'locationnum'}                        ),
-    %hash,
-  };
+  # usually this doesn't matter.  the two cases where it does are:
+  # 1. unused_credit_change + pkgpart change + setup fee on the new package
+  # and
+  # 2. (more importantly) changing a package before it's billed
+  $hash{'waive_setup'} = $self->waive_setup;
+
+  my $custnum = $self->custnum;
+  if ( $opt->{cust_main} ) {
+    my $cust_main = $opt->{cust_main};
+    unless ( $cust_main->custnum ) { 
+      my $error = $cust_main->insert( @{ $opt->{cust_main_insert_args}||[] } );
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "inserting customer record: $error";
+      }
+    }
+    $custnum = $cust_main->custnum;
+  }
+
+  $hash{'contactnum'} = $opt->{'contactnum'} if $opt->{'contactnum'};
+
+  my $cust_pkg;
+  if ( $opt->{'cust_pkg'} ) {
+    # The target package already exists; update it to show that it was 
+    # changed from this package.
+    $cust_pkg = $opt->{'cust_pkg'};
+
+    foreach ( qw( pkgnum pkgpart locationnum ) ) {
+      $cust_pkg->set("change_$_", $self->get($_));
+    }
+    $cust_pkg->set('change_date', $time);
+    $error = $cust_pkg->replace;
 
-  $error = $cust_pkg->insert( 'change' => 1 );
+  } else {
+    # Create the new package.
+    $cust_pkg = new FS::cust_pkg {
+      custnum     => $custnum,
+      locationnum => $opt->{'locationnum'},
+      ( map {  $_ => ( $opt->{$_} || $self->$_() )  }
+          qw( pkgpart quantity refnum salesnum )
+      ),
+      %hash,
+    };
+    $error = $cust_pkg->insert( 'change' => 1,
+                                'allow_pkgpart' => $same_pkgpart );
+  }
   if ($error) {
     $dbh->rollback if $oldAutoCommit;
-    return $error;
+    return "inserting new package: $error";
   }
 
   # Transfer services and cancel old package.
@@ -1713,7 +1953,7 @@ sub change {
   if ($error and $error == 0) {
     # $old_pkg->transfer failed.
     $dbh->rollback if $oldAutoCommit;
-    return $error;
+    return "transferring $error";
   }
 
   if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
@@ -1722,15 +1962,19 @@ sub change {
     if ($error and $error == 0) {
       # $old_pkg->transfer failed.
       $dbh->rollback if $oldAutoCommit;
-      return $error;
+      return "converting $error";
     }
   }
 
-  if ($error > 0) {
+  # We set unprotect_svcs when executing a "future package change".  It's 
+  # not a user-interactive operation, so returning an error means the 
+  # package change will just fail.  Rather than have that happen, we'll 
+  # let leftover services be deleted.
+  if ($error > 0 and !$opt->{'unprotect_svcs'}) {
     # Transfers were successful, but we still had services left on the old
     # package.  We can't change the package under this circumstances, so abort.
     $dbh->rollback if $oldAutoCommit;
-    return "Unable to transfer all services from package ". $self->pkgnum;
+    return "unable to transfer all services";
   }
 
   #reset usage if changing pkgpart
@@ -1745,31 +1989,135 @@ sub change {
 
     if ($error) {
       $dbh->rollback if $oldAutoCommit;
-      return "Error setting usage values: $error";
+      return "setting usage values: $error";
+    }
+  } else {
+    # if NOT changing pkgpart, transfer any usage pools over
+    foreach my $usage ($self->cust_pkg_usage) {
+      $usage->set('pkgnum', $cust_pkg->pkgnum);
+      $error = $usage->replace;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "transferring usage pools: $error";
+      }
+    }
+  }
+
+  # transfer discounts, if we're not changing pkgpart
+  if ( $same_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 {
+        'pkgnum'      => $cust_pkg->pkgnum,
+        'discountnum' => $old_discount->discountnum,
+        'months_used' => $old_discount->months_used,
+      };
+      $error = $new_discount->insert;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "transferring discounts: $error";
+      }
     }
   }
 
+  # transfer (copy) invoice details
+  foreach my $detail ($self->cust_pkg_detail) {
+    my $new_detail = FS::cust_pkg_detail->new({ $detail->hash });
+    $new_detail->set('pkgdetailnum', '');
+    $new_detail->set('pkgnum', $cust_pkg->pkgnum);
+    $error = $new_detail->insert;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "transferring package notes: $error";
+    }
+  }
+  
+  my @new_supp_pkgs;
+
+  if ( !$opt->{'cust_pkg'} ) {
+    # Order any supplemental packages.
+    my $part_pkg = $cust_pkg->part_pkg;
+    my @old_supp_pkgs = $self->supplemental_pkgs;
+    foreach my $link ($part_pkg->supp_part_pkg_link) {
+      my $old;
+      foreach (@old_supp_pkgs) {
+        if ($_->pkgpart == $link->dst_pkgpart) {
+          $old = $_;
+          $_->pkgpart(0); # so that it can't match more than once
+        }
+        last if $old;
+      }
+      # false laziness with FS::cust_main::Packages::order_pkg
+      my $new = FS::cust_pkg->new({
+          pkgpart       => $link->dst_pkgpart,
+          pkglinknum    => $link->pkglinknum,
+          custnum       => $custnum,
+          main_pkgnum   => $cust_pkg->pkgnum,
+          locationnum   => $cust_pkg->locationnum,
+          start_date    => $cust_pkg->start_date,
+          order_date    => $cust_pkg->order_date,
+          expire        => $cust_pkg->expire,
+          adjourn       => $cust_pkg->adjourn,
+          contract_end  => $cust_pkg->contract_end,
+          refnum        => $cust_pkg->refnum,
+          discountnum   => $cust_pkg->discountnum,
+          waive_setup   => $cust_pkg->waive_setup,
+      });
+      if ( $old and $opt->{'keep_dates'} ) {
+        foreach (qw(setup bill last_bill)) {
+          $new->set($_, $old->get($_));
+        }
+      }
+      $error = $new->insert( allow_pkgpart => $same_pkgpart );
+      # transfer services
+      if ( $old ) {
+        $error ||= $old->transfer($new);
+      }
+      if ( $error and $error > 0 ) {
+        # no reason why this should ever fail, but still...
+        $error = "Unable to transfer all services from supplemental package ".
+          $old->pkgnum;
+      }
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $error;
+      }
+      push @new_supp_pkgs, $new;
+    }
+  } # if !$opt->{'cust_pkg'}
+    # because if there is one, then supplemental packages would already
+    # have been created for it.
+
   #Good to go, cancel old package.  Notify 'cancel' of whether to credit 
   #remaining time.
   #Don't allow billing the package (preceding period packages and/or 
   #outstanding usage) if we are keeping dates (i.e. location changing), 
   #because the new package will be billed for the same date range.
+  #Supplemental packages are also canceled here.
+
+  # during scheduled changes, avoid canceling the package we just
+  # changed to (duh)
+  $self->set('change_to_pkgnum' => '');
+
   $error = $self->cancel(
-    quiet         => 1, 
-    unused_credit => $unused_credit,
-    nobill        => $keep_dates
+    quiet          => 1, 
+    unused_credit  => $unused_credit,
+    nobill         => $keep_dates,
+    change_custnum => ( $self->custnum != $custnum ? $custnum : '' ),
   );
   if ($error) {
     $dbh->rollback if $oldAutoCommit;
-    return $error;
+    return "canceling old package: $error";
   }
 
   if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
     #$self->cust_main
-    my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] );
+    my $error = $cust_pkg->cust_main->bill( 
+      'pkg_list' => [ $cust_pkg, @new_supp_pkgs ]
+    );
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
-      return $error;
+      return "billing new package: $error";
     }
   }
 
@@ -1779,8 +2127,378 @@ sub change {
 
 }
 
+=item change_later OPTION => VALUE...
+
+Schedule a package change for a later date.  This actually orders the new
+package immediately, but sets its start date for a future date, and sets
+the current package to expire on the same date.
+
+If the package is already scheduled for a change, this can be called with 
+'start_date' to change the scheduled date, or with pkgpart and/or 
+locationnum to modify the package change.  To cancel the scheduled change 
+entirely, see C<abort_change>.
+
+Options include:
+
+=over 4
+
+=item start_date
+
+The date for the package change.  Required, and must be in the future.
+
+=item pkgpart
+
+=item locationnum
+
+=item quantity
+
+The pkgpart. locationnum, and quantity of the new package, with the same 
+meaning as in C<change>.
+
+=back
+
+=cut
+
+sub change_later {
+  my $self = shift;
+  my $opt = ref($_[0]) ? shift : { @_ };
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $cust_main = $self->cust_main;
+
+  my $date = delete $opt->{'start_date'} or return 'start_date required';
+ 
+  if ( $date <= time ) {
+    $dbh->rollback if $oldAutoCommit;
+    return "start_date $date is in the past";
+  }
+
+  my $error;
+
+  if ( $self->change_to_pkgnum ) {
+    my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
+    my $new_pkgpart = $opt->{'pkgpart'}
+        if $opt->{'pkgpart'} and $opt->{'pkgpart'} != $change_to->pkgpart;
+    my $new_locationnum = $opt->{'locationnum'}
+        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 ) {
+      # 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...
+      my $err_or_pkg = $change_to->change(%$opt);
+      if ( ref $err_or_pkg ) {
+        # Then set that package up for a future start.
+        $self->set('change_to_pkgnum', $err_or_pkg->pkgnum);
+        $self->set('expire', $date); # in case it's different
+        $err_or_pkg->set('start_date', $date);
+        $err_or_pkg->set('change_date', '');
+        $err_or_pkg->set('change_pkgnum', '');
+
+        $error = $self->replace       ||
+                 $err_or_pkg->replace ||
+                 $change_to->cancel   ||
+                 $change_to->delete;
+      } else {
+        $error = $err_or_pkg;
+      }
+    } else { # change the start date only.
+      $self->set('expire', $date);
+      $change_to->set('start_date', $date);
+      $error = $self->replace || $change_to->replace;
+    }
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    } else {
+      $dbh->commit if $oldAutoCommit;
+      return '';
+    }
+  } # if $self->change_to_pkgnum
+
+  my $new_pkgpart = $opt->{'pkgpart'}
+      if $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart;
+  my $new_locationnum = $opt->{'locationnum'}
+      if $opt->{'locationnum'} and $opt->{'locationnum'} != $self->locationnum;
+  my $new_quantity = $opt->{'quantity'}
+      if $opt->{'quantity'} and $opt->{'quantity'} != $self->quantity;
+
+  return '' unless $new_pkgpart or $new_locationnum or $new_quantity; # wouldn't do anything
+
+  # allow $opt->{'locationnum'} = '' to specifically set it to null
+  # (i.e. customer default location)
+  $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
+
+  my $new = FS::cust_pkg->new( {
+    custnum     => $self->custnum,
+    locationnum => $opt->{'locationnum'},
+    start_date  => $date,
+    map   {  $_ => ( $opt->{$_} || $self->$_() )  }
+      qw( pkgpart quantity refnum salesnum )
+  } );
+  $error = $new->insert('change' => 1, 
+                        'allow_pkgpart' => ($new_pkgpart ? 0 : 1));
+  if ( !$error ) {
+    $self->set('change_to_pkgnum', $new->pkgnum);
+    $self->set('expire', $date);
+    $error = $self->replace;
+  }
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+  } else {
+    $dbh->commit if $oldAutoCommit;
+  }
+
+  $error;
+}
+
+=item abort_change
+
+Cancels a future package change scheduled by C<change_later>.
+
+=cut
+
+sub abort_change {
+  my $self = shift;
+  my $pkgnum = $self->change_to_pkgnum;
+  my $change_to = FS::cust_pkg->by_key($pkgnum) if $pkgnum;
+  my $error;
+  if ( $change_to ) {
+    $error = $change_to->cancel || $change_to->delete;
+    return $error if $error;
+  }
+  $self->set('change_to_pkgnum', '');
+  $self->set('expire', '');
+  $self->replace;
+}
+
+=item set_quantity QUANTITY
+
+Change the package's quantity field.  This is one of the few package properties
+that can safely be changed without canceling and reordering the package
+(because it doesn't affect tax eligibility).  Returns an error or an 
+empty string.
+
+=cut
+
+sub set_quantity {
+  my $self = shift;
+  $self = $self->replace_old; # just to make sure
+  $self->quantity(shift);
+  $self->replace;
+}
+
+=item set_salesnum SALESNUM
+
+Change the package's salesnum (sales person) field.  This is one of the few
+package properties that can safely be changed without canceling and reordering
+the package (because it doesn't affect tax eligibility).  Returns an error or
+an empty string.
+
+=cut
+
+sub set_salesnum {
+  my $self = shift;
+  $self = $self->replace_old; # just to make sure
+  $self->salesnum(shift);
+  $self->replace;
+  # XXX this should probably reassign any credit that's already been given
+}
+
+=item modify_charge OPTIONS
+
+Change the properties of a one-time charge.  The following properties can
+be changed this way:
+- pkg: the package description
+- classnum: the package class
+- additional: arrayref of additional invoice details to add to this package
+
+and, I<if the charge has not yet been billed>:
+- start_date: the date when it will be billed
+- amount: the setup fee to be charged
+- quantity: the multiplier for the setup fee
+
+If you pass 'adjust_commission' => 1, and the classnum changes, and there are
+commission credits linked to this charge, they will be recalculated.
+
+=cut
+
+sub modify_charge {
+  my $self = shift;
+  my %opt = @_;
+  my $part_pkg = $self->part_pkg;
+  my $pkgnum = $self->pkgnum;
+
+  my $dbh = dbh;
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+
+  return "Can't use modify_charge except on one-time charges"
+    unless $part_pkg->freq eq '0';
+
+  if ( length($opt{'pkg'}) and $part_pkg->pkg ne $opt{'pkg'} ) {
+    $part_pkg->set('pkg', $opt{'pkg'});
+  }
+
+  my %pkg_opt = $part_pkg->options;
+  my $pkg_opt_modified = 0;
+
+  $opt{'additional'} ||= [];
+  my $i;
+  my @old_additional;
+  foreach (grep /^additional/, keys %pkg_opt) {
+    ($i) = ($_ =~ /^additional_info(\d+)$/);
+    $old_additional[$i] = $pkg_opt{$_} if $i;
+    delete $pkg_opt{$_};
+  }
+
+  for ( $i = 0; exists($opt{'additional'}->[$i]); $i++ ) {
+    $pkg_opt{ "additional_info$i" } = $opt{'additional'}->[$i];
+    if (!exists($old_additional[$i])
+        or $old_additional[$i] ne $opt{'additional'}->[$i])
+    {
+      $pkg_opt_modified = 1;
+    }
+  }
+  $pkg_opt_modified = 1 if (scalar(@old_additional) - 1) != $i;
+  $pkg_opt{'additional_count'} = $i if $i > 0;
+
+  my $old_classnum;
+  if ( exists($opt{'classnum'}) and $part_pkg->classnum ne $opt{'classnum'} )
+  {
+    # remember it
+    $old_classnum = $part_pkg->classnum;
+    $part_pkg->set('classnum', $opt{'classnum'});
+  }
+
+  if ( !$self->get('setup') ) {
+    # not yet billed, so allow amount and quantity
+    if ( exists($opt{'quantity'})
+          and $opt{'quantity'} != $self->quantity
+          and $opt{'quantity'} > 0 ) {
+        
+      $self->set('quantity', $opt{'quantity'});
+    }
+    if ( exists($opt{'start_date'})
+          and $opt{'start_date'} != $self->start_date ) {
+
+      $self->set('start_date', $opt{'start_date'});
+    }
+
+    if ( exists($opt{'amount'}) 
+          and $part_pkg->option('setup_fee') != $opt{'amount'}
+          and $opt{'amount'} > 0 ) {
+
+      $pkg_opt{'setup_fee'} = $opt{'amount'};
+      $pkg_opt_modified = 1;
+
+    }
+  } # else simply ignore them; the UI shouldn't allow editing the fields
+
+  my $error;
+  if ( $part_pkg->modified or $pkg_opt_modified ) {
+    # can we safely modify the package def?
+    # Yes, if it's not available for purchase, and this is the only instance
+    # of it.
+    if ( $part_pkg->disabled
+         and FS::cust_pkg->count('pkgpart = '.$part_pkg->pkgpart) == 1
+         and FS::quotation_pkg->count('pkgpart = '.$part_pkg->pkgpart) == 0
+       ) {
+      $error = $part_pkg->replace( options => \%pkg_opt );
+    } else {
+      # clone it
+      $part_pkg = $part_pkg->clone;
+      $part_pkg->set('disabled' => 'Y');
+      $error = $part_pkg->insert( options => \%pkg_opt );
+      # and associate this as yet-unbilled package to the new package def
+      $self->set('pkgpart' => $part_pkg->pkgpart);
+    }
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  if ($self->modified) { # for quantity or start_date change, or if we had
+                         # to clone the existing package def
+    my $error = $self->replace;
+    return $error if $error;
+  }
+  if (defined $old_classnum) {
+    # fix invoice grouping records
+    my $old_catname = $old_classnum
+                      ? FS::pkg_class->by_key($old_classnum)->categoryname
+                      : '';
+    my $new_catname = $opt{'classnum'}
+                      ? $part_pkg->pkg_class->categoryname
+                      : '';
+    if ( $old_catname ne $new_catname ) {
+      foreach my $cust_bill_pkg ($self->cust_bill_pkg) {
+        # (there should only be one...)
+        my @display = qsearch( 'cust_bill_pkg_display', {
+            'billpkgnum'  => $cust_bill_pkg->billpkgnum,
+            'section'     => $old_catname,
+        });
+        foreach (@display) {
+          $_->set('section', $new_catname);
+          $error = $_->replace;
+          if ( $error ) {
+            $dbh->rollback if $oldAutoCommit;
+            return $error;
+          }
+        }
+      } # foreach $cust_bill_pkg
+    }
+
+    if ( $opt{'adjust_commission'} ) {
+      # fix commission credits...tricky.
+      foreach my $cust_event ($self->cust_event) {
+        my $part_event = $cust_event->part_event;
+        foreach my $table (qw(sales agent)) {
+          my $class =
+            "FS::part_event::Action::Mixin::credit_${table}_pkg_class";
+          my $credit = qsearchs('cust_credit', {
+              'eventnum' => $cust_event->eventnum,
+          });
+          if ( $part_event->isa($class) ) {
+            # Yes, this results in current commission rates being applied 
+            # retroactively to a one-time charge.  For accounting purposes 
+            # there ought to be some kind of time limit on doing this.
+            my $amount = $part_event->_calc_credit($self);
+            if ( $credit and $credit->amount ne $amount ) {
+              # Void the old credit.
+              $error = $credit->void('Package class changed');
+              if ( $error ) {
+                $dbh->rollback if $oldAutoCommit;
+                return "$error (adjusting commission credit)";
+              }
+            }
+            # redo the event action to recreate the credit.
+            local $@ = '';
+            eval { $part_event->do_action( $self, $cust_event ) };
+            if ( $@ ) {
+              $dbh->rollback if $oldAutoCommit;
+              return $@;
+            }
+          } # if $part_event->isa($class)
+        } # foreach $table
+      } # foreach $cust_event
+    } # if $opt{'adjust_commission'}
+  } # if defined $old_classnum
+
+  $dbh->commit if $oldAutoCommit;
+  '';
+}
+
+
+
 use Storable 'thaw';
 use MIME::Base64;
+use Data::Dumper;
 sub process_bulk_cust_pkg {
   my $job = shift;
   my $param = thaw(decode_base64(shift));
@@ -1909,6 +2627,18 @@ sub old_cust_pkg {
   qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
 }
 
+=item change_cust_main
+
+Returns the customter this package was detached to, if any.
+
+=cut
+
+sub change_cust_main {
+  my $self = shift;
+  return '' unless $self->change_custnum;
+  qsearchs('cust_main', { 'custnum' => $self->change_custnum } );
+}
+
 =item calc_setup
 
 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
@@ -2053,7 +2783,7 @@ sub set_cust_pkg_detail {
 
 =item cust_event
 
-Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
+Returns the customer billing events (see L<FS::cust_event>) for this invoice.
 
 =cut
 
@@ -2068,37 +2798,75 @@ sub cust_event {
   });
 }
 
-=item num_cust_event
+=item num_cust_event
+
+Returns the number of customer billing events (see L<FS::cust_event>) for this package.
+
+=cut
+
+#false laziness w/cust_bill.pm
+sub num_cust_event {
+  my $self = shift;
+  my $sql = "SELECT COUNT(*) ". $self->_from_cust_event_where;
+  $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref->[0];
+}
+
+=item exists_cust_event
 
-Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
+Returns true if there are customer billing events (see L<FS::cust_event>) for this package.  More efficient than using num_cust_event.
 
 =cut
 
-#false laziness w/cust_bill.pm
-sub num_cust_event {
+sub exists_cust_event {
   my $self = shift;
-  my $sql =
-    "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
-    "  WHERE tablenum = ? AND eventtable = 'cust_pkg'";
+  my $sql = "SELECT 1 ". $self->_from_cust_event_where. " LIMIT 1";
+  my $row = $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref;
+  $row ? $row->[0] : '';
+}
+
+sub _from_cust_event_where {
+  #my $self = shift;
+  " FROM cust_event JOIN part_event USING ( eventpart ) ".
+  "  WHERE tablenum = ? AND eventtable = 'cust_pkg' ";
+}
+
+sub _prep_ex {
+  my( $self, $sql, @args ) = @_;
   my $sth = dbh->prepare($sql) or die  dbh->errstr. " preparing $sql"; 
-  $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
-  $sth->fetchrow_arrayref->[0];
+  $sth->execute(@args)         or die $sth->errstr. " executing $sql";
+  $sth;
 }
 
 =item cust_svc [ SVCPART ] (old, deprecated usage)
 
 =item cust_svc [ OPTION => VALUE ... ] (current usage)
 
+=item cust_svc_unsorted [ OPTION => VALUE ... ] 
+
 Returns the services for this package, as FS::cust_svc objects (see
 L<FS::cust_svc>).  Available options are svcpart and svcdb.  If either is
 spcififed, returns only the matching services.
 
+As an optimization, use the cust_svc_unsorted version if you are not displaying
+the results.
+
 =cut
 
 sub cust_svc {
   my $self = shift;
+  cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
+  $self->_sort_cust_svc( $self->cust_svc_unsorted_arrayref(@_) );
+}
 
-  return () unless $self->num_cust_svc(@_);
+sub cust_svc_unsorted {
+  my $self = shift;
+  @{ $self->cust_svc_unsorted_arrayref(@_) };
+}
+
+sub cust_svc_unsorted_arrayref {
+  my $self = shift;
+
+  return [] unless $self->num_cust_svc(@_);
 
   my %opt = ();
   if ( @_ && $_[0] =~ /^\d+/ ) {
@@ -2121,13 +2889,7 @@ sub cust_svc {
     $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{'svcdb'} );
   }
 
-  cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
-
-  #if ( $self->{'_svcnum'} ) {
-  #  values %{ $self->{'_svcnum'}->cache };
-  #} else {
-    $self->_sort_cust_svc( [ qsearch(\%search) ] );
-  #}
+  [ qsearch(\%search) ];
 
 }
 
@@ -2180,11 +2942,13 @@ sub _sort_cust_svc {
   my $sort =
     sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] };
 
+  my %pkg_svc = map { $_->svcpart => $_ }
+                qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
+
   map  { $_->[0] }
   sort $sort
   map {
-        my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
-                                             'svcpart' => $_->svcpart     } );
+        my $pkg_svc = $pkg_svc{ $_->svcpart } || '';
         [ $_,
           $pkg_svc ? $pkg_svc->primary_svc : '',
           $pkg_svc ? $pkg_svc->quantity : 0,
@@ -2280,17 +3044,35 @@ following extra fields:
 
 =over 4
 
-=item num_cust_svc  (count)
+=item num_cust_svc
+
+(count)
 
-=item num_avail     (quantity - count)
+=item num_avail
 
-=item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
+(quantity - count)
+
+=item cust_pkg_svc
+
+(services) - array reference containing the provisioned services, as cust_svc objects
 
 =back
 
-Accepts one option: summarize_size.  If specified and non-zero, will omit the
-extra cust_pkg_svc option for objects where num_cust_svc is this size or
-greater.
+Accepts two options:
+
+=over 4
+
+=item summarize_size
+
+If true, will omit the extra cust_pkg_svc option for objects where num_cust_svc
+is this size or greater.
+
+=item hide_discontinued
+
+If true, will omit looking for services that are no longer avaialble in the
+package definition.
+
+=back
 
 =cut
 
@@ -2319,16 +3101,18 @@ sub part_svc {
     $part_svc;
   } $self->part_pkg->pkg_svc;
 
-  #extras
-  push @part_svc, map {
-    my $part_svc = $_;
-    my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
-    $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
-    $part_svc->{'Hash'}{'num_avail'}    = 0; #0-$num_cust_svc ?
-    $part_svc->{'Hash'}{'cust_pkg_svc'} =
-      $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
-    $part_svc;
-  } $self->extra_part_svc;
+  unless ( $opt{hide_discontinued} ) {
+    #extras
+    push @part_svc, map {
+      my $part_svc = $_;
+      my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
+      $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
+      $part_svc->{'Hash'}{'num_avail'}    = 0; #0-$num_cust_svc ?
+      $part_svc->{'Hash'}{'cust_pkg_svc'} =
+        $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
+      $part_svc;
+    } $self->extra_part_svc;
+  }
 
   @part_svc;
 
@@ -2395,6 +3179,8 @@ Returns a short status string for this package, currently:
 
 =over 4
 
+=item on hold
+
 =item not yet billed
 
 =item one-time charge
@@ -2415,6 +3201,7 @@ sub status {
   my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
 
   return 'cancelled' if $self->get('cancel');
+  return 'on hold' if $self->susp && ! $self->setup;
   return 'suspended' if $self->susp;
   return 'not yet billed' unless $self->setup;
   return 'one-time charge' if $freq =~ /^(0|$)/;
@@ -2441,8 +3228,9 @@ Class method that returns the list of possible status strings for packages
 =cut
 
 tie my %statuscolor, 'Tie::IxHash', 
+  'on hold'         => '7E0079', #purple!
   'not yet billed'  => '009999', #teal? cyan?
-  'one-time charge' => '000000',
+  'one-time charge' => '0000CC', #blue  #'000000',
   'active'          => '00CC00',
   'suspended'       => 'FF9900',
   'cancelled'       => 'FF0000',
@@ -2455,6 +3243,11 @@ sub statuses {
     keys %statuscolor;
 }
 
+sub statuscolors {
+  #my $self = shift;
+  \%statuscolor;
+}
+
 =item statuscolor
 
 Returns a hex triplet color string for this package's status.
@@ -2469,7 +3262,7 @@ sub statuscolor {
 =item pkg_label
 
 Returns a label for this package.  (Currently "pkgnum: pkg - comment" or
-"pkg-comment" depending on user preference).
+"pkg - comment" depending on user preference).
 
 =cut
 
@@ -2496,6 +3289,17 @@ sub pkg_label_long {
   $label;
 }
 
+=item pkg_locale
+
+Returns a customer-localized label for this package.
+
+=cut
+
+sub pkg_locale {
+  my $self = shift;
+  $self->part_pkg->pkg_locale( $self->cust_main->locale );
+}
+
 =item primary_cust_svc
 
 Returns a primary service (as FS::cust_svc object) if one can be identified.
@@ -2711,7 +3515,16 @@ Returns the L<FS::cust_location> object for tax_locationnum.
 
 sub tax_location {
   my $self = shift;
-  FS::cust_location->by_key( $self->tax_locationnum )
+  my $conf = FS::Conf->new;
+  if ( $conf->exists('tax-pkg_address') and $self->locationnum ) {
+    return FS::cust_location->by_key($self->locationnum);
+  }
+  elsif ( $conf->exists('tax-ship_address') ) {
+    return $self->cust_main->ship_location;
+  }
+  else {
+    return $self->cust_main->bill_location;
+  }
 }
 
 =item seconds_since TIMESTAMP
@@ -2791,8 +3604,7 @@ sub attribute_since_sqlradacct {
   foreach my $cust_svc (
     grep {
       my $part_svc = $_->part_svc;
-      $part_svc->svcdb eq 'svc_acct'
-        && scalar($part_svc->part_export_usage);
+      scalar($part_svc->part_export_usage);
     } $self->cust_svc
   ) {
     $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
@@ -2853,7 +3665,7 @@ sub transfer {
   return ('Package does not exist: '.$dest_pkgnum) unless $dest;
 
   foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
-    $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
+    $target{$pkg_svc->svcpart} = $pkg_svc->quantity * ( $dest->quantity || 1 );
   }
 
   foreach my $cust_svc ($dest->cust_svc) {
@@ -2888,14 +3700,15 @@ sub transfer {
     }
   }
 
+  my $error;
   foreach my $cust_svc ($self->cust_svc) {
+    my $svcnum = $cust_svc->svcnum;
     if($target{$cust_svc->svcpart} > 0
        or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option
       $target{$cust_svc->svcpart}--;
       my $new = new FS::cust_svc { $cust_svc->hash };
       $new->pkgnum($dest_pkgnum);
-      my $error = $new->replace($cust_svc);
-      return $error if $error;
+      $error = $new->replace($cust_svc);
     } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
       if ( $DEBUG ) {
         warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
@@ -2915,18 +3728,61 @@ sub transfer {
         my $new = new FS::cust_svc { $cust_svc->hash };
         $new->svcpart($change_svcpart);
         $new->pkgnum($dest_pkgnum);
-        my $error = $new->replace($cust_svc);
-        return $error if $error;
+        $error = $new->replace($cust_svc);
       } else {
         $remaining++;
       }
     } else {
       $remaining++
     }
+    if ( $error ) {
+      my @label = $cust_svc->label;
+      return "service $label[1]: $error";
+    }
   }
   return $remaining;
 }
 
+=item grab_svcnums SVCNUM, SVCNUM ...
+
+Change the pkgnum for the provided services to this packages.  If there is an
+error, returns the error, otherwise returns false.
+
+=cut
+
+sub grab_svcnums {
+  my $self = shift;
+  my @svcnum = @_;
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  foreach my $svcnum (@svcnum) {
+    my $cust_svc = qsearchs('cust_svc', { svcnum=>$svcnum } ) or do {
+      $dbh->rollback if $oldAutoCommit;
+      return "unknown svcnum $svcnum";
+    };
+    $cust_svc->pkgnum( $self->pkgnum );
+    my $error = $cust_svc->replace;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+
+}
+
 =item reexport
 
 This method is deprecated.  See the I<depend_jobnum> option to the insert and
@@ -2965,6 +3821,39 @@ sub reexport {
 
 }
 
+=item export_pkg_change OLD_CUST_PKG
+
+Calls the "pkg_change" export action for all services attached to this package.
+
+=cut
+
+sub export_pkg_change {
+  my( $self, $old )  = ( shift, shift );
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  foreach my $svc_x ( map $_->svc_x, $self->cust_svc ) {
+    my $error = $svc_x->export('pkg_change', $self, $old);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+
+}
+
 =item insert_reason
 
 Associates this package with a (suspension or cancellation) reason (see
@@ -3137,6 +4026,207 @@ sub cust_pkg_discount_active {
   grep { $_->status eq 'active' } $self->cust_pkg_discount;
 }
 
+=item cust_pkg_usage
+
+Returns a list of all voice usage counters attached to this package.
+
+=cut
+
+sub cust_pkg_usage {
+  my $self = shift;
+  qsearch('cust_pkg_usage', { pkgnum => $self->pkgnum });
+}
+
+=item apply_usage OPTIONS
+
+Takes the following options:
+- cdr: a call detail record (L<FS::cdr>)
+- rate_detail: the rate determined for this call (L<FS::rate_detail>)
+- minutes: the maximum number of minutes to be charged
+
+Finds available usage minutes for a call of this class, and subtracts
+up to that many minutes from the usage pool.  If the usage pool is empty,
+and the C<cdr-minutes_priority> global config option is set, minutes may
+be taken from other calls as well.  Either way, an allocation record will
+be created (L<FS::cdr_cust_pkg_usage>) and this method will return the 
+number of minutes of usage applied to the call.
+
+=cut
+
+sub apply_usage {
+  my ($self, %opt) = @_;
+  my $cdr = $opt{cdr};
+  my $rate_detail = $opt{rate_detail};
+  my $minutes = $opt{minutes};
+  my $classnum = $rate_detail->classnum;
+  my $pkgnum = $self->pkgnum;
+  my $custnum = $self->custnum;
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE'; 
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE'; 
+  local $SIG{PIPE} = 'IGNORE'; 
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+  my $order = FS::Conf->new->config('cdr-minutes_priority');
+
+  my $is_classnum;
+  if ( $classnum ) {
+    $is_classnum = ' part_pkg_usage_class.classnum = '.$classnum;
+  } else {
+    $is_classnum = ' part_pkg_usage_class.classnum IS NULL';
+  }
+  my @usage_recs = qsearch({
+      'table'     => 'cust_pkg_usage',
+      'addl_from' => ' JOIN part_pkg_usage       USING (pkgusagepart)'.
+                     ' JOIN cust_pkg             USING (pkgnum)'.
+                     ' JOIN part_pkg_usage_class USING (pkgusagepart)',
+      'select'    => 'cust_pkg_usage.*',
+      'extra_sql' => " WHERE ( cust_pkg.pkgnum = $pkgnum OR ".
+                     " ( cust_pkg.custnum = $custnum AND ".
+                     " part_pkg_usage.shared IS NOT NULL ) ) AND ".
+                     $is_classnum . ' AND '.
+                     " cust_pkg_usage.minutes > 0",
+      'order_by'  => " ORDER BY priority ASC",
+  });
+
+  my $orig_minutes = $minutes;
+  my $error;
+  while (!$error and $minutes > 0 and @usage_recs) {
+    my $cust_pkg_usage = shift @usage_recs;
+    $cust_pkg_usage->select_for_update;
+    my $cdr_cust_pkg_usage = FS::cdr_cust_pkg_usage->new({
+        pkgusagenum => $cust_pkg_usage->pkgusagenum,
+        acctid      => $cdr->acctid,
+        minutes     => min($cust_pkg_usage->minutes, $minutes),
+    });
+    $cust_pkg_usage->set('minutes',
+      $cust_pkg_usage->minutes - $cdr_cust_pkg_usage->minutes
+    );
+    $error = $cust_pkg_usage->replace || $cdr_cust_pkg_usage->insert;
+    $minutes -= $cdr_cust_pkg_usage->minutes;
+  }
+  if ( $order and $minutes > 0 and !$error ) {
+    # then try to steal minutes from another call
+    my %search = (
+        'table'     => 'cdr_cust_pkg_usage',
+        'addl_from' => ' JOIN cust_pkg_usage        USING (pkgusagenum)'.
+                       ' JOIN part_pkg_usage        USING (pkgusagepart)'.
+                       ' JOIN cust_pkg              USING (pkgnum)'.
+                       ' JOIN part_pkg_usage_class  USING (pkgusagepart)'.
+                       ' JOIN cdr                   USING (acctid)',
+        'select'    => 'cdr_cust_pkg_usage.*',
+        'extra_sql' => " WHERE cdr.freesidestatus = 'rated' AND ".
+                       " ( cust_pkg.pkgnum = $pkgnum OR ".
+                       " ( cust_pkg.custnum = $custnum AND ".
+                       " part_pkg_usage.shared IS NOT NULL ) ) AND ".
+                       " part_pkg_usage_class.classnum = $classnum",
+        'order_by'  => ' ORDER BY part_pkg_usage.priority ASC',
+    );
+    if ( $order eq 'time' ) {
+      # find CDRs that are using minutes, but have a later startdate
+      # than this call
+      my $startdate = $cdr->startdate;
+      if ($startdate !~ /^\d+$/) {
+        die "bad cdr startdate '$startdate'";
+      }
+      $search{'extra_sql'} .= " AND cdr.startdate > $startdate";
+      # minimize needless reshuffling
+      $search{'order_by'} .= ', cdr.startdate DESC';
+    } else {
+      # XXX may not work correctly with rate_time schedules.  Could 
+      # fix this by storing ratedetailnum in cdr_cust_pkg_usage, I 
+      # think...
+      $search{'addl_from'} .=
+        ' JOIN rate_detail'.
+        ' ON (cdr.rated_ratedetailnum = rate_detail.ratedetailnum)';
+      if ( $order eq 'rate_high' ) {
+        $search{'extra_sql'} .= ' AND rate_detail.min_charge < '.
+                                $rate_detail->min_charge;
+        $search{'order_by'} .= ', rate_detail.min_charge ASC';
+      } elsif ( $order eq 'rate_low' ) {
+        $search{'extra_sql'} .= ' AND rate_detail.min_charge > '.
+                                $rate_detail->min_charge;
+        $search{'order_by'} .= ', rate_detail.min_charge DESC';
+      } else {
+        #  this should really never happen
+        die "invalid cdr-minutes_priority value '$order'\n";
+      }
+    }
+    my @cdr_usage_recs = qsearch(\%search);
+    my %reproc_cdrs;
+    while (!$error and @cdr_usage_recs and $minutes > 0) {
+      my $cdr_cust_pkg_usage = shift @cdr_usage_recs;
+      my $cust_pkg_usage = $cdr_cust_pkg_usage->cust_pkg_usage;
+      my $old_cdr = $cdr_cust_pkg_usage->cdr;
+      $reproc_cdrs{$old_cdr->acctid} = $old_cdr;
+      $cdr_cust_pkg_usage->select_for_update;
+      $old_cdr->select_for_update;
+      $cust_pkg_usage->select_for_update;
+      # in case someone else stole the usage from this CDR
+      # while waiting for the lock...
+      next if $old_cdr->acctid != $cdr_cust_pkg_usage->acctid;
+      # steal the usage allocation and flag the old CDR for reprocessing
+      $cdr_cust_pkg_usage->set('acctid', $cdr->acctid);
+      # if the allocation is more minutes than we need, adjust it...
+      my $delta = $cdr_cust_pkg_usage->minutes - $minutes;
+      if ( $delta > 0 ) {
+        $cdr_cust_pkg_usage->set('minutes', $minutes);
+        $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $delta);
+        $error = $cust_pkg_usage->replace;
+      }
+      #warn 'CDR '.$cdr->acctid . ' stealing allocation '.$cdr_cust_pkg_usage->cdrusagenum.' from CDR '.$old_cdr->acctid."\n";
+      $error ||= $cdr_cust_pkg_usage->replace;
+      # deduct the stolen minutes
+      $minutes -= $cdr_cust_pkg_usage->minutes;
+    }
+    # after all minute-stealing is done, reset the affected CDRs
+    foreach (values %reproc_cdrs) {
+      $error ||= $_->set_status('');
+      # XXX or should we just call $cdr->rate right here?
+      # it's not like we can create a loop this way, since the min_charge
+      # or call time has to go monotonically in one direction.
+      # we COULD get some very deep recursions going, though...
+    }
+  } # if $order and $minutes
+  if ( $error ) {
+    $dbh->rollback;
+    die "error applying included minutes\npkgnum ".$self->pkgnum.", class $classnum, acctid ".$cdr->acctid."\n$error\n"
+  } else {
+    $dbh->commit if $oldAutoCommit;
+    return $orig_minutes - $minutes;
+  }
+}
+
+=item supplemental_pkgs
+
+Returns a list of all packages supplemental to this one.
+
+=cut
+
+sub supplemental_pkgs {
+  my $self = shift;
+  qsearch('cust_pkg', { 'main_pkgnum' => $self->pkgnum });
+}
+
+=item main_pkg
+
+Returns the package that this one is supplemental to, if any.
+
+=cut
+
+sub main_pkg {
+  my $self = shift;
+  if ( $self->main_pkgnum ) {
+    return FS::cust_pkg->by_key($self->main_pkgnum);
+  }
+  return;
+}
+
 =back
 
 =head1 CLASS METHODS
@@ -3215,6 +4305,21 @@ sub inactive_sql { "
   AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 )
 "; }
 
+=item on_hold_sql
+
+Returns an SQL expression identifying on-hold packages.
+
+=cut
+
+sub on_hold_sql {
+  #$_[0]->recurring_sql(). ' AND '.
+  "
+        ( cust_pkg.cancel IS     NULL  OR cust_pkg.cancel  = 0 )
+    AND   cust_pkg.susp   IS NOT NULL AND cust_pkg.susp   != 0
+    AND ( cust_pkg.setup  IS     NULL  OR cust_pkg.setup   = 0 )
+  ";
+}
+
 =item susp_sql
 =item suspended_sql
 
@@ -3228,6 +4333,7 @@ sub susp_sql {
   "
         ( cust_pkg.cancel IS     NULL  OR cust_pkg.cancel = 0 )
     AND   cust_pkg.susp   IS NOT NULL AND cust_pkg.susp  != 0
+    AND   cust_pkg.setup  IS NOT NULL AND cust_pkg.setup != 0
   ";
 }
 
@@ -3253,6 +4359,7 @@ Returns an SQL expression to give the package status as a string.
 sub status_sql {
 "CASE
   WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled'
+  WHEN ( cust_pkg.susp IS NOT NULL AND cust_pkg.setup IS NULL ) THEN 'on hold'
   WHEN cust_pkg.susp IS NOT NULL THEN 'suspended'
   WHEN cust_pkg.setup IS NULL THEN 'not yet billed'
   WHEN ".onetime_sql()." THEN 'one-time charge'
@@ -3271,13 +4378,15 @@ Valid parameters are
 
 =item agentnum
 
-=item magic
+=item status
 
-active, inactive, suspended, cancel (or cancelled)
+on hold, active, inactive (or one-time charge), suspended, canceled (or cancelled)
 
-=item status
+=item magic
 
-active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
+Equivalent to "status", except that "canceled"/"cancelled" will exclude 
+packages that were changed into a new package with the same pkgpart (i.e.
+location or quantity changes).
 
 =item custom
 
@@ -3338,6 +4447,38 @@ boolean; if true, returns only packages with more than 0 FCC phone lines.
 Limit to packages with a service location in the specified state and country.
 For FCC 477 reporting, mostly.
 
+=item location_cust
+
+Limit to packages whose service locations are the same as the customer's 
+default service location.
+
+=item location_nocust
+
+Limit to packages whose service locations are not the customer's default 
+service location.
+
+=item location_census
+
+Limit to packages whose service locations have census tracts.
+
+=item location_nocensus
+
+Limit to packages whose service locations do not have a census tract.
+
+=item location_geocode
+
+Limit to packages whose locations have geocodes.
+
+=item location_geocode
+
+Limit to packages whose locations do not have geocodes.
+
+=item towernum
+
+Limit to packages associated with a svc_broadband, associated with a sector,
+associated with this towernum (or any of these, if it's an arrayref) (or NO
+towernum, if it's zero). This is an extreme niche case.
+
 =back
 
 =cut
@@ -3356,6 +4497,33 @@ sub search {
   }
 
   ##
+  # parse cust_status
+  ##
+
+  if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) {
+    push @where, FS::cust_main->cust_status_sql . " = '$1' ";
+  }
+
+  ##
+  # parse customer sales person
+  ##
+
+  if ( $params->{'cust_main_salesnum'} =~ /^(\d+)$/ ) {
+    push @where, ($1 > 0) ? "cust_main.salesnum = $1"
+                          : 'cust_main.salesnum IS NULL';
+  }
+
+
+  ##
+  # parse sales person
+  ##
+
+  if ( $params->{'salesnum'} =~ /^(\d+)$/ ) {
+    push @where, ($1 > 0) ? "cust_pkg.salesnum = $1"
+                          : 'cust_pkg.salesnum IS NULL';
+  }
+
+  ##
   # parse custnum
   ##
 
@@ -3392,6 +4560,12 @@ sub search {
 
     push @where, FS::cust_pkg->inactive_sql();
 
+  } elsif (    $params->{'magic'}  =~ /^on[ _]hold$/
+            || $params->{'status'} =~ /^on[ _]hold$/ ) {
+
+    push @where, FS::cust_pkg->on_hold_sql();
+
+
   } elsif (    $params->{'magic'}  eq 'suspended'
             || $params->{'status'} eq 'suspended'  ) {
 
@@ -3403,6 +4577,19 @@ sub search {
     push @where, FS::cust_pkg->cancelled_sql();
 
   }
+  
+  ### special case: "magic" is used in detail links from browse/part_pkg,
+  # where "cancelled" has the restriction "and not replaced with a package
+  # of the same pkgpart".  Be consistent with that.
+  ###
+
+  if ( $params->{'magic'} =~ /^cancell?ed$/ ) {
+    my $new_pkgpart = "SELECT pkgpart FROM cust_pkg AS cust_pkg_next ".
+                      "WHERE cust_pkg_next.change_pkgnum = cust_pkg.pkgnum";
+    # ...may not exist, if this was just canceled and not changed; in that
+    # case give it a "new pkgpart" that never equals the old pkgpart
+    push @where, "COALESCE(($new_pkgpart), 0) != cust_pkg.pkgpart";
+  }
 
   ###
   # parse package class
@@ -3531,7 +4718,7 @@ sub search {
   }
 
   ###
-  # parse country/state
+  # parse country/state/zip
   ###
   for (qw(state country)) { # parsing rules are the same for these
   if ( exists($params->{$_}) 
@@ -3541,6 +4728,25 @@ sub search {
       push @where, "cust_location.$_ = '$1'";
     }
   }
+  if ( exists($params->{zip}) ) {
+    push @where, "cust_location.zip = " . dbh->quote($params->{zip});
+  }
+
+  ###
+  # location_* flags
+  ###
+  if ( $params->{location_cust} xor $params->{location_nocust} ) {
+    my $op = $params->{location_cust} ? '=' : '!=';
+    push @where, "cust_location.locationnum $op cust_main.ship_locationnum";
+  }
+  if ( $params->{location_census} xor $params->{location_nocensus} ) {
+    my $op = $params->{location_census} ? "IS NOT NULL" : "IS NULL";
+    push @where, "cust_location.censustract $op";
+  }
+  if ( $params->{location_geocode} xor $params->{location_nogeocode} ) {
+    my $op = $params->{location_geocode} ? "IS NOT NULL" : "IS NULL";
+    push @where, "cust_location.geocode $op";
+  }
 
   ###
   # parse part_pkg
@@ -3582,15 +4788,24 @@ sub search {
   );
 
   if( exists($params->{'active'} ) ) {
-    # This overrides all the other date-related fields
+    # This overrides all the other date-related fields, and includes packages
+    # that were active at some time during the interval.  It excludes:
+    # - packages that were set up after the end of the interval
+    # - packages that were canceled before the start of the interval
+    # - packages that were suspended before the start of the interval
+    #   and are still suspended now
     my($beginning, $ending) = @{$params->{'active'}};
     push @where,
       "cust_pkg.setup IS NOT NULL",
       "cust_pkg.setup <= $ending",
       "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
+      "(cust_pkg.susp   IS NULL OR cust_pkg.susp   >= $beginning )",
       "NOT (".FS::cust_pkg->onetime_sql . ")";
   }
   else {
+    my $exclude_change_from = 0;
+    my $exclude_change_to = 0;
+
     foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end change_date cancel )) {
 
       next unless exists($params->{$field});
@@ -3606,6 +4821,27 @@ sub search {
 
       $orderby ||= "ORDER BY cust_pkg.$field";
 
+      if ( $field eq 'setup' ) {
+        $exclude_change_from = 1;
+      } elsif ( $field eq 'cancel' ) {
+        $exclude_change_to = 1;
+      } elsif ( $field eq 'change_date' ) {
+        # if we are given setup and change_date ranges, and the setup date
+        # falls in _both_ ranges, then include the package whether it was 
+        # a change or not
+        $exclude_change_from = 0;
+      }
+    }
+
+    if ($exclude_change_from) {
+      push @where, "change_pkgnum IS NULL";
+    }
+    if ($exclude_change_to) {
+      # a join might be more efficient here
+      push @where, "NOT EXISTS(
+        SELECT 1 FROM cust_pkg AS changed_to_pkg
+        WHERE cust_pkg.pkgnum = changed_to_pkg.change_pkgnum
+      )";
     }
   }
 
@@ -3645,6 +4881,26 @@ sub search {
   }
 
   ##
+  # parse the extremely weird 'towernum' param
+  ##
+
+  if ($params->{towernum}) {
+    my $towernum = $params->{towernum};
+    $towernum = [ $towernum ] if !ref($towernum);
+    my $in = join(',', grep /^\d+$/, @$towernum);
+    if (length $in) {
+      # inefficient, but this is an obscure feature
+      eval "use FS::Report::Table";
+      FS::Report::Table->_init_tower_pkg_cache; # probably does nothing
+      push @where, "EXISTS(
+      SELECT 1 FROM tower_pkg_cache
+      WHERE tower_pkg_cache.pkgnum = cust_pkg.pkgnum
+        AND tower_pkg_cache.towernum IN ($in)
+      )"
+    }
+  }
+
+  ##
   # setup queries, links, subs, etc. for the search
   ##
 
@@ -3664,10 +4920,10 @@ sub search {
 
   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
 
-  my $addl_from = 'LEFT JOIN cust_main USING ( custnum  ) '.
-                  'LEFT JOIN part_pkg  USING ( pkgpart  ) '.
+  my $addl_from = 'LEFT JOIN part_pkg  USING ( pkgpart  ) '.
                   'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) '.
-                  'LEFT JOIN cust_location USING ( locationnum ) ';
+                  'LEFT JOIN cust_location USING ( locationnum ) '.
+                  FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg');
 
   my $select;
   my $count_query;
@@ -3951,11 +5207,25 @@ sub order {
                                       %hash,
                                     };
     $error = $cust_pkg->insert( 'change' => $change );
+    push @$return_cust_pkg, $cust_pkg;
+
+    foreach my $link ($cust_pkg->part_pkg->supp_part_pkg_link) {
+      my $supp_pkg = FS::cust_pkg->new({
+          custnum => $custnum,
+          pkgpart => $link->dst_pkgpart,
+          refnum  => $refnum,
+          main_pkgnum => $cust_pkg->pkgnum,
+          %hash,
+      });
+      $error ||= $supp_pkg->insert( 'change' => $change );
+      push @$return_cust_pkg, $supp_pkg;
+    }
+
     if ($error) {
       $dbh->rollback if $oldAutoCommit;
       return $error;
     }
-    push @$return_cust_pkg, $cust_pkg;
+
   }
   # $return_cust_pkg now contains refs to all of the newly 
   # created packages.