projects / freeside.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
fix FS::Record::qsearch to (hopefully) work as before and cluck loudly when the FS...
[freeside.git] / FS / FS / Record.pm
diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 3c8e9ba..4e5e18a 100644 (file)
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -1,20 +1,28 @@
 package FS::Record;
 
 use strict;
 package FS::Record;
 
 use strict;
-use vars qw($dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG);
+use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG
+             $me %dbdef_cache %virtual_fields_cache );
 use subs qw(reload_dbdef);
 use Exporter;
 use Carp qw(carp cluck croak confess);
 use File::CounterFile;
 use Locale::Country;
 use subs qw(reload_dbdef);
 use Exporter;
 use Carp qw(carp cluck croak confess);
 use File::CounterFile;
 use Locale::Country;
-use DBIx::DBSchema 0.19;
-use FS::UID qw(dbh checkruid getotaker datasrc driver_name);
+use DBI qw(:sql_types);
+use DBIx::DBSchema 0.23;
+use FS::UID qw(dbh getotaker datasrc driver_name);
 use FS::SearchCache;
 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;
 
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch);
 
 $DEBUG = 0;
+$me = '[FS::Record]';
 
 #ask FS::UID to run this stuff for us later
 $FS::UID::callback{'FS::Record'} = sub { 
 
 #ask FS::UID to run this stuff for us later
 $FS::UID::callback{'FS::Record'} = sub { 
@@ -56,14 +64,12 @@ FS::Record - Database record objects
     $hashref = $record->hashref;
 
     $error = $record->insert;
     $hashref = $record->hashref;
 
     $error = $record->insert;
-    #$error = $record->add; #depriciated
 
     $error = $record->delete;
 
     $error = $record->delete;
-    #$error = $record->del; #depriciated
 
     $error = $new_record->replace($old_record);
 
     $error = $new_record->replace($old_record);
-    #$error = $new_record->rep($old_record); #depriciated
 
 
+    # external use deprecated - handled by the database (at least for Pg, mysql)
     $value = $record->unique('column');
 
     $error = $record->ut_float('column');
     $value = $record->unique('column');
 
     $error = $record->ut_float('column');
@@ -84,7 +90,7 @@ FS::Record - Database record objects
 
     $quoted_value = _quote($value,'table','field');
 
 
     $quoted_value = _quote($value,'table','field');
 
-    #depriciated
+    #deprecated
     $fields = hfields('table');
     if ( $fields->{Field} ) { # etc.
 
     $fields = hfields('table');
     if ( $fields->{Field} ) { # etc.
 
@@ -121,19 +127,15 @@ sub new {
   my $self = {};
   bless ($self, $class);
 
   my $self = {};
   bless ($self, $class);
 
-  $self->{'Table'} = shift unless defined ( $self->table );
+  unless ( defined ( $self->table ) ) {
+    $self->{'Table'} = shift;
+    carp "warning: FS::Record::new called with table name ". $self->{'Table'};
+  }
 
   my $hashref = $self->{'Hash'} = shift;
 
 
   my $hashref = $self->{'Hash'} = shift;
 
-  foreach my $field ( $self->fields ) { 
-    $hashref->{$field}='' unless defined $hashref->{$field};
-    #trim the '$' and ',' from money fields for Pg (belong HERE?)
-    #(what about Pg i18n?)
-    if ( driver_name =~ /^Pg$/i
-         && $self->dbdef_table->column($field)->type eq 'money' ) {
-      ${$hashref}{$field} =~ s/^\$//;
-      ${$hashref}{$field} =~ s/\,//;
-    }
+  foreach my $field ( grep !defined($hashref->{$_}), $self->fields ) { 
+    $hashref->{$field}='';
   }
 
   $self->_cache($hashref, shift) if $self->can('_cache') && @_;
   }
 
   $self->_cache($hashref, shift) if $self->can('_cache') && @_;
@@ -167,14 +169,14 @@ sub create {
   my $self = {};
   bless ($self, $class);
   if ( defined $self->table ) {
   my $self = {};
   bless ($self, $class);
   if ( defined $self->table ) {
-    cluck "create constructor is depriciated, use new!";
+    cluck "create constructor is deprecated, use new!";
     $self->new(@_);
   } else {
     croak "FS::Record::create called (not from a subclass)!";
   }
 }
 
     $self->new(@_);
   } else {
     croak "FS::Record::create called (not from a subclass)!";
   }
 }
 
-=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL
+=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ
 
 Searches the database for all records matching (at least) the key/value pairs
 in HASHREF.  Returns all the records found as `FS::TABLE' objects if that
 
 Searches the database for all records matching (at least) the key/value pairs
 in HASHREF.  Returns all the records found as `FS::TABLE' objects if that
@@ -202,68 +204,213 @@ sub qsearch {
   my $dbh = dbh;
 
   my $table = $cache ? $cache->table : $stable;
   my $dbh = dbh;
 
   my $table = $cache ? $cache->table : $stable;
+  my $dbdef_table = $dbdef->table($table)
+    or die "No schema for table $table found - ".
+           "do you need to create it or run dbdef-create?";
+  my $pkey = $dbdef_table->primary_key;
 
 
-  my @fields = grep exists($record->{$_}), fields($table);
+  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";
+    @virtual_fields = ();
+  }
 
   my $statement = "SELECT $select FROM $stable";
 
   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 = $_;
+      if ( ref($record->{$_}) ) {
+        $op = $record->{$_}{'op'} if $record->{$_}{'op'};
+        #$op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name ne 'Pg';
+        if ( uc($op) eq 'ILIKE' ) {
+          $op = 'LIKE';
+          $record->{$_}{'value'} = lc($record->{$_}{'value'});
+          $column = "LOWER($_)";
+        }
+        $record->{$_} = $record->{$_}{'value'}
+      }
+
       if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
       if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
-        if ( driver_name =~ /^Pg$/i ) {
-          "$_ IS NULL";
+        if ( $op eq '=' ) {
+          if ( driver_name eq 'Pg' ) {
+            my $type = $dbdef->table($table)->column($column)->type;
+            if ( $type =~ /(int|serial)/i ) {
+              qq-( $column IS NULL )-;
+            } else {
+              qq-( $column IS NULL OR $column = '' )-;
+            }
+          } else {
+            qq-( $column IS NULL OR $column = "" )-;
+          }
+        } elsif ( $op eq '!=' ) {
+          if ( driver_name eq 'Pg' ) {
+            my $type = $dbdef->table($table)->column($column)->type;
+            if ( $type =~ /(int|serial)/i ) {
+              qq-( $column IS NOT NULL )-;
+            } else {
+              qq-( $column IS NOT NULL AND $column != '' )-;
+            }
+          } else {
+            qq-( $column IS NOT NULL AND $column != "" )-;
+          }
         } else {
         } else {
-          qq-( $_ IS NULL OR $_ = "" )-;
+          if ( driver_name eq 'Pg' ) {
+            qq-( $column $op '' )-;
+          } else {
+            qq-( $column $op "" )-;
+          }
         }
       } else {
         }
       } else {
-        "$_ = ?";
+        "$column $op ?";
+      }
+    } @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'};
       }
       }
