automatic package changes for supplemental packages, #37102

4 files changed, 164 insertions, 38 deletions

diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index 24ca858..7e5f8e1 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -3197,6 +3197,10 @@ sub tables_hashref {
         'delay_start',   'int',     'NULL', '', '', '',
         'start_on_hold', 'char',    'NULL',  1, '', '',
         'agent_pkgpartid', 'varchar', 'NULL', 20, '', '',
+        'expire_months', 'int',     'NULL', '', '', '',
+        'adjourn_months', 'int',    'NULL', '', '', '',
+        'contract_end_months','int','NULL', '', '', '',
+        'change_to_pkgpart', 'int', 'NULL', '', '', '',
       ],
       'primary_key'  => 'pkgpart',
       'unique'       => [],
@@ -3225,6 +3229,10 @@ sub tables_hashref {
                             table      => 'part_pkg',
                             references => [ 'pkgpart' ],
                           },
+                          { columns    => [ 'change_to_pkgpart' ],
+                            table      => 'part_pkg',
+                            references => [ 'pkgpart' ],
+                          },
                         ],
     },
 
diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 950d348..fbecd8d 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -251,19 +251,53 @@ or contract_end timers to some number of months after the start date
 a delayed setup fee after a period of "free days", will also set the 
 start date to the end of that period.
 
+If the package has an automatic transfer rule (C<change_to_pkgnum>), then
+this will also order the package and set its start date.
+
 =cut
 
 sub set_initial_timers {
   my $self = shift;
   my $part_pkg = $self->part_pkg;
+  my $start = $self->start_date || $self->setup || time;
+
   foreach my $action ( qw(expire adjourn contract_end) ) {
-    my $months = $part_pkg->option("${action}_months",1);
+    my $months = $part_pkg->get("${action}_months");
     if($months and !$self->get($action)) {
-      my $start = $self->start_date || $self->setup || time;
       $self->set($action, $part_pkg->add_freq($start, $months) );
     }
   }
 
+  # if this package has an expire date and a change_to_pkgpart, set automatic
+  # package transfer
+  # (but don't call change_later, as that would call $self->replace, and we're
+  # probably in the middle of $self->insert right now)
+  if ( $part_pkg->expire_months and $part_pkg->change_to_pkgpart ) {
+    if ( $self->change_to_pkgnum ) {
+      # this can happen if a package is ordered on hold, scheduled for a 
+      # future change _while on hold_, and then released from hold, causing
+      # the automatic transfer to schedule.
+      #
+      # what's correct behavior in that case? I think it's to disallow
+      # future-changing an on-hold package that has an automatic transfer.
+      # but if we DO get into this situation, let the manual package change
+      # win.
+      warn "pkgnum ".$self->pkgnum.": manual future package change blocks ".
+           "automatic transfer.\n";
+    } else {
+      my $change_to = FS::cust_pkg->new( {
+          start_date  => $self->get('expire'),
+          pkgpart     => $part_pkg->change_to_pkgpart,
+          map { $_ => $self->get($_) }
+            qw( custnum locationnum quantity refnum salesnum contract_end )
+      } );
+      my $error = $change_to->insert;
+
+      return $error if $error;
+      $self->set('change_to_pkgnum', $change_to->pkgnum);
+    }
+  }
+
   # if this package has "free days" and delayed setup fee, then
   # set start date that many days in the future.
   # (this should have been set in the UI, but enforce it here)
@@ -273,6 +307,7 @@ sub set_initial_timers {
   {
     $self->start_date( $part_pkg->default_start_date );
   }
+
   '';
 }
 
@@ -332,9 +367,12 @@ a location change).
 sub insert {
   my( $self, %options ) = @_;
 
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
   my $error;
   $error = $self->check_pkgpart unless $options{'allow_pkgpart'};
-  return $error if $error;
 
   my $part_pkg = $self->part_pkg;
 
@@ -359,15 +397,12 @@ sub insert {
       $self->set('start_date', '');
     } else {
       # set expire/adjourn/contract_end timers, and free days, if appropriate
-      $self->set_initial_timers;
+      # and automatic package transfer, which can fail, so capture the result
+      $error = $self->set_initial_timers;
     }
   } # else this is a package change, and shouldn't have "new package" behavior
 
-  my $oldAutoCommit = $FS::UID::AutoCommit;
-  local $FS::UID::AutoCommit = 0;
-  my $dbh = dbh;
-
-  $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
+  $error ||= $self->SUPER::insert($options{options} ? %{$options{options}} : ());
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
@@ -461,9 +496,26 @@ hide cancelled packages.
 
 =cut
 
