X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fpart_pkg.pm;h=1db5a708c6e0974f922d47e0f7844e4290c5ba46;hp=85269c5a66d5cbd1559fc181a6a49faaba26e1fd;hb=aed8ec35ccb9cdeb7ea0cb6ff2946f9d83d582f6;hpb=e6c54cd41c23d8c0da9d5e0f66c20a571470d435

diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm
index 85269c5a6..1db5a708c 100644
--- a/FS/FS/part_pkg.pm
+++ b/FS/FS/part_pkg.pm
@@ -21,6 +21,7 @@ use FS::part_pkg_taxoverride;
 use FS::part_pkg_taxproduct;
 use FS::part_pkg_link;
 use FS::part_pkg_discount;
+use FS::part_pkg_vendor;
 
 @ISA = qw( FS::m2m_Common FS::option_Common );
 $DEBUG = 0;
@@ -144,7 +145,9 @@ Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg>,
 I<custnum_ref> and I<options>.
 
 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
-values, appropriate FS::pkg_svc records will be inserted.
+values, appropriate FS::pkg_svc records will be inserted.  I<hidden_svc> can 
+be set to a hashref of svcparts and flag values ('Y' or '') to set the 
+'hidden' field in these records.
 
 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
 FS::pkg_svc record will be updated.
@@ -230,6 +233,7 @@ sub insert {
 
     warn "  inserting pkg_svc records" if $DEBUG;
     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 $primary_svc =
@@ -242,6 +246,7 @@ sub insert {
         'svcpart'     => $part_svc->svcpart,
         'quantity'    => $quantity, 
         'primary_svc' => $primary_svc,
+        'hidden'      => $hidden_svc->{$part_svc->svcpart},
       } );
       my $error = $pkg_svc->insert;
       if ( $error ) {
@@ -271,6 +276,24 @@ sub insert {
     }
   }
 
+  if ( $options{'part_pkg_vendor'} ) {
+      while ( my ($exportnum, $vendor_pkg_id) =
+                each %{ $options{part_pkg_vendor} }
+            )
+      {
+            my $ppv = new FS::part_pkg_vendor( {
+                    'pkgpart' => $self->pkgpart,
+                    'exportnum' => $exportnum,
+                    'vendor_pkg_id' => $vendor_pkg_id, 
+                } );
+            my $error = $ppv->insert;
+            if ( $error ) {
+              $dbh->rollback if $oldAutoCommit;
+              return "Error inserting part_pkg_vendor record: $error";
+            }
+      }
+  }
+
   warn "  commiting transaction" if $DEBUG;
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
@@ -293,10 +316,13 @@ sub delete {
 Replaces OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 
-Currently available options are: I<pkg_svc>, I<primary_svc> and I<options>
+Currently available options are: I<pkg_svc>, I<hidden_svc>, I<primary_svc> 
+and I<options>
 
 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
-values, the appropriate FS::pkg_svc records will be replaced.
+values, the appropriate FS::pkg_svc records will be replaced.  I<hidden_svc>
+can be set to a hashref of svcparts and flag values ('Y' or '') to set the 
+'hidden' field in these records.
 
 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
 FS::pkg_svc record will be updated.
@@ -379,8 +405,10 @@ sub replace {
 
   warn "  replacing pkg_svc records" if $DEBUG;
   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
@@ -388,17 +416,24 @@ sub replace {
         ? 'Y'
         : '';
 
-
     my $old_pkg_svc = qsearchs('pkg_svc', {
-      'pkgpart' => $old->pkgpart,
-      'svcpart' => $part_svc->svcpart,
-    } );
-    my $old_quantity = $old_pkg_svc ? $old_pkg_svc->quantity : 0;
-    my $old_primary_svc =
-      ( $old_pkg_svc && $old_pkg_svc->dbdef_table->column('primary_svc') )
-        ? $old_pkg_svc->primary_svc
-        : '';
-    next unless $old_quantity != $quantity || $old_primary_svc ne $primary_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;
+    }
+ 
+    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 : '' ),
@@ -406,6 +441,7 @@ sub replace {
       'svcpart'     => $part_svc->svcpart,
       'quantity'    => $quantity, 
       'primary_svc' => $primary_svc,
+      'hidden'      => $hidden,
     } );
     my $error = $old_pkg_svc
                   ? $new_pkg_svc->replace($old_pkg_svc)