-    } @fields );
+
+      # ... 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);
 
   $statement .= " $extra_sql" if defined($extra_sql);
 
-  warn $statement if $DEBUG;
+  warn "[debug]$me $statement\n" if $DEBUG > 1;
   my $sth = $dbh->prepare($statement)
     or croak "$dbh->errstr doing $statement";
 
   my $sth = $dbh->prepare($statement)
     or croak "$dbh->errstr doing $statement";
 
-  $sth->execute( map $record->{$_},
-    grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
-  ) or croak "Error executing \"$statement\": ". $dbh->errstr;
-  $dbh->commit or croak $dbh->errstr if $FS::UID::AutoCommit;
+  my $bind = 1;
+
+  foreach my $field (
+    grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields
+  ) {
+    if ( $record->{$field} =~ /^\d+(\.\d+)?$/
+         && $dbdef->table($table)->column($field)->type =~ /(int|serial)/i
+    ) {
+      $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_INTEGER } );
+    } else {
+      $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_VARCHAR } );
+    }
+  }
+
+#  $sth->execute( map $record->{$_},
+#    grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
+#  ) or croak "Error executing \"$statement\": ". $sth->errstr;
+
+  $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr;
 
   if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
 
   if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
+    @virtual_fields = "FS::$table"->virtual_fields;
+  } else {
+    cluck "warning: FS::$table not loaded; virtual fields not returned either";
+    @virtual_fields = ();
+  }
+
+  my %result;
+  tie %result, "Tie::IxHash";
+  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 )
     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", { %{$_} } )
       } 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( { %{$_} } )';
       }
     } 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, { %{$_} } );
     }
   } else {
     cluck "warning: FS::$table not loaded; returning FS::Record objects";
     map {
       FS::Record->new( $table, { %{$_} } );
-    } @{$sth->fetchall_arrayref( {} )};
+    } values(%result);
   }
 
 }
 
   }
 
 }
 
-=item jsearch
+=item jsearch TABLE, HASHREF, SELECT, EXTRA_SQL, PRIMARY_TABLE, PRIMARY_KEY
 
 Experimental JOINed search method.  Using this method, you can execute a
 single SELECT spanning multiple tables, and cache the results for subsequent
 method calls.  Interface will almost definately change in an incompatible
 fashion.
 
 
 Experimental JOINed search method.  Using this method, you can execute a
 single SELECT spanning multiple tables, and cache the results for subsequent
 method calls.  Interface will almost definately change in an incompatible
 fashion.
 
+Arguments: 
+
 =cut
 
 sub jsearch {
 =cut
 
 sub jsearch {
@@ -285,9 +432,11 @@ for a single item, or your data is corrupted.
 =cut
 
 sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash);
 =cut
 
 sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash);
+  my $table = $_[0];
   my(@result) = qsearch(@_);
   my(@result) = qsearch(@_);
