custom fields, RT11714

4 files changed, 154 insertions, 478 deletions

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 411e911..e63abf2 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -2,8 +2,8 @@ package FS::Record;
 
 use strict;
 use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG
-             $conf $conf_encryption $me
              %virtual_fields_cache
+             $conf $conf_encryption $me
              $nowarn_identical $nowarn_classload
              $no_update_diff $no_check_foreign
              @encrypt_payby
@@ -23,6 +23,7 @@ use FS::Schema qw(dbdef);
 use FS::SearchCache;
 use FS::Msgcat qw(gettext);
 use NetAddr::IP; # for validation
+use Data::Dumper;
 #use FS::Conf; #dependency loop bs, in install_callback below instead
 
 use FS::part_virtual_field;
@@ -378,22 +379,12 @@ sub qsearch {
     my $pkey = $dbdef_table->primary_key;
 
     my @real_fields = grep exists($record->{$_}), real_fields($table);
-    my @virtual_fields;
-    if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
-      @virtual_fields = grep exists($record->{$_}), "FS::$table"->virtual_fields;
-    } else {
-      cluck "warning: FS::$table not loaded; virtual fields not searchable"
-        unless $nowarn_classload;
-      @virtual_fields = ();
-    }
 
     my $statement .= "SELECT $select FROM $stable";
     $statement .= " $addl_from" if $addl_from;
-    if ( @real_fields or @virtual_fields ) {
+    if ( @real_fields ) {
       $statement .= ' WHERE '. join(' AND ',
-        get_real_fields($table, $record, \@real_fields) ,
-        get_virtual_fields($table, $pkey, $record, \@virtual_fields),
-        );
+        get_real_fields($table, $record, \@real_fields));
     }
 
     $statement .= " $extra_sql" if defined($extra_sql);
@@ -459,21 +450,11 @@ sub qsearch {
 
   $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr;
 
-  # virtual fields and blessings are nonsense in a heterogeneous UNION, right?
   my $table = $stable[0];
   my $pkey = '';
   $table = '' if grep { $_ ne $table } @stable;
   $pkey = dbdef->table($table)->primary_key if $table;
 
-  my @virtual_fields = ();
-  if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
-    @virtual_fields = "FS::$table"->virtual_fields;
-  } else {
-    cluck "warning: FS::$table not loaded; virtual fields not returned either"
-      unless $nowarn_classload;
-    @virtual_fields = ();
-  }
-
   my %result;
   tie %result, "Tie::IxHash";
   my @stuff = @{ $sth->fetchall_arrayref( {} ) };
@@ -485,28 +466,6 @@ sub qsearch {
 
   $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;
-      }
-    }
-  }
   my @return;
   if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
     if ( eval 'FS::'. $table. '->can(\'new\')' eq \&new ) {
@@ -556,50 +515,6 @@ sub qsearch {
 
 ## makes this easier to read
 
-sub get_virtual_fields {
-   my $table = shift;
-   my $pkey = shift;
-   my $record = shift;
-   my $virtual_fields = shift;
-   
-   return
-    ( 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 } ) ;
-}
-
 sub get_real_fields {
   my $table = shift;
   my $record = shift;
@@ -1110,34 +1025,6 @@ sub insert {
 
   }
 
-  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 = $self->vfieldpart_hashref;
-
-    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');
@@ -1209,17 +1096,6 @@ sub delete {
   }
 
   my $primary_key = $self->dbdef_table->primary_key;
-  my $v_sth;
-  my @del_vfields;
-  my $vfp = $self->vfieldpart_hashref;
-  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';
@@ -1231,9 +1107,6 @@ 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;
 
@@ -1362,44 +1235,6 @@ 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 = $old->vfieldpart_hashref;
-  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'; 
@@ -1412,23 +1247,6 @@ sub replace {
   $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;
 
   # Now that it has been saved, reset the encrypted fields so that $new 
@@ -1470,35 +1288,49 @@ sub rep {
 
 =item check
 
-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.
+Checks custom fields. Subclasses should still provide a check method to validate
+non-custom fields, foreign keys, etc., and call this method via $self->SUPER::check.
+
+=cut
+
+sub check { 
+    my $self = shift;
+    foreach my $field ($self->virtual_fields) {
+        my $error = $self->ut_textn($field);
+        return $error if $error;
+    }
+    '';
+}
+
+=item virtual_fields [ TABLE ]
 
-(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?)
+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 check {
-  #confess "FS::Record::check not implemented; supply one in subclass!";
+sub virtual_fields {
   my $self = shift;
+  my $table;
+  $table = $self->table or confess "virtual_fields called on non-table";
 
-  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;
-      if ( $@ ) {
-        #this is bad, probably want to follow the stack backtrace up and see
-        #wtf happened
-        my $err = "Fatal error checking $field for $self";
-        cluck "$err: $@";
-        return "$err (see log for backtrace): $@";
+  confess "Unknown table $table" unless dbdef->table($table);
 
-      }
-      $self->setfield($field, $_);
-    }
+  return () unless dbdef->table('part_virtual_field');
+
+  unless ( $virtual_fields_cache{$table} ) {
+    my $concat = [ "'cf_'", "name" ];
+    my $query = "SELECT ".concat_sql($concat).' from part_virtual_field ' .
+                "WHERE dbtable = '$table'";
+    my $dbh = dbh;
+    my $result = $dbh->selectcol_arrayref($query);
+    confess "Error executing virtual fields query: $query: ". $dbh->errstr
+      if $dbh->err;
+    $virtual_fields_cache{$table} = $result;
   }
-  '';
+
+  @{$virtual_fields_cache{$table}};
+
 }
 
 =item process_batch_import JOB OPTIONS_HASHREF PARAMS
@@ -2737,40 +2569,9 @@ sub ut_agentnum_acl {
 
 }
 
-=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 $self = shift;
-  my $table;
-  $table = $self->table or confess "virtual_fields called on non-table";
-
-  confess "Unknown table $table" unless dbdef->table($table);
-
-  return () unless dbdef->table('part_virtual_field');
-
-  unless ( $virtual_fields_cache{$table} ) {
-    my $query = 'SELECT name from part_virtual_field ' .
-                "WHERE dbtable = '$table'";
-    my $dbh = dbh;
-    my $result = $dbh->selectcol_arrayref($query);
-    confess "Error executing virtual fields query: $query: ". $dbh->errstr
-      if $dbh->err;
-    $virtual_fields_cache{$table} = $result;
-  }
-
-  @{$virtual_fields_cache{$table}};
-
-}
-
-
 =item fields [ TABLE ]
 
-This is a wrapper for real_fields and virtual_fields.  Code that called
+This is a wrapper for real_fields.  Code that called
 fields before should probably continue to call fields.
 
 =cut
@@ -2784,48 +2585,9 @@ sub fields {
     $table = $something;
     $something = "FS::$table";
   }
-  return (real_fields($table), $something->virtual_fields());
-}
-
-=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 } );
-  }
-  ''
+  return (real_fields($table));
 }
 
