historical package definition feature, part 1, #16824

diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index 2bc1f19..ee7f2b4 100644 (file)
--- a/FS/FS/Conf.pm
+++ b/FS/FS/Conf.pm
@@ -694,6 +694,13 @@ sub reason_type_options {
   },
 
   {
   },
 
   {

+    'key'         => 'part_pkg-lineage',
+    'section'     => '',
+    'description' => 'When editing a package definition, if setup or recur fees are changed, create a new package rather than changing the existing package.',
+    'type'        => 'checkbox',
+  },
+
+  {

     'key'         => 'apacheip',
     #not actually deprecated yet
     #'section'     => 'deprecated',
     'key'         => 'apacheip',
     #not actually deprecated yet
     #'section'     => 'deprecated',

diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index ab853e6..9b21dfc 100644 (file)
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -1690,6 +1690,8 @@ sub tables_hashref {
         'no_auto',          'char', 'NULL',  1, '', '', 
         'recur_show_zero',  'char', 'NULL',  1, '', '',
         'setup_show_zero',  'char', 'NULL',  1, '', '',
         'no_auto',          'char', 'NULL',  1, '', '', 
         'recur_show_zero',  'char', 'NULL',  1, '', '',
         'setup_show_zero',  'char', 'NULL',  1, '', '',

+        'successor',     'int',     'NULL', '', '', '',
+        'family_pkgpart','int',     'NULL', '', '', '',

       ],
       'primary_key' => 'pkgpart',
       'unique' => [],
       ],
       'primary_key' => 'pkgpart',
       'unique' => [],

diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm
index 373982b..061001b 100644 (file)
--- a/FS/FS/part_pkg.pm
+++ b/FS/FS/part_pkg.pm
@@ -103,6 +103,13 @@ inherits from FS::Record.  The following fields are currently supported:
 
 =item fcc_ds0s - Optional DS0 equivalency number for FCC form 477
 
 
 =item fcc_ds0s - Optional DS0 equivalency number for FCC form 477
 

+=item successor - Foreign key for the part_pkg that replaced this record.
+If this record is not obsolete, will be null.
+
+=item family_pkgpart - Foreign key for the part_pkg that was the earliest
+ancestor of this record.  If this record is not a successor to another 
+part_pkg, will be equal to pkgpart.
+

 =back
 
 =head1 METHODS
 =back
 
 =head1 METHODS


@@ -192,6 +199,16 @@ sub insert {
     return $error;
   }
 
     return $error;
   }
 

+  # set family_pkgpart
+  if ( $self->get('family_pkgpart') eq '' ) {
+    $self->set('family_pkgpart' => $self->pkgpart);
+    $error = $self->SUPER::replace;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+

   my $conf = new FS::Conf;
   if ( $conf->exists('agent_defaultpkg') ) {
     warn "  agent_defaultpkg set; allowing all agents to purchase package"
   my $conf = new FS::Conf;
   if ( $conf->exists('agent_defaultpkg') ) {
     warn "  agent_defaultpkg set; allowing all agents to purchase package"


@@ -294,7 +311,7 @@ sub insert {
       }
   }
 
       }
   }
 

-  warn "  commiting transaction" if $DEBUG;
+  warn "  committing transaction" if $DEBUG and $oldAutoCommit;

   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   '';
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   '';


@@ -360,6 +377,28 @@ sub replace {
   my $oldAutoCommit = $FS::UID::AutoCommit;
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
   my $oldAutoCommit = $FS::UID::AutoCommit;
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;

+  
+  my $conf = new FS::Conf;
+  if ( $conf->exists('part_pkg-lineage') ) {
+    if ( grep { $options->{options}->{$_} ne $old->option($_, 1) }
+          qw(setup_fee recur_fee) #others? config?
+        ) { 
+    
+      warn "  superseding package" if $DEBUG;
+
+      my $error = $new->supersede($old, %$options);
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $error;
+      }
+      else {
+        warn "  committing transaction" if $DEBUG and $oldAutoCommit;
+        $dbh->commit if $oldAutoCommit;
+        return $error;
+      }
+    }
+    #else nothing
+  }

 
   #plandata shit stays in replace for upgrades until after 2.0 (or edit
   #_upgrade_data)
 
   #plandata shit stays in replace for upgrades until after 2.0 (or edit
   #_upgrade_data)


@@ -501,8 +540,18 @@ sub replace {
         }
       }
   }
         }
       }
   }

+  
+  # propagate changes to certain core fields
+  if ( $conf->exists('part_pkg-lineage') ) {
+    warn "  propagating changes to family" if $DEBUG;
+    my $error = $new->propagate($old);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }

 
 

-  warn "  commiting transaction" if $DEBUG;
+  warn "  committing transaction" if $DEBUG and $oldAutoCommit;

   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
 }
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
 }


