export host selection per service, RT#17914
[freeside.git] / FS / FS / part_svc.pm
index 580038b..7f22411 100644 (file)
@@ -9,6 +9,7 @@ use FS::part_svc_column;
 use FS::part_export;
 use FS::export_svc;
 use FS::cust_svc;
+use FS::part_svc_class;
 
 @ISA = qw(FS::Record);
 
@@ -51,8 +52,12 @@ FS::Record.  The following fields are currently supported:
 =item svcdb - table used for this service.  See L<FS::svc_acct>,
 L<FS::svc_domain>, and L<FS::svc_forward>, among others.
 
+=item classnum - Optional service class (see L<FS::svc_class>)
+
 =item disabled - Disabled flag, empty or `Y'
 
+=item preserve - Preserve after cancellation, empty or 'Y'
+
 =back
 
 =head1 METHODS
@@ -80,12 +85,12 @@ the part_svc_column table appropriately (see L<FS::part_svc_column>).
 
 =item I<svcdb>__I<field> - Default or fixed value for I<field> in I<svcdb>.
 
-=item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null or empty (no default), `D' for default, `F' for fixed (unchangeable), `M' for manual selection from inventory, or `A' for automatic selection from inventory.  For virtual fields, can also be 'X' for excluded.
+=item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null or empty (no default), `D' for default, `F' for fixed (unchangeable), , `S' for selectable choice, `M' for manual selection from inventory, or `A' for automatic selection from inventory.  For virtual fields, can also be 'X' for excluded.
 
 =back
 
 If you want to add part_svc_column records for fields that do not exist as