-=item vfieldpart_hashref TABLE
-
-Returns a hashref of virtual field names and vfieldparts applicable to the given
-TABLE.
-
-=cut
-
-sub vfieldpart_hashref {
-  my $self = shift;
-  my $table = $self->table;
-
-  return {} unless dbdef->table('part_virtual_field');
-
-  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 encrypt($value)
 
@@ -3006,6 +2768,29 @@ sub real_fields {
   $table_obj->columns;
 }
 
+=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) {
+    $name =~ s/^cf_//;
+    my $concat = [ "'cf_'", "name" ];
+    return qsearchs({   table   =>  'part_virtual_field',
+                        hashref =>  { dbtable => $self->table,
+                                      name    => $name 
+                                    },
+                        select  =>  'vfieldpart, dbtable, length, label, '.concat_sql($concat).' as name',
+                    });
+  }
+  ''
+}
+
 =item _quote VALUE, TABLE, COLUMN
 
 This is an internal function used to construct SQL statements.  It returns
diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm
index 3ae79a6..1306d41 100644
--- a/FS/FS/part_svc.pm
+++ b/FS/FS/part_svc.pm
@@ -82,12 +82,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), `M' for manual selection from inventory, or `A' for automatic selection from inventory. 
 
 =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
@@ -618,28 +618,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
   
 }
diff --git a/FS/FS/part_virtual_field.pm b/FS/FS/part_virtual_field.pm
index f5a4161..4e6d2e4 100755
--- a/FS/FS/part_virtual_field.pm
+++ b/FS/FS/part_virtual_field.pm
@@ -29,11 +29,9 @@ FS::part_virtual_field - Object methods for part_virtual_field records
 
 =head1 DESCRIPTION
 
-An FS::part_virtual_field object represents the definition of a virtual field 
+An FS::part_virtual_field object represents the definition of a custom 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.
+base table of the field. 
 
 FS::part_virtual_field inherits from FS::Record.  The following fields are 
 currently supported:
@@ -46,75 +44,12 @@ currently supported:
 
 =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
@@ -128,87 +63,13 @@ Create a new record.  To add the record to the database, see "insert".
 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 = 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.
+The only UI_TYPE currently supported is 'HTML', and possible MODEs are 'view'
+and 'edit'.
 
 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>
@@ -235,22 +96,12 @@ sub widget {
     } 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="! . escapeHTML($value) . q!"!;
         if ($self->length) {
           $text .= q! SIZE="! . $self->length . q!"!;
         }
         $text .= '>';
