RT#20687: Future package change [comment about bug fix]

[freeside.git] / FS / FS / cust_pkg.pm

diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index ad530f7..dcbcfeb 100644 (file)
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -108,6 +108,8 @@ FS::cust_pkg - Object methods for cust_pkg objects
 
   $seconds = $record->seconds_since($timestamp);
 
 
   $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 ] );
 
   $error = FS::cust_pkg::order( $custnum, \@pkgparts );
   $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
 


@@ -673,8 +675,9 @@ sub check {
     || $self->ut_numbern('resume')
     || $self->ut_numbern('expire')
     || $self->ut_numbern('dundate')
     || $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_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_textn('agent_pkgid')
     || $self->ut_enum('recur_show_zero', [ '', 'Y', 'N', ])
     || $self->ut_enum('setup_show_zero', [ '', 'Y', 'N', ])


@@ -790,18 +793,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.
 
 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
 
 =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
 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);
   }
 
     return $self->main_pkg->cancel(%options);
   }
 


@@ -834,6 +849,21 @@ sub cancel {
   my $date = $options{'date'} if $options{'date'}; # expire/cancel later
   $date = '' if ($date && $date <= $cancel_time);      # complain instead?
 
   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
   #race condition: usage could be ongoing until unprovisioned
   #resolved by performing a change package instead (which unprovisions) and
   #later cancelling


@@ -898,22 +928,32 @@ sub cancel {
         return $error;
       }
     }
         return $error;
       }
     }

-

   } #unless $date
 
   my %hash = $self->hash;
   if ( $date ) {
     $hash{'expire'} = $date;
   } #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'};
 
   } 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);
   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;
   }
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;


@@ -921,18 +961,31 @@ sub cancel {
   }
 
   foreach my $supp_pkg ( $self->supplemental_pkgs ) {
   }
 
   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";
     }
   }
 
     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";
+      }

     }
   }
 
     }
   }
 


@@ -952,7 +1005,7 @@ sub cancel {
     }
     else {
       $error = send_email(
     }
     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') ],
         'to'      => \@invoicing_list,
         'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
         'body'    => [ map "$_\n", $conf->config('cancelmessage') ],


@@ -1042,7 +1095,8 @@ sub uncancel {
       setup
       susp adjourn resume expire start_date contract_end dundate
       change_date change_pkgpart change_locationnum
       setup
       susp adjourn resume expire start_date contract_end dundate
       change_date change_pkgpart change_locationnum

-      manual_flag no_auto quantity agent_pkgid recur_show_zero setup_show_zero
+      manual_flag no_auto separate_bill quantity agent_pkgid 
+      recur_show_zero setup_show_zero

     ),
   };
 
     ),
   };
 


@@ -1226,7 +1280,7 @@ Available options are:
 
 =over 4
 
 
 =over 4
 

-=item reason - can be set to a cancellation reason (see L<FS:reason>), 
+=item reason - can be set to a cancellation reason (see L<FS:reason>),

 either a reasonnum of an existing reason, or passing a hashref will create 
 a new reason.  The hashref should have the following keys: 
 - typenum - Reason type (see L<FS::reason_type>
 either a reasonnum of an existing reason, or passing a hashref will create 
 a new reason.  The hashref should have the following keys: 
 - typenum - Reason type (see L<FS::reason_type>


@@ -1245,6 +1299,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_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.
 =back
 
 If there is an error, returns the error, otherwise returns false.


@@ -1294,7 +1351,7 @@ sub suspend {
   }
 
   # some false laziness with sub cancel
   }
 
   # 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 
        $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 


@@ -1311,6 +1368,7 @@ sub suspend {
       if $error;
   }
 
       if $error;
   }
 

+  my $cust_pkg_reason;

   if ( $options{'reason'} ) {
     $error = $self->insert_reason( 'reason' => $options{'reason'},
                                    'action' => $date ? 'adjourn' : 'suspend',
   if ( $options{'reason'} ) {
     $error = $self->insert_reason( 'reason' => $options{'reason'},
                                    'action' => $date ? 'adjourn' : 'suspend',


@@ -1321,6 +1379,21 @@ sub suspend {
       dbh->rollback if $oldAutoCommit;
       return "Error inserting cust_pkg_reason: $error";
     }
       dbh->rollback if $oldAutoCommit;
       return "Error inserting cust_pkg_reason: $error";
     }

+    $cust_pkg_reason = qsearchs('cust_pkg_reason', {
+        'date'    => $date ? $date : $suspend_time,
+        'action'  => $date ? 'A' : 'S',
+        'pkgnum'  => $self->pkgnum,
+    });
+  }
+
+  # 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;
   }
 
   my %hash = $self->hash;


@@ -1347,13 +1420,21 @@ sub suspend {
     return $error;
   }
 
     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;
+        }

       }
     }
 
       }
     }
 


