add quantity to self-service change_pkg, RT#34068
[freeside.git] / FS / FS / cust_pkg.pm
index 088eee9..0a1d002 100644 (file)
@@ -1,7 +1,9 @@
 package FS::cust_pkg;
-use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Sales_Mixin
+use base qw( FS::cust_pkg::Search FS::cust_pkg::API
+             FS::otaker_Mixin FS::cust_main_Mixin FS::Sales_Mixin
              FS::contact_Mixin FS::location_Mixin
-             FS::m2m_Common FS::option_Common );
+             FS::m2m_Common FS::option_Common
+           );
 
 use strict;
 use Carp qw(cluck);
@@ -33,7 +35,6 @@ use FS::reason;
 use FS::cust_pkg_usageprice;
 use FS::cust_pkg_discount;
 use FS::discount;
-use FS::UI::Web;
 use FS::sales;
 # for modify_charge
 use FS::cust_credit;
@@ -105,6 +106,8 @@ FS::cust_pkg - Object methods for cust_pkg objects
 
   $seconds = $record->seconds_since($timestamp);
 
+  #bulk cancel+order... perhaps slightly deprecated, only used by the bulk
+  # cancel+order in the web UI and nowhere else (edit/process/cust_pkg.cgi)
   $error = FS::cust_pkg::order( $custnum, \@pkgparts );
   $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
 
@@ -240,6 +243,39 @@ sub cust_unlinked_msg {
   ' (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
@@ -268,7 +304,8 @@ The following options are available:
 =item change
 
 If set true, supresses actions that should only be taken for new package
-orders.  (Currently this includes: intro periods when delay_setup is on.)
+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
 
@@ -301,7 +338,11 @@ sub insert {
 
   my $part_pkg = $self->part_pkg;
 
-  if (! $import) {
+  if ( ! $import && ! $options{'change'} ) {
+
+    # set order date to now
+    $self->order_date(time) unless ($import && $self->order_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];
@@ -310,31 +351,17 @@ sub insert {
       $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
     }
 
-    # set up any automatic expire/adjourn/contract_end timers
-    # based on the start date
-    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) );
-      }
-    }
-
-    # if this package has "free days" and delayed setup fee, tehn 
-    # set start date that many days in the future.
-    # (this should have been set in the UI, but enforce it here)
-    if (    ! $options{'change'}
-         && ( my $free_days = $part_pkg->option('free_days',1) )
-         && $part_pkg->option('delay_setup',1)
-         #&& ! $self->start_date
-       )
-    {
-      $self->start_date( $part_pkg->default_start_date );
+    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;
     }
-  }
-
-  # set order date unless it was specified as part of an import
-  $self->order_date(time) unless $import && $self->order_date;
+  } # else this is a package change, and shouldn't have "new package" behavior
 
   my $oldAutoCommit = $FS::UID::AutoCommit;
   local $FS::UID::AutoCommit = 0;