@@ -415,6 +451,56 @@ sub replace {
       return $error;
     }
   }
+  
+  my @part_pkg_vendor = $old->part_pkg_vendor;
+  my @current_exportnum = ();
+  if ( $options->{'part_pkg_vendor'} ) {
+      my($exportnum,$vendor_pkg_id);
+      while ( ($exportnum,$vendor_pkg_id) 
+                                = each %{$options->{'part_pkg_vendor'}} ) {
+          my $noinsert = 0;
+          foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
+            if($exportnum == $part_pkg_vendor->exportnum
+                && $vendor_pkg_id ne $part_pkg_vendor->vendor_pkg_id) {
+                $part_pkg_vendor->vendor_pkg_id($vendor_pkg_id);
+                my $error = $part_pkg_vendor->replace;
+                if ( $error ) {
+                  $dbh->rollback if $oldAutoCommit;
+                  return "Error replacing part_pkg_vendor record: $error";
+                }
+                $noinsert = 1;
+                last;
+            }
+            elsif($exportnum == $part_pkg_vendor->exportnum
+                && $vendor_pkg_id eq $part_pkg_vendor->vendor_pkg_id) {
+                $noinsert = 1;
+                last;
+            }
+          }
+          unless ( $noinsert ) {
+            my $ppv = new FS::part_pkg_vendor( {
+                    'pkgpart' => $new->pkgpart,
+                    'exportnum' => $exportnum,
+                    'vendor_pkg_id' => $vendor_pkg_id, 
+                } );
+            my $error = $ppv->insert;
+            if ( $error ) {
+              $dbh->rollback if $oldAutoCommit;
+              return "Error inserting part_pkg_vendor record: $error";
+            }
+          }
+          push @current_exportnum, $exportnum;
+      }
+  }
+  foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
+      unless ( grep($_ eq $part_pkg_vendor->exportnum, @current_exportnum) ) {
+        my $error = $part_pkg_vendor->delete;
+        if ( $error ) {
+          $dbh->rollback if $oldAutoCommit;
+          return "Error deleting part_pkg_vendor record: $error";
+        }
+      }
+  }
 
   warn "  commiting transaction" if $DEBUG;
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
@@ -467,6 +553,8 @@ sub check {
     || $self->ut_enum('disabled', [ '', 'Y' ] )
     || $self->ut_enum('custom', [ '', 'Y' ] )
     || $self->ut_enum('no_auto', [ '', 'Y' ])
+    || $self->ut_enum('recur_show_zero', [ '', 'Y' ])
+    || $self->ut_enum('setup_show_zero', [ '', 'Y' ])
     #|| $self->ut_moneyn('setup_cost')
     #|| $self->ut_moneyn('recur_cost')
     || $self->ut_floatn('setup_cost')
@@ -520,9 +608,13 @@ sub pkg_comment {
   $pre. $self->pkg. ' - '. $self->custom_comment;
 }
 
+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->custom ? '(CUSTOM) ' : '' ). $self->comment . ' ' . $self->price_info;
 }
 
 =item pkg_class
