fix 'Can't call method "setup" on an undefined value' error when using into rates...
[freeside.git] / FS / FS / part_svc.pm
index 4fae457..19a71df 100644 (file)
@@ -53,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
@@ -133,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);
@@ -142,20 +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
-      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 +192,8 @@ sub insert {
     }
   }
 
+  # XXX shouldn't this update fixed values?
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   '';
@@ -254,24 +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
-        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 +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;
 
@@ -409,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 } );
 }
@@ -425,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).
@@ -623,7 +675,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
 
@@ -685,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->{$_};
@@ -697,20 +756,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;
 
@@ -725,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
@@ -756,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'} } );
 
@@ -804,6 +868,49 @@ 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;
+  }
+
+  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.