@@ -1383,8 +1464,29 @@ sub suspend {
       }
     }
 
       }
     }
 

+    # suspension fees: if there is a feepart, and it's not an unsuspend fee,
+    # and this is not a suspend-before-cancel
+    if ( $cust_pkg_reason ) {
+      my $reason_obj = $cust_pkg_reason->reason;
+      if ( $reason_obj->feepart and
+           ! $reason_obj->fee_on_unsuspend and
+           ! $options{'from_cancel'} ) {
+
+        # register the need to charge a fee, cust_main->bill will do the rest
+        warn "registering suspend fee: pkgnum ".$self->pkgnum.", feepart ".$reason->feepart."\n"
+          if $DEBUG;
+        my $cust_pkg_reason_fee = FS::cust_pkg_reason_fee->new({
+            'pkgreasonnum'  => $cust_pkg_reason->num,
+            'pkgnum'        => $self->pkgnum,
+            'feepart'       => $reason->feepart,
+            'nextbill'      => $reason->fee_hold,
+        });
+        $error ||= $cust_pkg_reason_fee->insert;
+      }
+    }
+

     my $conf = new FS::Conf;
     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),
  
       my $error = send_email(
         'from'    => $conf->config('invoice_from', $self->cust_main->agentnum),


@@ -1434,6 +1536,21 @@ are mandatory.
 
 =cut
 
 
 =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) = @_;
 sub credit_remaining {
   # Add a credit for remaining service
   my ($self, $mode, $time) = @_;


@@ -1450,7 +1567,23 @@ sub credit_remaining {
       and $next_bill > 0      # the package has a next bill date
       and $next_bill >= $time # which is in the future
   ) {
       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 $remaining_value = 0;
+
+    my $remain_pkg = $self;
+    $remaining_value = $remain_pkg->calc_remain('time' => $time);
+
+    # 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);
+    }
+

     if ( $remaining_value > 0 ) {
       warn "Crediting for $remaining_value on package ".$self->pkgnum."\n"
         if $DEBUG;
     if ( $remaining_value > 0 ) {
       warn "Crediting for $remaining_value on package ".$self->pkgnum."\n"
         if $DEBUG;


@@ -1594,19 +1727,46 @@ sub unsuspend {
 
   my $conf = new FS::Conf;
 
 
   my $conf = new FS::Conf;
 

-  $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
-    if $inactive > 0
+  # 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)
        )
     && ( $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'}
-  ;
+  ) {
+    $adjust_bill = 1;
+  }
+
+  # 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 ( $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'} = '';
   $hash{'adjourn'} = '' if $hash{'adjourn'} and $hash{'adjourn'} < time;
 
   $hash{'susp'} = '';
   $hash{'adjourn'} = '' if $hash{'adjourn'} and $hash{'adjourn'} < time;


@@ -1620,23 +1780,39 @@ sub unsuspend {
 
   my $unsusp_pkg;
 
 
   my $unsusp_pkg;
 

-  if ( $reason && $reason->unsuspend_pkgpart ) {
-    my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart)
-      or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart.
-                  " not found.";
-    my $start_date = $self->cust_main->next_bill_date 
-      if $reason->unsuspend_hold;
-
-    if ( $part_pkg ) {
-      $unsusp_pkg = FS::cust_pkg->new({
-          'custnum'     => $self->custnum,
-          'pkgpart'     => $reason->unsuspend_pkgpart,
-          'start_date'  => $start_date,
-          'locationnum' => $self->locationnum,
-          # discount? probably not...
+  if ( $reason ) {
+    if ( $reason->unsuspend_pkgpart ) {
+      #warn "Suspend reason '".$reason->reason."' uses deprecated unsuspend_pkgpart feature.\n"; # in 4.x
+      my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart)
+        or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart.
+                    " not found.";
+      my $start_date = $self->cust_main->next_bill_date 
+        if $reason->unsuspend_hold;
+
+      if ( $part_pkg ) {
+        $unsusp_pkg = FS::cust_pkg->new({
+            'custnum'     => $self->custnum,
+            'pkgpart'     => $reason->unsuspend_pkgpart,
+            'start_date'  => $start_date,
+            'locationnum' => $self->locationnum,
+            # discount? probably not...
+        });
+
+        $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg );
+      }
+    }
+    # new way, using fees
+    if ( $reason->feepart and $reason->fee_on_unsuspend ) {
+      # register the need to charge a fee, cust_main->bill will do the rest
+      warn "registering unsuspend fee: pkgnum ".$self->pkgnum.", feepart ".$reason->feepart."\n"
+        if $DEBUG;
+      my $cust_pkg_reason_fee = FS::cust_pkg_reason_fee->new({
+          'pkgreasonnum'  => $cust_pkg_reason->num,
+          'pkgnum'        => $self->pkgnum,
+          'feepart'       => $reason->feepart,
+          'nextbill'      => $reason->fee_hold,

       });
       });

-      
-      $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg );
+      $error ||= $cust_pkg_reason_fee->insert;

     }
 
     if ( $error ) {
     }
 
     if ( $error ) {


@@ -1837,6 +2013,40 @@ sub change {
 
   my $error;
 
 
   my $error;
 

+  if ( $opt->{'cust_location'} ) {
+    $error = $opt->{'cust_location'}->find_or_insert;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "creating location record: $error";
+    }
+    $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
+  }
+
+  # Before going any further here: if the package is still in the pre-setup
+  # state, it's safe to modify it in place. No need to charge/credit for 
+  # partial period, transfer services, transfer usage pools, copy invoice
+  # details, or change any dates.
+  if ( ! $self->setup and ! $opt->{cust_pkg} and ! $opt->{cust_main} ) {
+    foreach ( qw( locationnum pkgpart quantity refnum salesnum ) ) {
+      if ( length($opt->{$_}) ) {
+        $self->set($_, $opt->{$_});
+      }
+    }
+    # almost. if the new pkgpart specifies start/adjourn/expire timers, 
+    # apply those.
+    if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) {
+      $self->set_initial_timers;
+    }
+    $error = $self->replace;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "modifying package: $error";
+    } else {
+      $dbh->commit if $oldAutoCommit;
+      return $self;
+    }
+  }
+

   my %hash = (); 
 
   my $time = time;
   my %hash = (); 
 
   my $time = time;


@@ -1847,15 +2057,6 @@ sub change {
   $hash{"change_$_"}  = $self->$_()
     foreach qw( pkgnum pkgpart locationnum );
 
   $hash{"change_$_"}  = $self->$_()
     foreach qw( pkgnum pkgpart locationnum );
 

-  if ( $opt->{'cust_location'} ) {
-    $error = $opt->{'cust_location'}->find_or_insert;
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return "creating location record: $error";
-    }
-    $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
-  }
-

   if ( $opt->{'cust_pkg'} ) {
     # treat changing to a package with a different pkgpart as a 
     # pkgpart change (because it is)
   if ( $opt->{'cust_pkg'} ) {
     # treat changing to a package with a different pkgpart as a 
     # pkgpart change (because it is)


@@ -1870,6 +2071,7 @@ sub change {
 
   my $unused_credit = 0;
   my $keep_dates = $opt->{'keep_dates'};
 
   my $unused_credit = 0;
   my $keep_dates = $opt->{'keep_dates'};

+

   # Special case.  If the pkgpart is changing, and the customer is
   # going to be credited for remaining time, don't keep setup, bill, 
   # or last_bill dates, and DO pass the flag to cancel() to credit 
   # 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 


@@ -1883,14 +2085,15 @@ sub change {
   }
 
   if ( $keep_dates ) {
   }
 
   if ( $keep_dates ) {

-    foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire 
-                          resume start_date contract_end ) ) {
+    foreach my $date ( qw(setup bill last_bill) ) {

       $hash{$date} = $self->getfield($date);
     }
   }
       $hash{$date} = $self->getfield($date);
     }
   }

-  # always keep this date, regardless of anything
-  # (the date of the package change is in a different field)
-  $hash{'order_date'} = $self->getfield('order_date');
+  # always keep the following dates
+  foreach my $date (qw(order_date susp adjourn cancel expire resume 
+                    start_date contract_end)) {
+    $hash{$date} = $self->getfield($date);
+  }

 
   # allow $opt->{'locationnum'} = '' to specifically set it to null
   # (i.e. customer default location)
 
   # allow $opt->{'locationnum'} = '' to specifically set it to null
   # (i.e. customer default location)


@@ -1902,6 +2105,9 @@ sub change {
   # 2. (more importantly) changing a package before it's billed
   $hash{'waive_setup'} = $self->waive_setup;
 
   # 2. (more importantly) changing a package before it's billed
   $hash{'waive_setup'} = $self->waive_setup;
 

+  # if this package is scheduled for a future package change, preserve that
+  $hash{'change_to_pkgnum'} = $self->change_to_pkgnum;
+

   my $custnum = $self->custnum;
   if ( $opt->{cust_main} ) {
     my $cust_main = $opt->{cust_main};
   my $custnum = $self->custnum;
   if ( $opt->{cust_main} ) {
     my $cust_main = $opt->{cust_main};


@@ -1923,10 +2129,15 @@ sub change {
     # changed from this package.
     $cust_pkg = $opt->{'cust_pkg'};
 
     # changed from this package.
     $cust_pkg = $opt->{'cust_pkg'};
 

-    foreach ( qw( pkgnum pkgpart locationnum ) ) {
-      $cust_pkg->set("change_$_", $self->get($_));
+    # follow all the above rules for date changes, etc.
+    foreach (keys %hash) {
+      $cust_pkg->set($_, $hash{$_});

     }
     }

-    $cust_pkg->set('change_date', $time);
+    # except those that implement the future package change behavior
+    foreach (qw(change_to_pkgnum start_date expire)) {
+      $cust_pkg->set($_, '');
+    }
+

     $error = $cust_pkg->replace;
 
   } else {
     $error = $cust_pkg->replace;
 
   } else {


@@ -1948,7 +2159,9 @@ sub change {
   }
 
   # Transfer services and cancel old package.
   }
 
   # 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.
   $error = $self->transfer($cust_pkg);
   if ($error and $error == 0) {
     # $old_pkg->transfer failed.


@@ -2104,6 +2317,7 @@ sub change {
     unused_credit  => $unused_credit,
     nobill         => $keep_dates,
     change_custnum => ( $self->custnum != $custnum ? $custnum : '' ),
     unused_credit  => $unused_credit,
     nobill         => $keep_dates,
     change_custnum => ( $self->custnum != $custnum ? $custnum : '' ),

+    no_delay_cancel => 1,

   );
   if ($error) {
     $dbh->rollback if $oldAutoCommit;
   );
   if ($error) {
     $dbh->rollback if $oldAutoCommit;


@@ -2201,8 +2415,10 @@ sub change_later {
 
         $error = $self->replace       ||
                  $err_or_pkg->replace ||
 
         $error = $self->replace       ||
                  $err_or_pkg->replace ||

-                 $change_to->cancel   ||
-                 $change_to->delete;
+                 #because change() might've edited existing scheduled change in place
+                 (($err_or_pkg->pkgnum == $change_to->pkgnum) ? '' :
+                  $change_to->cancel('no_delay_cancel' => 1) ||
+                  $change_to->delete);

       } else {
         $error = $err_or_pkg;
       }
       } else {
         $error = $err_or_pkg;
       }


@@ -2321,6 +2537,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
 - 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.
 
 If you pass 'adjust_commission' => 1, and the classnum changes, and there are
 commission credits linked to this charge, they will be recalculated.


@@ -2376,29 +2593,52 @@ sub modify_charge {
   }
 
   if ( !$self->get('setup') ) {
   }
 
   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{'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{'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;
+    if ( exists($opt{'separate_bill'})
+          and $opt{'separate_bill'} ne $self->separate_bill ) {

 
 

+      $self->set('separate_bill', $opt{'separate_bill'});

     }
     }

+
+

   } # else simply ignore them; the UI shouldn't allow editing the fields
 
   } # else simply ignore them; the UI shouldn't allow editing the fields
 

+  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?
   my $error;
   if ( $part_pkg->modified or $pkg_opt_modified ) {
     # can we safely modify the package def?


@@ -3228,7 +3468,7 @@ Class method that returns the list of possible status strings for packages
 =cut
 
 tie my %statuscolor, 'Tie::IxHash', 
 =cut
 
 tie my %statuscolor, 'Tie::IxHash', 

-  'on hold'         => '7E0079', #purple!
+  'on hold'         => 'FF00F5', #brighter purple!

   'not yet billed'  => '009999', #teal? cyan?
   'one-time charge' => '0000CC', #blue  #'000000',
   'active'          => '00CC00',
   'not yet billed'  => '009999', #teal? cyan?
   'one-time charge' => '0000CC', #blue  #'000000',
   'active'          => '00CC00',


@@ -3259,6 +3499,40 @@ sub statuscolor {
   $statuscolor{$self->status};
 }
 
   $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.
+
+Accepts option I<part_pkg-delay_cancel-days> which should be
+the value of the config setting, to avoid looking it up again.
+
+This is not a real status, this only meant for hacking display 
+values, because otherwise treating the package as suspended is 
+really the whole point of the delay_cancel option.
+
+=cut
+
+sub is_status_delay_cancel {
+  my ($self,%opt) = @_;
+  if ( $self->main_pkgnum and $self->pkglinknum ) {
+    return $self->main_pkg->is_status_delay_cancel;
+  }
+  return 0 unless $self->part_pkg->option('delay_cancel',1);
+  return 0 unless $self->status eq 'suspended';
+  return 0 unless $self->expire;
+  my $expdays = $opt{'part_pkg-delay_cancel-days'};
+  unless ($expdays) {
+    my $conf = new FS::Conf;
+    $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
+  }
+  my $expsecs = 60*60*24*$expdays;
+  return 0 unless $self->expire < time + $expsecs;
+  return 1;
+}
+

 =item pkg_label
 
 Returns a label for this package.  (Currently "pkgnum: pkg - comment" or
 =item pkg_label
 
 Returns a label for this package.  (Currently "pkgnum: pkg - comment" or


@@ -3451,6 +3725,7 @@ Returns the parent customer object (see L<FS::cust_main>).
 
 sub cust_main {
   my $self = shift;
 
 sub cust_main {
   my $self = shift;

+  cluck 'cust_pkg->cust_main called' if $DEBUG;

   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 }
 
   qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 }
 


@@ -3912,7 +4187,7 @@ sub insert_reason {
     $reasonnum = $reason->reasonnum;
 
   } else {
     $reasonnum = $reason->reasonnum;
 
   } else {

-    return "Unparsable reason: ". $options{'reason'};
+    return "Unparseable reason: ". $options{'reason'};

   }
 
   my $cust_pkg_reason =
   }
 
   my $cust_pkg_reason =


@@ -4479,6 +4754,15 @@ 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.
 
 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.
 

+=item 477part, 477rownum, date
+
+Limit to packages included in a specific row of one of the FCC 477 reports.
+'477part' is the section name (see L<FS::Report::FCC_477> methods), 'date'
+is the report as-of date (completely unrelated to the package setup/bill/
+other date fields), and '477rownum' is the row number of the report starting
+with zero. Row numbers have no inherent meaning, so this is useful only 
+for explaining a 477 report you've already run.
+

 =back
 
 =cut
 =back
 
 =cut


@@ -4633,6 +4917,21 @@ sub search {
   }
 
   ###
   }
 
   ###

+  # parse refnum (advertising source)
+  ###
+
+  if ( exists($params->{'refnum'}) ) {
+    my @refnum;
+    if (ref $params->{'refnum'}) {
+      @refnum = @{ $params->{'refnum'} };
+    } else {
+      @refnum = ( $params->{'refnum'} );
+    }
+    my $in = join(',', grep /^\d+$/, @refnum);
+    push @where, "refnum IN($in)" if length $in;
+  }
+
+  ###

   # parse package report options
   ###
 
   # parse package report options
   ###
 


@@ -4901,6 +5200,39 @@ sub search {
   }
 
   ##
   }
 
   ##

+  # parse the 477 report drill-down options
+  ##
+
+  if ($params->{'477part'} =~ /^([a-z]+)$/) {
+    my $section = $1;
+    my ($date, $rownum, $agentnum);
+    if ($params->{'date'} =~ /^(\d+)$/) {
+      $date = $1;
+    }
+    if ($params->{'477rownum'} =~ /^(\d+)$/) {
+      $rownum = $1;
+    }
+    if ($params->{'agentnum'} =~ /^(\d+)$/) {
+      $agentnum = $1;
+    }
+    if ($date and defined($rownum)) {
+      my $report = FS::Report::FCC_477->report($section,
+        'date'      => $date,
+        'agentnum'  => $agentnum,
+        'detail'    => 1
+      );
+      my $pkgnums = $report->{detail}->[$rownum]
+        or die "row $rownum is past the end of the report";
+        # '0' so that if there are no pkgnums (empty string) it will create
+        # a valid query that returns nothing
+      warn "PKGNUMS:\n$pkgnums\n\n"; # XXX debug
+
+      # and this overrides everything
+      @where = ( "cust_pkg.pkgnum IN($pkgnums)" );
+    } # else we're missing some params, ignore the whole business
+  }
+
+  ##

   # setup queries, links, subs, etc. for the search
   ##
 
   # setup queries, links, subs, etc. for the search
   ##
 


@@ -5121,6 +5453,9 @@ sub _X_show_zero {
 
 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
 
 
 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
 

+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
 CUSTNUM is a customer (see L<FS::cust_main>)
 
 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see


@@ -5264,7 +5599,7 @@ sub order {
       $dbh->rollback if $oldAutoCommit;
       return "Unable to transfer all services from package ".$old_pkg->pkgnum;
     }
       $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;
     if ($error) {
       $dbh->rollback;
       return $error;


@@ -5334,6 +5669,78 @@ sub bulk_change {
   '';
 }
 
   '';
 }
 

+=item forward_emails
+
+Returns a hash of svcnums and corresponding email addresses
+for svc_acct services that can be used as source or dest
+for svc_forward services provisioned in this package.
+
+Accepts options I<svc_forward> OR I<svcnum> for a svc_forward
+service;  if included, will ensure the current values of the
+specified service are included in the list, even if for some
+other reason they wouldn't be.  If called as a class method
+with a specified service, returns only these current values.
+
+Caution: does not actually check if svc_forward services are
+available to be provisioned on this package.
+
+=cut
+
+sub forward_emails {
+  my $self = shift;
+  my %opt = @_;
+
+  #load optional service, thoroughly validated
+  die "Use svcnum or svc_forward, not both"
+    if $opt{'svcnum'} && $opt{'svc_forward'};
+  my $svc_forward = $opt{'svc_forward'};
+  $svc_forward ||= qsearchs('svc_forward',{ 'svcnum' => $opt{'svcnum'} })
+    if $opt{'svcnum'};
+  die "Specified service is not a forward service"
+    if $svc_forward && (ref($svc_forward) ne 'FS::svc_forward');
+  die "Specified service not found"
+    if ($opt{'svcnum'} || $opt{'svc_forward'}) && !$svc_forward;
+
+  my %email;
+
+  ## everything below was basically copied from httemplate/edit/svc_forward.cgi 
+  ## with minimal refactoring, not sure why we can't just load all svc_accts for this custnum
+
+  #add current values from specified service, if there was one
+  if ($svc_forward) {
+    foreach my $method (qw( srcsvc_acct dstsvc_acct )) {
+      my $svc_acct = $svc_forward->$method();
+      $email{$svc_acct->svcnum} = $svc_acct->email if $svc_acct;
+    }
+  }
+
+  if (ref($self) eq 'FS::cust_pkg') {
+
+    #and including the rest for this customer
+    my($u_part_svc,@u_acct_svcparts);
+    foreach $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) {
+      push @u_acct_svcparts,$u_part_svc->getfield('svcpart');
+    }
+
+    my $custnum = $self->getfield('custnum');
+    foreach my $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
+      my $cust_pkgnum = $i_cust_pkg->getfield('pkgnum');
+      #now find the corresponding record(s) in cust_svc (for this pkgnum!)
+      foreach my $acct_svcpart (@u_acct_svcparts) {
+        foreach my $i_cust_svc (
+          qsearch( 'cust_svc', { 'pkgnum'  => $cust_pkgnum,
+                                 'svcpart' => $acct_svcpart } )
+        ) {
+          my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $i_cust_svc->svcnum } );
+          $email{$svc_acct->svcnum} = $svc_acct->email;
+        }  
+      }
+    }
+  }
+
+  return %email;
+}
+

 # Used by FS::Upgrade to migrate to a new database.
 sub _upgrade_data {  # class method
   my ($class, %opts) = @_;
 # Used by FS::Upgrade to migrate to a new database.
 sub _upgrade_data {  # class method
   my ($class, %opts) = @_;


@@ -5357,6 +5764,23 @@ sub _upgrade_data {  # class method
     my $sth = dbh->prepare($sql);
     $sth->execute or die $sth->errstr;
   }
     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
 }
 
 =back