RT#34289: Flag service fields as mandatory

1 files changed, 111 insertions, 85 deletions

diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm
index 1da30cb..ca26074 100644
--- a/FS/FS/part_svc.pm
+++ b/FS/FS/part_svc.pm
@@ -142,56 +142,53 @@ sub insert {
   # add part_svc_column records
 
   my $svcdb = $self->svcdb;
-#  my @rows = map { /^${svcdb}__(.*)$/; $1 }
-#    grep ! /_flag$/,
-#      grep /^${svcdb}__/,
-#        fields('part_svc');
-  foreach my $field (
-    grep { $_ ne 'svcnum'
-           && ( defined( $self->getfield($svcdb.'__'.$_.'_flag') )
-                || defined($self->getfield($svcdb.'__'.$_.'_required'))
-                || $self->getfield($svcdb.'__'.$_.'_label') !~ /^\s*$/ )
-         } (fields($svcdb), @fields)
-  ) {
-    my $part_svc_column = $self->part_svc_column($field);
-    my $previous = qsearchs('part_svc_column', {
-      'svcpart'    => $self->svcpart,
-      'columnname' => $field,
-    } );
+  foreach my $field (fields($svcdb), @fields) {
+    next if $field eq 'svcnum';
+    my $prefix = $svcdb.'__';
+    if ( defined( $self->getfield($prefix.$_.'_flag'))
+      or defined($self->getfield($prefix.$_.'_required'))
+      or length($self->getfield($prefix.$_.'_label'))
+    ) {
+      my $part_svc_column = $self->part_svc_column($field);
+      my $previous = qsearchs('part_svc_column', {
+        'svcpart'    => $self->svcpart,
+        'columnname' => $field,
+      } );
 
-    my $flag  = $self->getfield($svcdb.'__'.$field.'_flag');
-    my $label = $self->getfield($svcdb.'__'.$field.'_label');
-    my $required = $self->getfield($svcdb.'__'.$field.'_required') ? 'Y' : '';
-    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))
-        );
-      }
+      my $flag  = $self->getfield($prefix.$field.'_flag');
+      my $label = $self->getfield($prefix.$field.'_label');
+      my $required = $self->getfield($prefix.$field.'_required') ? 'Y' : '';
+      if ( uc($flag) =~ /^([A-Z])$/ || $label !~ /^\s*$/ ) {
 
-      $part_svc_column->setfield('columnlabel', $label)
-        if $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($prefix.$field))
+          );
+        }
+
+        $part_svc_column->setfield('columnlabel', $label)
+          if $label !~ /^\s*$/;
 
-      $part_svc_column->setfield('required', $required);
+        $part_svc_column->setfield('required', $required);
+
+        if ( $previous ) {
+          $error = $part_svc_column->replace($previous);
+        } else {
+          $error = $part_svc_column->insert;
+        }
 
-      if ( $previous ) {
-        $error = $part_svc_column->replace($previous);
       } else {
-        $error = $part_svc_column->insert;
+        $error = $previous ? $previous->delete : '';
+      }
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $error;
       }
 
-    } else {
-      $error = $previous ? $previous->delete : '';
-    }
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return $error;
     }
-
   }
 
   # add export_svc records
@@ -284,54 +281,54 @@ sub replace {
    # maintain part_svc_column records
 
     my $svcdb = $new->svcdb;
-    foreach my $field (
-      grep { $_ ne 'svcnum'
-             && ( defined( $new->getfield($svcdb.'__'.$_.'_flag') )
-                  || defined($new->getfield($svcdb.'__'.$_.'_required'))
-                  || $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');
-      my $label = $new->getfield($svcdb.'__'.$field.'_label');
-      my $required = $new->getfield($svcdb.'__'.$field.'_required') ? 'Y' : '';
+    foreach my $field (fields($svcdb),@fields) {
+      next if $field eq 'svcnum';
+      my $prefix = $svcdb.'__';
+      if ( defined( $new->getfield($prefix.$_.'_flag'))
+        or defined($new->getfield($prefix.$_.'_required'))
+        or length($new->getfield($prefix.$_.'_label'))
+      ) {
+        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');
+        my $label = $new->getfield($svcdb.'__'.$field.'_label');
+        my $required = $new->getfield($svcdb.'__'.$field.'_required') ? 'Y' : '';
  
-      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', '');
-        }
+        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*$/;
+          $part_svc_column->setfield('columnlabel', $label)
+            if $label !~ /^\s*$/;
 
-        $part_svc_column->setfield('required', $required);
+          $part_svc_column->setfield('required', $required);
 
-        if ( $previous ) {
-          $error = $part_svc_column->replace($previous);
+          if ( $previous ) {
+            $error = $part_svc_column->replace($previous);
+          } else {
+            $error = $part_svc_column->insert;
+          }
         } else {
-          $error = $part_svc_column->insert;
+          $error = $previous ? $previous->delete : '';
+        }
+        if ( $error ) {
+          $dbh->rollback if $oldAutoCommit;
+          return $error;
         }
-      } else {
-        $error = $previous ? $previous->delete : '';
-      }
-      if ( $error ) {
-        $dbh->rollback if $oldAutoCommit;
-        return $error;
       }
     }
 
@@ -605,6 +602,7 @@ sub svc_x {
 =cut
 
 my $svc_defs;
+my $svc_info;
 sub _svc_defs {
 
   return $svc_defs if $svc_defs; #cache
@@ -659,7 +657,14 @@ sub _svc_defs {
     sort { $info{$a}->{'display_weight'} <=> $info{$b}->{'display_weight'} }
     keys %info,
   ;
-  
+
+  tie my %svc_info, 'Tie::IxHash',
+    map  { $_ => $info{$_} }
+    sort { $info{$a}->{'display_weight'} <=> $info{$b}->{'display_weight'} }
+    keys %info,
+  ;
+    
+  $svc_info = \%svc_info; #access via svc_table_info  
   $svc_defs = \%svc_defs; #cache
   
 }
@@ -735,6 +740,27 @@ sub svc_table_fields {
   $def;
 }
 
+=item svc_table_info TABLE
+
+Returns table_info for TABLE from cache, or empty
+hashref if none is found.
+
+Caution:  caches table_info for ALL services when run;
+access a service's table_info directly unless you know
+you're loading them all.
+
+Caution:  does not standardize fields into hashrefs;
+use L</svc_table_fields> to access fields.
+
+=cut
+
+sub svc_table_info {
+  my $class = shift;
+  my $table = shift;
+  $class->_svc_defs; #creates cache if needed
+  return $svc_info->{$table} || {};
+}
+
 =back
 
 =head1 SUBROUTINES