Virtual field merge

53 files changed, 796 insertions, 228 deletions

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 02fd4e3..9d82d94 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -14,10 +14,14 @@ use FS::UID qw(dbh getotaker datasrc driver_name);
 use FS::SearchCache;
 use FS::Msgcat qw(gettext);
 
+use FS::part_virtual_field;
+
+use Tie::IxHash;
+
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch);
 
-$DEBUG = 0;
+$DEBUG = 2;
 $me = '[FS::Record]';
 
 #ask FS::UID to run this stuff for us later
@@ -200,12 +204,15 @@ sub qsearch {
   my $dbh = dbh;
 
   my $table = $cache ? $cache->table : $stable;
+  my $pkey = $dbdef->table($table)->primary_key;
 
-  my @fields = grep exists($record->{$_}), fields($table);
+  my @real_fields = grep exists($record->{$_}), real_fields($table);
+  my @virtual_fields = grep exists($record->{$_}), "FS::$table"->virtual_fields;
 
   my $statement = "SELECT $select FROM $stable";
-  if ( @fields ) {
-    $statement .= ' WHERE '. join(' AND ', map {
+  if ( @real_fields or @virtual_fields ) {
+    $statement .= ' WHERE '. join(' AND ',
+      ( map {
 
       my $op = '=';
       my $column = $_;
@@ -251,8 +258,45 @@ sub qsearch {
       } else {
         "$column $op ?";
       }
-    } @fields );
+    } @real_fields ), 
+    ( map {
+      my $op = '=';
+      my $column = $_;
+      if ( ref($record->{$_}) ) {
+        $op = $record->{$_}{'op'} if $record->{$_}{'op'};
+	if ( uc($op) eq 'ILIKE' ) {
+	  $op = 'LIKE';
+	  $record->{$_}{'value'} = lc($record->{$_}{'value'});
+	  $column = "LOWER($_)";
+	}
+	$record->{$_} = $record->{$_}{'value'};
+      }
+
+      # ... EXISTS ( SELECT name, value FROM part_virtual_field
+      #              JOIN virtual_field
+      #              ON part_virtual_field.vfieldpart = virtual_field.vfieldpart
+      #              WHERE recnum = svc_acct.svcnum
+      #              AND (name, value) = ('egad', 'brain') )
+
+      my $value = $record->{$_};
+
+      my $subq;
+
+      $subq = ($value ? 'EXISTS ' : 'NOT EXISTS ') .
+      "( SELECT part_virtual_field.name, virtual_field.value ".
+      "FROM part_virtual_field JOIN virtual_field ".
+      "ON part_virtual_field.vfieldpart = virtual_field.vfieldpart ".
+      "WHERE virtual_field.recnum = ${table}.${pkey} ".
+      "AND part_virtual_field.name = '${column}'".
+      ($value ? 
+        " AND virtual_field.value ${op} '${value}'"
+      : "") . ")";
+      $subq;
+
+    } @virtual_fields ) );
+
   }
+
   $statement .= " $extra_sql" if defined($extra_sql);
 
   warn "[debug]$me $statement\n" if $DEBUG > 1;
@@ -262,7 +306,7 @@ sub qsearch {
   my $bind = 1;
 
   foreach my $field (
-    grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
+    grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields
   ) {
     if ( $record->{$field} =~ /^\d+(\.\d+)?$/
          && $dbdef->table($table)->column($field)->type =~ /(int)/i
@@ -279,31 +323,64 @@ sub qsearch {
 
   $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr;
 
-  $dbh->commit or croak $dbh->errstr if $FS::UID::AutoCommit;
+  my %result;
+  tie %result, "Tie::IxHash";
+  @virtual_fields = "FS::$table"->virtual_fields;
+
+  my @stuff = @{ $sth->fetchall_arrayref( {} ) };
+  if($pkey) {
+    %result = map { $_->{$pkey}, $_ } @stuff;
+  } else {
+    @result{@stuff} = @stuff;
+  }
 
+  $sth->finish;
+  if ( keys(%result) and @virtual_fields ) {
+    $statement =
+      "SELECT virtual_field.recnum, part_virtual_field.name, ".
+             "virtual_field.value ".
+      "FROM part_virtual_field JOIN virtual_field USING (vfieldpart) ".
+      "WHERE part_virtual_field.dbtable = '$table' AND ".
+      "virtual_field.recnum IN (".
+      join(',', keys(%result)). ") AND part_virtual_field.name IN ('".
+      join(q!', '!, @virtual_fields) . "')";
+    warn "[debug]$me $statement\n" if $DEBUG > 1;
+    $sth = $dbh->prepare($statement) or croak "$dbh->errstr doing $statement";
+    $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr;
+
+    foreach (@{ $sth->fetchall_arrayref({}) }) {
+      my $recnum = $_->{recnum};
+      my $name = $_->{name};
+      my $value = $_->{value};
+      if (exists($result{$recnum})) {
+        $result{$recnum}->{$name} = $value;
+      }
+    }
+  }
+  
   if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
     if ( eval 'FS::'. $table. '->can(\'new\')' eq \&new ) {
       #derivied class didn't override new method, so this optimization is safe
       if ( $cache ) {
         map {
           new_or_cached( "FS::$table", { %{$_} }, $cache )
-        } @{$sth->fetchall_arrayref( {} )};
+        } values(%result);
       } else {
         map {
           new( "FS::$table", { %{$_} } )
-        } @{$sth->fetchall_arrayref( {} )};
+        } values(%result);
       }
     } else {
       warn "untested code (class FS::$table uses custom new method)";
       map {
         eval 'FS::'. $table. '->new( { %{$_} } )';
-      } @{$sth->fetchall_arrayref( {} )};
+      } values(%result);
     }
   } else {
     cluck "warning: FS::$table not loaded; returning FS::Record objects";
     map {
       FS::Record->new( $table, { %{$_} } );
-    } @{$sth->fetchall_arrayref( {} )};
+    } values(%result);
   }
 
 }