@@ -573,6 +622,8 @@ sub check {
            : $self->ut_agentnum_acl('agentnum', \@null_agentnum_right)
        )
     || $self->ut_numbern('fcc_ds0s')
            : $self->ut_agentnum_acl('agentnum', \@null_agentnum_right)
        )
     || $self->ut_numbern('fcc_ds0s')

+    || $self->ut_foreign_keyn('successor', 'part_pkg', 'pkgpart')
+    || $self->ut_foreign_keyn('family_pkgpart', 'part_pkg', 'pkgpart')

     || $self->SUPER::check
   ;
   return $error if $error;
     || $self->SUPER::check
   ;
   return $error if $error;


@@ -587,6 +638,76 @@ sub check {
   '';
 }
 
   '';
 }
 

+=item supersede OLD [, OPTION => VALUE ... ]
+
+Inserts this package as a successor to the package OLD.  All options are as
+for C<insert>.  After inserting, disables OLD and sets the new package as its
+successor.
+
+=cut
+
+sub supersede {
+  my ($new, $old, %options) = @_;
+  my $error;
+
+  $new->set('pkgpart' => '');
+  $new->set('family_pkgpart' => $old->family_pkgpart);
+  warn "    inserting successor package\n" if $DEBUG;
+  $error = $new->insert(%options);
+  return $error if $error;
+ 
+  warn "    disabling superseded package\n" if $DEBUG; 
+  $old->set('successor' => $new->pkgpart);
+  $old->set('disabled' => 'Y');
+  $error = $old->SUPER::replace; # don't change its options/pkg_svc records
+  return $error if $error;
+
+  warn "  propagating changes to family" if $DEBUG;
+  $new->propagate($old);
+}
+
+=item propagate OLD
+
+If any of certain fields have changed from OLD to this package, then,
+for all packages in the same lineage as this one, sets those fields 
+to their values in this package.
+
+=cut
+
+my @propagate_fields = (
+  qw( pkg classnum setup_cost recur_cost taxclass
+  setuptax recurtax pay_weight credit_weight
+  )
+);
+
+sub propagate {
+  my $new = shift;
+  my $old = shift;
+  my %fields = (
+    map { $_ => $new->get($_) }
+    grep { $new->get($_) ne $old->get($_) }
+    @propagate_fields
+  );
+
+  my @part_pkg = qsearch('part_pkg', { 
+      'family_pkgpart' => $new->family_pkgpart 
+  });
+  my @error;
+  foreach my $part_pkg ( @part_pkg ) {
+    my $pkgpart = $part_pkg->pkgpart;
+    next if $pkgpart == $new->pkgpart; # don't modify $new
+    warn "    propagating to pkgpart $pkgpart\n" if $DEBUG;
+    foreach ( keys %fields ) {
+      $part_pkg->set($_, $fields{$_});
+    }
+    # SUPER::replace to avoid changing non-core fields
+    my $error = $part_pkg->SUPER::replace;
+    push @error, "pkgpart $pkgpart: $error"
+      if $error;
+  }
+  join("\n", @error);
+}
+

 =item pkg_comment [ OPTION => VALUE... ]
 
 Returns an (internal) string representing this package.  Currently,
 =item pkg_comment [ OPTION => VALUE... ]
 
 Returns an (internal) string representing this package.  Currently,


@@ -1277,7 +1398,7 @@ sub _rebless {
   }
   return $self if ref($self) =~ /::$plan$/; #already blessed into plan subclass
   my $class = ref($self). "::$plan";
   }
   return $self if ref($self) =~ /::$plan$/; #already blessed into plan subclass
   my $class = ref($self). "::$plan";

-  warn "reblessing $self into $class" if $DEBUG;
+  warn "reblessing $self into $class" if $DEBUG > 1;

   eval "use $class;";
   die $@ if $@;
   bless($self, $class) unless $@;
   eval "use $class;";
   die $@ if $@;
   bless($self, $class) unless $@;


@@ -1410,6 +1531,14 @@ sub _upgrade_data { # class method
     die $error if $error;
   }
 
     die $error if $error;
   }
 

