added part_pkg.agent_pkgpartid, RT#27214
[freeside.git] / FS / FS / part_pkg.pm
index ed5fa96..d1ec0fb 100644 (file)
@@ -1,10 +1,12 @@
 package FS::part_pkg;
+use base qw( FS::m2m_Common FS::o2m_Common FS::option_Common );
 
 use strict;
-use vars qw( @ISA %plans $DEBUG $setup_hack $skip_pkg_svc_hack );
+use vars qw( %plans $DEBUG $setup_hack $skip_pkg_svc_hack );
 use Carp qw(carp cluck confess);
 use Scalar::Util qw( blessed );
-use Time::Local qw( timelocal_nocheck );
+use DateTime;
+use Time::Local qw( timelocal timelocal_nocheck ); # eventually replace with DateTime
 use Tie::IxHash;
 use FS::Conf;
 use FS::Record qw( qsearch qsearchs dbh dbdef );
@@ -16,14 +18,15 @@ use FS::type_pkgs;
 use FS::part_pkg_option;
 use FS::pkg_class;
 use FS::agent;
+use FS::part_pkg_msgcat;
 use FS::part_pkg_taxrate;
 use FS::part_pkg_taxoverride;
 use FS::part_pkg_taxproduct;
 use FS::part_pkg_link;
 use FS::part_pkg_discount;
+use FS::part_pkg_usage;
 use FS::part_pkg_vendor;
 
-@ISA = qw( FS::m2m_Common FS::option_Common );
 $DEBUG = 0;
 $setup_hack = 0;
 $skip_pkg_svc_hack = 0;
@@ -103,6 +106,18 @@ inherits from FS::Record.  The following fields are currently supported:
 
 =item fcc_ds0s - Optional DS0 equivalency number for FCC form 477
 
+=item fcc_voip_class - Which column of FCC form 477 part II.B this package 
+belongs in.
+
+=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.
+
+=item delay_start - Number of days to delay package start, by default
+
 =back
 
 =head1 METHODS
@@ -192,6 +207,16 @@ sub insert {
     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"
@@ -294,7 +319,7 @@ sub insert {
       }
   }
 
-  warn "  commiting transaction" if $DEBUG;
+  warn "  committing transaction" if $DEBUG and $oldAutoCommit;
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   '';
@@ -344,7 +369,7 @@ sub replace {
       ? shift
       : { @_ };
 
-  $options->{options} = {} unless defined($options->{options});
+  $options->{options} = { $old->options } unless defined($options->{options});
 
   warn "FS::part_pkg::replace called on $new to replace $old with options".
        join(', ', map "$_ => ". $options->{$_}, keys %$options)
@@ -360,6 +385,28 @@ sub replace {
   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)
@@ -404,53 +451,55 @@ sub replace {
   }
 
   warn "  replacing pkg_svc records" if $DEBUG;
-  my $pkg_svc = $options->{'pkg_svc'} || {};
+  my $pkg_svc = $options->{'pkg_svc'};
   my $hidden_svc = $options->{'hidden_svc'} || {};
-  foreach my $part_svc ( qsearch('part_svc', {} ) ) {
-    my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
-    my $hidden = $hidden_svc->{$part_svc->svcpart} || '';
-    my $primary_svc =
-      ( defined($options->{'primary_svc'}) && $options->{'primary_svc'}
-        && $options->{'primary_svc'} == $part_svc->svcpart
-      )
-        ? 'Y'
-        : '';
+  if ( $pkg_svc ) { # if it wasn't passed, don't change existing pkg_svcs
+    foreach my $part_svc ( qsearch('part_svc', {} ) ) {
+      my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
+      my $hidden = $hidden_svc->{$part_svc->svcpart} || '';
+      my $primary_svc =
+        ( defined($options->{'primary_svc'}) && $options->{'primary_svc'}
+          && $options->{'primary_svc'} == $part_svc->svcpart
+        )
+          ? 'Y'
+          : '';
 
-    my $old_pkg_svc = qsearchs('pkg_svc', {
-        'pkgpart' => $old->pkgpart,
-        'svcpart' => $part_svc->svcpart,
+      my $old_pkg_svc = qsearchs('pkg_svc', {
+          'pkgpart' => $old->pkgpart,
+          'svcpart' => $part_svc->svcpart,
+        }
+      );
+      my $old_quantity = 0;
+      my $old_primary_svc = '';
+      my $old_hidden = '';
+      if ( $old_pkg_svc ) {
+        $old_quantity = $old_pkg_svc->quantity;
+        $old_primary_svc = $old_pkg_svc->primary_svc 
+          if $old_pkg_svc->dbdef_table->column('primary_svc'); # is this needed?
+        $old_hidden = $old_pkg_svc->hidden;
       }
-    );
-    my $old_quantity = 0;
-    my $old_primary_svc = '';
-    my $old_hidden = '';
-    if ( $old_pkg_svc ) {
-      $old_quantity = $old_pkg_svc->quantity;
-      $old_primary_svc = $old_pkg_svc->primary_svc 
-        if $old_pkg_svc->dbdef_table->column('primary_svc'); # is this needed?
-      $old_hidden = $old_pkg_svc->hidden;
-    }
-    next unless $old_quantity != $quantity || 
-                $old_primary_svc ne $primary_svc ||
-                $old_hidden ne $hidden;
-  
-    my $new_pkg_svc = new FS::pkg_svc( {
-      'pkgsvcnum'   => ( $old_pkg_svc ? $old_pkg_svc->pkgsvcnum : '' ),
-      'pkgpart'     => $new->pkgpart,
-      'svcpart'     => $part_svc->svcpart,
-      'quantity'    => $quantity, 
-      'primary_svc' => $primary_svc,
-      'hidden'      => $hidden,
-    } );
-    my $error = $old_pkg_svc
-                  ? $new_pkg_svc->replace($old_pkg_svc)
-                  : $new_pkg_svc->insert;
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return $error;
-    }
-  }
+   
+      next unless $old_quantity != $quantity || 
+                  $old_primary_svc ne $primary_svc ||
+                  $old_hidden ne $hidden;
+    
+      my $new_pkg_svc = new FS::pkg_svc( {
+        'pkgsvcnum'   => ( $old_pkg_svc ? $old_pkg_svc->pkgsvcnum : '' ),
+        'pkgpart'     => $new->pkgpart,
+        'svcpart'     => $part_svc->svcpart,
+        'quantity'    => $quantity, 
+        'primary_svc' => $primary_svc,
+        'hidden'      => $hidden,
+      } );
+      my $error = $old_pkg_svc
+                    ? $new_pkg_svc->replace($old_pkg_svc)
+                    : $new_pkg_svc->insert;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $error;
+      }
+    } #foreach $part_svc
+  } #if $options->{pkg_svc}
   
   my @part_pkg_vendor = $old->part_pkg_vendor;
   my @current_exportnum = ();