@@ -512,15 +589,15 @@ sub insert {
 
   my $table = $self->table;
   #false laziness w/delete
-  my @fields =
+  my @real_fields =
     grep defined($self->getfield($_)) && $self->getfield($_) ne "",
-    $self->fields
+    real_fields($table)
   ;
-  my @values = map { _quote( $self->getfield($_), $table, $_) } @fields;
+  my @values = map { _quote( $self->getfield($_), $table, $_) } @real_fields;
   #eslaf
 
   my $statement = "INSERT INTO $table ( ".
-      join( ', ', @fields ).
+      join( ', ', @real_fields ).
     ") VALUES (".
       join( ', ', @values ).
     ")"
@@ -537,9 +614,9 @@ sub insert {
 
   $sth->execute or return $sth->errstr;
 
+  my $insertid = '';
   if ( $db_seq ) { # get inserted id from the database, if applicable
     warn "[debug]$me retreiving sequence from database\n" if $DEBUG;
-    my $insertid = '';
     if ( driver_name eq 'Pg' ) {
 
       my $oid = $sth->{'pg_oid_status'};
@@ -581,6 +658,34 @@ sub insert {
     $self->setfield($primary_key, $insertid);
   }
 
+  my @virtual_fields = 
+      grep defined($self->getfield($_)) && $self->getfield($_) ne "",
+          $self->virtual_fields;
+  if (@virtual_fields) {
+    my %v_values = map { $_, $self->getfield($_) } @virtual_fields;
+
+    my $vfieldpart = vfieldpart_hashref($table);
+
+    my $v_statement = "INSERT INTO virtual_field(recnum, vfieldpart, value) ".
+                    "VALUES (?, ?, ?)";
+
+    my $v_sth = dbh->prepare($v_statement) or do {
+      dbh->rollback if $FS::UID::AutoCommit;
+      return dbh->errstr;
+    };
+
+    foreach (keys(%v_values)) {
+      $v_sth->execute($self->getfield($primary_key),
+                      $vfieldpart->{$_},
+                      $v_values{$_})
+      or do {
+        dbh->rollback if $FS::UID::AutoCommit;
+        return $v_sth->errstr;
+      };
+    }
+  }
+
+
   my $h_sth;
   if ( defined $dbdef->table('h_'. $table) ) {
     my $h_statement = $self->_h_statement('insert');
@@ -631,7 +736,7 @@ sub delete {
         : "$_ = ". _quote($self->getfield($_),$self->table,$_)
     } ( $self->dbdef_table->primary_key )
           ? ( $self->dbdef_table->primary_key)
-          : $self->fields
+          : real_fields($self->table)
   );
   warn "[debug]$me $statement\n" if $DEBUG > 1;
   my $sth = dbh->prepare($statement) or return dbh->errstr;
@@ -645,6 +750,19 @@ sub delete {
     $h_sth = '';
   }
 
+  my $primary_key = $self->dbdef_table->primary_key;
+  my $v_sth;
+  my @del_vfields;
+  my $vfp = vfieldpart_hashref($self->table);
+  foreach($self->virtual_fields) {
+    next if $self->getfield($_) eq '';
+    unless(@del_vfields) {
+      my $st = "DELETE FROM virtual_field WHERE recnum = ? AND vfieldpart = ?";
+      $v_sth = dbh->prepare($st) or return dbh->errstr;
+    }
+    push @del_vfields, $_;
+  }
+
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE'; 
@@ -655,6 +773,10 @@ sub delete {
   my $rc = $sth->execute or return $sth->errstr;
   #not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0";
   $h_sth->execute or return $h_sth->errstr if $h_sth;
+  $v_sth->execute($self->getfield($primary_key), $vfp->{$_}) 
+    or return $v_sth->errstr 
+        foreach (@del_vfields);
+  
   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
   #no need to needlessly destoy the data either (causes problems actually)
@@ -695,8 +817,11 @@ sub replace {
   my $error = $new->check;
   return $error if $error;
 
-  my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields;
-  unless ( @diff ) {
+  #my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields;
+  my %diff = map { ($new->getfield($_) ne $old->getfield($_))
+                   ? ($_, $new->getfield($_)) : () } $old->fields;
+                   
+  unless ( keys(%diff) ) {
     carp "[warning]$me $new -> replace $old: records identical";
     return '';
   }
@@ -704,7 +829,7 @@ sub replace {
   my $statement = "UPDATE ". $old->table. " SET ". join(', ',
     map {
       "$_ = ". _quote($new->getfield($_),$old->table,$_) 
-    } @diff
+    } real_fields($old->table)
   ). ' WHERE '.
     join(' AND ',
       map {
@@ -715,7 +840,7 @@ sub replace {
                 : "( $_ IS NULL OR $_ = \"\" )"
             )
           : "$_ = ". _quote($old->getfield($_),$old->table,$_)
-      } ( $primary_key ? ( $primary_key ) : $old->fields )
+      } ( $primary_key ? ( $primary_key ) : real_fields($old->table) )
     )
   ;
   warn "[debug]$me $statement\n" if $DEBUG > 1;
@@ -739,6 +864,44 @@ sub replace {
     $h_new_sth = '';
   }
 
+  # For virtual fields we have three cases with different SQL 
+  # statements: add, replace, delete
+  my $v_add_sth;
+  my $v_rep_sth;
+  my $v_del_sth;
+  my (@add_vfields, @rep_vfields, @del_vfields);
+  my $vfp = vfieldpart_hashref($old->table);
+  foreach(grep { exists($diff{$_}) } $new->virtual_fields) {
+    if($diff{$_} eq '') {
+      # Delete
+      unless(@del_vfields) {
+        my $st = "DELETE FROM virtual_field WHERE recnum = ? ".
+                 "AND vfieldpart = ?";
+        warn "[debug]$me $st\n" if $DEBUG > 2;
+        $v_del_sth = dbh->prepare($st) or return dbh->errstr;
+      }
+      push @del_vfields, $_;
+    } elsif($old->getfield($_) eq '') {
+      # Add
+      unless(@add_vfields) {
+        my $st = "INSERT INTO virtual_field (value, recnum, vfieldpart) ".
+	         "VALUES (?, ?, ?)";
+        warn "[debug]$me $st\n" if $DEBUG > 2;
+        $v_add_sth = dbh->prepare($st) or return dbh->errstr;
+      }
+      push @add_vfields, $_;
+    } else {
+      # Replace
+      unless(@rep_vfields) {
+        my $st = "UPDATE virtual_field SET value = ? ".
+                 "WHERE recnum = ? AND vfieldpart = ?";
+        warn "[debug]$me $st\n" if $DEBUG > 2;
+        $v_rep_sth = dbh->prepare($st) or return dbh->errstr;
+      }
+      push @rep_vfields, $_;
+    }
+  }
+
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE'; 
@@ -750,6 +913,24 @@ sub replace {
   #not portable #return "Record not found (or records identical)." if $rc eq "0E0";
   $h_old_sth->execute or return $h_old_sth->errstr if $h_old_sth;
   $h_new_sth->execute or return $h_new_sth->errstr if $h_new_sth;
+
+  $v_del_sth->execute($old->getfield($primary_key),
+                      $vfp->{$_})
+        or return $v_del_sth->errstr
+      foreach(@del_vfields);
+
+  $v_add_sth->execute($new->getfield($_),
+                      $old->getfield($primary_key),
+                      $vfp->{$_})
+        or return $v_add_sth->errstr
+      foreach(@add_vfields);
+
+  $v_rep_sth->execute($new->getfield($_),
+                      $old->getfield($primary_key),
+                      $vfp->{$_})
+        or return $v_rep_sth->errstr
+      foreach(@rep_vfields);
+
   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
   '';
@@ -769,12 +950,28 @@ sub rep {
 
 =item check
 
-Not yet implemented, croaks.  Derived classes should provide a check method.
+Checks virtual fields (using check_blocks).  Subclasses should still provide 
+a check method to validate real fields, foreign keys, etc., and call this 
+method via $self->SUPER::check.
+
+(FIXME: Should this method try to make sure that it I<is> being called from 
+a subclass's check method, to keep the current semantics as far as possible?)
 
 =cut
 
 sub check {
-  confess "FS::Record::check not implemented; supply one in subclass!";
+  #confess "FS::Record::check not implemented; supply one in subclass!";
+  my $self = shift;
+
+  foreach my $field ($self->virtual_fields) {
+    for ($self->getfield($field)) {
+      # See notes on check_block in FS::part_virtual_field.
+      eval $self->pvf($field)->check_block;
+      return $@ if $@;
+      $self->setfield($field, $_);
+    }
+  }
+  '';
 }
 
 sub _h_statement {
@@ -782,7 +979,7 @@ sub _h_statement {
 
   my @fields =
     grep defined($self->getfield($_)) && $self->getfield($_) ne "",
-    $self->fields
+    real_fields($self->table);
   ;
   my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields;
 
@@ -1163,36 +1360,89 @@ sub ut_foreign_keyn {
     : '';
 }
 
+
+=item virtual_fields [ TABLE ]
+
+Returns a list of virtual fields defined for the table.  This should not 
+be exported, and should only be called as an instance or class method.
+
+=cut
+
+sub virtual_fields {
+  my $something = shift;
+  my $table;
+  $table = $something->table or confess "virtual_fields called on non-table";
+
+  confess "Unknown table $table" unless $dbdef->table($table);
+
+  # This should be smart enough to cache results.
+
+  my $query = 'SELECT name from part_virtual_field ' .
+              "WHERE dbtable = '$table'";
+  my $dbh = dbh;
+  my $result = $dbh->selectcol_arrayref($query);
+  confess $dbh->errstr if $dbh->err;
+  return @$result;
+}
+
+
 =item fields [ TABLE ]
 
-This can be used as both a subroutine and a method call.  It returns a list
-of the columns in this record's table, or an explicitly specified table.
-(See L<DBIx::DBSchema::Table>).
+This is a wrapper for real_fields and virtual_fields.  Code that called
+fields before should probably continue to call fields.
 
 =cut
 
-# Usage: @fields = fields($table);
-#        @fields = $record->fields;
 sub fields {
   my $something = shift;
   my $table;
-  if ( ref($something) ) {
+  if($something->isa('FS::Record')) {
     $table = $something->table;
   } else {
     $table = $something;
+    $something = "FS::$table";
   }
-  #croak "Usage: \@fields = fields(\$table)\n   or: \@fields = \$record->fields" unless $table;
-  my($table_obj) = $dbdef->table($table);
-  confess "Unknown table $table" unless $table_obj;
-  $table_obj->columns;
+  return (real_fields($table), $something->virtual_fields());
 }
 
 =back
 
+=item pvf FIELD_NAME
+
+Returns the FS::part_virtual_field object corresponding to a field in the 
+record (specified by FIELD_NAME).
+
+=cut
+
+sub pvf {
+  my ($self, $name) = (shift, shift);
+
+  if(grep /^$name$/, $self->virtual_fields) {
+    return qsearchs('part_virtual_field', { dbtable => $self->table,
+                                            name    => $name } );
+  }
+  ''
+}
+
 =head1 SUBROUTINES
 
 =over 4
 
+=item real_fields [ TABLE ]
+
+Returns a list of the real columns in the specified table.  Called only by 
+fields() and other subroutines elsewhere in FS::Record.
+
+=cut
+
+sub real_fields {
+  my $table = shift;
+
+  my($table_obj) = $dbdef->table($table);
+  confess "Unknown table $table" unless $table_obj;
+  $table_obj->columns;
+}
+
 =item reload_dbdef([FILENAME])
 
 Load a database definition (see L<DBIx::DBSchema>), optionally from a
@@ -1251,6 +1501,28 @@ sub _quote {
   }
 }
 
+=item vfieldpart_hashref TABLE
+
+Returns a hashref of virtual field names and vfieldparts applicable to the given
+TABLE.
+
+=cut
+
+sub vfieldpart_hashref {
+  my ($table) = @_;
+
+  return () unless $table;
+  my $dbh = dbh;
+  my $statement = "SELECT vfieldpart, name FROM part_virtual_field WHERE ".
+                  "dbtable = '$table'";
+  my $sth = $dbh->prepare($statement);
+  $sth->execute or croak "Execution of '$statement' failed: ".$dbh->errstr;
+  return { map { $_->{name}, $_->{vfieldpart} } 
+    @{$sth->fetchall_arrayref({})} };
+
+}
+
+
 =item hfields TABLE
 
 This is deprecated.  Don't use it.
diff --git a/FS/FS/addr_block.pm b/FS/FS/addr_block.pm
index c5ddca7..4b034ef 100755
--- a/FS/FS/addr_block.pm
+++ b/FS/FS/addr_block.pm
@@ -122,7 +122,7 @@ sub check {
     }
   }
 
-  '';
+  $self->SUPER::check;
 }
 
 
diff --git a/FS/FS/agent.pm b/FS/FS/agent.pm
index f11a28d..6de15ae 100644
--- a/FS/FS/agent.pm
+++ b/FS/FS/agent.pm
@@ -113,8 +113,7 @@ sub check {
   return "Unknown typenum!"
     unless $self->agent_type;
 
-  '';
-
+  $self->SUPER::check;
 }
 
 =item agent_type
@@ -145,7 +144,7 @@ sub pkgpart_hashref {
 
 =head1 VERSION
 
-$Id: agent.pm,v 1.3 2002-03-24 18:23:47 ivan Exp $
+$Id: agent.pm,v 1.4 2003-08-05 00:20:40 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/agent_type.pm b/FS/FS/agent_type.pm
index 988533a..5ba5ef2 100644
--- a/FS/FS/agent_type.pm
+++ b/FS/FS/agent_type.pm
@@ -102,7 +102,8 @@ sub check {
   my $self = shift;
 
   $self->ut_numbern('typenum')
-  or $self->ut_text('atype');
+  or $self->ut_text('atype')
+  or $self->SUPER::check;
 
 }
 
@@ -150,7 +151,7 @@ sub pkgpart {
 
 =head1 VERSION
 
-$Id: agent_type.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
+$Id: agent_type.pm,v 1.2 2003-08-05 00:20:40 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm
index a22f44b..4793608 100644
--- a/FS/FS/cust_bill.pm
+++ b/FS/FS/cust_bill.pm
@@ -161,7 +161,7 @@ sub check {
 
   $self->printed(0) if $self->printed eq '';
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =item previous
diff --git a/FS/FS/cust_bill_event.pm b/FS/FS/cust_bill_event.pm
index c977347..ddd6762 100644
--- a/FS/FS/cust_bill_event.pm
+++ b/FS/FS/cust_bill_event.pm
@@ -122,7 +122,7 @@ sub check {
   return "Unknown eventpart ". $self->eventpart
     unless qsearchs( 'part_bill_event' ,{ 'eventpart' => $self->eventpart } );
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =item part_bill_event
diff --git a/FS/FS/cust_bill_pay.pm b/FS/FS/cust_bill_pay.pm
index 913704b..5f4a491 100644
--- a/FS/FS/cust_bill_pay.pm
+++ b/FS/FS/cust_bill_pay.pm
@@ -170,7 +170,7 @@ sub check {
 
   $self->_date(time) unless $self->_date;
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =item cust_pay 
@@ -199,7 +199,7 @@ sub cust_bill {
 
 =head1 VERSION
 
-$Id: cust_bill_pay.pm,v 1.12 2002-02-07 22:29:34 ivan Exp $
+$Id: cust_bill_pay.pm,v 1.13 2003-08-05 00:20:41 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm
index a6615d0..6800707 100644
--- a/FS/FS/cust_bill_pkg.pm
+++ b/FS/FS/cust_bill_pkg.pm
@@ -171,7 +171,7 @@ sub check {
   return "Unknown invnum"
     unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } );
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =item cust_pkg
diff --git a/FS/FS/cust_bill_pkg_detail.pm b/FS/FS/cust_bill_pkg_detail.pm
index 199de43..261aa80 100644
--- a/FS/FS/cust_bill_pkg_detail.pm
+++ b/FS/FS/cust_bill_pkg_detail.pm
@@ -105,7 +105,8 @@ sub check {
     || $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum')
     || $self->ut_foreign_key('invnum', 'cust_pkg', 'invnum')
     || $self->ut_text('detail')
-  ;
+    || $self->SUPER::check
+    ;
 
 }
 
diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm
index 284d59d..e668abd 100644
--- a/FS/FS/cust_credit.pm
+++ b/FS/FS/cust_credit.pm
@@ -174,7 +174,7 @@ sub check {
 
   $self->otaker(getotaker);
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =item cust_refund
@@ -242,7 +242,7 @@ sub credited {
 
 =head1 VERSION
 
-$Id: cust_credit.pm,v 1.16 2002-06-04 14:35:52 ivan Exp $
+$Id: cust_credit.pm,v 1.17 2003-08-05 00:20:41 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/cust_credit_bill.pm b/FS/FS/cust_credit_bill.pm
index 6221541..a54acb6 100644
--- a/FS/FS/cust_credit_bill.pm
+++ b/FS/FS/cust_credit_bill.pm
@@ -127,7 +127,7 @@ sub check {
   return "Cannot apply more than remaining value of invoice"
     unless $self->amount <= $cust_bill->owed;
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =item sub cust_credit
@@ -145,7 +145,7 @@ sub cust_credit {
 
 =head1 VERSION
 
-$Id: cust_credit_bill.pm,v 1.7 2002-01-24 16:58:47 ivan Exp $
+$Id: cust_credit_bill.pm,v 1.8 2003-08-05 00:20:41 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/cust_credit_refund.pm b/FS/FS/cust_credit_refund.pm
index cc3b32c..d0deae2 100644
--- a/FS/FS/cust_credit_refund.pm
+++ b/FS/FS/cust_credit_refund.pm
@@ -156,7 +156,7 @@ sub check {
   return "unknown cust_credit.crednum: ". $self->crednum
     unless qsearchs( 'cust_credit', { 'crednum' => $self->crednum } );
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =item cust_refund
@@ -185,7 +185,7 @@ sub cust_credit {
 
 =head1 VERSION
 
-$Id: cust_credit_refund.pm,v 1.9 2002-01-26 01:52:31 ivan Exp $
+$Id: cust_credit_refund.pm,v 1.10 2003-08-05 00:20:41 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index 51037ef..2af2e98 100644
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -798,7 +798,7 @@ sub check {
 
   #warn "AFTER: \n". $self->_dump;
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =item all_pkgs
diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm
index d8796e4..f631d8c 100644
--- a/FS/FS/cust_main_county.pm
+++ b/FS/FS/cust_main_county.pm
@@ -113,7 +113,9 @@ sub check {
     || $self->ut_textn('taxclass') # ...
     || $self->ut_money('exempt_amount')
     || $self->ut_textn('taxname')
-  ;
+    || $self->SUPER::check
+    ;
+
 
 }
 
diff --git a/FS/FS/cust_main_invoice.pm b/FS/FS/cust_main_invoice.pm
index bcb1437..add0cca 100644
--- a/FS/FS/cust_main_invoice.pm
+++ b/FS/FS/cust_main_invoice.pm
@@ -107,7 +107,7 @@ sub check {
   return "Unknown customer"
     unless qsearchs('cust_main',{ 'custnum' => $self->custnum });
 
-  ''; #noerror
+  $self->SUPER::check;
 }
 
 =item checkdest
@@ -163,7 +163,7 @@ sub address {
 
 =head1 VERSION
 
-$Id: cust_main_invoice.pm,v 1.13 2002-09-18 22:50:44 ivan Exp $
+$Id: cust_main_invoice.pm,v 1.14 2003-08-05 00:20:42 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm
index 55f2fc4..7be1153 100644
--- a/FS/FS/cust_pay.pm
+++ b/FS/FS/cust_pay.pm
@@ -354,8 +354,7 @@ sub check {
     return $error if $error;
   }
 
-  ''; #no error
-
+  $self->SUPER::check;
 }
 
 =item cust_bill_pay
@@ -390,7 +389,7 @@ sub unapplied {
 
 =head1 VERSION
 
-$Id: cust_pay.pm,v 1.24 2003-05-19 12:00:44 ivan Exp $
+$Id: cust_pay.pm,v 1.25 2003-08-05 00:20:42 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/cust_pay_batch.pm b/FS/FS/cust_pay_batch.pm
index c4427c3..1a53046 100644
--- a/FS/FS/cust_pay_batch.pm
+++ b/FS/FS/cust_pay_batch.pm
@@ -185,14 +185,14 @@ sub check {
 
   #check invnum, custnum, ?
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =back
 
 =head1 VERSION
 
-$Id: cust_pay_batch.pm,v 1.6 2002-02-22 23:08:11 ivan Exp $
+$Id: cust_pay_batch.pm,v 1.7 2003-08-05 00:20:42 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index a423c55..f59b45a 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -249,7 +249,7 @@ sub check {
     $self->manual_flag($1);
   }
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =item cancel
diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm
index 7636717..250bd20 100644
--- a/FS/FS/cust_refund.pm
+++ b/FS/FS/cust_refund.pm
@@ -260,14 +260,14 @@ sub check {
 
   $self->otaker(getotaker);
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =back
 
 =head1 VERSION
 
-$Id: cust_refund.pm,v 1.20 2002-11-19 09:51:58 ivan Exp $
+$Id: cust_refund.pm,v 1.21 2003-08-05 00:20:42 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm
index c0cb6f4..7aa311b 100644
--- a/FS/FS/cust_svc.pm
+++ b/FS/FS/cust_svc.pm
@@ -234,7 +234,7 @@ sub check {
       if scalar(@cust_svc) >= $quantity && (!$ignore_quantity || !$quantity);
   }
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =item part_svc
diff --git a/FS/FS/cust_tax_exempt.pm b/FS/FS/cust_tax_exempt.pm
index ab873c0..da0de00 100644
--- a/FS/FS/cust_tax_exempt.pm
+++ b/FS/FS/cust_tax_exempt.pm
@@ -111,6 +111,7 @@ sub check {
     || $self->ut_number('year') #check better
     || $self->ut_number('month') #check better
     || $self->ut_money('amount')
+    || $self->SUPER::check
   ;
 }
 
diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm
index 77b9550..ea0c48d 100644
--- a/FS/FS/domain_record.pm
+++ b/FS/FS/domain_record.pm
@@ -271,7 +271,7 @@ sub check {
     die "ack!";
   }
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =item increment_serial
@@ -332,7 +332,7 @@ sub zone {
 
 =head1 VERSION
 
-$Id: domain_record.pm,v 1.15 2003-04-29 18:28:50 khoff Exp $
+$Id: domain_record.pm,v 1.16 2003-08-05 00:20:43 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/export_svc.pm b/FS/FS/export_svc.pm
index da9ac69..c104e45 100644
--- a/FS/FS/export_svc.pm
+++ b/FS/FS/export_svc.pm
@@ -105,6 +105,7 @@ sub check {
     || $self->ut_foreign_key('exportnum', 'part_export', 'exportnum')
     || $self->ut_number('svcpart')
     || $self->ut_foreign_key('svcpart', 'part_svc', 'svcpart')
+    || $self->SUPER::check
   ;
 }
 
diff --git a/FS/FS/msgcat.pm b/FS/FS/msgcat.pm
index fa10d34..855b8b2 100644
--- a/FS/FS/msgcat.pm
+++ b/FS/FS/msgcat.pm
@@ -113,7 +113,7 @@ sub check {
   $self->locale =~ /^([\w\@]+)$/ or return "illegal locale: ". $self->locale;
   $self->locale($1);
 
-  ''; #no error
+  $self->SUPER::check
 }
 
 =back
diff --git a/FS/FS/nas.pm b/FS/FS/nas.pm
index 58c6827..2d17df8 100644
--- a/FS/FS/nas.pm
+++ b/FS/FS/nas.pm
@@ -114,7 +114,9 @@ sub check {
     || $self->ut_text('nas')
     || $self->ut_ip('nasip')
     || $self->ut_domain('nasfqdn')
-    || $self->ut_numbern('last');
+    || $self->ut_numbern('last')
+    || $self->SUPER::check
+    ;
 }
 
 =item heartbeat TIMESTAMP
@@ -136,7 +138,7 @@ sub heartbeat {
 
 =head1 VERSION
 
-$Id: nas.pm,v 1.6 2002-03-04 12:48:49 ivan Exp $
+$Id: nas.pm,v 1.7 2003-08-05 00:20:43 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/part_bill_event.pm b/FS/FS/part_bill_event.pm
index e0e4f3f..9e5d821 100644
--- a/FS/FS/part_bill_event.pm
+++ b/FS/FS/part_bill_event.pm
@@ -162,8 +162,7 @@ sub check {
     }
   }
 
-  '';
-
+  $self->SUPER::check;
 }
 
 =back
diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm
index ff51996..ab0a4b5 100644
--- a/FS/FS/part_export.pm
+++ b/FS/FS/part_export.pm
@@ -285,7 +285,7 @@ sub check {
 
   #check exporttype?
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 #=item part_svc
@@ -667,6 +667,19 @@ END
   },
 ;
 
+tie my %router_options, 'Tie::IxHash',
+  'protocol' => {
+	  label=>'Protocol',
+	  type =>'select',
+	  options => [qw(telnet ssh)],
+	  default => 'telnet'},
+  'insert' => {label=>'Insert command', default=>'' },
+  'delete' => {label=>'Delete command', default=>'' },
+  'replace' => {label=>'Replace command', default=>'' },
+  'Timeout' => {label=>'Time to wait for prompt', default=>'20' },
+  'Prompt' => {label=>'Prompt string', default=>'#' }
+;
+
 tie my %domain_shellcommands_options, 'Tie::IxHash',
   'user' => { lable=>'Remote username', default=>'root' },
   'useradd' => { label=>'Insert command',
@@ -1013,8 +1026,12 @@ tie my %forward_shellcommands_options, 'Tie::IxHash',
   },
 
   'svc_broadband' => {
+    'router' => {
+      'desc' => 'Send a command to a router.',
+      'options' => \%router_options,
+      'notes' => '',
+    },
   },
-
 );
 
 =back
diff --git a/FS/FS/part_export_option.pm b/FS/FS/part_export_option.pm
index a0b19fd..33b5e5a 100644
--- a/FS/FS/part_export_option.pm
+++ b/FS/FS/part_export_option.pm
@@ -115,7 +115,7 @@ sub check {
 
   #check options & values?
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =back
diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm
index 6525864..12ee804 100644
--- a/FS/FS/part_pkg.pm
+++ b/FS/FS/part_pkg.pm
@@ -241,6 +241,7 @@ sub check {
       || $self->ut_enum('recurtax', [ '', 'Y' ] )
       || $self->ut_textn('taxclass')
       || $self->ut_enum('disabled', [ '', 'Y' ] )
+      || $self->SUPER::check
     ;
 }
 
diff --git a/FS/FS/part_pop_local.pm b/FS/FS/part_pop_local.pm
index 0b7cdf6..f7d5eac 100644
--- a/FS/FS/part_pop_local.pm
+++ b/FS/FS/part_pop_local.pm
@@ -92,6 +92,7 @@ sub check {
       or $self->ut_text('state')
       or $self->ut_number('npa')
       or $self->ut_number('nxx')
+      or $self->SUPER::check
   ;
 
 }
@@ -100,7 +101,7 @@ sub check {
 
 =head1 VERSION
 
-$Id: part_pop_local.pm,v 1.1 2001-09-26 09:17:06 ivan Exp $
+$Id: part_pop_local.pm,v 1.2 2003-08-05 00:20:44 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/part_referral.pm b/FS/FS/part_referral.pm
index 23885df..f30ddad 100644
--- a/FS/FS/part_referral.pm
+++ b/FS/FS/part_referral.pm
@@ -93,6 +93,7 @@ sub check {
 
   $self->ut_numbern('refnum')
     || $self->ut_text('referral')
+    || $self->SUPER::check
   ;
 }
 
diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm
index 63bc2ad..aacc3ab 100644
--- a/FS/FS/part_svc.pm
+++ b/FS/FS/part_svc.pm
@@ -68,7 +68,7 @@ TODOC:
 
 =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, `D' for default, or `F' for fixed
+=item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null, `D' for default, or `F' for fixed.  For virtual fields, can also be 'X' for excluded.
 
 TODOC: EXTRA_FIELDS_ARRAYREF
 
@@ -113,7 +113,7 @@ sub insert {
     } );
 
     my $flag = $self->getfield($svcdb.'__'.$field.'_flag');
-    if ( uc($flag) =~ /^([DF])$/ ) {
+    if ( uc($flag) =~ /^([DFX])$/ ) {
       $part_svc_column->setfield('columnflag', $1);
       $part_svc_column->setfield('columnvalue',
         $self->getfield($svcdb.'__'.$field)
@@ -201,7 +201,7 @@ sub replace {
       } );
 
       my $flag = $new->getfield($svcdb.'__'.$field.'_flag');
-      if ( uc($flag) =~ /^([DF])$/ ) {
+      if ( uc($flag) =~ /^([DFX])$/ ) {
         $part_svc_column->setfield('columnflag', $1);
         $part_svc_column->setfield('columnvalue',
           $new->getfield($svcdb.'__'.$field)
@@ -254,7 +254,7 @@ sub check {
   my @fields = eval { fields( $recref->{svcdb} ) }; #might die
   return "Unknown svcdb!" unless @fields;
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =item part_svc_column COLUMNNAME
diff --git a/FS/FS/part_svc_column.pm b/FS/FS/part_svc_column.pm
index 37e841e..885155b 100644
--- a/FS/FS/part_svc_column.pm
+++ b/FS/FS/part_svc_column.pm
@@ -41,7 +41,7 @@ fields are currently supported:
 
 =item columnvalue - default or fixed value for the column
 
-=item columnflag - null, D or F
+=item columnflag - null, D, F, X (virtual fields)
 
 =back
 
@@ -91,18 +91,18 @@ sub check {
   ;
   return $error if $error;
 
-  $self->columnflag =~ /^([DF])$/
+  $self->columnflag =~ /^([DFX])$/
     or return "illegal columnflag ". $self->columnflag;
   $self->columnflag(uc($1));
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =back
 
 =head1 VERSION
 
-$Id: part_svc_column.pm,v 1.1 2001-09-07 20:49:15 ivan Exp $
+$Id: part_svc_column.pm,v 1.2 2003-08-05 00:20:44 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/part_virtual_field.pm b/FS/FS/part_virtual_field.pm
new file mode 100755
index 0000000..03c34cc
--- /dev/null
+++ b/FS/FS/part_virtual_field.pm
@@ -0,0 +1,303 @@
+package FS::part_virtual_field;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearchs qsearch dbdef );
+
+@ISA = qw( FS::Record );
+
+=head1 NAME
+
+FS::part_virtual_field - Object methods for part_virtual_field records
+
+=head1 SYNOPSIS
+
+  use FS::part_virtual_field;
+
+  $record = new FS::part_virtual_field \%hash;
+  $record = new FS::part_virtual_field { 'column' => 'value' };
+
+  $error = $record->insert;
+
+  $error = $new_record->replace($old_record);
+
+  $error = $record->delete;
+
+  $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::part_virtual_field object represents the definition of a virtual field 
+(see the BACKGROUND section).  FS::part_virtual_field contains the name and 
+base table of the field, as well as validation rules and UI hints about the 
+display of the field.  The actual data is stored in FS::virtual_field; see 
+its manpage for details.
+
+FS::part_virtual_field inherits from FS::Record.  The following fields are 
+currently supported:
+
+=over 2
+
+=item vfieldpart - primary key (assigned automatically)
+
+=item name - name of the field
+
+=item dbtable - table for which this virtual field is defined
+
+=item check_block - Perl code to validate/normalize data
+
+=item list_source - Perl code to generate a list of values (UI hint)
+
+=item length - expected length of the value (UI hint)
+
+=item label - descriptive label for the field (UI hint)
+
+=item sequence - sort key (UI hint; unimplemented)
+
+=back
+
+=head1 BACKGROUND
+
+"Form is none other than emptiness,
+ and emptiness is none other than form."
+-- Heart Sutra
+
+The virtual field mechanism allows site admins to make trivial changes to 
+the Freeside database schema without modifying the code.  Specifically, the 
+user can add custom-defined 'fields' to the set of data tracked by Freeside 
+about objects such as customers and services.  These fields are not associated 
+with any logic in the core Freeside system, but may be referenced in peripheral 
+code such as exports, price calculations, or alternate interfaces, or may just 
+be stored in the database for future reference.
+
+This system was originally devised for svc_broadband, which (by necessity) 
+comprises such a wide range of access technologies that no static set of fields 
+could contain all the information needed by the exports.  In an appalling 
+display of False Laziness, a parallel mechanism was implemented for the 
+router table, to store properties such as passwords to configure routers.
+
+The original system treated svc_broadband custom fields (sb_fields) as records 
+in a completely separate table.  Any code that accessed or manipulated these 
+fields had to be aware that they were I<not> fields in svc_broadband, but 
+records in sb_field.  For example, code that inserted a svc_broadband with 
+several custom fields had to create an FS::svc_broadband object, call its 
+insert() method, and then create several FS::sb_field objects and call I<their>
+insert() methods.
+
+This created a problem for exports.  The insert method on any FS::svc_Common 
+object (including svc_broadband) automatically triggers exports after the 
+record has been inserted.  However, at this point, the sb_fields had not yet 
+been inserted, so the export could not rely on their presence, which was the 
+original purpose of sb_fields.
+
+Hence the new system.  Virtual fields are appended to the field list of every 
+record at the FS::Record level, whether the object is created ex nihilo with 
+new() or fetched with qsearch().  The fields() method now returns a list of 
+both real and virtual fields.  The insert(), replace(), and delete() methods 
+now update both the base table and the virtual fields, in a single transaction.
+
+A new method is provided, virtual_fields(), which gives only the virtual 
+fields.  UI code that dynamically generates form widgets to edit virtual field
+data should use this to figure out what fields are defined.  (See below.)
+
+Subclasses may override virtual_fields() to restrict the set of virtual 
+fields available.  Some discipline and sanity on the part of the programmer 
+are required; in particular, this function should probably not depend on any 
+fields in the record other than the primary key, since the others may change 
+after the object is instantiated.  (Making it depend on I<virtual> fields is 
+just asking for pain.)  One use of this is seen in FS::svc_Common; another 
+possibility is field-level access control based on FS::UID::getotaker().
+
+As a trivial case, a subclass may opt out of supporting virtual fields with 
+the following code:
+
+sub virtual_fields { () }
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Create a new record.  To add the record to the database, see "insert".
+
+=cut
+
+sub table { 'part_virtual_field'; }
+sub virtual_fields { () }
+
+=item insert
+
+Adds this record to the database.  If there is an error, returns the error,
+otherwise returns false.
+
+=item delete
+
+Deletes this record from the database.  If there is an error, returns the
+error, otherwise returns false.
+
+=item replace OLD_RECORD
+
+Replaces OLD_RECORD with this one in the database.  If there is an error,
+returns the error, otherwise returns false.
+
+=item check
+
+If there is an error, returns the error, otherwise returns false.
+Called by the insert and replace methods.
+
+=back
+
+=cut
+
+sub check {
+  my $self = shift;
+
+  my $error = $self->ut_text('name') ||
+              $self->ut_text('dbtable') ||
+              $self->ut_number('length')
+              ;
+  return $error if $error;
+
+  # Make sure it's a real table with a numeric primary key
+  my ($table, $pkey);
+  if($table = $FS::Record::dbdef->table($self->dbtable)) {
+    if($pkey = $table->primary_key) {
+      if($table->column($pkey)->type =~ /int/i) {
+        # this is what it should be
+      } else {
+        $error = "$table.$pkey is not an integer";
+      }
+    } else {
+      $error = "$table does not have a single-field primary key";
+    }
+  } else {
+    $error = "$table does not exist in the schema";
+  }
+  return $error if $error;
+
+  # Possibly some sanity checks for check_block and list_source?
+
+  $self->SUPER::check;  
+}
+
+=item list
+
+Evaluates list_source.
+
+=cut
+
+sub list {
+  my $self = shift;
+  return () unless $self->list_source;
+
+  my @opts = eval($self->list_source);
+  if($@) {
+    warn $@;
+    return ();
+  } else {
+    return @opts;
+  }
+}
+
+=item widget UI_TYPE MODE [ VALUE ]
+
+Generates UI code for a widget suitable for editing/viewing the field, based on 
+list_source and length.  
+
+The only UI_TYPE currently supported is 'HTML', and the only MODE is 'view'.
+Others will be added later.
+
+In HTML, all widgets are assumed to be table rows.  View widgets look like
+<TR><TD ALIGN="right">Label</TD><TD BGCOLOR="#ffffff">Value</TD></TR>
+
+(Most of the display style stuff, such as the colors, should probably go into 
+a separate module specific to the UI.  That can wait, though.  The API for 
+this function won't change.)
+
+VALUE (optional) is the current value of the field.
+
+=cut
+
+sub widget {
+  my $self = shift;
+  my ($ui_type, $mode, $value) = @_;
+  my $text;
+  my $label = $self->label || $self->name;
+
+  if ($ui_type eq 'HTML') {
+    if ($mode eq 'view') {
+      $text = q!<TR><TD ALIGN="right">! . $label . 
+              q!</TD><TD BGCOLOR="#ffffff">! . $value .
+              q!</TD></TR>! . "\n";
+    } elsif ($mode eq 'edit') {
+      $text = q!<TR><TD ALIGN="right">! . $label .
+              q!</TD><TD>!;
+      if ($self->list_source) {
+        $text .= q!<SELECT NAME="! . $self->name . 
+                q!" SIZE=1>! . "\n";
+        foreach ($self->list) {
+          $text .= q!<OPTION VALUE="! . $_ . q!"!;
+          $text .= ' SELECTED' if ($_ eq $value);
+          $text .= '>' . $_ . '</OPTION>' . "\n";
+        }
+      } else {
+        $text .= q!<INPUT NAME="! . $self->name .
+                q!" VALUE="! . $value . q!"!;
+        if ($self->length) {
+          $text .= q! SIZE="! . $self->length . q!"!;
+        }
+        $text .= '>';
+      }
+      $text .= q!</TD></TR>! . "\n";
+    } else {
+      return '';
+    }
+  } else {
+    return '';
+  }
+  return $text;
+}
+
+=head1 VERSION
+
+$Id: part_virtual_field.pm,v 1.2 2003-08-05 00:20:45 khoff Exp $
+
+=head1 NOTES
+
+=head2 Semantics of check_block:
+
+This has been changed from the sb_field implementation to make check_blocks 
+simpler and more natural to Perl programmers who work on things other than 
+Freeside.
+
+The check_block is eval'd with the (proposed) new value of the field in $_, 
+and the object to be updated in $self.  Its return value is ignored.  The 
+check_block may change the value of $_ to override the proposed value, or 
+call die() (with an appropriate error message) to reject the update entirely;
+the error string will be returned as the output of the check() method.
+
+This makes check_blocks like
+
+C<s/foo/bar/>
+
+do what you expect.
+
+The check_block is expected NOT to do anything freaky to $self, like modifying 
+other fields or calling $self->check().  You have been warned.
+
+(FIXME: Rewrite some of the warnings from part_sb_field and insert here.)
+
+=head1 BUGS
+
+None.  It's absolutely falwless.
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::virtual_field>
+
+=cut
+
+1;
+
+
diff --git a/FS/FS/pkg_svc.pm b/FS/FS/pkg_svc.pm
index 3c544ff..2ac1a55 100644
--- a/FS/FS/pkg_svc.pm
+++ b/FS/FS/pkg_svc.pm
@@ -108,7 +108,7 @@ sub check {
   return "Unknown pkgpart!" unless $self->part_pkg;
   return "Unknown svcpart!" unless $self->part_svc;
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =item part_pkg
@@ -137,7 +137,7 @@ sub part_svc {
 
 =head1 VERSION
 
-$Id: pkg_svc.pm,v 1.3 2002-06-10 01:39:50 khoff Exp $
+$Id: pkg_svc.pm,v 1.4 2003-08-05 00:20:45 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/port.pm b/FS/FS/port.pm
index 13455ca..620030a 100644
--- a/FS/FS/port.pm
+++ b/FS/FS/port.pm
@@ -113,7 +113,7 @@ sub check {
     unless $self->ip || $self->nasport;
   return "Unknown nasnum"
     unless qsearchs('nas', { 'nasnum' => $self->nasnum } );
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =item session
@@ -133,7 +133,7 @@ sub session {
 
 =head1 VERSION
 
-$Id: port.pm,v 1.5 2001-02-14 04:33:06 ivan Exp $
+$Id: port.pm,v 1.6 2003-08-05 00:20:45 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/prepay_credit.pm b/FS/FS/prepay_credit.pm
index 7ed9b83..a9d26d1 100644
--- a/FS/FS/prepay_credit.pm
+++ b/FS/FS/prepay_credit.pm
@@ -108,6 +108,7 @@ sub check {
   || $self->ut_alpha('identifier')
   || $self->ut_money('amount')
   || $self->utnumbern('seconds')
+  || $self->SUPER::check
   ;
 
 }
diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm
index d35dc88..634f7f4 100644
--- a/FS/FS/queue.pm
+++ b/FS/FS/queue.pm
@@ -207,7 +207,7 @@ sub check {
   $self->status('new') unless $self->status;
   $self->_date(time) unless $self->_date;
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =item args
@@ -385,7 +385,7 @@ END
 
 =head1 VERSION
 
-$Id: queue.pm,v 1.15 2002-07-02 06:48:59 ivan Exp $
+$Id: queue.pm,v 1.16 2003-08-05 00:20:46 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/queue_arg.pm b/FS/FS/queue_arg.pm
index 08fe473..d23ee2a 100644
--- a/FS/FS/queue_arg.pm
+++ b/FS/FS/queue_arg.pm
@@ -100,14 +100,14 @@ sub check {
   ;
   return $error if $error;
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =back
 
 =head1 VERSION
 
-$Id: queue_arg.pm,v 1.1 2001-09-11 00:08:18 ivan Exp $
+$Id: queue_arg.pm,v 1.2 2003-08-05 00:20:46 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/queue_depend.pm b/FS/FS/queue_depend.pm
index 4a4e3c5..bc910d8 100644
--- a/FS/FS/queue_depend.pm
+++ b/FS/FS/queue_depend.pm
@@ -103,6 +103,7 @@ sub check {
   $self->ut_numbern('dependnum')
     || $self->ut_foreign_key('jobnum',        'queue', 'jobnum')
     || $self->ut_foreign_key('depend_jobnum', 'queue', 'jobnum')
+    || $self->SUPER::check
   ;
 }
 
diff --git a/FS/FS/radius_usergroup.pm b/FS/FS/radius_usergroup.pm
index 647621d..9bba057 100644
--- a/FS/FS/radius_usergroup.pm
+++ b/FS/FS/radius_usergroup.pm
@@ -100,6 +100,7 @@ sub check {
     || $self->ut_number('svcnum')
     || $self->ut_foreign_key('svcnum','svc_acct','svcnum')
     || $self->ut_text('groupname')
+    || $self->SUPER::check
   ;
 }
 
diff --git a/FS/FS/router.pm b/FS/FS/router.pm
index 3f9459a..2554ce8 100755
--- a/FS/FS/router.pm
+++ b/FS/FS/router.pm
@@ -85,7 +85,7 @@ sub check {
     || $self->ut_text('routername');
   return $error if $error;
 
-  '';
+  $self->SUPER::check;
 }
 
 =item addr_block
@@ -100,18 +100,6 @@ sub addr_block {
   return qsearch('addr_block', { routernum => $self->routernum });
 }
 
-=item router_field
-
-Returns a list of FS::router_field objects assigned to this object.
-
-=cut
-
-sub router_field {
-  my $self = shift;
-
-  return qsearch('router_field', { routernum => $self->routernum });
-}
-
 =item part_svc_router
 
 Returns a list of FS::part_svc_router objects associated with this 
@@ -147,7 +135,7 @@ $Id:
 
 =head1 SEE ALSO
 
-FS::svc_broadband, FS::router, FS::addr_block, FS::router_field, FS::part_svc,
+FS::svc_broadband, FS::router, FS::addr_block, FS::part_svc,
 schema.html from the base documentation.
 
 =cut
diff --git a/FS/FS/session.pm b/FS/FS/session.pm
index de0f2a7..2ad594c 100644
--- a/FS/FS/session.pm
+++ b/FS/FS/session.pm
@@ -216,7 +216,7 @@ sub check {
   return $error if $error;
   return "Unknown svcnum"
     unless qsearchs('svc_acct', { 'svcnum' => $self->svcnum } );
-  '';
+  $self->SUPER::check;
 }
 
 =item nas_heartbeat
@@ -247,7 +247,7 @@ sub svc_acct {
 
 =head1 VERSION
 
-$Id: session.pm,v 1.7 2001-04-15 13:35:12 ivan Exp $
+$Id: session.pm,v 1.8 2003-08-05 00:20:46 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm
index 87b6097..524e550 100644
--- a/FS/FS/svc_Common.pm
+++ b/FS/FS/svc_Common.pm
@@ -2,7 +2,7 @@ package FS::svc_Common;
 
 use strict;
 use vars qw( @ISA $noexport_hack );
-use FS::Record qw( qsearchs fields dbh );
+use FS::Record qw( qsearch qsearchs fields dbh );
 use FS::cust_svc;
 use FS::part_svc;
 use FS::queue;
@@ -28,6 +28,58 @@ inherit from, i.e. FS::svc_acct.  FS::svc_Common inherits from FS::Record.
 
 =over 4
 
+=cut
+
+sub virtual_fields {
+
+  # This restricts the fields based on part_svc_column and the svcpart of 
+  # the service.  There are four possible cases:
+  # 1.  svcpart passed as part of the svc_x hash.
+  # 2.  svcpart fetched via cust_svc based on svcnum.
+  # 3.  No svcnum or svcpart.  In this case, return ALL the fields with 
+  #     dbtable eq $self->table.
+  # 4.  Called via "fields('svc_acct')" or something similar.  In this case
+  #     there is no $self object.
+
+  my $self = shift;
+  my $svcpart;
+  my @vfields = $self->SUPER::virtual_fields;
+
+  return @vfields unless (ref $self); # Case 4
+
+  if ($self->svcpart) { # Case 1
+    $svcpart = $self->svcpart;
+  } elsif (my $cust_svc = $self->cust_svc) { # Case 2
+    $svcpart = $cust_svc->svcpart;
+  } else { # Case 3
+    $svcpart = '';
+  }
+
+  if ($svcpart) { #Cases 1 and 2
+    my %flags = map { $_->columnname, $_->columnflag } (
+        qsearch ('part_svc_column', { svcpart => $svcpart } )
+      );
+    return grep { not ($flags{$_} eq 'X') } @vfields;
+  } else { # Case 3
+    return @vfields;
+  } 
+  return ();
+}
+
+=item check
+
+Checks the validity of fields in this record.
+
+At present, this does nothing but call FS::Record::check (which, in turn, 
+does nothing but run virtual field checks).
+
+=cut
+
+sub check {
+  my $self = shift;
+  $self->SUPER::check;
+}
+
 =item insert [ JOBNUM_ARRAYREF ]
 
 Adds this record to the database.  If there is an error, returns the error,
@@ -254,7 +306,7 @@ sub setx {
 
   #set default/fixed/whatever fields from part_svc
   my $table = $self->table;
-  foreach my $field ( grep { $_ ne 'svcnum' } fields($table) ) {
+  foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
     my $part_svc_column = $part_svc->part_svc_column($field);
     if ( $part_svc_column->columnflag eq $x ) {
       $self->setfield( $field, $part_svc_column->columnvalue );
@@ -364,7 +416,7 @@ sub cancel { ''; }
 
 =head1 VERSION
 
-$Id: svc_Common.pm,v 1.12 2002-06-14 11:22:53 ivan Exp $
+$Id: svc_Common.pm,v 1.13 2003-08-05 00:20:47 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index 8a6f2c4..0ee7a72 100644
--- a/FS/FS/svc_acct.pm
+++ b/FS/FS/svc_acct.pm
@@ -832,7 +832,7 @@ sub check {
            ": ". $recref->{_password};
   }
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =item radius
diff --git a/FS/FS/svc_acct_pop.pm b/FS/FS/svc_acct_pop.pm
index 196ab7e..f98f91a 100644
--- a/FS/FS/svc_acct_pop.pm
+++ b/FS/FS/svc_acct_pop.pm
@@ -93,6 +93,7 @@ sub check {
       or $self->ut_number('ac')
       or $self->ut_number('exch')
       or $self->ut_numbern('loc')
+      or $self->SUPER::check
   ;
 
 }
@@ -187,7 +188,7 @@ END
 
 =head1 VERSION
 
-$Id: svc_acct_pop.pm,v 1.9 2003-07-04 01:37:46 ivan Exp $
+$Id: svc_acct_pop.pm,v 1.10 2003-08-05 00:20:47 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/FS/svc_broadband.pm b/FS/FS/svc_broadband.pm
index 45f6c36..ec91532 100755
--- a/FS/FS/svc_broadband.pm
+++ b/FS/FS/svc_broadband.pm
@@ -116,50 +116,6 @@ returns the error, otherwise returns false.
 
 # Standard FS::svc_Common::replace
 
-=item sb_field
-
-Returns a list of FS::sb_field objects assigned to this object.
-
-=cut
-
-sub sb_field {
-  my $self = shift;
-
-  return qsearch( 'sb_field', { svcnum => $self->svcnum } );
-}
-
-=item sb_field_hashref
-
-Returns a hashref of the FS::sb_field key/value pairs for this object.
-
-Deprecated.  Please don't use it.
-
-=cut
-
-# Kristian wrote this, but don't hold it against him.  He was under a powerful
-# distracting influence whom he evidently found much more interesting than
-# svc_broadband.pm.  I can't say I blame him.
-
-sub sb_field_hashref {
-  my $self = shift;
-  my $svcpart = shift;
-
-  if ((not $svcpart) && ($self->cust_svc)) {
-    $svcpart = $self->cust_svc->svcpart;
-  }
-
-  my $hashref = {};
-
-  map {
-    my $sb_field = qsearchs('sb_field', { sbfieldpart => $_->sbfieldpart,
-                                          svcnum => $self->svcnum });
-    $hashref->{$_->getfield('name')} = $sb_field ? $sb_field->getfield('value') : '';
-  } qsearch('part_sb_field', { svcpart => $svcpart });
-
-  return $hashref;
-
-}
-
 =item suspend
 
 Called by the suspend method of FS::cust_pkg (see FS::cust_pkg).
@@ -223,8 +179,7 @@ sub check {
     return 'Router '.$router->routernum.' cannot provide svcpart '.$self->svcpart;
   }
 
-
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =item NetAddr
@@ -267,19 +222,11 @@ sub allowed_routers {
 
 =head1 BUGS
 
-I think there's one place in the code where we actually use sb_field_hashref.
-That's a bug in itself.
-
-The real problem with it is that we're still grappling with the question of how
-tightly xfields should be integrated with real fields.  There are a few
-different directions we could go with it--we I<could> override several
-functions in Record so that xfields behave almost exactly like real fields (can
-be set with setfield(), appear in fields() and hash(), used as criteria in
-qsearch(), etc.).
+The business with sb_field has been 'fixed', in a manner of speaking.
 
 =head1 SEE ALSO
 
-FS::svc_Common, FS::Record, FS::addr_block, FS::sb_field,
+FS::svc_Common, FS::Record, FS::addr_block,
 FS::part_svc, schema.html from the base documentation.
 
 =cut
diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm
index 32b9456..ff0fa2f 100644
--- a/FS/FS/svc_domain.pm
+++ b/FS/FS/svc_domain.pm
@@ -342,7 +342,9 @@ sub check {
     return "Unknown catchall" unless $svc_acct;
   }
 
-  $self->ut_textn('purpose');
+  my $error = $self->ut_textn('purpose')
+           or $self->SUPER::check;
+  return $error if $error;
 
 }
 
diff --git a/FS/FS/svc_forward.pm b/FS/FS/svc_forward.pm
index 2b1fb92..7a121b8 100644
--- a/FS/FS/svc_forward.pm
+++ b/FS/FS/svc_forward.pm
@@ -241,7 +241,7 @@ sub check {
     $self->dst('');
   }
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =item srcsvc_acct
diff --git a/FS/FS/svc_www.pm b/FS/FS/svc_www.pm
index d7a42c8..7e89083 100644
--- a/FS/FS/svc_www.pm
+++ b/FS/FS/svc_www.pm
@@ -234,7 +234,8 @@ sub check {
   return "Unknown usersvc (svc_acct.svcnum): ". $self->usersvc
     unless qsearchs('svc_acct', { 'svcnum' => $self->usersvc } );
 
-  ''; #no error
+  $self->SUPER::check;
+
 }
 
 =item domain_record
diff --git a/FS/FS/type_pkgs.pm b/FS/FS/type_pkgs.pm
index efba60d..5b3b11c 100644
--- a/FS/FS/type_pkgs.pm
+++ b/FS/FS/type_pkgs.pm
@@ -91,7 +91,7 @@ sub check {
   return "Unknown pkgpart"
     unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 =item part_pkg
@@ -111,7 +111,7 @@ sub part_pkg {
 
 =head1 VERSION
 
-$Id: type_pkgs.pm,v 1.2 2002-10-04 12:57:06 ivan Exp $
+$Id: type_pkgs.pm,v 1.3 2003-08-05 00:20:48 khoff Exp $
 
 =head1 BUGS
 
diff --git a/FS/MANIFEST b/FS/MANIFEST
index 846f373..0fbbf5c 100644
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -92,9 +92,8 @@ FS/part_pop_local.pm
 FS/part_referral.pm
 FS/part_svc.pm
 FS/part_svc_column.pm
-FS/part_router_field.pm
-FS/part_sb_field.pm
 FS/part_svc_router.pm
+FS/part_virtual_field.pm
 FS/pkg_svc.pm
 FS/svc_Common.pm
 FS/svc_acct.pm
@@ -102,7 +101,6 @@ FS/svc_acct_pop.pm
 FS/svc_broadband.pm
 FS/svc_domain.pm
 FS/router.pm
-FS/router_field.pm
 FS/type_pkgs.pm
 FS/nas.pm
 FS/port.pm
@@ -111,7 +109,6 @@ FS/domain_record.pm
 FS/prepay_credit.pm
 FS/svc_www.pm
 FS/svc_forward.pm
-FS/sb_field.pm
 FS/raddb.pm
 FS/radius_usergroup.pm
 FS/queue.pm
diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup
index 734744e..2cb555e 100755
--- a/FS/bin/freeside-setup
+++ b/FS/bin/freeside-setup
@@ -1031,7 +1031,7 @@ sub tables_hash_hack {
       'columns' => [
         'routernum', 'serial', '', '',
         'routername', 'varchar', '', $char_d,
-        'svcnum', 'int', '0', '',
+        'svcnum', 'int', 'NULL', '',
       ],
       'primary_key' => 'routernum',
       'unique'      => [],
@@ -1048,30 +1048,6 @@ sub tables_hash_hack {
       'index'       => [],
     },
 
-    'part_router_field' => {
-      'columns' => [
-        'routerfieldpart', 'serial', '', '',
-        'name', 'varchar', '', $char_d,
-	'length', 'int', '', '',
-	'check_block', 'text', 'NULL', '',
-	'list_source', 'text', 'NULL', '',
-      ],
-      'primary_key' => 'routerfieldpart',
-      'unique'      => [],
-      'index'       => [],
-    },
-
-    'router_field' => {
-      'columns' => [
-        'routerfieldpart', 'int', '', '',
-        'routernum', 'int', '', '',
-        'value', 'varchar', '', 128,
-      ],
-      'primary_key' => '',
-      'unique'      => [ [ 'routerfieldpart', 'routernum' ] ],
-      'index'       => [],
-    },
-
     'addr_block' => {
       'columns' => [
         'blocknum', 'serial', '', '',
@@ -1084,31 +1060,6 @@ sub tables_hash_hack {
       'index'       => [],
     },
 
-    'part_sb_field' => {
-      'columns' => [
-        'sbfieldpart', 'serial', '', '',
-	'svcpart', 'int', '', '',
-	'name', 'varchar', '', $char_d,
-	'length', 'int', '', '',
-	'check_block', 'text', 'NULL', '',
-	'list_source', 'text', 'NULL', '',
-      ],
-      'primary_key' => 'sbfieldpart',
-      'unique'      => [ [ 'sbfieldpart', 'svcpart' ] ],
-      'index'       => [],
-    },
-
-    'sb_field' => {
-      'columns' => [
-        'sbfieldpart', 'int', '', '',
-	'svcnum', 'int', '', '',
-	'value', 'varchar', '', 128,
-      ],
-      'primary_key' => '',
-      'unique'      => [ [ 'sbfieldpart', 'svcnum' ] ],
-      'index'       => [],
-    },
-
     'svc_broadband' => {
       'columns' => [
         'svcnum', 'int', '', '',
@@ -1122,6 +1073,32 @@ sub tables_hash_hack {
       'index'       => [],
     },
 
+    'part_virtual_field' => {
+      'columns' => [
+        'vfieldpart', 'int', '', '',
+        'dbtable', 'varchar', '', 32,
+        'name', 'varchar', '', 32,
+        'check_block', 'text', 'NULL', '',
+        'length', 'int', 'NULL', '',
+        'list_source', 'text', 'NULL', '',
+        'label', 'varchar', 'NULL', 80,
+      ],
+      'primary_key' => 'vfieldpart',
+      'unique' => [],
+      'index' => [],
+    },
+
+    'virtual_field' => {
+      'columns' => [
+        'recnum', 'int', '', '',
+        'vfieldpart', 'int', '', '',
+        'value', 'varchar', '', 128,
+      ],
+      'primary_key' => '',
+      'unique' => [ [ 'vfieldpart', 'recnum' ] ],
+      'index' => [],
+    },
+
   );
 
   %tables;