@@ -759,10 +851,7 @@ Returns true if this package is free.
 
 sub is_free {
   my $self = shift;
-  unless ( $self->plan ) {
-    $self->setup =~ /^\s*0+(\.0*)?\s*$/
-      && $self->recur =~ /^\s*0+(\.0*)?\s*$/;
-  } elsif ( $self->can('is_free_options') ) {
+  if ( $self->can('is_free_options') ) {
     not grep { $_ !~ /^\s*0*(\.0*)?\s*$/ }
          map { $self->option($_) } 
              $self->is_free_options;
@@ -775,6 +864,8 @@ sub is_free {
 
 sub can_discount { 0; }
 
+sub can_start_date { 1; }
+
 sub freqs_href {
   # moved to FS::Misc to make this accessible to other packages
   # at initialization
@@ -868,6 +959,29 @@ sub plandata {
   }
 }
 
+=item part_pkg_vendor
+
+Returns all vendor/external package ids as FS::part_pkg_vendor objects (see
+L<FS::part_pkg_vendor>).
+
+=cut
+
+sub part_pkg_vendor {
+  my $self = shift;
+  qsearch('part_pkg_vendor', { 'pkgpart' => $self->pkgpart } );
+}
+
+=item vendor_pkg_ids
+
+Returns a list of vendor/external package ids by exportnum
+
+=cut
+
+sub vendor_pkg_ids {
+  my $self = shift;
+  map { $_->exportnum => $_->vendor_pkg_id } $self->part_pkg_vendor;
+}
+
 =item part_pkg_option
 
 Returns all options as FS::part_pkg_option objects (see
@@ -941,6 +1055,8 @@ sub _part_pkg_link {
   qsearch({ table    => 'part_pkg_link',
             hashref  => { 'src_pkgpart' => $self->pkgpart,
                           'link_type'   => $type,
+                          #protection against infinite recursive links
+                          'dst_pkgpart' => { op=>'!=', value=> $self->pkgpart },
                         },
             order_by => "ORDER BY hidden",
          });
@@ -950,6 +1066,10 @@ sub self_and_bill_linked {
   shift->_self_and_linked('bill', @_);
 }
 
+sub self_and_svc_linked {
+  shift->_self_and_linked('svc', @_);
+}
+
 sub _self_and_linked {
   my( $self, $type, $hidden ) = @_;
   $hidden ||= '';
@@ -1164,38 +1284,11 @@ sub _rebless {
   $self;
 }
 
-#fallbacks that eval the setup and recur fields, for backwards compat
-
-sub calc_setup {
-  my $self = shift;
-  warn 'no price plan class for '. $self->plan. ", eval-ing setup\n";
-  $self->_calc_eval('setup', @_);
-}
-
-sub calc_recur {
-  my $self = shift;
-  warn 'no price plan class for '. $self->plan. ", eval-ing recur\n";
-  $self->_calc_eval('recur', @_);
-}
-
-use vars qw( $sdate @details );
-sub _calc_eval {
-  #my( $self, $field, $cust_pkg ) = @_;
-  my( $self, $field, $cust_pkg, $sdateref, $detailsref ) = @_;
-  *sdate = $sdateref;
-  *details = $detailsref;
-  $self->$field() =~ /^(.*)$/
-    or die "Illegal $field (pkgpart ". $self->pkgpart. '): '.
-            $self->$field(). "\n";
-  my $prog = $1;
-  return 0 if $prog =~ /^\s*$/;
-  my $value = eval $prog;
-  die $@ if $@;
-  $value;
-}
+#fatal fallbacks
+sub calc_setup { die 'no calc_setup for '. shift->plan. "\n"; }
+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; }
@@ -1203,6 +1296,9 @@ sub calc_units  { 0; }
 #fallback for everything except bulk.pm
 sub hide_svc_detail { 0; }
 
+#fallback for packages that can't/won't summarize usage
+sub sum_usage { 0; }
+
 =item recur_cost_permonth CUST_PKG
 
 recur_cost divided by freq (only supported for monthly and longer frequencies)
@@ -1349,6 +1445,59 @@ sub _upgrade_data { # class method
     die $error if $error;
   }
 
+  my @part_pkg_option = qsearch('part_pkg_option',
+    { 'optionname'  => 'unused_credit',
+      'optionvalue' => 1,
+    });
+  foreach my $old_opt (@part_pkg_option) {
+    my $pkgpart = $old_opt->pkgpart;
+    my $error = $old_opt->delete;
+    die $error if $error;
+
+    foreach (qw(unused_credit_cancel unused_credit_change)) {
+      my $new_opt = new FS::part_pkg_option {
+        'pkgpart'     => $pkgpart,
+        'optionname'  => $_,
+        'optionvalue' => 1,
+      };
+      $error = $new_opt->insert;
+      die $error if $error;
+    }
+  }
+
+  # migrate use_disposition_taqua and use_disposition to disposition_in
+  @part_pkg_option = qsearch('part_pkg_option',
+    { 'optionname'  => { op => 'LIKE',
+                         value => 'use_disposition%',
+                       },
+      'optionvalue' => 1,
+    });
+  my %newopts = map { $_->pkgpart => $_ } 
+    qsearch('part_pkg_option',  { 'optionname'  => 'disposition_in', } );
+  foreach my $old_opt (@part_pkg_option) {
+        my $pkgpart = $old_opt->pkgpart;
+        my $newval = $old_opt->optionname eq 'use_disposition_taqua' ? '100' 
+                                                                  : 'ANSWERED';
+        my $error = $old_opt->delete;
+        die $error if $error;
+
+        if ( exists($newopts{$pkgpart}) ) {
+            my $opt = $newopts{$pkgpart};
+            $opt->optionvalue($opt->optionvalue.",$newval");
+            $error = $opt->replace;
+            die $error if $error;
+        } else {
+            my $new_opt = new FS::part_pkg_option {
+                'pkgpart'     => $pkgpart,
+                'optionname'  => 'disposition_in',
+                'optionvalue' => $newval,
+              };
+              $error = $new_opt->insert;
+              die $error if $error;
+              $newopts{$pkgpart} = $new_opt;
+        }
+  }
+
 }
 
 =item curuser_pkgs_sql
@@ -1435,19 +1584,53 @@ foreach my $INC ( @INC ) {
       next;
     }
     warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG;
-    if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
-      warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
-      next;
-    }
+    #if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
+    #  warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
+    #  next;
+    #}
     $info{$mod} = $info;
+    $info->{'weight'} ||= 0; # quiet warnings
   }
 }
 
+# copy one level deep to allow replacement of fields and fieldorder
 tie %plans, 'Tie::IxHash',
-  map  { $_ => $info{$_} }
+  map  { my %infohash = %{ $info{$_} }; 
+          $_ => \%infohash }
   sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} }
   keys %info;
 