@@ -501,8 +550,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;
   '';
 }
@@ -544,7 +603,7 @@ sub check {
 
   my $error = $self->ut_numbern('pkgpart')
     || $self->ut_text('pkg')
-    || $self->ut_text('comment')
+    || $self->ut_textn('comment')
     || $self->ut_textn('promo_code')
     || $self->ut_alphan('plan')
     || $self->ut_enum('setuptax', [ '', 'Y' ] )
@@ -573,6 +632,11 @@ sub check {
            : $self->ut_agentnum_acl('agentnum', \@null_agentnum_right)
        )
     || $self->ut_numbern('fcc_ds0s')
+    || $self->ut_numbern('fcc_voip_class')
+    || $self->ut_numbern('delay_start')
+    || $self->ut_foreign_keyn('successor', 'part_pkg', 'pkgpart')
+    || $self->ut_foreign_keyn('family_pkgpart', 'part_pkg', 'pkgpart')
+    || $self->ut_alphan('agent_pkgpartid')
     || $self->SUPER::check
   ;
   return $error if $error;
@@ -587,6 +651,105 @@ 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_locale LOCALE
+
+Returns a customer-viewable string representing this package for the given
+locale, from the part_pkg_msgcat table.  If the given locale is empty or no
+localized string is found, returns the base pkg field.
+
+=cut
+
+sub pkg_locale {
+  my( $self, $locale ) = @_;
+  return $self->pkg unless $locale;
+  my $part_pkg_msgcat = $self->part_pkg_msgcat($locale) or return $self->pkg;
+  $part_pkg_msgcat->pkg;
+}
+
+=item part_pkg_msgcat LOCALE
+
+Like pkg_locale, but returns the FS::part_pkg_msgcat object itself.
+
+=cut
+
+sub part_pkg_msgcat {
+  my( $self, $locale ) = @_;
+  qsearchs( 'part_pkg_msgcat', {
+    pkgpart => $self->pkgpart,
+    locale  => $locale,
+  });
+}
+
 =item pkg_comment [ OPTION => VALUE... ]
 
 Returns an (internal) string representing this package.  Currently,
@@ -605,7 +768,8 @@ sub pkg_comment {
   #$self->pkg. ' - '. $self->comment;
   #$self->pkg. ' ('. $self->comment. ')';
   my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': ';
-  $pre. $self->pkg. ' - '. $self->custom_comment;
+  my $custom_comment = $self->custom_comment(%opt);
+  $pre. $self->pkg. ( $custom_comment ? " - $custom_comment" : '' );
 }
 
 sub price_info { # safety, in case a part_pkg hasn't defined price_info
@@ -614,7 +778,16 @@ sub price_info { # safety, in case a part_pkg hasn't defined price_info
 
 sub custom_comment {
   my $self = shift;
-  ( $self->custom ? '(CUSTOM) ' : '' ). $self->comment . ' ' . $self->price_info;
+  my $price_info = $self->price_info(@_);
+  ( $self->custom ? '(CUSTOM) ' : '' ).
+    $self->comment.
+    ( ( ($self->custom || $self->comment) && $price_info ) ? ' - ' : '' ).
+    $price_info;
+}
+
+sub pkg_price_info {
+  my $self = shift;
+  $self->pkg. ' - '. ($self->price_info || 'No charge');
 }
 
 =item pkg_class
@@ -862,10 +1035,24 @@ sub is_free {
   }
 }
 
+# whether the plan allows discounts to be applied to this package
 sub can_discount { 0; }
 
+# whether the plan allows changing the start date
 sub can_start_date { 1; }
 
+# the delay start date if present
+sub delay_start_date {
+  my $self = shift;
+
+  my $delay = $self->delay_start or return '';
+
+  # avoid timelocal silliness  
+  my $dt = DateTime->today(time_zone => 'local');
+  $dt->add(days => $delay);
+  $dt->epoch;
+}
+
 sub freqs_href {
   # moved to FS::Misc to make this accessible to other packages
   # at initialization
@@ -923,6 +1110,9 @@ sub add_freq {
   if ( $freq =~ /^\d+$/ ) {
     $mon += $freq;
     until ( $mon < 12 ) { $mon -= 12; $year++; }
+
+    $mday = 28 if $mday > 28 && FS::Conf->new->exists('anniversary-rollback');
+
   } elsif ( $freq =~ /^(\d+)w$/ ) {
     my $weeks = $1;
     $mday += $weeks * 7;
@@ -1050,6 +1240,17 @@ sub svc_part_pkg_link {
   shift->_part_pkg_link('svc', @_);
 }
 
+=item supp_part_pkg_link
+
+Returns the associated part_pkg_link records of type 'supp' (supplemental
+packages).
+
+=cut
+
+sub supp_part_pkg_link {
+  shift->_part_pkg_link('supp', @_);
+}
+
 sub _part_pkg_link {
   my( $self, $type ) = @_;
   qsearch({ table    => 'part_pkg_link',
@@ -1177,74 +1378,40 @@ sub taxproduct_description {
   $part_pkg_taxproduct ? $part_pkg_taxproduct->description : '';
 }
 
-=item part_pkg_taxrate DATA_PROVIDER, GEOCODE, [ CLASS ]
 
-Returns the package to taxrate m2m records for this package in the location
-specified by GEOCODE (see L<FS::part_pkg_taxrate>) and usage class CLASS.
-CLASS may be one of 'setup', 'recur', or one of the usage classes numbers
-(see L<FS::usage_class>).
+=item tax_rates DATA_PROVIDER, GEOCODE, [ CLASS ]
+
+Returns the tax table entries (L<FS::tax_rate> objects) that apply to this
+package in the location specified by GEOCODE, for usage class CLASS (one of
+'setup', 'recur', null, or a C<usage_class> number).
 
 =cut
 
-sub _expand_cch_taxproductnum {
+sub tax_rates {
   my $self = shift;
-  my $class = shift;
-  my $part_pkg_taxproduct = $self->taxproduct($class);
-
-  my ($a,$b,$c,$d) = ( $part_pkg_taxproduct
-                         ? ( split ':', $part_pkg_taxproduct->taxproduct )
-                         : ()
-                     );
-  $a = '' unless $a; $b = '' unless $b; $c = '' unless $c; $d = '' unless $d;
-  my $extra_sql = "AND ( taxproduct = '$a:$b:$c:$d'
-                      OR taxproduct = '$a:$b:$c:'
-                      OR taxproduct = '$a:$b:".":$d'
-                      OR taxproduct = '$a:$b:".":' )";
-  map { $_->taxproductnum } qsearch( { 'table'     => 'part_pkg_taxproduct',
-                                       'hashref'   => { 'data_vendor'=>'cch' },
-                                       'extra_sql' => $extra_sql,
-                                   } );
-                                     
-}
-
-sub part_pkg_taxrate {
-  my $self = shift;
-  my ($data_vendor, $geocode, $class) = @_;
-
-  my $dbh = dbh;
-  my $extra_sql = 'WHERE part_pkg_taxproduct.data_vendor = '.
-                  dbh->quote($data_vendor);
-  
-  # CCH oddness in m2m
-  $extra_sql .= ' AND ('.
-    join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
-                 qw(10 5 2)
-        ).
-    ')';
-  # much more CCH oddness in m2m -- this is kludgy
-  my @tpnums = $self->_expand_cch_taxproductnum($class);
-  if (scalar(@tpnums)) {
-    $extra_sql .= ' AND ('.
-                            join(' OR ', map{ "taxproductnum = $_" } @tpnums ).
-                       ')';
-  } else {
-    $extra_sql .= ' AND ( 0 = 1 )';
+  my ($vendor, $geocode, $class) = @_;
+  my @taxclassnums = map { $_->taxclassnum } 
+                     $self->part_pkg_taxoverride($class);
+  if (!@taxclassnums) {
+    my $part_pkg_taxproduct = $self->taxproduct($class);
+    @taxclassnums = map { $_->taxclassnum }
+                    grep { $_->taxable eq 'Y' } # why do we need this?
+                    $part_pkg_taxproduct->part_pkg_taxrate($geocode);
   }
+  return unless @taxclassnums;
 
-  my $addl_from = 'LEFT JOIN part_pkg_taxproduct USING ( taxproductnum )';
-  my $order_by = 'ORDER BY taxclassnum, length(geocode) desc, length(taxproduct) desc';
-  my $select   = 'DISTINCT ON(taxclassnum) *, taxproduct';
+  warn "Found taxclassnum values of ". join(',', @taxclassnums) ."\n"
+      if $DEBUG;
+  my $extra_sql = "AND taxclassnum IN (". join(',', @taxclassnums) . ")";
+  my @taxes = qsearch({ 'table'     => 'tax_rate',
+                        'hashref'   => { 'geocode'     => $geocode,
+                                         'data_vendor' => $vendor },
+                        'extra_sql' => $extra_sql,
+                      });
+  warn "Found taxes ". join(',', map {$_->taxnum} @taxes) ."\n"
+      if $DEBUG;
 
-  # should qsearch preface columns with the table to facilitate joins?
-  qsearch( { 'table'     => 'part_pkg_taxrate',
-             'select'    => $select,
-             'hashref'   => { # 'data_vendor'   => $data_vendor,
-                              # 'taxproductnum' => $self->taxproductnum,
-                            },
-             'addl_from' => $addl_from,
-             'extra_sql' => $extra_sql,
-             'order_by'  => $order_by,
-         } );
+  return @taxes;
 }
 
 =item part_pkg_discount
@@ -1259,6 +1426,18 @@ sub part_pkg_discount {
   qsearch('part_pkg_discount', { 'pkgpart' => $self->pkgpart });
 }
 
+=item part_pkg_usage
+
+Returns the voice usage pools (see L<FS::part_pkg_usage>) defined for 
+this package.
+
+=cut
+
+sub part_pkg_usage {
+  my $self = shift;
+  qsearch('part_pkg_usage', { 'pkgpart' => $self->pkgpart });
+}
+
 =item _rebless
 
 Reblesses the object into the FS::part_pkg::PLAN class (if available), where
@@ -1277,7 +1456,7 @@ sub _rebless {
   }
   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 $@;
@@ -1290,9 +1469,12 @@ sub calc_recur { die 'no calc_recur for '. shift->plan. "\n"; }
 
 #fallback that return 0 for old legacy packages with no plan
 sub calc_remain { 0; }
-sub calc_cancel { 0; }
 sub calc_units  { 0; }
 
+#fallback for everything not based on flat.pm
+sub recur_temporality { 'upcoming'; }
+sub calc_cancel { 0; }
+
 #fallback for everything except bulk.pm
 sub hide_svc_detail { 0; }
 
@@ -1311,6 +1493,40 @@ sub recur_cost_permonth {
   sprintf('%.2f', $self->recur_cost / $self->freq );
 }
 
+=item cust_bill_pkg_recur CUST_PKG
+
+Actual recurring charge for the specified customer package from customer's most
+recent invoice
+
+=cut
+
+sub cust_bill_pkg_recur {
+  my($self, $cust_pkg) = @_;
+  my $cust_bill_pkg = qsearchs({
+    'table'     => 'cust_bill_pkg',
+    'addl_from' => 'LEFT JOIN cust_bill USING ( invnum )',
+    'hashref'   => { 'pkgnum' => $cust_pkg->pkgnum,
+                     'recur'  => { op=>'>', value=>'0' },
+                   },
+    'order_by'  => 'ORDER BY cust_bill._date     DESC,
+                             cust_bill_pkg.sdate DESC
+                     LIMIT 1
+                   ',
+  }) or return 0; #die "use cust_bill_pkg_recur credits with once_perinv condition";
+  $cust_bill_pkg->recur;
+}
+
+=item unit_setup CUST_PKG
+
+Returns the setup fee for one unit of the package.
+
+=cut
+
+sub unit_setup {
+  my ($self, $cust_pkg) = @_;
+  $self->option('setup_fee') || 0;
+}
+
 =item format OPTION DATA
 
 Returns data formatted according to the function 'format' described
@@ -1407,6 +1623,14 @@ sub _upgrade_data { # class method
     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,
@@ -1460,6 +1684,83 @@ sub _upgrade_data { # class method
         }
   }
 
+  # set any package with FCC voice lines to the "VoIP with broadband" category
+  # for backward compatibility
+  #
+  # recover from a bad upgrade bug
+  my $upgrade = 'part_pkg_fcc_voip_class_FIX';
+  if (!FS::upgrade_journal->is_done($upgrade)) {
+    my $bad_upgrade = qsearchs('upgrade_journal', 
+      { upgrade => 'part_pkg_fcc_voip_class' }
+    );
+    if ( $bad_upgrade ) {
+      my $where = 'WHERE history_date <= '.$bad_upgrade->_date.
+                  ' AND  history_date >  '.($bad_upgrade->_date - 3600);
+      my @h_part_pkg_option = map { FS::part_pkg_option->new($_->hashref) }
+        qsearch({
+          'select'    => '*',
+          'table'     => 'h_part_pkg_option',
+          'hashref'   => {},
+          'extra_sql' => "$where AND history_action = 'delete'",
+          'order_by'  => 'ORDER BY history_date ASC',
+        });
+      my @h_pkg_svc = map { FS::pkg_svc->new($_->hashref) }
+        qsearch({
+          'select'    => '*',
+          'table'     => 'h_pkg_svc',
+          'hashref'   => {},
+          'extra_sql' => "$where AND history_action = 'replace_old'",
+          'order_by'  => 'ORDER BY history_date ASC',
+        });
+      my %opt;
+      foreach my $deleted (@h_part_pkg_option, @h_pkg_svc) {
+        my $pkgpart ||= $deleted->pkgpart;
+        $opt{$pkgpart} ||= {
+          options => {},
+          pkg_svc => {},
+          primary_svc => '',
+          hidden_svc => {},
+        };
+        if ( $deleted->isa('FS::part_pkg_option') ) {
+          $opt{$pkgpart}{options}{ $deleted->optionname } = $deleted->optionvalue;
+        } else { # pkg_svc
+          my $svcpart = $deleted->svcpart;
+          $opt{$pkgpart}{pkg_svc}{$svcpart} = $deleted->quantity;
+          $opt{$pkgpart}{hidden_svc}{$svcpart} ||= $deleted->hidden;
+          $opt{$pkgpart}{primary_svc} = $svcpart if $deleted->primary_svc;
+        }
+      }
+      foreach my $pkgpart (keys %opt) {
+        my $part_pkg = FS::part_pkg->by_key($pkgpart);
+        my $error = $part_pkg->replace( $part_pkg->replace_old, $opt{$pkgpart} );
+        if ( $error ) {
+          die "error recovering damaged pkgpart $pkgpart:\n$error\n";
+        }
+      }
+    } # $bad_upgrade exists
+    else { # do the original upgrade, but correctly this time
+      @part_pkg = qsearch('part_pkg', {
+          fcc_ds0s        => { op => '>', value => 0 },
+          fcc_voip_class  => ''
+      });
+      foreach my $part_pkg (@part_pkg) {
+        $part_pkg->set(fcc_voip_class => 2);
+        my @pkg_svc = $part_pkg->pkg_svc;
+        my %quantity = map {$_->svcpart, $_->quantity} @pkg_svc;
+        my %hidden   = map {$_->svcpart, $_->hidden  } @pkg_svc;
+        my $error = $part_pkg->replace(
+          $part_pkg->replace_old,
+          options     => { $part_pkg->options },
+          pkg_svc     => \%quantity,
+          hidden_svc  => \%hidden,
+          primary_svc => ($part_pkg->svcpart || ''),
+        );
+        die $error if $error;
+      }
+    }
+    FS::upgrade_journal->set_done($upgrade);
+  }
+
 }
 
 =item curuser_pkgs_sql