+# this is still used internally to abort future package changes, so it 
+# does need to work
+
 sub delete {
   my $self = shift;
 
+  # The following foreign keys to cust_pkg are not cleaned up here, and will
+  # cause package deletion to fail:
+  #
+  # cust_credit.pkgnum and commission_pkgnum (and cust_credit_void)
+  # cust_credit_bill.pkgnum
+  # cust_pay_pending.pkgnum
+  # cust_pay.pkgnum (and cust_pay_void)
+  # cust_bill_pay.pkgnum (wtf, shouldn't reference pkgnum)
+  # cust_pkg_usage.pkgnum
+  # cust_pkg.uncancel_pkgnum, change_pkgnum, main_pkgnum, and change_to_pkgnum
+
+  # cust_svc is handled by canceling the package before deleting it
+  # cust_pkg_option is handled via option_Common
+
   my $oldAutoCommit = $FS::UID::AutoCommit;
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
@@ -499,7 +551,13 @@ sub delete {
     }
   }
 
-  #pkg_referral?
+  foreach my $pkg_referral ( $self->pkg_referral ) {
+    my $error = $pkg_referral->delete;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
 
   my $error = $self->SUPER::delete(@_);
   if ( $error ) {
@@ -807,12 +865,15 @@ sub cancel {
   my( $self, %options ) = @_;
   my $error;
 
-  # pass all suspend/cancel actions to the main package
-  # (unless the pkglinknum has been removed, then the link is defunct and
-  # this package can be canceled on its own)
-  if ( $self->main_pkgnum and $self->pkglinknum and !$options{'from_main'} ) {
-    return $self->main_pkg->cancel(%options);
-  }
+  # supplemental packages can now be separately canceled, though the UI
+  # shouldn't permit it
+  #
+  ## pass all suspend/cancel actions to the main package
+  ## (unless the pkglinknum has been removed, then the link is defunct and
+  ## this package can be canceled on its own)
+  #if ( $self->main_pkgnum and $self->pkglinknum and !$options{'from_main'} ) {
+  #  return $self->main_pkg->cancel(%options);
+  #}
 
   my $conf = new FS::Conf;
 
@@ -936,8 +997,14 @@ sub cancel {
     $hash{main_pkgnum} = '';
   }
 
+  # if there is a future package change scheduled, unlink from it (like
+  # abort_change) first, then delete it.
+  $hash{'change_to_pkgnum'} = '';
+
+  # save the package state
   my $new = new FS::cust_pkg ( \%hash );
   $error = $new->replace( $self, options => { $self->options } );
+
   if ( $self->change_to_pkgnum ) {
     my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
     $error ||= $change_to->cancel('no_delay_cancel' => 1) || $change_to->delete;
@@ -1285,9 +1352,13 @@ sub suspend {
   my( $self, %options ) = @_;
   my $error;
 
-  # pass all suspend/cancel actions to the main package
+  # supplemental packages still can't be separately suspended, but silently
+  # exit instead of failing or passing the action to the main package (so
+  # that the "Suspend customer" action doesn't trip over the supplemental
+  # packages and die)
+
   if ( $self->main_pkgnum and !$options{'from_main'} ) {
-    return $self->main_pkg->suspend(%options);
+    return;
   }
 
   my $oldAutoCommit = $FS::UID::AutoCommit;
@@ -1659,7 +1730,11 @@ sub unsuspend {
 
   if (!$self->setup) {
     # then this package is being released from on-hold status
-    $self->set_initial_timers;
+    $error = $self->set_initial_timers;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
   }
 
   my @labels = ();
@@ -2034,12 +2109,12 @@ sub change {
     # 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->set_initial_timers;
     }
     # but if contract_end was explicitly specified, that overrides all else
     $self->set('contract_end', $opt->{'contract_end'})
       if $opt->{'contract_end'};
-    $error = $self->replace;
+    $error ||= $self->replace;
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
       return "modifying package: $error";
@@ -2509,16 +2584,28 @@ Cancels a future package change scheduled by C<change_later>.
 
 sub abort_change {
   my $self = shift;
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+
   my $pkgnum = $self->change_to_pkgnum;
   my $change_to = FS::cust_pkg->by_key($pkgnum) if $pkgnum;
   my $error;
-  if ( $change_to ) {
-    $error = $change_to->cancel || $change_to->delete;
-    return $error if $error;
-  }
   $self->set('change_to_pkgnum', '');
   $self->set('expire', '');
-  $self->replace;
+  $error = $self->replace;
+  if ( $change_to ) {
+    $error ||= $change_to->cancel || $change_to->delete;
+  }
+
+  if ( $oldAutoCommit ) {
+    if ( $error ) {
+      dbh->rollback;
+    } else {
+      dbh->commit;
+    }
+  }
+
+  return $error;
 }
 
 =item set_quantity QUANTITY
diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm
index 0e9ee05..498da8a 100644
--- a/FS/FS/part_pkg.pm
+++ b/FS/FS/part_pkg.pm
@@ -127,6 +127,18 @@ part_pkg, will be equal to pkgpart.
 ordered. The package will not start billing or have a setup fee charged 
 until it is manually unsuspended.
 
+=item change_to_pkgpart - When this package is ordered, schedule a future 
+package change. The 'expire_months' field will determine when the package
+change occurs.
+
+=item expire_months - Number of months until this package expires (or changes
+to another package).
+
+=item adjourn_months - Number of months until this package becomes suspended.
+
+=item contract_end_months - Number of months until the package's contract 
+ends.
+
 =back
 
 =head1 METHODS
@@ -722,6 +734,11 @@ sub check {
     || $self->ut_numbern('delay_start')
     || $self->ut_foreign_keyn('successor', 'part_pkg', 'pkgpart')
     || $self->ut_foreign_keyn('family_pkgpart', 'part_pkg', 'pkgpart')
+    || $self->ut_numbern('expire_months')
+    || $self->ut_numbern('adjourn_months')
+    || $self->ut_numbern('contract_end_months')
+    || $self->ut_numbern('change_to_pkgpart')
+    || $self->ut_foreign_keyn('change_to_pkgpart', 'part_pkg', 'pkgpart')
     || $self->ut_alphan('agent_pkgpartid')
     || $self->SUPER::check
   ;
@@ -1696,6 +1713,19 @@ for this package.
 Returns the voice usage pools (see L<FS::part_pkg_usage>) defined for 
 this package.
 
+=item change_to_pkg
+
+Returns the automatic transfer target for this package, or an empty string
+if there isn't one.
+
+=cut
+
+sub change_to_pkg {
+  my $self = shift;
+  my $pkgpart = $self->change_to_pkgpart or return '';
+  FS::part_pkg->by_key($pkgpart);
+}
+
 =item _rebless
 
 Reblesses the object into the FS::part_pkg::PLAN class (if available), where
@@ -2202,6 +2232,19 @@ sub queueable_upgrade {
     FS::upgrade_journal->set_done($upgrade);
   }
 
+  # migrate adjourn_months, expire_months, and contract_end_months to 
+  # real fields
+  foreach my $field (qw(adjourn_months expire_months contract_end_months)) {
+    foreach my $option (qsearch('part_pkg_option', { optionname => $field })) {
+      my $part_pkg = $option->part_pkg;
+      my $error = $option->delete;
+      if ( $option->optionvalue and $part_pkg->get($field) eq '' ) {
+        $part_pkg->set($field, $option->optionvalue);
+        $error ||= $part_pkg->replace;
+      }
+      die $error if $error;
+    }
+  }
 }
 
 =item curuser_pkgs_sql
diff --git a/FS/FS/part_pkg/flat.pm b/FS/FS/part_pkg/flat.pm
index eb70253..d11b99b 100644
--- a/FS/FS/part_pkg/flat.pm
+++ b/FS/FS/part_pkg/flat.pm
@@ -34,16 +34,6 @@ tie my %contract_years, 'Tie::IxHash', (
                              'select_options' => \%temporalities,
                            },
 
-    #used in cust_pkg.pm so could add to any price plan
-    'expire_months' => { 'name' => 'Auto-add an expiration date this number of months out',
-                       },
-    'adjourn_months'=> { 'name' => 'Auto-add a suspension date this number of months out',
-                       },
-    'contract_end_months'=> { 
-                        'name' => 'Auto-add a contract end date this number of years out',
-                        'type' => 'select',
-                        'select_options' => \%contract_years,
-                      },
     #used in cust_pkg.pm so could add to any price plan where it made sense
     'start_1st'     => { 'name' => 'Auto-add a start date to the 1st, ignoring the current month.',
                          'type' => 'checkbox',
@@ -85,8 +75,6 @@ tie my %contract_years, 'Tie::IxHash', (
                     },
   },
   'fieldorder' => [ qw( recur_temporality 
-                        expire_months adjourn_months
-                        contract_end_months
                         start_1st
                         sync_bill_date prorate_defer_bill prorate_round_day
                         suspend_bill unsuspend_adjust_bill