+# inheritance of plan options
+foreach my $name (keys(%info)) {
+  if (exists($info{$name}->{'disabled'}) and $info{$name}->{'disabled'}) {
+    warn "skipping disabled plan FS::part_pkg::$name" if $DEBUG;
+    delete $plans{$name};
+    next;
+  }
+  my $parents = $info{$name}->{'inherit_fields'} || [];
+  my (%fields, %field_exists, @fieldorder);
+  foreach my $parent ($name, @$parents) {
+    if ( !exists($info{$parent}) ) {
+      warn "$name tried to inherit from nonexistent '$parent'\n";
+      next;
+    }
+    %fields = ( # avoid replacing existing fields
+      %{ $info{$parent}->{'fields'} || {} },
+      %fields
+    );
+    foreach (@{ $info{$parent}->{'fieldorder'} || [] }) {
+      # avoid duplicates
+      next if $field_exists{$_};
+      $field_exists{$_} = 1;
+      # allow inheritors to remove inherited fields from the fieldorder
+      push @fieldorder, $_ if !exists($fields{$_}) or
+                              !exists($fields{$_}->{'disabled'});
+    }
+  }
+  $plans{$name}->{'fields'} = \%fields;
+  $plans{$name}->{'fieldorder'} = \@fieldorder;
+}
+
 sub plan_info {
   \%plans;
 }