-  carp "warning: Multiple records in scalar search!" if scalar(@result) > 1;
-    #should warn more vehemently if the search was on a primary key?
+  carp "warning: Multiple records in scalar search ($table)"
+    if scalar(@result) > 1;
+  #should warn more vehemently if the search was on a primary key?
   scalar(@result) ? ($result[0]) : ();
 }
 
   scalar(@result) ? ($result[0]) : ();
 }
 
@@ -304,14 +453,14 @@ Returns the table name.
 =cut
 
 sub table {
 =cut
 
 sub table {
-#  cluck "warning: FS::Record::table depriciated; supply one in subclass!";
+#  cluck "warning: FS::Record::table deprecated; supply one in subclass!";
   my $self = shift;
   $self -> {'Table'};
 }
 
 =item dbdef_table
 
   my $self = shift;
   $self -> {'Table'};
 }
 
 =item dbdef_table
 
-Returns the FS::dbdef_table object for the table.
+Returns the DBIx::DBSchema::Table object for the table.
 
 =cut
 
 
 =cut
 
@@ -365,32 +514,32 @@ $record->column('value') is a synonym for $record->set('column','value');
 =cut
 
 # readable/safe
 =cut
 
 # readable/safe
-#sub AUTOLOAD {
-#  my($self,$value)=@_;
-#  my($field)=$AUTOLOAD;
-#  $field =~ s/.*://;
-#  if ( defined($value) ) {
-#    confess "errant AUTOLOAD $field for $self (arg $value)"
-#      unless $self->can('setfield');
-#    $self->setfield($field,$value);
-#  } else {
-#    confess "errant AUTOLOAD $field for $self (no args)"
-#      unless $self->can('getfield');
-#    $self->getfield($field);
-#  }    
-#}
-
-# efficient
 sub AUTOLOAD {
 sub AUTOLOAD {
-  my $field = $AUTOLOAD;
+  my($self,$value)=@_;
+  my($field)=$AUTOLOAD;
   $field =~ s/.*://;
   $field =~ s/.*://;
-  if ( scalar(@_) == 2 ) {
-    $_[0]->setfield($field, $_[1]);
+  if ( defined($value) ) {
+    confess "errant AUTOLOAD $field for $self (arg $value)"
+      unless ref($self) && $self->can('setfield');
+    $self->setfield($field,$value);
   } else {
   } else {
-    $_[0]->getfield($field);
+    confess "errant AUTOLOAD $field for $self (no args)"
+      unless ref($self) && $self->can('getfield');
+    $self->getfield($field);
   }    
 }
 
   }    
 }
 
+# efficient
+#sub AUTOLOAD {
+#  my $field = $AUTOLOAD;
+#  $field =~ s/.*://;
+#  if ( defined($_[1]) ) {
+#    $_[0]->setfield($field, $_[1]);
+#  } else {
+#    $_[0]->getfield($field);
+#  }    
+#}
+
 =item hash
 
 Returns a list of the column/value pairs, usually for assigning to a new hash.
 =item hash
 
 Returns a list of the column/value pairs, usually for assigning to a new hash.
@@ -403,6 +552,8 @@ To make a distinct duplicate of an FS::Record object, you can do:
 
 sub hash {
   my($self) = @_;
 
 sub hash {
   my($self) = @_;
+  confess $self. ' -> hash: Hash attribute is undefined'
+    unless defined($self->{'Hash'});
   %{ $self->{'Hash'} }; 
 }
 
   %{ $self->{'Hash'} }; 
 }
 