-      }
       $text .= q!</TD></TR>! . "\n";
     } else {
       return '';
@@ -261,38 +112,67 @@ sub widget {
   return $text;
 }
 
-=head1 NOTES
 
-=head2 Semantics of check_block:
+=item insert
 
-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.
+Adds this record to the database.  If there is an error, returns the error,
+otherwise returns false.
 
-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.
+=item delete
 
-This makes check_blocks like
+Deletes this record from the database.  If there is an error, returns the
+error, otherwise returns false.
 
-C<s/foo/bar/>
+=item replace OLD_RECORD
 
-do what you expect.
+Replaces OLD_RECORD with this one in the database.  If there is an error,
+returns the error, otherwise returns false.
 
-The check_block is expected NOT to do anything freaky to $self, like modifying 
-other fields or calling $self->check().  You have been warned.
+=item check
 
-(FIXME: Rewrite some of the warnings from part_sb_field and insert here.)
+If there is an error, returns the error, otherwise returns false.
+Called by the insert and replace methods.
 
-=head1 BUGS
+=back
 
-None.  It's absolutely falwless.
+=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 = 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;
+
+  $self->SUPER::check;  
+}
+
+=head1 NOTES
+
+=head1 BUGS
 
 =head1 SEE ALSO
 
-L<FS::Record>, L<FS::virtual_field>
+L<FS::Record>
 
 =cut
 
diff --git a/FS/bin/freeside-upgrade b/FS/bin/freeside-upgrade
index 16c30d9..6f4e439 100755
--- a/FS/bin/freeside-upgrade
+++ b/FS/bin/freeside-upgrade
@@ -127,18 +127,27 @@ my @statements = dbdef->sql_update_schema( dbdef_dist(datasrc),
                                            { 'nullify_default' => 1, },
                                          );
 
-#### NEW CUSTOM FIELDS (prevent columns from being dropped by upgrade)
+#### NEW CUSTOM FIELDS:
+# 1. prevent new custom field columns from being dropped by upgrade
+# 2. migrate old virtual fields to real fields (new custom fields)
+####
 my $cfsth = $dbh->prepare("SELECT * FROM part_virtual_field") 
                                                          or die $dbh->errstr;
 $cfsth->execute or die $cfsth->errstr;
 my $cf; 
-# likely a very inefficient implementation of this
 while ( $cf = $cfsth->fetchrow_hashref ) {
     my $tbl = $cf->{'dbtable'};
     my $name = $cf->{'name'};
-    @statements = grep { $_ !~ /^\s*ALTER\s+TABLE\s+$tbl\s+DROP\s+COLUMN\s+cf_$name\s*$/i }
+    @statements = grep { $_ !~ /^\s*ALTER\s+TABLE\s+(h_|)$tbl\s+DROP\s+COLUMN\s+cf_$name\s*$/i }
                                                                     @statements;
+    push @statements, 
+        "ALTER TABLE $tbl ADD COLUMN cf_$name varchar(".$cf->{'length'}.")"
+     unless (dbdef->table($tbl) && dbdef->table($tbl)->column("cf_$name"));
+    push @statements, 
+        "ALTER TABLE h_$tbl ADD COLUMN cf_$name varchar(".$cf->{'length'}.")"
+     unless (dbdef->table("h_$tbl") && dbdef->table("h_$tbl")->column("cf_$name"));
 }
+warn "Custom fields schema upgrade completed";
 
 @statements = 
   grep { $_ !~ /^CREATE +INDEX +h_queue/i } #useless, holds up queue insertion
@@ -240,6 +249,30 @@ $dbh = adminsuidsetup($user);
 warn "Re-initialization with updated schema completed in ". (time-$start). " seconds\n"; # if $DEBUG;
 $start = time;
 
+#### NEW CUSTOM FIELDS:
+# 3. migrate old virtual field data to the new custom fields
+####
+$cfsth = $dbh->prepare("SELECT * FROM virtual_field left join part_virtual_field using (vfieldpart)")
+                                                         or die $dbh->errstr;
+$cfsth->execute or die $cfsth->errstr;
+my @cfst;
+while ( $cf = $cfsth->fetchrow_hashref ) {
+    my $tbl = $cf->{'dbtable'};
+    my $name = $cf->{'name'};
+    my $dtable = dbdef->table($tbl);
+    next unless $dtable && $dtable->primary_key; # XXX: warn first?
+    my $pkey = $dtable->primary_key;
+    next unless $dtable->column($pkey)->type =~ /int/i; # XXX: warn first?
+    push @cfst, "UPDATE $tbl set cf_$name = '".$cf->{'value'}."' WHERE $pkey = ".$cf->{'recnum'};
+    push @cfst, "DELETE FROM virtual_field WHERE vfieldnum = ".$cf->{'vfieldnum'};
+}
+foreach my $cfst ( @cfst ) {
+    warn "$cfst\n";
+    $dbh->do( $cfst )
+      or die "Error: ". $dbh->errstr. "\n executing: $cfst";
+}
+warn "Custom fields data upgrade completed";
+
 upgrade_config()
   unless $DRY_RUN || $opt_s;