+  # set family_pkgpart on any packages that don't have it
+  @part_pkg = qsearch('part_pkg', { 'family_pkgpart' => '' });
+  foreach my $part_pkg (@part_pkg) {
+    $part_pkg->set('family_pkgpart' => $part_pkg->pkgpart);
+    my $error = $part_pkg->SUPER::replace;
+    die $error if $error;
+  }
+

   my @part_pkg_option = qsearch('part_pkg_option',
     { 'optionname'  => 'unused_credit',
       'optionvalue' => 1,
   my @part_pkg_option = qsearch('part_pkg_option',
     { 'optionname'  => 'unused_credit',
       'optionvalue' => 1,

diff --git a/httemplate/browse/part_pkg.cgi b/httemplate/browse/part_pkg.cgi
index 7668060..4ca78d7 100755 (executable)
--- a/httemplate/browse/part_pkg.cgi
+++ b/httemplate/browse/part_pkg.cgi
@@ -45,6 +45,7 @@ my $select = '*';
 my $orderby = 'pkgpart';
 my %hash = ();
 my $extra_count = '';
 my $orderby = 'pkgpart';
 my %hash = ();
 my $extra_count = '';

+my $family_pkgpart;

 
 if ( $cgi->param('active') ) {
   $orderby = 'num_active DESC';
 
 if ( $cgi->param('active') ) {
   $orderby = 'num_active DESC';


@@ -77,6 +78,16 @@ if ( $cgi->param('missing_recur_fee') ) {
                     )";
 }
 
                     )";
 }
 

+if ( $cgi->param('family') =~ /^(\d+)$/ ) {
+  $family_pkgpart = $1;
+  push @where, "family_pkgpart = $1";
+  # Hiding disabled or one-time charges and limiting by classnum aren't 
+  # very useful in this mode, so all links should still refer back to the 
+  # non-family-limited display.
+  $cgi->param('showdisabled', 1);
+  $cgi->delete('family');
+}
+

 push @where, FS::part_pkg->curuser_pkgs_sql
   unless $acl_edit_global;
 
 push @where, FS::part_pkg->curuser_pkgs_sql
   unless $acl_edit_global;
 


@@ -209,6 +220,16 @@ push @fields, sub {
                   $part_pkg->part_pkg_discount;
 
   [
                   $part_pkg->part_pkg_discount;
 
   [

+    ( !$family_pkgpart &&
+      $part_pkg->pkgpart == $part_pkg->family_pkgpart ? () : [
+      {
+        'align'=> 'center',
+        'colspan' => 2,
+        'size' => '-1',
+        'data' => '<b>Show all versions</b>',
+        'link' => $p.'browse/part_pkg.cgi?family='.$part_pkg->family_pkgpart,
+      }
+    ] ),

     [
       { data =>$plan,
         align=>'center',
     [
       { data =>$plan,
         align=>'center',

diff --git a/httemplate/edit/part_pkg.cgi b/httemplate/edit/part_pkg.cgi
index e5edcde..cd07313 100755 (executable)
--- a/httemplate/edit/part_pkg.cgi
+++ b/httemplate/edit/part_pkg.cgi
@@ -24,6 +24,8 @@
               'error_callback'        => $error_callback,
               'field_callback'        => $field_callback,
 
               'error_callback'        => $error_callback,
               'field_callback'        => $field_callback,
 

+              'onsubmit'              => 'confirm_submit',
+

               'labels' => { 
                             'pkgpart'          => 'Package Definition',
                             'pkg'              => 'Package (customer-visible)',
               'labels' => { 
                             'pkgpart'          => 'Package Definition',
                             'pkg'              => 'Package (customer-visible)',


@@ -66,6 +68,8 @@
                             },
 
                             { field=>'custom',  type=>'hidden' },
                             },
 
                             { field=>'custom',  type=>'hidden' },

+                            { field=>'family_pkgpart', type=>'hidden' },
+                            { field=>'successor', type=>'hidden' },

 
                             { type => 'columnstart' },
                             
 
                             { type => 'columnstart' },
                             


@@ -593,7 +597,7 @@ my $javascript = <<'END';
 
     }
 
 
     }
 

-    function aux_planchanged(what) {
+    function aux_planchanged(what) { //?

 
       alert('called!');
       var plan = what.options[what.selectedIndex].value;
 
       alert('called!');
       var plan = what.options[what.selectedIndex].value;


@@ -609,9 +613,29 @@ my $javascript = <<'END';
 
     }
 
 
     }
 

-  </SCRIPT>

 END
 
 END
 

+my $warning =
+  'Changing the setup or recurring fee will create a new package definition. '.
+  'Continue?';
+              
+if ( $conf->exists('part_pkg-lineage') ) {
+  $javascript .= "
+    function confirm_submit(f) {
+    
+      var fields = Array('setup_fee','recur_fee');
+      for(var i=0; i < fields.length; i++) {
+          if ( f[fields[i]].value != f[fields[i]].defaultValue ) {
+              return confirm('$warning');
+          }
+      }
+      return true;
+    }
+";
+}
+
+$javascript .= '</SCRIPT>';
+

 tie my %plans, 'Tie::IxHash', %{ FS::part_pkg::plan_info() };
 
 tie my %plan_labels, 'Tie::IxHash',
 tie my %plans, 'Tie::IxHash', %{ FS::part_pkg::plan_info() };
 
 tie my %plan_labels, 'Tie::IxHash',