@@ -431,26 +582,46 @@ sub insert {
   return $error if $error;
 
   #single-field unique keys are given a value if false
   return $error if $error;
 
   #single-field unique keys are given a value if false
-  #(like MySQL's AUTO_INCREMENT)
+  #(like MySQL's AUTO_INCREMENT or Pg SERIAL)
   foreach ( $self->dbdef_table->unique->singles ) {
     $self->unique($_) unless $self->getfield($_);
   }
   foreach ( $self->dbdef_table->unique->singles ) {
     $self->unique($_) unless $self->getfield($_);
   }
-  #and also the primary key
+
+  #and also the primary key, if the database isn't going to
   my $primary_key = $self->dbdef_table->primary_key;
   my $primary_key = $self->dbdef_table->primary_key;
-  $self->unique($primary_key) 
-    if $primary_key && ! $self->getfield($primary_key);
+  my $db_seq = 0;
+  if ( $primary_key ) {
+    my $col = $self->dbdef_table->column($primary_key);
+    
+    $db_seq =
+      uc($col->type) eq 'SERIAL'
+      || ( driver_name eq 'Pg'
+             && defined($col->default)
+             && $col->default =~ /^nextval\(/i
+         )
+      || ( driver_name eq 'mysql'
+             && defined($col->local)
+             && $col->local =~ /AUTO_INCREMENT/i
+         );
+    $self->unique($primary_key) unless $self->getfield($primary_key) || $db_seq;
+  }
 
 
-  my @fields =
+  my $table = $self->table;
+  #false laziness w/delete
+  my @real_fields =
     grep defined($self->getfield($_)) && $self->getfield($_) ne "",
     grep defined($self->getfield($_)) && $self->getfield($_) ne "",
-    $self->fields
+    real_fields($table)
   ;
   ;
+  my @values = map { _quote( $self->getfield($_), $table, $_) } @real_fields;
+  #eslaf
 
 
-  my $statement = "INSERT INTO ". $self->table. " ( ".
-      join(', ',@fields ).
+  my $statement = "INSERT INTO $table ( ".
+      join( ', ', @real_fields ).
     ") VALUES (".
     ") VALUES (".
-      join(', ',map(_quote($self->getfield($_),$self->table,$_), @fields)).
+      join( ', ', @values ).
     ")"
   ;
     ")"
   ;
+  warn "[debug]$me $statement\n" if $DEBUG > 1;
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
   local $SIG{HUP} = 'IGNORE';
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
   local $SIG{HUP} = 'IGNORE';
@@ -461,6 +632,92 @@ sub insert {
   local $SIG{PIPE} = 'IGNORE';
 
   $sth->execute or return $sth->errstr;
   local $SIG{PIPE} = 'IGNORE';
 
   $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;
+    if ( driver_name eq 'Pg' ) {
+
+      my $oid = $sth->{'pg_oid_status'};
+      my $i_sql = "SELECT $primary_key FROM $table WHERE oid = ?";
+      my $i_sth = dbh->prepare($i_sql) or do {
+        dbh->rollback if $FS::UID::AutoCommit;
+        return dbh->errstr;
+      };
+      $i_sth->execute($oid) or do {
+        dbh->rollback if $FS::UID::AutoCommit;
+        return $i_sth->errstr;
+      };
+      $insertid = $i_sth->fetchrow_arrayref->[0];
+
+    } elsif ( driver_name eq 'mysql' ) {
+
+      $insertid = dbh->{'mysql_insertid'};
+      # work around mysql_insertid being null some of the time, ala RT :/
+      unless ( $insertid ) {
+        warn "WARNING: DBD::mysql didn't return mysql_insertid; ".
+             "using SELECT LAST_INSERT_ID();";
+        my $i_sql = "SELECT LAST_INSERT_ID()";
+        my $i_sth = dbh->prepare($i_sql) or do {
+          dbh->rollback if $FS::UID::AutoCommit;
+          return dbh->errstr;
+        };
+        $i_sth->execute or do {
+          dbh->rollback if $FS::UID::AutoCommit;
+          return $i_sth->errstr;
+        };
+        $insertid = $i_sth->fetchrow_arrayref->[0];
+      }
+
+    } else {
+      dbh->rollback if $FS::UID::AutoCommit;
+      return "don't know how to retreive inserted ids from ". driver_name. 
+             ", try using counterfiles (maybe run dbdef-create?)";
+    }
+    $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 = $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');
+    warn "[debug]$me $h_statement\n" if $DEBUG > 2;
+    $h_sth = dbh->prepare($h_statement) or do {
+      dbh->rollback if $FS::UID::AutoCommit;
+      return dbh->errstr;
+    };
+  } else {
+    $h_sth = '';
+  }
+  $h_sth->execute or return $h_sth->errstr if $h_sth;
+
   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
   '';
   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
   '';
@@ -473,7 +730,7 @@ Depriciated (use insert instead).
 =cut
 
 sub add {
 =cut
 
 sub add {
-  cluck "warning: FS::Record::add depriciated!";
+  cluck "warning: FS::Record::add deprecated!";
   insert @_; #call method in this scope
 }
 
   insert @_; #call method in this scope
 }
 
@@ -487,21 +744,44 @@ otherwise returns false.
 sub delete {
   my $self = shift;
 
 sub delete {
   my $self = shift;
 
-  my($statement)="DELETE FROM ". $self->table. " WHERE ". join(' AND ',
+  my $statement = "DELETE FROM ". $self->table. " WHERE ". join(' AND ',
     map {
       $self->getfield($_) eq ''
         #? "( $_ IS NULL OR $_ = \"\" )"
     map {
       $self->getfield($_) eq ''
         #? "( $_ IS NULL OR $_ = \"\" )"
-        ? ( driver_name =~ /^Pg$/i
+        ? ( driver_name eq 'Pg'
               ? "$_ IS NULL"
               : "( $_ IS NULL OR $_ = \"\" )"
           )
         : "$_ = ". _quote($self->getfield($_),$self->table,$_)
     } ( $self->dbdef_table->primary_key )
           ? ( $self->dbdef_table->primary_key)
               ? "$_ IS NULL"
               : "( $_ IS NULL OR $_ = \"\" )"
           )
         : "$_ = ". _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;
 
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
+  my $h_sth;
+  if ( defined $dbdef->table('h_'. $self->table) ) {
+    my $h_statement = $self->_h_statement('delete');
+    warn "[debug]$me $h_statement\n" if $DEBUG > 2;
+    $h_sth = dbh->prepare($h_statement) or return dbh->errstr;
+  } else {
+    $h_sth = '';
+  }
+
+  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';
   local $SIG{QUIT} = 'IGNORE'; 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE'; 
@@ -511,9 +791,15 @@ sub delete {
 
   my $rc = $sth->execute or return $sth->errstr;
   #not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0";
 
   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;
 
   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
-  undef $self; #no need to keep object!
+  #no need to needlessly destoy the data either (causes problems actually)
+  #undef $self; #no need to keep object!
 
   '';
 }
 
   '';
 }
@@ -525,7 +811,7 @@ Depriciated (use delete instead).
 =cut
 
 sub del {
 =cut
 
 sub del {
-  cluck "warning: FS::Record::del depriciated!";
+  cluck "warning: FS::Record::del deprecated!";
   &delete(@_); #call method in this scope
 }
 
   &delete(@_); #call method in this scope
 }
 
@@ -537,15 +823,26 @@ returns the error, otherwise returns false.
 =cut
 
 sub replace {
 =cut
 
 sub replace {
-  my ( $new, $old ) = ( shift, shift );
-  warn "[debug][FS::Record] $new ->replace $old\n" if $DEBUG;
+  my $new = shift;
 
 
-  my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields;
-  unless ( @diff ) {
-    carp "[warning][FS::Record] $new -> replace $old: records identical";
-    return '';
+  my $old;
+  if ( @_ ) { 
+    $old = shift;
+  } else {
+    warn "[debug]$me replace called with no arguments; autoloading old record\n"
+     if $DEBUG;
+    my $primary_key = $new->dbdef_table->primary_key;
+    if ( $primary_key ) {
+      $old = qsearchs($new->table, { $primary_key => $new->$primary_key() } )
+        or croak "can't find ". $new->table. ".$primary_key ".
+                 $new->$primary_key();
+    } else {
+      croak $new->table. " has no primary key; pass old record as argument";
+    }
   }
 
   }
 
+  warn "[debug]$me $new ->replace $old\n" if $DEBUG;
+
   return "Records not in same table!" unless $new->table eq $old->table;
 
   my $primary_key = $old->dbdef_table->primary_key;
   return "Records not in same table!" unless $new->table eq $old->table;
 
   my $primary_key = $old->dbdef_table->primary_key;
@@ -556,25 +853,91 @@ sub replace {
   my $error = $new->check;
   return $error if $error;
 
   my $error = $new->check;
   return $error if $error;
 
+  #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 '';
+  }
+
   my $statement = "UPDATE ". $old->table. " SET ". join(', ',
     map {
       "$_ = ". _quote($new->getfield($_),$old->table,$_) 
   my $statement = "UPDATE ". $old->table. " SET ". join(', ',
     map {
       "$_ = ". _quote($new->getfield($_),$old->table,$_) 
-    } @diff
+    } real_fields($old->table)
   ). ' WHERE '.
     join(' AND ',
       map {
         $old->getfield($_) eq ''
           #? "( $_ IS NULL OR $_ = \"\" )"
   ). ' WHERE '.
     join(' AND ',
       map {
         $old->getfield($_) eq ''
           #? "( $_ IS NULL OR $_ = \"\" )"
-          ? ( driver_name =~ /^Pg$/i
-                ? "$_ IS NULL"
+          ? ( driver_name eq 'Pg'
+                ? "( $_ IS NULL OR $_ = '' )"
                 : "( $_ IS NULL OR $_ = \"\" )"
             )
           : "$_ = ". _quote($old->getfield($_),$old->table,$_)
                 : "( $_ 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;
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
+  my $h_old_sth;
+  if ( defined $dbdef->table('h_'. $old->table) ) {
+    my $h_old_statement = $old->_h_statement('replace_old');
+    warn "[debug]$me $h_old_statement\n" if $DEBUG > 2;
+    $h_old_sth = dbh->prepare($h_old_statement) or return dbh->errstr;
+  } else {
+    $h_old_sth = '';
+  }
+
+  my $h_new_sth;
+  if ( defined $dbdef->table('h_'. $new->table) ) {
+    my $h_new_statement = $new->_h_statement('replace_new');
+    warn "[debug]$me $h_new_statement\n" if $DEBUG > 2;
+    $h_new_sth = dbh->prepare($h_new_statement) or return dbh->errstr;
+  } else {
+    $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'; 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE'; 
@@ -584,6 +947,26 @@ sub replace {
 
   my $rc = $sth->execute or return $sth->errstr;
   #not portable #return "Record not found (or records identical)." if $rc eq "0E0";
 
   my $rc = $sth->execute or return $sth->errstr;
   #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;
 
   '';
   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
   '';
@@ -597,24 +980,69 @@ Depriciated (use replace instead).
 =cut
 
 sub rep {
 =cut
 
 sub rep {
-  cluck "warning: FS::Record::rep depriciated!";
+  cluck "warning: FS::Record::rep deprecated!";
   replace @_; #call method in this scope
 }
 
 =item check
 
   replace @_; #call method in this scope
 }
 
 =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 {
 
 =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;
+      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): $@";
+
+      }
+      $self->setfield($field, $_);
+    }
+  }
+  '';
+}
+
+sub _h_statement {
+  my( $self, $action ) = @_;
+
+  my @fields =
+    grep defined($self->getfield($_)) && $self->getfield($_) ne "",
+    real_fields($self->table);
+  ;
+  my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields;
+
+  "INSERT INTO h_". $self->table. " ( ".
+      join(', ', qw(history_date history_user history_action), @fields ).
+    ") VALUES (".
+      join(', ', time, dbh->quote(getotaker()), dbh->quote($action), @values).
+    ")"
+  ;
 }
 
 =item unique COLUMN
 
 }
 
 =item unique COLUMN
 
-Replaces COLUMN in record with a unique number.  Called by the B<add> method
-on primary keys and single-field unique columns (see L<DBIx::DBSchema::Table>).
+B<Warning>: External use is B<deprecated>.  
+
+Replaces COLUMN in record with a unique number, using counters in the
+filesystem.  Used by the B<insert> method on single-field unique columns
+(see L<DBIx::DBSchema::Table>) and also as a fallback for primary keys
+that aren't SERIAL (Pg) or AUTO_INCREMENT (mysql).
+
 Returns the new value.
 
 =cut
 Returns the new value.
 
 =cut
@@ -623,8 +1051,6 @@ sub unique {
   my($self,$field) = @_;
   my($table)=$self->table;
 
   my($self,$field) = @_;
   my($table)=$self->table;
 
-  croak("&FS::UID::checkruid failed") unless &checkruid;
-
   croak "Unique called on field $field, but it is ",
         $self->getfield($field),
         ", not null!"
   croak "Unique called on field $field, but it is ",
         $self->getfield($field),
         ", not null!"
@@ -640,9 +1066,8 @@ sub unique {
 #  my($counter) = new File::CounterFile "$user/$table.$field",0;
 # endhack
 
 #  my($counter) = new File::CounterFile "$user/$table.$field",0;
 # endhack
 
-  my($index)=$counter->inc;
-  $index=$counter->inc
-    while qsearchs($table,{$field=>$index}); #just in case
+  my $index = $counter->inc;
+  $index = $counter->inc while qsearchs($table, { $field=>$index } );
 
   $index =~ /^(\d*)$/;
   $index=$1;
 
   $index =~ /^(\d*)$/;
   $index=$1;
@@ -669,6 +1094,21 @@ sub ut_float {
   '';
 }
 
   '';
 }
 
+=item ut_snumber COLUMN
+
+Check/untaint signed numeric data (whole numbers).  May not be null.  If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_snumber {
+  my($self, $field) = @_;
+  $self->getfield($field) =~ /^(-?)\s*(\d+)$/
+    or return "Illegal or empty (numeric) $field: ". $self->getfield($field);
+  $self->setfield($field, "$1$2");
+  '';
+}
+
 =item ut_number COLUMN
 
 Check/untaint simple numeric data (whole numbers).  May not be null.  If there
 =item ut_number COLUMN
 
 Check/untaint simple numeric data (whole numbers).  May not be null.  If there
@@ -719,7 +1159,7 @@ sub ut_money {
 =item ut_text COLUMN
 
 Check/untaint text.  Alphanumerics, spaces, and the following punctuation
 =item ut_text COLUMN
 
 Check/untaint text.  Alphanumerics, spaces, and the following punctuation
-symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? /
+symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / =
 May not be null.  If there is an error, returns the error, otherwise returns
 false.
 
 May not be null.  If there is an error, returns the error, otherwise returns
 false.
 
@@ -727,8 +1167,12 @@ false.
 
 sub ut_text {
   my($self,$field)=@_;
 
 sub ut_text {
   my($self,$field)=@_;
-  $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]+)$/
-    or return "Illegal or empty (text) $field: ". $self->getfield($field);
+  #warn "msgcat ". \&msgcat. "\n";
+  #warn "notexist ". \&notexist. "\n";
+  #warn "AUTOLOAD ". \&AUTOLOAD. "\n";
+  $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]+)$/
+    or return gettext('illegal_or_empty_text'). " $field: ".
+               $self->getfield($field);
   $self->setfield($field,$1);
   '';
 }
   $self->setfield($field,$1);
   '';
 }
@@ -743,8 +1187,8 @@ May be null.  If there is an error, returns the error, otherwise returns false.
 
 sub ut_textn {
   my($self,$field)=@_;
 
 sub ut_textn {
   my($self,$field)=@_;
-  $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]*)$/
-    or return "Illegal (text) $field: ". $self->getfield($field);
+  $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]*)$/
+    or return gettext('illegal_text'). " $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
 }
   $self->setfield($field,$1);
   '';
 }
@@ -799,12 +1243,12 @@ sub ut_phonen {
   } elsif ( $country eq 'US' || $country eq 'CA' ) {
     $phonen =~ s/\D//g;
     $phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/
   } elsif ( $country eq 'US' || $country eq 'CA' ) {
     $phonen =~ s/\D//g;
     $phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/
-      or return "Illegal (phone) $field: ". $self->getfield($field);
+      or return gettext('illegal_phone'). " $field: ". $self->getfield($field);
     $phonen = "$1-$2-$3";
     $phonen .= " x$4" if $4;
     $self->setfield($field,$phonen);
   } else {
     $phonen = "$1-$2-$3";
     $phonen .= " x$4" if $4;
     $self->setfield($field,$phonen);
   } else {
-    warn "don't know how to check phone numbers for country $country";
+    warn "warning: don't know how to check phone numbers for country $country";
     return $self->ut_textn($field);
   }
   '';
     return $self->ut_textn($field);
   }
   '';
@@ -821,7 +1265,7 @@ sub ut_ip {
   $self->getfield($field) =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/
     or return "Illegal (IP address) $field: ". $self->getfield($field);
   for ( $1, $2, $3, $4 ) { return "Illegal (IP address) $field" if $_ > 255; }
   $self->getfield($field) =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/
     or return "Illegal (IP address) $field: ". $self->getfield($field);
   for ( $1, $2, $3, $4 ) { return "Illegal (IP address) $field" if $_ > 255; }
-  $self->setfield($field, "$1.$2.$3.$3");
+  $self->setfield($field, "$1.$2.$3.$4");
   '';
 }
 
   '';
 }
 
@@ -850,7 +1294,7 @@ Check/untaint host and domain names.
 sub ut_domain {
   my( $self, $field ) = @_;
   #$self->getfield($field) =~/^(\w+\.)*\w+$/
 sub ut_domain {
   my( $self, $field ) = @_;
   #$self->getfield($field) =~/^(\w+\.)*\w+$/
-  $self->getfield($field) =~/^(\w+\.)*\w+$/
+  $self->getfield($field) =~/^(([\w\-]+\.)*\w+)$/
     or return "Illegal (domain) $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
     or return "Illegal (domain) $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
@@ -868,7 +1312,7 @@ May not be null.
 sub ut_name {
   my( $self, $field ) = @_;
   $self->getfield($field) =~ /^([\w \,\.\-\']+)$/
 sub ut_name {
   my( $self, $field ) = @_;
   $self->getfield($field) =~ /^([\w \,\.\-\']+)$/
-    or return "Illegal (name) $field: ". $self->getfield($field);
+    or return gettext('illegal_name'). " $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
 }
   $self->setfield($field,$1);
   '';
 }
@@ -883,13 +1327,17 @@ sub ut_zip {
   my( $self, $field, $country ) = @_;
   if ( $country eq 'US' ) {
     $self->getfield($field) =~ /\s*(\d{5}(\-\d{4})?)\s*$/
   my( $self, $field, $country ) = @_;
   if ( $country eq 'US' ) {
     $self->getfield($field) =~ /\s*(\d{5}(\-\d{4})?)\s*$/
-      or return "Illegal (zip) $field for country $country: ".
+      or return gettext('illegal_zip'). " $field for country $country: ".
                 $self->getfield($field);
     $self->setfield($field,$1);
   } else {
                 $self->getfield($field);
     $self->setfield($field,$1);
   } else {
-    $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
-      or return "Illegal (zip) $field: ". $self->getfield($field);
-    $self->setfield($field,$1);
+    if ( $self->getfield($field) =~ /^\s*$/ ) {
+      $self->setfield($field,'');
+    } else {
+      $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
+        or return gettext('illegal_zip'). " $field: ". $self->getfield($field);
+      $self->setfield($field,$1);
+    }
   }
   '';
 }
   }
   '';
 }
@@ -946,36 +1394,122 @@ sub ut_enum {
   return "Illegal (enum) field $field: ". $self->getfield($field);
 }
 
   return "Illegal (enum) field $field: ". $self->getfield($field);
 }
 
+=item ut_foreign_key COLUMN FOREIGN_TABLE FOREIGN_COLUMN
+
+Check/untaint a foreign column key.  Call a regular ut_ method (like ut_number)
+on the column first.
+
+=cut
+
+sub ut_foreign_key {
+  my( $self, $field, $table, $foreign ) = @_;
+  qsearchs($table, { $foreign => $self->getfield($field) })
+    or return "Can't find $field ". $self->getfield($field).
+              " in $table.$foreign";
+  '';
+}
+
+=item ut_foreign_keyn COLUMN FOREIGN_TABLE FOREIGN_COLUMN
+
+Like ut_foreign_key, except the null value is also allowed.
+
+=cut
+
+sub ut_foreign_keyn {
+  my( $self, $field, $table, $foreign ) = @_;
+  $self->getfield($field)
+    ? $self->ut_foreign_key($field, $table, $foreign)
+    : '';
+}
+
+
+=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 $self->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 $dbh->errstr if $dbh->err;
+    $virtual_fields_cache{$table} = $result;
+  }
+
+  @{$virtual_fields_cache{$table}};
+
+}
+
+
 =item fields [ TABLE ]
 
 =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
 
 
 =cut
 
-# Usage: @fields = fields($table);
-#        @fields = $record->fields;
 sub fields {
   my $something = shift;
   my $table;
 sub fields {
   my $something = shift;
   my $table;
-  if ( ref($something) ) {
+  if($something->isa('FS::Record')) {
     $table = $something->table;
   } else {
     $table = $something;
     $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
 
 }
 
 =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
 
 =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
 =item reload_dbdef([FILENAME])
 
 Load a database definition (see L<DBIx::DBSchema>), optionally from a
@@ -986,12 +1520,20 @@ I<$FS::Record::setup_hack> is true.  Returns a DBIx::DBSchema object.
 
 sub reload_dbdef {
   my $file = shift || $dbdef_file;
 
 sub reload_dbdef {
   my $file = shift || $dbdef_file;
-  $dbdef = load DBIx::DBSchema $file;
+
+  unless ( exists $dbdef_cache{$file} ) {
+    warn "[debug]$me loading dbdef for $file\n" if $DEBUG;
+    $dbdef_cache{$file} = DBIx::DBSchema->load( $file )
+                            or die "can't load database schema from $file";
+  } else {
+    warn "[debug]$me re-using cached dbdef for $file\n" if $DEBUG;
+  }
+  $dbdef = $dbdef_cache{$file};
 }
 
 =item dbdef
 
 }
 
 =item dbdef
 
-Returns the current database definition.  See L<FS::dbdef>.
+Returns the current database definition.  See L<DBIx::DBSchema>.
 
 =cut
 
 
 =cut
 
@@ -1001,33 +1543,65 @@ sub dbdef { $dbdef; }
 
 This is an internal function used to construct SQL statements.  It returns
 VALUE DBI-quoted (see L<DBI/"quote">) unless VALUE is a number and the column
 
 This is an internal function used to construct SQL statements.  It returns
 VALUE DBI-quoted (see L<DBI/"quote">) unless VALUE is a number and the column
-type (see L<FS::dbdef_column>) does not end in `char' or `binary'.
+type (see L<DBIx::DBSchema::Column>) does not end in `char' or `binary'.
 
 =cut
 
 sub _quote {
 
 =cut
 
 sub _quote {
-  my($value,$table,$field)=@_;
-  my($dbh)=dbh;
-  if ( $value =~ /^\d+(\.\d+)?$/ && 
-#       ! ( datatype($table,$field) =~ /^char/ ) 
-       ! ( $dbdef->table($table)->column($field)->type =~ /(char|binary)$/i ) 
-  ) {
+  my($value, $table, $column) = @_;
+  my $column_obj = $dbdef->table($table)->column($column);
+  my $column_type = $column_obj->type;
+
+  if ( $value eq '' && $column_type =~ /^int/ ) {
+    if ( $column_obj->null ) {
+      'NULL';
+    } else {
+      cluck "WARNING: Attempting to set non-null integer $table.$column null; ".
+            "using 0 instead";
+      0;
+    }
+  } elsif ( $value =~ /^\d+(\.\d+)?$/ && 
+            ! $column_type =~ /(char|binary|text)$/i ) {
     $value;
   } else {
     $value;
   } else {
-    $dbh->quote($value);
+    dbh->quote($value);
   }
 }
 
   }
 }
 
+=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 $self->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 hfields TABLE
 
 =item hfields TABLE
 
-This is depriciated.  Don't use it.
+This is deprecated.  Don't use it.
 
 It returns a hash-type list with the fields of this record's table set true.
 
 =cut
 
 sub hfields {
 
 It returns a hash-type list with the fields of this record's table set true.
 
 =cut
 
 sub hfields {
-  carp "warning: hfields is depriciated";
+  carp "warning: hfields is deprecated";
   my($table)=@_;
   my(%hash);
   foreach (fields($table)) {
   my($table)=@_;
   my(%hash);
   foreach (fields($table)) {
@@ -1036,12 +1610,12 @@ sub hfields {
   \%hash;
 }
 
   \%hash;
 }
 
-#sub _dump {
-#  my($self)=@_;
-#  join("\n", map {
-#    "$_: ". $self->getfield($_). "|"
-#  } (fields($self->table)) );
-#}
+sub _dump {
+  my($self)=@_;
+  join("\n", map {
+    "$_: ". $self->getfield($_). "|"
+  } (fields($self->table)) );
+}
 
 sub DESTROY { return; }
 
 
 sub DESTROY { return; }
 
@@ -1063,7 +1637,7 @@ sub DESTROY { return; }
 This module should probably be renamed, since much of the functionality is
 of general use.  It is not completely unlike Adapter::DBI (see below).
 
 This module should probably be renamed, since much of the functionality is
 of general use.  It is not completely unlike Adapter::DBI (see below).
 
-Exported qsearch and qsearchs should be depriciated in favor of method calls
+Exported qsearch and qsearchs should be deprecated in favor of method calls
 (against an FS::Record object like the old search and searchs that qsearch
 and qsearchs were on top of.)
 
 (against an FS::Record object like the old search and searchs that qsearch
 and qsearchs were on top of.)
 
@@ -1071,7 +1645,7 @@ The whole fields / hfields mess should be removed.
 
 The various WHERE clauses should be subroutined.
 
 
 The various WHERE clauses should be subroutined.
 
-table string should be depriciated in favor of FS::dbdef_table.
+table string should be deprecated in favor of DBIx::DBSchema::Table.
 
 No doubt we could benefit from a Tied hash.  Documenting how exists / defined
 true maps to the database (and WHERE clauses) would also help.
 
 No doubt we could benefit from a Tied hash.  Documenting how exists / defined
 true maps to the database (and WHERE clauses) would also help.
Freeside billing, trouble ticketing, network monitoring and provisioning