@@ -642,9 +669,10 @@ sub check {
     || $self->ut_numbern('resume')
     || $self->ut_numbern('expire')
     || $self->ut_numbern('dundate')
-    || $self->ut_enum('no_auto', [ '', 'Y' ])
-    || $self->ut_enum('waive_setup', [ '', 'Y' ])
-    || $self->ut_numbern('agent_pkgid')
+    || $self->ut_flag('no_auto', [ '', 'Y' ])
+    || $self->ut_flag('waive_setup', [ '', 'Y' ])
+    || $self->ut_flag('separate_bill')
+    || $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')
@@ -759,18 +787,30 @@ to a different pkgpart or location, and probably shouldn't be in any other
 case.  If it's not set, the 'unused_credit_cancel' part_pkg option will 
 be used.
 
+=item no_delay_cancel - prevents delay_cancel behavior
+no matter what other options say, for use when changing packages (or any
+other time you're really sure you want an immediate cancel)
+
 =back
 
 If there is an error, returns the error, otherwise returns false.
 
 =cut
 
+#NOT DOCUMENTING - this should only be used when calling recursively
+#=item delay_cancel - for internal use, to allow proper handling of
+#supplemental packages when the main package is flagged to suspend 
+#before cancelling, probably shouldn't be used otherwise (set the
+#corresponding package option instead)
+
 sub cancel {
   my( $self, %options ) = @_;
   my $error;
 
   # pass all suspend/cancel actions to the main package
-  if ( $self->main_pkgnum and !$options{'from_main'} ) {
+  # (unless the pkglinknum has been removed, then the link is defunct and
+  # this package can be canceled on its own)
+  if ( $self->main_pkgnum and $self->pkglinknum and !$options{'from_main'} ) {
     return $self->main_pkg->cancel(%options);
   }
 
@@ -796,6 +836,21 @@ sub cancel {
   my $date = $options{'date'} if $options{'date'}; # expire/cancel later
   $date = '' if ($date && $date <= $cancel_time);      # complain instead?
 
+  my $delay_cancel = $options{'no_delay_cancel'} ? 0 : $options{'delay_cancel'};
+  if ( !$date && $self->part_pkg->option('delay_cancel',1)
+       && (($self->status eq 'active') || ($self->status eq 'suspended'))
+       && !$options{'no_delay_cancel'}
+  ) {
+    my $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
+    my $expsecs = 60*60*24*$expdays;
+    my $suspfor = $self->susp ? $cancel_time - $self->susp : 0;
+    $expsecs = $expsecs - $suspfor if $suspfor;
+    unless ($expsecs <= 0) { #if it's already been suspended long enough, don't re-suspend
+      $delay_cancel = 1;
+      $date = $cancel_time + $expsecs;
+    }
+  }
+
   #race condition: usage could be ongoing until unprovisioned
   #resolved by performing a change package instead (which unprovisions) and
   #later cancelling
@@ -860,22 +915,32 @@ sub cancel {
         return $error;
       }
     }
-
   } #unless $date
 
   my %hash = $self->hash;
   if ( $date ) {
     $hash{'expire'} = $date;
+    if ($delay_cancel) {
+      # just to be sure these are clear
+      $hash{'adjourn'} = undef;
+      $hash{'resume'} = undef;
+    }
   } else {
     $hash{'cancel'} = $cancel_time;
   }
   $hash{'change_custnum'} = $options{'change_custnum'};
 
+  # if this is a supplemental package that's lost its part_pkg_link, and it's
+  # being canceled for real, unlink it completely
+  if ( !$date and ! $self->pkglinknum ) {
+    $hash{main_pkgnum} = '';
+  }
+
   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;
+    $error ||= $change_to->cancel('no_delay_cancel' => 1) || $change_to->delete;
   }
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
@@ -883,18 +948,31 @@ sub cancel {
   }
 
   foreach my $supp_pkg ( $self->supplemental_pkgs ) {
-    $error = $supp_pkg->cancel(%options, 'from_main' => 1);
+    $error = $supp_pkg->cancel(%options, 
+      'from_main' => 1, 
+      'date' => $date, #in case it got changed by delay_cancel
+      'delay_cancel' => $delay_cancel,
+    );
     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";
+  if ($delay_cancel && !$options{'from_main'}) {
+    $error = $new->suspend(
+      'from_cancel' => 1,
+      'time'        => $cancel_time
+    );
+  }
+
+  unless ($date) {
+    foreach my $usage ( $self->cust_pkg_usage ) {
+      $error = $usage->delete;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "deleting usage pools: $error";
+      }
     }
   }
 
@@ -914,10 +992,12 @@ sub cancel {
     }
     else {
       $error = send_email(
-        'from'    => $conf->config('invoice_from', $self->cust_main->agentnum),
+        '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?
       );
     }
     #should this do something on errors?
@@ -995,7 +1075,8 @@ sub uncancel {
       setup
       susp adjourn resume expire start_date contract_end dundate
       change_date change_pkgpart change_locationnum
-      manual_flag no_auto quantity agent_pkgid recur_show_zero setup_show_zero
+      manual_flag no_auto separate_bill quantity agent_pkgid 
+      recur_show_zero setup_show_zero
     ),
   };
 
@@ -1172,7 +1253,7 @@ Available options are:
 
 =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>
@@ -1191,6 +1272,9 @@ separately.
 =item from_main - allows a supplemental package to be suspended, rather
 than redirecting the method call to its main package.  For internal use.
 
+=item from_cancel - used when suspending from the cancel method, forces
+this to skip everything besides basic suspension.  For internal use.
+
 =back
 
 If there is an error, returns the error, otherwise returns false.
@@ -1233,7 +1317,7 @@ sub suspend {
   }
 
   # some false laziness with sub cancel
-  if ( !$options{nobill} && !$date &&
+  if ( !$options{nobill} && !$date && !$options{'from_cancel'} &&
        $self->part_pkg->option('bill_suspend_as_cancel',1) ) {
     # kind of a kludge--'bill_suspend_as_cancel' to avoid having to 
     # make the entire cust_main->bill path recognize 'suspend' and 
@@ -1262,6 +1346,16 @@ sub suspend {
     }
   }
 
+  # if a reasonnum was passed, get the actual reason object so we can check
+  # unused_credit
+  # (passing a reason hashref is still allowed, but it can't be used with
+  # the fancy behavioral options.)
+
+  my $reason;
+  if ($options{'reason'} =~ /^\d+$/) {
+    $reason = FS::reason->by_key($options{'reason'});
+  }
+
   my %hash = $self->hash;
   if ( $date ) {
     $hash{'adjourn'} = $date;
@@ -1286,13 +1380,21 @@ sub suspend {
     return $error;
   }
 
-  unless ( $date ) {
-    # credit remaining time if appropriate
-    if ( $self->part_pkg->option('unused_credit_suspend', 1) ) {
-      my $error = $self->credit_remaining('suspend', $suspend_time);
-      if ($error) {
-        $dbh->rollback if $oldAutoCommit;
-        return $error;
+  unless ( $date ) { # then we are suspending now
+
+    unless ($options{'from_cancel'}) {
+      # credit remaining time if appropriate
+      # (if required by the package def, or the suspend reason)
+      my $unused_credit = $self->part_pkg->option('unused_credit_suspend',1)
+                          || ( defined($reason) && $reason->unused_credit );
+
+      if ( $unused_credit ) {
+        warn "crediting unused time on pkg#".$self->pkgnum."\n" if $DEBUG;
+        my $error = $self->credit_remaining('suspend', $suspend_time);
+        if ($error) {
+          $dbh->rollback if $oldAutoCommit;
+          return $error;
+        }
       }
     }
 
@@ -1323,7 +1425,7 @@ sub suspend {
     }
 
     my $conf = new FS::Conf;
-    if ( $conf->config('suspend_email_admin') ) {
+    if ( $conf->config('suspend_email_admin') && !$options{'from_cancel'} ) {
  
       my $error = send_email(
         'from'    => $conf->config('invoice_from', $self->cust_main->agentnum),
@@ -1338,6 +1440,8 @@ sub suspend {
           'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
           ( map { "Service : $_\n" } @labels ),
         ],
+        'custnum' => $self->custnum,
+        'msgtype' => 'admin'
       );
 
       if ( $error ) {
@@ -1371,6 +1475,21 @@ are mandatory.
 
 =cut
 
+# Implementation note:
+#
+# If you pkgpart-change a package that has been billed, and it's set to give
+# credit on package change, then this method gets called and then the new
+# package will have no last_bill date. Therefore the customer will be credited
+# only once (per billing period) even if there are multiple package changes.
+#
+# If you location-change a package that has been billed, this method will NOT
+# be called and the new package WILL have the last bill date of the old
+# package.
+#
+# If the new package is then canceled within the same billing cycle, 
+# credit_remaining needs to run calc_remain on the OLD package to determine
+# the amount of unused time to credit.
+
 sub credit_remaining {
   # Add a credit for remaining service
   my ($self, $mode, $time) = @_;
@@ -1387,7 +1506,30 @@ sub credit_remaining {
       and $next_bill > 0      # the package has a next bill date
       and $next_bill >= $time # which is in the future
   ) {
-    my $remaining_value = $self->calc_remain('time' => $time);
+    my @cust_credit_source_bill_pkg = ();
+    my $remaining_value = 0;
+
+    my $remain_pkg = $self;
+    $remaining_value = $remain_pkg->calc_remain(
+      'time' => $time, 
+      'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
+    );
+
+    # 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,
+      );
+    }
+
     if ( $remaining_value > 0 ) {
       warn "Crediting for $remaining_value on package ".$self->pkgnum."\n"
         if $DEBUG;
@@ -1395,6 +1537,7 @@ sub credit_remaining {
         $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"
@@ -1459,6 +1602,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?
 
@@ -1482,6 +1627,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 (
@@ -1517,15 +1667,46 @@ 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) )
-     ) {
+  #adjust the next bill date forward
+  # increment next bill date if certain conditions are met:
+  # - it was due to be billed at some point
+  # - either the global or local config says to do this
+  my $adjust_bill = 0;
+  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)
+       )
+  ) {
+    $adjust_bill = 1;
+  }
 
-    $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive;
-  
+  # but not if:
+  # - the package billed during suspension
+  # - or it was ordered on hold
+  # - or the customer was credited for the unused time
+
+  if ( $self->option('suspend_bill',1)
+      or ( $self->part_pkg->option('suspend_bill',1)
+           and ! $self->option('no_suspend_bill',1)
+         )
+      or $hash{'order_date'} == $hash{'susp'}
+  ) {
+    $adjust_bill = 0;
+  }
+
+  if ( $adjust_bill ) {
+    if (    $self->part_pkg->option('unused_credit_suspend')
+         or ( ref($reason) and $reason->unused_credit ) ) {
+      # then the customer was credited for the unused time before suspending,
+      # so their next bill should be immediate 
+      $hash{'bill'} = time;
+    } else {
+      # add the length of time suspended to the bill date
+      $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive;
+    }
   }
 
   $hash{'susp'} = '';
@@ -1584,6 +1765,8 @@ sub unsuspend {
           : ''
         ),
       ],
+      'custnum' => $self->custnum,
+      'msgtype' => 'admin',
     );
 
     if ( $error ) {
@@ -1792,6 +1975,9 @@ 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)
@@ -1849,7 +2035,9 @@ sub change {
   }
 
   # Transfer services and cancel old package.
-
+  # Enforce service limits only if this is a pkgpart change.
+  local $FS::cust_svc::ignore_quantity;
+  $FS::cust_svc::ignore_quantity = 1 if $same_pkgpart;
   $error = $self->transfer($cust_pkg);
   if ($error and $error == 0) {
     # $old_pkg->transfer failed.
@@ -2021,6 +2209,7 @@ sub change {
     unused_credit  => $unused_credit,
     nobill         => $keep_dates,
     change_custnum => ( $self->custnum != $custnum ? $custnum : '' ),
+    no_delay_cancel => 1,
   );
   if ($error) {
     $dbh->rollback if $oldAutoCommit;
@@ -2118,7 +2307,7 @@ sub change_later {
 
         $error = $self->replace       ||
                  $err_or_pkg->replace ||
-                 $change_to->cancel   ||
+                 $change_to->cancel('no_delay_cancel' => 1) ||
                  $change_to->delete;
       } else {
         $error = $err_or_pkg;
@@ -2238,6 +2427,7 @@ 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
+- separate_bill: whether to put the charge on a separate invoice
 
 If you pass 'adjust_commission' => 1, and the classnum changes, and there are
 commission credits linked to this charge, they will be recalculated.
@@ -2262,14 +2452,27 @@ sub modify_charge {
   }
 
   my %pkg_opt = $part_pkg->options;
-  if ( ref($opt{'additional'}) ) {
-    delete $pkg_opt{$_} foreach grep /^additional/, keys %pkg_opt;
-    my $i;
-    for ( $i = 0; exists($opt{'additional'}->[$i]); $i++ ) {
-      $pkg_opt{ "additional_info$i" } = $opt{'additional'}->[$i];
+  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{'additional_count'} = $i if $i > 0;
   }
+  $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'} )
@@ -2280,44 +2483,82 @@ sub modify_charge {
   }
 
   if ( !$self->get('setup') ) {
-    # not yet billed, so allow amount and quantity
+    # not yet billed, so allow amount, setup_cost, quantity, start_date,
+    # and separate_bill
+
+    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;
+    }
+
+    if ( exists($opt{'setup_cost'}) 
+          and $part_pkg->setup_cost != $opt{'setup_cost'}
+          and $opt{'setup_cost'} > 0 ) {
+
+      $part_pkg->set('setup_cost', $opt{'setup_cost'});
+    }
+
     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 ($self->modified) { # for quantity or start_date change
-      my $error = $self->replace;
-      return $error if $error;
-    }
 
-    if ( exists($opt{'amount'}) 
-          and $part_pkg->option('setup_fee') != $opt{'amount'}
-          and $opt{'amount'} > 0 ) {
+    if ( exists($opt{'separate_bill'})
+          and $opt{'separate_bill'} ne $self->separate_bill ) {
 
-      $pkg_opt{'setup_fee'} = $opt{'amount'};
-      # standard for one-time charges is to set comment = (formatted) amount
-      # update it to avoid confusion
-      my $conf = FS::Conf->new;
-      $part_pkg->set('comment', 
-        ($conf->config('money_char') || '$') .
-        sprintf('%.2f', $opt{'amount'})
-      );
+      $self->set('separate_bill', $opt{'separate_bill'});
     }
+
+
   } # else simply ignore them; the UI shouldn't allow editing the fields
 
-  my $error = $part_pkg->replace( options => \%pkg_opt );
-  if ( $error ) {
-    $dbh->rollback if $oldAutoCommit;
-    return $error;
+  
+  if ( exists($opt{'taxclass'}) 
+          and $part_pkg->taxclass ne $opt{'taxclass'}) {
+    
+      $part_pkg->set('taxclass', $opt{'taxclass'});
+  }
+
+  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
@@ -2386,12 +2627,10 @@ sub modify_charge {
 
 
 
-use Storable 'thaw';
-use MIME::Base64;
 use Data::Dumper;
 sub process_bulk_cust_pkg {
   my $job = shift;
-  my $param = thaw(decode_base64(shift));
+  my $param = shift;
   warn Dumper($param) if $DEBUG;
 
   my $old_part_pkg = qsearchs('part_pkg', 
@@ -2671,7 +2910,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
 
@@ -2688,19 +2927,41 @@ sub cust_event {
 
 =item num_cust_event
 
-Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
+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(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
-    "  WHERE tablenum = ? AND eventtable = 'cust_pkg'";
+  my $sql = "SELECT COUNT(*) ". $self->_from_cust_event_where;
+  $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref->[0];
+}
+
+=item exists_cust_event
+
+Returns true if there are customer billing events (see L<FS::cust_event>) for this package.  More efficient than using num_cust_event.
+
+=cut
+
+sub exists_cust_event {
+  my $self = shift;
+  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 part_pkg_currency_option OPTIONNAME
@@ -2752,7 +3013,7 @@ sub cust_svc_unsorted {
 sub cust_svc_unsorted_arrayref {
   my $self = shift;
 
-  return () unless $self->num_cust_svc(@_);
+  return [] unless $self->num_cust_svc(@_);
 
   my %opt = ();
   if ( @_ && $_[0] =~ /^\d+/ ) {
@@ -2808,12 +3069,16 @@ sub h_cust_svc {
     if $DEBUG;
 
   my ($end, $start, $mode) = @_;
+
+  local($FS::Record::qsearch_qualify_columns) = 0;
+
   my @cust_svc = $self->_sort_cust_svc(
     [ qsearch( 'h_cust_svc',
       { 'pkgnum' => $self->pkgnum, },  
       FS::h_cust_svc->sql_h_search(@_),  
     ) ]
   );
+
   if ( defined($mode) && $mode eq 'I' ) {
     my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc;
     return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc;
@@ -2930,17 +3195,35 @@ following extra fields:
 
 =over 4
 
-=item num_cust_svc  (count)
+=item num_cust_svc
+
+(count)
+
+=item num_avail
 
-=item num_avail     (quantity - count)
+(quantity - count)
 
-=item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
+=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
 
@@ -2969,16 +3252,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;
 
@@ -3045,6 +3330,8 @@ Returns a short status string for this package, currently:
 
 =over 4
 
+=item on hold
+
 =item not yet billed
 
 =item one-time charge
@@ -3065,6 +3352,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|$)/;
@@ -3091,8 +3379,9 @@ Class method that returns the list of possible status strings for packages
 =cut
 
 tie my %statuscolor, 'Tie::IxHash', 
+  'on hold'         => 'FF00F5', #brighter purple!
   'not yet billed'  => '009999', #teal? cyan?
-  'one-time charge' => '000000',
+  'one-time charge' => '0000CC', #blue  #'000000',
   'active'          => '00CC00',
   'suspended'       => 'FF9900',
   'cancelled'       => 'FF0000',
@@ -3105,6 +3394,11 @@ sub statuses {
     keys %statuscolor;
 }
 
+sub statuscolors {
+  #my $self = shift;
+  \%statuscolor;
+}
+
 =item statuscolor
 
 Returns a hex triplet color string for this package's status.
@@ -3116,6 +3410,34 @@ sub statuscolor {
   $statuscolor{$self->status};
 }
 
+=item is_status_delay_cancel
+
+Returns true if part_pkg has option delay_cancel, 
+cust_pkg status is 'suspended' and expire is set
+to cancel package within the next day (or however
+many days are set in global config part_pkg-delay_cancel-days.
+
+This is not a real status, this only meant for hacking display 
+values, because otherwise treating the package as suspended is 
+really the whole point of the delay_cancel option.
+
+=cut
+
+sub is_status_delay_cancel {
+  my ($self) = @_;
+  if ( $self->main_pkgnum and $self->pkglinknum ) {
+    return $self->main_pkg->is_status_delay_cancel;
+  }
+  return 0 unless $self->part_pkg->option('delay_cancel',1);
+  return 0 unless $self->status eq 'suspended';
+  return 0 unless $self->expire;
+  my $conf = new FS::Conf;
+  my $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
+  my $expsecs = 60*60*24*$expdays;
+  return 0 unless $self->expire < time + $expsecs;
+  return 1;
+}
+
 =item pkg_label
 
 Returns a label for this package.  (Currently "pkgnum: pkg - comment" or
@@ -3365,7 +3687,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
@@ -3506,7 +3837,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) {
@@ -3541,6 +3872,7 @@ sub transfer {
     }
   }
 
+  my $error;
   foreach my $cust_svc ($self->cust_svc) {
     my $svcnum = $cust_svc->svcnum;
     if($target{$cust_svc->svcpart} > 0
@@ -3548,8 +3880,7 @@ sub transfer {
       $target{$cust_svc->svcpart}--;
       my $new = new FS::cust_svc { $cust_svc->hash };
       $new->pkgnum($dest_pkgnum);
-      my $error = $new->replace($cust_svc);
-      return "svcnum $svcnum: $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";
@@ -3569,14 +3900,17 @@ 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 "svcnum $svcnum: $error" if $error;
+        $error = $new->replace($cust_svc);
       } else {
         $remaining++;
       }
     } else {
       $remaining++
     }
+    if ( $error ) {
+      my @label = $cust_svc->label;
+      return "$label[0] $label[1]: $error";
+    }
   }
   return $remaining;
 }
@@ -3731,7 +4065,7 @@ sub insert_reason {
     $reasonnum = $reason->reasonnum;
 
   } else {
-    return "Unparsable reason: ". $options{'reason'};
+    return "Unparseable reason: ". $options{'reason'};
   }
 
   my $cust_pkg_reason =
@@ -3932,7 +4266,7 @@ sub apply_usage {
         minutes     => min($cust_pkg_usage->minutes, $minutes),
     });
     $cust_pkg_usage->set('minutes',
-      sprintf('%.0f', $cust_pkg_usage->minutes - $cdr_cust_pkg_usage->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;
@@ -4132,6 +4466,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
 
@@ -4145,6 +4494,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
   ";
 }
 
@@ -4170,6 +4520,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'
@@ -4177,519 +4528,6 @@ sub status_sql {
 END"
 }
 
-=item search HASHREF
-
-(Class method)
-
-Returns a qsearch hash expression to search for parameters specified in HASHREF.
-Valid parameters are
-
-=over 4
-
-=item agentnum
-
-=item magic
-
-active, inactive, suspended, cancel (or cancelled)
-
-=item status
-
-active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
-
-=item custom
-
- boolean selects custom packages
-
-=item classnum
-
-=item pkgpart
-
-pkgpart or arrayref or hashref of pkgparts
-
-=item setup
-
-arrayref of beginning and ending epoch date
-
-=item last_bill
-
-arrayref of beginning and ending epoch date
-
-=item bill
-
-arrayref of beginning and ending epoch date
-
-=item adjourn
-
-arrayref of beginning and ending epoch date
-
-=item susp
-
-arrayref of beginning and ending epoch date
-
-=item expire
-
-arrayref of beginning and ending epoch date
-
-=item cancel
-
-arrayref of beginning and ending epoch date
-
-=item query
-
-pkgnum or APKG_pkgnum
-
-=item cust_fields
-
-a value suited to passing to FS::UI::Web::cust_header
-
-=item CurrentUser
-
-specifies the user for agent virtualization
-
-=item fcc_line
-
-boolean; if true, returns only packages with more than 0 FCC phone lines.
-
-=item state, country
-
-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.
-
-=back
-
-=cut
-
-sub search {
-  my ($class, $params) = @_;
-  my @where = ();
-
-  ##
-  # parse agent
-  ##
-
-  if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
-    push @where,
-      "cust_main.agentnum = $1";
-  }
-
-  ##
-  # 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
-  ##
-
-  if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
-    push @where,
-      "cust_pkg.custnum = $1";
-  }
-
-  ##
-  # custbatch
-  ##
-
-  if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
-    push @where,
-      "cust_pkg.pkgbatch = '$1'";
-  }
-
-  ##
-  # parse status
-  ##
-
-  if (    $params->{'magic'}  eq 'active'
-       || $params->{'status'} eq 'active' ) {
-
-    push @where, FS::cust_pkg->active_sql();
-
-  } elsif (    $params->{'magic'}  =~ /^not[ _]yet[ _]billed$/
-            || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
-
-    push @where, FS::cust_pkg->not_yet_billed_sql();
-
-  } elsif (    $params->{'magic'}  =~ /^(one-time charge|inactive)/
-            || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
-
-    push @where, FS::cust_pkg->inactive_sql();
-
-  } elsif (    $params->{'magic'}  eq 'suspended'
-            || $params->{'status'} eq 'suspended'  ) {
-
-    push @where, FS::cust_pkg->suspended_sql();
-
-  } elsif (    $params->{'magic'}  =~ /^cancell?ed$/
-            || $params->{'status'} =~ /^cancell?ed$/ ) {
-
-    push @where, FS::cust_pkg->cancelled_sql();
-
-  }
-
-  ###
-  # parse package class
-  ###
-
-  if ( exists($params->{'classnum'}) ) {
-
-    my @classnum = ();
-    if ( ref($params->{'classnum'}) ) {
-
-      if ( ref($params->{'classnum'}) eq 'HASH' ) {
-        @classnum = grep $params->{'classnum'}{$_}, keys %{ $params->{'classnum'} };
-      } elsif ( ref($params->{'classnum'}) eq 'ARRAY' ) {
-        @classnum = @{ $params->{'classnum'} };
-      } else {
-        die 'unhandled classnum ref '. $params->{'classnum'};
-      }
-
-
-    } elsif ( $params->{'classnum'} =~ /^(\d*)$/ && $1 ne '0' ) {
-      @classnum = ( $1 );
-    }
-
-    if ( @classnum ) {
-
-      my @c_where = ();
-      my @nums = grep $_, @classnum;
-      push @c_where, 'part_pkg.classnum IN ('. join(',',@nums). ')' if @nums;
-      my $null = scalar( grep { $_ eq '' } @classnum );
-      push @c_where, 'part_pkg.classnum IS NULL' if $null;
-
-      if ( scalar(@c_where) == 1 ) {
-        push @where, @c_where;
-      } elsif ( @c_where ) {
-        push @where, ' ( '. join(' OR ', @c_where). ' ) ';
-      }
-
-    }
-    
-
-  }
-
-  ###
-  # parse package report options
-  ###
-
-  my @report_option = ();
-  if ( exists($params->{'report_option'}) ) {
-    if ( ref($params->{'report_option'}) eq 'ARRAY' ) {
-      @report_option = @{ $params->{'report_option'} };
-    } elsif ( $params->{'report_option'} =~ /^([,\d]*)$/ ) {
-      @report_option = split(',', $1);
-    }
-
-  }
-
-  if (@report_option) {
-    # this will result in the empty set for the dangling comma case as it should
-    push @where, 
-      map{ "0 < ( SELECT count(*) FROM part_pkg_option
-                    WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
-                    AND optionname = 'report_option_$_'
-                    AND optionvalue = '1' )"
-         } @report_option;
-  }
-
-  foreach my $any ( grep /^report_option_any/, keys %$params ) {
-
-    my @report_option_any = ();
-    if ( ref($params->{$any}) eq 'ARRAY' ) {
-      @report_option_any = @{ $params->{$any} };
-    } elsif ( $params->{$any} =~ /^([,\d]*)$/ ) {
-      @report_option_any = split(',', $1);
-    }
-
-    if (@report_option_any) {
-      # this will result in the empty set for the dangling comma case as it should
-      push @where, ' ( '. join(' OR ',
-        map{ "0 < ( SELECT count(*) FROM part_pkg_option
-                      WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
-                      AND optionname = 'report_option_$_'
-                      AND optionvalue = '1' )"
-           } @report_option_any
-      ). ' ) ';
-    }
-
-  }
-
-  ###
-  # parse custom
-  ###
-
-  push @where,  "part_pkg.custom = 'Y'" if $params->{custom};
-
-  ###
-  # parse fcc_line
-  ###
-
-  push @where,  "(part_pkg.fcc_ds0s > 0 OR pkg_class.fcc_ds0s > 0)" 
-                                                        if $params->{fcc_line};
-
-  ###
-  # parse censustract
-  ###
-
-  if ( exists($params->{'censustract'}) ) {
-    $params->{'censustract'} =~ /^([.\d]*)$/;
-    my $censustract = "cust_location.censustract = '$1'";
-    $censustract .= ' OR cust_location.censustract is NULL' unless $1;
-    push @where,  "( $censustract )";
-  }
-
-  ###
-  # parse censustract2
-  ###
-  if ( exists($params->{'censustract2'})
-       && $params->{'censustract2'} =~ /^(\d*)$/
-     )
-  {
-    if ($1) {
-      push @where, "cust_location.censustract LIKE '$1%'";
-    } else {
-      push @where,
-        "( cust_location.censustract = '' OR cust_location.censustract IS NULL )";
-    }
-  }
-
-  ###
-  # parse country/state
-  ###
-  for (qw(state country)) { # parsing rules are the same for these
-  if ( exists($params->{$_}) 
-    && uc($params->{$_}) =~ /^([A-Z]{2})$/ )
-    {
-      # XXX post-2.3 only--before that, state/country may be in cust_main
-      push @where, "cust_location.$_ = '$1'";
-    }
-  }
-
-  ###
-  # 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
-  ###
-
-  if ( ref($params->{'pkgpart'}) ) {
-
-    my @pkgpart = ();
-    if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
-      @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
-    } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
-      @pkgpart = @{ $params->{'pkgpart'} };
-    } else {
-      die 'unhandled pkgpart ref '. $params->{'pkgpart'};
-    }
-
-    @pkgpart = grep /^(\d+)$/, @pkgpart;
-
-    push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
-
-  } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
-    push @where, "pkgpart = $1";
-  } 
-
-  ###
-  # parse dates
-  ###
-
-  my $orderby = '';
-
-  #false laziness w/report_cust_pkg.html
-  my %disable = (
-    'all'             => {},
-    'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
-    'active'          => { 'susp'=>1, 'cancel'=>1 },
-    'suspended'       => { 'cancel' => 1 },
-    'cancelled'       => {},
-    ''                => {},
-  );
-
-  if( exists($params->{'active'} ) ) {
-    # This overrides all the other date-related fields
-    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 )",
-      "NOT (".FS::cust_pkg->onetime_sql . ")";
-  }
-  else {
-    foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end change_date cancel )) {
-
-      next unless exists($params->{$field});
-
-      my($beginning, $ending) = @{$params->{$field}};
-
-      next if $beginning == 0 && $ending == 4294967295;
-
-      push @where,
-        "cust_pkg.$field IS NOT NULL",
-        "cust_pkg.$field >= $beginning",
-        "cust_pkg.$field <= $ending";
-
-      $orderby ||= "ORDER BY cust_pkg.$field";
-
-    }
-  }
-
-  $orderby ||= 'ORDER BY bill';
-
-  ###
-  # parse magic, legacy, etc.
-  ###
-
-  if ( $params->{'magic'} &&
-       $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
-  ) {
-
-    $orderby = 'ORDER BY pkgnum';
-
-    if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
-      push @where, "pkgpart = $1";
-    }
-
-  } elsif ( $params->{'query'} eq 'pkgnum' ) {
-
-    $orderby = 'ORDER BY pkgnum';
-
-  } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
-
-    $orderby = 'ORDER BY pkgnum';
-
-    push @where, '0 < (
-      SELECT count(*) FROM pkg_svc
-       WHERE pkg_svc.pkgpart =  cust_pkg.pkgpart
-         AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
-                                   WHERE cust_svc.pkgnum  = cust_pkg.pkgnum
-                                     AND cust_svc.svcpart = pkg_svc.svcpart
-                                )
-    )';
-  
-  }
-
-  ##
-  # setup queries, links, subs, etc. for the search
-  ##
-
-  # here is the agent virtualization
-  if ($params->{CurrentUser}) {
-    my $access_user =
-      qsearchs('access_user', { username => $params->{CurrentUser} });
-
-    if ($access_user) {
-      push @where, $access_user->agentnums_sql('table'=>'cust_main');
-    } else {
-      push @where, "1=0";
-    }
-  } else {
-    push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
-  }
-
-  my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
-
-  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 ) '.
-                  FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg');
-
-  my $select;
-  my $count_query;
-  if ( $params->{'select_zip5'} ) {
-    my $zip = 'cust_location.zip';
-
-    $select = "DISTINCT substr($zip,1,5) as zip";
-    $orderby = "ORDER BY substr($zip,1,5)";
-    $count_query = "SELECT COUNT( DISTINCT substr($zip,1,5) )";
-  } else {
-    $select = join(', ',
-                         'cust_pkg.*',
-                         ( map "part_pkg.$_", qw( pkg freq ) ),
-                         'pkg_class.classname',
-                         'cust_main.custnum AS cust_main_custnum',
-                         FS::UI::Web::cust_sql_fields(
-                           $params->{'cust_fields'}
-                         ),
-                  );
-    $count_query = 'SELECT COUNT(*)';
-  }
-
-  $count_query .= " FROM cust_pkg $addl_from $extra_sql";
-
-  my $sql_query = {
-    'table'       => 'cust_pkg',
-    'hashref'     => {},
-    'select'      => $select,
-    'extra_sql'   => $extra_sql,
-    'order_by'    => $orderby,
-    'addl_from'   => $addl_from,
-    'count_query' => $count_query,
-  };
-
-}
-
 =item fcc_477_count
 
 Returns a list of two package counts.  The first is a count of packages
@@ -4851,6 +4689,9 @@ sub _X_show_zero {
 
 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
 
+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)
+
 CUSTNUM is a customer (see L<FS::cust_main>)
 
 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
@@ -4987,7 +4828,7 @@ sub order {
       $dbh->rollback if $oldAutoCommit;
       return "Unable to transfer all services from package ".$old_pkg->pkgnum;
     }
-    $error = $old_pkg->cancel( quiet=>1 );
+    $error = $old_pkg->cancel( quiet=>1, 'no_delay_cancel'=>1 );
     if ($error) {
       $dbh->rollback;
       return $error;
@@ -5073,6 +4914,23 @@ sub _upgrade_data {  # class method
     my $sth = dbh->prepare($sql);
     $sth->execute or die $sth->errstr;
   }
+
+  # RT31194: supplemental package links that are deleted don't clean up 
+  # linked records
+  my @pkglinknums = qsearch({
+      'select'    => 'DISTINCT cust_pkg.pkglinknum',
+      'table'     => 'cust_pkg',
+      'addl_from' => ' LEFT JOIN part_pkg_link USING (pkglinknum) ',
+      'extra_sql' => ' WHERE cust_pkg.pkglinknum IS NOT NULL 
+                        AND part_pkg_link.pkglinknum IS NULL',
+  });
+  foreach (@pkglinknums) {
+    my $pkglinknum = $_->pkglinknum;
+    warn "cleaning part_pkg_link #$pkglinknum\n";
+    my $part_pkg_link = FS::part_pkg_link->new({pkglinknum => $pkglinknum});
+    my $error = $part_pkg_link->remove_linked;
+    die $error if $error;
+  }
 }
 
 =back