X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fpart_svc.pm;h=1bb66ed9716dcdad562adad6ec31cac1e444498d;hb=5af515ac6bdc6ff88860c618207660eac48c276a;hp=258734735627fec9fbdd39b4f9545aa2470a7dee;hpb=1053db7f76169cbbc87840539959a4c362aff242;p=freeside.git

diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm
index 258734735..1bb66ed97 100644
--- a/FS/FS/part_svc.pm
+++ b/FS/FS/part_svc.pm
@@ -2,6 +2,7 @@ package FS::part_svc;
 
 use strict;
 use vars qw( @ISA $DEBUG );
+use Tie::IxHash;
 use FS::Record qw( qsearch qsearchs fields dbh );
 use FS::Schema qw( dbdef );
 use FS::part_svc_column;
@@ -11,7 +12,7 @@ use FS::cust_svc;
 
 @ISA = qw(FS::Record);
 
-$DEBUG = 1;
+$DEBUG = 0;
 
 =head1 NAME
 
@@ -52,6 +53,8 @@ L<FS::svc_domain>, and L<FS::svc_forward>, among others.
 
 =item disabled - Disabled flag, empty or `Y'
 
+=item preserve - Preserve after cancellation, empty or 'Y'
+
 =back
 
 =head1 METHODS
@@ -132,7 +135,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);
@@ -141,18 +145,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
-      $part_svc_column->setfield('columnflag', $1);
-      $part_svc_column->setfield('columnvalue',
-        $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 : '';
     }
@@ -178,6 +192,8 @@ sub insert {
     }
   }
 
+  # XXX shouldn't this update fixed values?
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   '';
@@ -251,22 +267,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
-        $part_svc_column->setfield('columnflag', $1);
-        $part_svc_column->setfield('columnvalue',
-          $new->getfield($svcdb.'__'.$field)
-        );
+      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('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 {
@@ -354,6 +385,7 @@ sub check {
     || $self->ut_text('svc')
     || $self->ut_alpha('svcdb')
     || $self->ut_enum('disabled', [ '', 'Y' ] )
+    || $self->ut_enum('preserve', [ '', 'Y' ] )
   ;
   return $error if $error;
 
@@ -404,6 +436,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 } );
 }
@@ -420,6 +453,30 @@ sub part_export_usage {
   grep $_->can('usage_sessions'), $self->part_export;
 }
 
+=item part_export_did
+
+Returns a list of any exports (see L<FS::part_export>) for this service that
+are capable of returing available DID (phone number) information.
+
+=cut
+
+sub part_export_did {
+  my $self = shift;
+  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 ] 
 
 Returns a list of associated customer services (FS::cust_svc records).
@@ -500,6 +557,162 @@ sub svc_x {
   map { $_->svc_x } $self->cust_svc;
 }
 
+=back
+
+=head1 CLASS METHODS
+
+=over 4
+
+=cut
+
+my $svc_defs;
+sub _svc_defs {
+
+  return $svc_defs if $svc_defs; #cache
+
+  my $conf = new FS::Conf;
+
+  #false laziness w/part_pkg.pm::plan_info
+
+  my %info;
+  foreach my $INC ( @INC ) {
+    warn "globbing $INC/FS/svc_*.pm\n" if $DEBUG;
+    foreach my $file ( glob("$INC/FS/svc_*.pm") ) {
+
+      warn "attempting to load service table info from $file\n" if $DEBUG;
+      $file =~ /\/(\w+)\.pm$/ or do {
+        warn "unrecognized file in $INC/FS/: $file\n";
+        next;
+      };
+      my $mod = $1;
+
+      if ( $mod =~ /^svc_[A-Z]/ or $mod =~ /^svc_acct_pop$/ ) {
+        warn "skipping FS::$mod" if $DEBUG;
+	next;
+      }
+
+      eval "use FS::$mod;";
+      if ( $@ ) {
+        die "error using FS::$mod (skipping): $@\n" if $@;
+        next;
+      }
+      unless ( UNIVERSAL::can("FS::$mod", 'table_info') ) {
+        warn "FS::$mod has no table_info method; skipping";
+	next;
+      }
+
+      my $info = "FS::$mod"->table_info;
+      unless ( keys %$info ) {
+        warn "FS::$mod->table_info doesn't return info, skipping\n";
+        next;
+      }
+      warn "got info from FS::$mod: $info\n" if $DEBUG;
+      if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
+        warn "skipping disabled service FS::$mod" if $DEBUG;
+        next;
+      }
+      $info{$mod} = $info;
+    }
+  }
+
+  tie my %svc_defs, 'Tie::IxHash', 
+    map  { $_ => $info{$_}->{'fields'} }
+    sort { $info{$a}->{'display_weight'} <=> $info{$b}->{'display_weight'} }
+    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
+  
+}
+
+=item svc_tables
+
+Returns a list of all svc_ tables.
+
+=cut
+
+sub svc_tables {
+  my $class = shift;
+  my $svc_defs = $class->_svc_defs;
+  grep { defined( dbdef->table($_) ) } keys %$svc_defs;
+}
+
+=item svc_table_fields TABLE
+
+Given a table name, returns a hashref of field names.  The field names
+returned are those with additional (service-definition related) information,
+not necessarily all database fields of the table.  Pseudo-fields may also
+be returned (i.e. svc_acct.usergroup).
+
+Each value of the hashref is another hashref, which can have one or more of
+the following keys:
+
+=over 4
+
+=item label - Description of the field
+
+=item def_label - Optional description of the field in the context of service definitions
+
+=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
+
+=item disable_fixed - This field should not allow a fixed value in service definitions
+
+=item disable_inventory - This field should not allow inventory values in service definitions
+
+=item select_list - If type is "text", this can be a listref of possible values.
+
+=item select_table - An alternative to select_list, this defines a database table with the possible choices.
+
+=item select_key - Used with select_table, this is the field name of keys
+
+=item select_label - Used with select_table, this is the field name of labels
+
+=back
+
+=cut
+
+#maybe this should move and be a class method in svc_Common.pm
+sub svc_table_fields {
+  my($class, $table) = @_;
+  my $svc_defs = $class->_svc_defs;
+  my $def = $svc_defs->{$table};
+
+  foreach ( grep !ref($def->{$_}), keys %$def ) {
+
+    #normalize the shortcut in %info hash
+    $def->{$_} = { 'label' => $def->{$_} };
+
+    $def->{$_}{'type'} ||= 'text';
+
+  }
+
+  $def;
+}
 
 =back
 
@@ -525,11 +738,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->{$_};
@@ -537,21 +756,26 @@ 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' } );
                     }
-                    ( $svcdb.'__'.$_, $svcdb.'__'.$_.'_flag' );
+		    if ( $flag =~ /^S$/ 
+                          or $_ eq 'usergroup' ) {
+                      $param->{ $f } = ref($param->{ $f })
+                                         ? join(',', @{$param->{ $f }} )
+                                         : $param->{ $f };
+		    }
+                    ( $f, $f.'_flag', $f.'_label' );
                   }
                   @fields;
 
-            } grep defined( dbdef->table($_) ),
-                   qw( svc_acct svc_domain svc_forward svc_www svc_broadband
-                       svc_phone svc_external
-                     )
+            } FS::part_svc->svc_tables()
       )
   } );
   
@@ -562,7 +786,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
@@ -593,6 +817,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'} } );
 
@@ -641,12 +868,40 @@ 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 if $error;
+        }
+        push @groupnums, $g->groupnum;
+    }
+    $col->columnvalue(join(',',@groupnums));
+    $error = $col->replace;
+    die $error if $error;
+  }
+
+}
+
 =head1 BUGS
 
 Delete is unimplemented.
 
-The list of svc_* tables is hardcoded.  When svc_acct_pop is renamed, this
-should be fixed.
+The list of svc_* tables is no longer hardcoded, but svc_acct_pop is skipped
+as a special case until it is renamed.
 
 all_part_svc_column methods should be documented