-(real or virtual) fields in the I<svcdb> table, make sure to list then in 
+fields in the I<svcdb> table, make sure to list then in 
 EXTRA_FIELDS_ARRAYREF also.
 
 If EXPORTNUMS_HASHREF is specified (keys are exportnums and values are
@@ -133,7 +138,8 @@ sub insert {
 #        fields('part_svc');
   foreach my $field (
     grep { $_ ne 'svcnum'
-           && defined( $self->getfield($svcdb.'__'.$_.'_flag') )
+           && ( defined( $self->getfield($svcdb.'__'.$_.'_flag') )
+                || $self->getfield($svcdb.'__'.$_.'_label') !~ /^\s*$/ )
          } (fields($svcdb), @fields)
   ) {
     my $part_svc_column = $self->part_svc_column($field);
@@ -142,20 +148,28 @@ sub insert {
       'columnname' => $field,
     } );
 
-    my $flag = $self->getfield($svcdb.'__'.$field.'_flag');
-    #if ( uc($flag) =~ /^([DFMAX])$/ ) {
-    if ( uc($flag) =~ /^([A-Z])$/ ) { #part_svc_column will test it
-      my $parser = FS::part_svc->svc_table_fields($svcdb)->{$field}->{parse}
-                   || sub { shift };
-      $part_svc_column->setfield('columnflag', $1);
-      $part_svc_column->setfield('columnvalue',
-        &$parser($self->getfield($svcdb.'__'.$field))
-      );
+    my $flag  = $self->getfield($svcdb.'__'.$field.'_flag');
+    my $label = $self->getfield($svcdb.'__'.$field.'_label');
+    if ( uc($flag) =~ /^([A-Z])$/ || $label !~ /^\s*$/ ) {
+
+      if ( uc($flag) =~ /^([A-Z])$/ ) {
+        my $parser = FS::part_svc->svc_table_fields($svcdb)->{$field}->{parse}
+                     || sub { shift };
+        $part_svc_column->setfield('columnflag', $1);
+        $part_svc_column->setfield('columnvalue',
+          &$parser($self->getfield($svcdb.'__'.$field))
+        );
+      }
+
+      $part_svc_column->setfield('columnlabel', $label)
+        if $label !~ /^\s*$/;
+
       if ( $previous ) {
         $error = $part_svc_column->replace($previous);
       } else {
         $error = $part_svc_column->insert;
       }
+
     } else {
       $error = $previous ? $previous->delete : '';
     }
@@ -181,6 +195,8 @@ sub insert {
     }
   }
 
+  # XXX shouldn't this update fixed values?
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   '';
@@ -254,24 +270,37 @@ sub replace {
     my $svcdb = $new->svcdb;
     foreach my $field (
       grep { $_ ne 'svcnum'
-             && defined( $new->getfield($svcdb.'__'.$_.'_flag') )
+             && ( defined( $new->getfield($svcdb.'__'.$_.'_flag') )
+                  || $new->getfield($svcdb.'__'.$_.'_label') !~ /^\s*$/ )
            } (fields($svcdb),@fields)
     ) {
+
       my $part_svc_column = $new->part_svc_column($field);
       my $previous = qsearchs('part_svc_column', {
         'svcpart'    => $new->svcpart,
         'columnname' => $field,
       } );
 
-      my $flag = $new->getfield($svcdb.'__'.$field.'_flag');
-      #if ( uc($flag) =~ /^([DFMAX])$/ ) {
-      if ( uc($flag) =~ /^([A-Z])$/ ) { #part_svc_column will test it
-        my $parser = FS::part_svc->svc_table_fields($svcdb)->{$field}->{parse}
+      my $flag  = $new->getfield($svcdb.'__'.$field.'_flag');
+      my $label = $new->getfield($svcdb.'__'.$field.'_label');
+      if ( uc($flag) =~ /^([A-Z])$/ || $label !~ /^\s*$/ ) {
+
+        if ( uc($flag) =~ /^([A-Z])$/ ) {
+          $part_svc_column->setfield('columnflag', $1);
+          my $parser = FS::part_svc->svc_table_fields($svcdb)->{$field}->{parse}
                      || sub { shift };
-        $part_svc_column->setfield('columnflag', $1);
-        $part_svc_column->setfield('columnvalue',
-          &$parser($new->getfield($svcdb.'__'.$field))
-        );
+          $part_svc_column->setfield('columnvalue',
+            &$parser($new->getfield($svcdb.'__'.$field))
+          );
+        } else {
+          $part_svc_column->setfield('columnflag',  '');
+          $part_svc_column->setfield('columnvalue', '');
+        }
+
+        $part_svc_column->setfield('columnlabel', $label)
+          if $label !~ /^\s*$/;
+
         if ( $previous ) {
           $error = $part_svc_column->replace($previous);
         } else {
@@ -359,6 +388,9 @@ sub check {
     || $self->ut_text('svc')
     || $self->ut_alpha('svcdb')
     || $self->ut_enum('disabled', [ '', 'Y' ] )
+    || $self->ut_enum('preserve', [ '', 'Y' ] )
+    || $self->ut_enum('selfservice_access', [ '', 'hidden', 'readonly' ] )
+    || $self->ut_foreign_keyn('classnum', 'part_svc_class', 'classnum' )
   ;
   return $error if $error;
 
@@ -409,6 +441,7 @@ sub part_export {
   my $self = shift;
   my %search;
   $search{'exporttype'} = shift if @_;
+  sort { $a->weight <=> $b->weight }
   map { qsearchs('part_export', { 'exportnum' => $_->exportnum, %search } ) }
     qsearch('export_svc', { 'svcpart' => $self->svcpart } );
 }
@@ -437,6 +470,17 @@ sub part_export_did {
   grep $_->can('get_dids'), $self->part_export;
 }
 
+=item part_export_dsl_pull
+
+Returns a list of any exports (see L<FS::part_export>) for this service that
+are capable of pulling/pushing DSL orders.
+
+=cut
+
+sub part_export_dsl_pull {
+    my $self = shift;
+    grep $_->can('dsl_pull'), $self->part_export;
+}
 
 =item cust_svc [ PKGPART ] 
 
@@ -547,7 +591,7 @@ sub _svc_defs {
       };
       my $mod = $1;
 
-      if ( $mod =~ /^svc_[A-Z]/ or $mod =~ /^svc_acct_pop$/ ) {
+      if ( $mod =~ /^svc_[A-Z]/ or $mod =~ /^(svc_acct_pop|svc_export_machine)$/ ) {
         warn "skipping FS::$mod" if $DEBUG;
        next;
       }
@@ -582,28 +626,6 @@ sub _svc_defs {
     keys %info,
   ;
   
-  # yuck.  maybe this won't be so bad when virtual fields become real fields
-  my %vfields;
-  foreach my $svcdb (grep dbdef->table($_), keys %svc_defs ) {
-    eval "use FS::$svcdb;";
-    my $self = "FS::$svcdb"->new;
-    $vfields{$svcdb} = {};
-    foreach my $field ($self->virtual_fields) { # svc_Common::virtual_fields with a null svcpart returns all of them
-      my $pvf = $self->pvf($field);
-      my @list = $pvf->list;
-      if (scalar @list) {
-        $svc_defs{$svcdb}->{$field} = { desc        => $pvf->label,
-                                        type        => 'select',
-                                        select_list => \@list };
-      } else {
-        $svc_defs{$svcdb}->{$field} = $pvf->label;
-      } #endif
-      $vfields{$svcdb}->{$field} = $pvf;
-      warn "\$vfields{$svcdb}->{$field} = $pvf"
-        if $DEBUG;
-    } #next $field
-  } #next $svcdb
-  
   $svc_defs = \%svc_defs; #cache
   
 }
@@ -636,7 +658,8 @@ the following keys:
 
 =item def_label - Optional description of the field in the context of service definitions
 
-=item type - Currently "text", "select", "disabled", or "radius_usergroup_selector"
+=item type - Currently "text", "select", "checkbox", "textarea", "disabled", 
+some components specified by "select-.*.html", and a bunch more...
 
 =item disable_default - This field should not allow a default value in service definitions
 
@@ -698,11 +721,17 @@ sub process {
   my $old = qsearchs('part_svc', { 'svcpart' => $param->{'svcpart'} }) 
     if $param->{'svcpart'};
 
-  $param->{'svc_acct__usergroup'} =
-    ref($param->{'svc_acct__usergroup'})
-      ? join(',', @{$param->{'svc_acct__usergroup'}} )
-      : $param->{'svc_acct__usergroup'};
+  #unmunge cgp_accessmodes (falze laziness-ish w/edit/process/svc_acct.cgi)
+  $param->{'svc_acct__cgp_accessmodes'} ||=
+    join(' ', sort
+      grep { $_ !~ /^(flag|label)$/ }
+           map { /^svc_acct__cgp_accessmodes_([\w\/]+)$/ or die "no way"; $1; }
+               grep $param->{$_},
+                    grep /^svc_acct__cgp_accessmodes_([\w\/]+)$/,
+                         keys %$param
+        );
   
+
   my $new = new FS::part_svc ( {
     map {
       $_ => $param->{$_};
@@ -710,20 +739,22 @@ sub process {
     } ( fields('part_svc'),
         map { my $svcdb = $_;
               my @fields = fields($svcdb);
-              push @fields, 'usergroup' if $svcdb eq 'svc_acct'; #kludge
+              push @fields, 'usergroup' if $svcdb eq 'svc_acct'
+                                        or $svcdb eq 'svc_broadband'; #kludge
 
               map {
-                    if ( $param->{ $svcdb.'__'.$_.'_flag' } =~ /^[MA]$/ ) {
-                      $param->{ $svcdb.'__'.$_ } =
-                        delete( $param->{ $svcdb.'__'.$_.'_classnum' } );
+                    my $f = $svcdb.'__'.$_;
+                    my $flag = $param->{ $f.'_flag' } || ''; #silence warnings
+                    if ( $flag =~ /^[MAH]$/ ) {
+                      $param->{ $f } = delete( $param->{ $f.'_classnum' } );
                     }
-                   if ( $param->{ $svcdb.'__'.$_.'_flag' } =~ /^S$/ ) {
-                      $param->{ $svcdb.'__'.$_} =
-                        ref($param->{ $svcdb.'__'.$_})
-                          ? join(',', @{$param->{ $svcdb.'__'.$_ }} )
-                          : $param->{ $svcdb.'__'.$_ };
+                   if ( $flag =~ /^S$/ 
+                          or $_ eq 'usergroup' ) {
+                      $param->{ $f } = ref($param->{ $f })
+                                         ? join(',', @{$param->{ $f }} )
+                                         : $param->{ $f };
                    }
-                    ( $svcdb.'__'.$_, $svcdb.'__'.$_.'_flag' );
+                    ( $f, $f.'_flag', $f.'_label' );
                   }
                   @fields;
 
@@ -738,7 +769,7 @@ sub process {
   my $error;
   if ( $param->{'svcpart'} ) {
     $error = $new->replace( $old,
-                            '1.3-COMPAT',
+                            '1.3-COMPAT',    #totally bunk, as jeff noted
                             [ 'usergroup' ],
                             \%exportnums,
                             $job
@@ -769,6 +800,9 @@ sub process_bulk_cust_svc {
   my $param = thaw(decode_base64(shift));
   warn Dumper($param) if $DEBUG;
 
+  local($FS::svc_Common::noexport_hack) = 1
+    if $param->{'noexport'};
+
   my $old_part_svc =
     qsearchs('part_svc', { 'svcpart' => $param->{'old_svcpart'} } );
 
@@ -817,6 +851,50 @@ sub process_bulk_cust_svc {
 
 }
 
+sub _upgrade_data {  #class method
+  my ($class, %opts) = @_;
+
+  my @part_svc_column = qsearch('part_svc_column', { 'columnname' => 'usergroup' });
+  foreach my $col ( @part_svc_column ) {
+    next if $col->columnvalue =~ /^[\d,]+$/ || !$col->columnvalue;
+    my @groupnames = split(',',$col->columnvalue);
+    my @groupnums;
+    my $error = '';
+    foreach my $groupname ( @groupnames ) {
+        my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
+        unless ( $g ) {
+            $g = new FS::radius_group {
+                            'groupname' => $groupname,
+                            'description' => $groupname,
+                            };
+            $error = $g->insert;
+            die "Error inserting new radius_group for service definition group \"$groupname\": $error"
+              if $error;
+        }
+        push @groupnums, $g->groupnum;
+    }
+    $col->columnvalue(join(',',@groupnums));
+    $error = $col->replace;
+    die $error if $error;
+  }
+
+  my @badlabels = qsearch({
+    'table' => 'part_svc_column',
+    'hashref' => {},
+    'extra_sql' => 'WHERE columnlabel IN ('.
+      "'Descriptive label for this particular device.',".
+      "'IP address.  Leave blank for automatic assignment.',".
+      "'Maximum upload speed for this service in Kbps.  0 denotes unlimited.',".
+      "'Maximum download speed for this service in Kbps.  0 denotes unlimited.')"
+  });
+  foreach my $col ( @badlabels ) {
+    $col->columnlabel('');
+    my $error = $col->replace;
+    die $error if $error;
+  }
+
+}
+
 =head1 BUGS
 
 Delete is unimplemented.