X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fpart_pkg.pm;h=1b887a2f09ead7202d4dfaf9a1b4035adff567d1;hp=373982b840a602657c705dddef694006dfb55178;hb=6ef0d344462736b9bc1782caccc6305f946632c7;hpb=7fbe88a91e80c40c70f3e666ce1965586544c181

diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm
index 373982b84..1b887a2f0 100644
--- a/FS/FS/part_pkg.pm
+++ b/FS/FS/part_pkg.pm
@@ -103,6 +103,16 @@ 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.
+
 =back
 
 =head1 METHODS
@@ -192,6 +202,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 +314,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 +364,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 +380,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 +446,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 +545,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;
   '';
 }
@@ -573,6 +627,9 @@ sub check {
            : $self->ut_agentnum_acl('agentnum', \@null_agentnum_right)
        )
     || $self->ut_numbern('fcc_ds0s')
+    || $self->ut_numbern('fcc_voip_class')
+    || $self->ut_foreign_keyn('successor', 'part_pkg', 'pkgpart')
+    || $self->ut_foreign_keyn('family_pkgpart', 'part_pkg', 'pkgpart')
     || $self->SUPER::check
   ;
   return $error if $error;
@@ -587,6 +644,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,
@@ -1050,6 +1177,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',
@@ -1277,7 +1415,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 $@;
@@ -1314,6 +1452,29 @@ 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 format OPTION DATA
 
 Returns data formatted according to the function 'format' described
@@ -1410,6 +1571,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,
@@ -1463,6 +1632,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