X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=e52d09424662e90b838dca7cf54ecfbd2ff7fc7c;hb=924777bf44006dd74dd6cc8643a9c6530e86ff5a;hp=c8216eca83cf3f4f684ba49e7ec9eea3a3e89813;hpb=36ac94ae711ab27d5f8d352ed7d2cba2e872ac31;p=freeside.git

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index c8216eca8..e52d09424 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -2,10 +2,12 @@ package FS::Record;
 
 use strict;
 use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG
-             $conf $conf_encryption $me
              %virtual_fields_cache
+             $conf $conf_encryption $money_char
+             $me
              $nowarn_identical $nowarn_classload
              $no_update_diff $no_check_foreign
+             @encrypt_payby
            );
 use Exporter;
 use Carp qw(carp cluck croak confess);
@@ -15,12 +17,14 @@ use Locale::Country;
 use Text::CSV_XS;
 use File::Slurp qw( slurp );
 use DBI qw(:sql_types);
-use DBIx::DBSchema 0.33;
+use DBIx::DBSchema 0.38;
 use FS::UID qw(dbh getotaker datasrc driver_name);
 use FS::CurrentUser;
 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;
@@ -29,9 +33,13 @@ use Tie::IxHash;
 
 @ISA = qw(Exporter);
 
+@encrypt_payby = qw( CARD DCRD CHEK DCHK );
+
 #export dbdef for now... everything else expects to find it here
-@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch
-                str2time_sql str2time_sql_closing );
+@EXPORT_OK = qw(
+  dbh fields hfields qsearch qsearchs dbdef jsearch
+  str2time_sql str2time_sql_closing regexp_sql not_regexp_sql concat_sql
+);
 
 $DEBUG = 0;
 $me = '[FS::Record]';
@@ -53,6 +61,7 @@ FS::UID->install_callback( sub {
   die $@ if $@;
   $conf = FS::Conf->new; 
   $conf_encryption = $conf->exists('encryption');
+  $money_char = $conf->config('money_char') || '$';
   $File::CounterFile::DEFAULT_DIR = $conf->base_dir . "/counters.". datasrc;
   if ( driver_name eq 'Pg' ) {
     eval "use DBD::Pg ':pg_types'";
@@ -244,6 +253,9 @@ fine in the common case where there are only two parameters:
 
   my @records = qsearch( 'table', { 'field' => 'value' } );
 
+Also possible is an experimental LISTREF of PARAMS_HASHREFs for a UNION of
+the individual PARAMS_HASHREF queries
+
 ###oops, argh, FS::Record::new only lets us create database fields.
 #Normal behaviour if SELECT is not specified is `*', as in
 #C<SELECT * FROM table WHERE ...>.  However, there is an experimental new
@@ -262,7 +274,7 @@ sub _bind_type {
 
   my $bind_type = { TYPE => SQL_VARCHAR };
 
-  if ( $type =~ /(big)?(int|serial)/i && $value =~ /^\d+(\.\d+)?$/ ) {
+  if ( $type =~ /(big)?(int|serial)/i && $value =~ /^-?\d+(\.\d+)?$/ ) {
 
     $bind_type = { TYPE => SQL_INTEGER };
 
@@ -300,104 +312,137 @@ sub _is_fs_float {
 }
 
 sub qsearch {
-  my($stable, $record, $cache );
-  my( $select, $extra_sql, $extra_param, $order_by, $addl_from );
-  my $debug = '';
-  if ( ref($_[0]) ) { #hashref for now, eventually maybe accept a list too
+  my( @stable, @record, @cache );
+  my( @select, @extra_sql, @extra_param, @order_by, @addl_from );
+  my @debug = ();
+  my %union_options = ();
+  if ( ref($_[0]) eq 'ARRAY' ) {
+    my $optlist = shift;
+    %union_options = @_;
+    foreach my $href ( @$optlist ) {
+      push @stable,      ( $href->{'table'} or die "table name is required" );
+      push @record,      ( $href->{'hashref'}     || {} );
+      push @select,      ( $href->{'select'}      || '*' );
+      push @extra_sql,   ( $href->{'extra_sql'}   || '' );
+      push @extra_param, ( $href->{'extra_param'} || [] );
+      push @order_by,    ( $href->{'order_by'}    || '' );
+      push @cache,       ( $href->{'cache_obj'}   || '' );
+      push @addl_from,   ( $href->{'addl_from'}   || '' );
+      push @debug,       ( $href->{'debug'}       || '' );
+    }
+    die "at least one hashref is required" unless scalar(@stable);
+  } elsif ( ref($_[0]) eq 'HASH' ) {
     my $opt = shift;
-    $stable      = $opt->{'table'}       or die "table name is required";
-    $record      = $opt->{'hashref'}     || {};
-    $select      = $opt->{'select'}      || '*';
-    $extra_sql   = $opt->{'extra_sql'}   || '';
-    $extra_param = $opt->{'extra_param'} || [];
-    $order_by    = $opt->{'order_by'}    || '';
-    $cache       = $opt->{'cache_obj'}   || '';
-    $addl_from   = $opt->{'addl_from'}   || '';
-    $debug       = $opt->{'debug'}       || '';
+    $stable[0]      = $opt->{'table'}       or die "table name is required";
+    $record[0]      = $opt->{'hashref'}     || {};
+    $select[0]      = $opt->{'select'}      || '*';
+    $extra_sql[0]   = $opt->{'extra_sql'}   || '';
+    $extra_param[0] = $opt->{'extra_param'} || [];
+    $order_by[0]    = $opt->{'order_by'}    || '';
+    $cache[0]       = $opt->{'cache_obj'}   || '';
+    $addl_from[0]   = $opt->{'addl_from'}   || '';
+    $debug[0]       = $opt->{'debug'}       || '';
   } else {
-    ($stable, $record, $select, $extra_sql, $cache, $addl_from ) = @_;
-    $select ||= '*';
+    ( $stable[0],
+      $record[0],
+      $select[0],
+      $extra_sql[0],
+      $cache[0],
+      $addl_from[0]
+    ) = @_;
+    $select[0] ||= '*';
   }
+  my $cache = $cache[0];
 
-  #$stable =~ /^([\w\_]+)$/ or die "Illegal table: $table";
-  #for jsearch
-  $stable =~ /^([\w\s\(\)\.\,\=]+)$/ or die "Illegal table: $stable";
-  $stable = $1;
+  my @statement = ();
+  my @value = ();
+  my @bind_type = ();
   my $dbh = dbh;
+  foreach my $stable ( @stable ) {
+    #stop altering the caller's hashref
+    my $record      = { %{ shift(@record) || {} } };#and be liberal in receipt
+    my $select      = shift @select;
+    my $extra_sql   = shift @extra_sql;
+    my $extra_param = shift @extra_param;
+    my $order_by    = shift @order_by;
+    my $cache       = shift @cache;
+    my $addl_from   = shift @addl_from;
+    my $debug       = shift @debug;
+
+    #$stable =~ /^([\w\_]+)$/ or die "Illegal table: $table";
+    #for jsearch
+    $stable =~ /^([\w\s\(\)\.\,\=]+)$/ or die "Illegal table: $stable";
+    $stable = $1;
+
+    my $table = $cache ? $cache->table : $stable;
+    my $dbdef_table = dbdef->table($table)
+      or die "No schema for table $table found - ".
+             "do you need to run freeside-upgrade?";
+    my $pkey = $dbdef_table->primary_key;
+
+    my @real_fields = grep exists($record->{$_}), real_fields($table);
+
+    my $statement .= "SELECT $select FROM $stable";
+    $statement .= " $addl_from" if $addl_from;
+    if ( @real_fields ) {
+      $statement .= ' WHERE '. join(' AND ',
+        get_real_fields($table, $record, \@real_fields));
+    }
 
-  my $table = $cache ? $cache->table : $stable;
-  my $dbdef_table = dbdef->table($table)
-    or die "No schema for table $table found - ".
-           "do you need to run freeside-upgrade?";
-  my $pkey = $dbdef_table->primary_key;
+    $statement .= " $extra_sql" if defined($extra_sql);
+    $statement .= " $order_by"  if defined($order_by);
 
-  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 = ();
-  }
+    push @statement, $statement;
 
-  my $statement = "SELECT $select FROM $stable";
-  $statement .= " $addl_from" if $addl_from;
-  if ( @real_fields or @virtual_fields ) {
-    $statement .= ' WHERE '. join(' AND ',
-      get_real_fields($table, $record, \@real_fields) ,
-      get_virtual_fields($table, $pkey, $record, \@virtual_fields),
-      );
-  }
+    warn "[debug]$me $statement\n" if $DEBUG > 1 || $debug;
+ 
 
-  $statement .= " $extra_sql" if defined($extra_sql);
-  $statement .= " $order_by"  if defined($order_by);
+    foreach my $field (
+      grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields
+    ) {
 
-  warn "[debug]$me $statement\n" if $DEBUG > 1 || $debug;
-  my $sth = $dbh->prepare($statement)
-    or croak "$dbh->errstr doing $statement";
+      my $value = $record->{$field};
+      my $op = (ref($value) && $value->{op}) ? $value->{op} : '=';
+      $value = $value->{'value'} if ref($value);
+      my $type = dbdef->table($table)->column($field)->type;
 
-  my $bind = 1;
+      my $bind_type = _bind_type($type, $value);
 
-  foreach my $field (
-    grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields
-  ) {
+      #if ( $DEBUG > 2 ) {
+      #  no strict 'refs';
+      #  %TYPE = map { &{"DBI::$_"}() => $_ } @{ $DBI::EXPORT_TAGS{sql_types} }
+      #    unless keys %TYPE;
+      #  warn "  bind_param $bind (for field $field), $value, TYPE $TYPE{$TYPE}\n";
+      #}
 
-    my $value = $record->{$field};
-    my $op = (ref($value) && $value->{op}) ? $value->{op} : '=';
-    $value = $value->{'value'} if ref($value);
-    my $type = dbdef->table($table)->column($field)->type;
-
-    my $bind_type = _bind_type($type, $value);
-
-    #if ( $DEBUG > 2 ) {
-    #  no strict 'refs';
-    #  %TYPE = map { &{"DBI::$_"}() => $_ } @{ $DBI::EXPORT_TAGS{sql_types} }
-    #    unless keys %TYPE;
-    #  warn "  bind_param $bind (for field $field), $value, TYPE $TYPE{$TYPE}\n";
-    #}
-
-    #if this needs to be re-enabled, it needs to use a custom op like
-    #"APPROX=" or something (better name?, not '=', to avoid affecting other
-    # searches
-    #if ($TYPE eq SQL_DECIMAL && $op eq 'APPROX=' ) {
-    #  # these values are arbitrary; better (faster?) ones welcome
-    #  $sth->bind_param($bind++, $value*1.00001, { TYPE => $TYPE } );
-    #  $sth->bind_param($bind++, $value*.99999, { TYPE => $TYPE } );
-    #} else {
-      $sth->bind_param($bind++, $value, $bind_type );
-    #}
+      push @value, $value;
+      push @bind_type, $bind_type;
 
-  }
+    }
 
-  foreach my $param ( @$extra_param ) {
-    my $bind_type = { TYPE => SQL_VARCHAR };
-    my $value = $param;
-    if ( ref($param) ) {
-      $value = $param->[0];
-      my $type = $param->[1];
-      $bind_type = _bind_type($type, $value);
+    foreach my $param ( @$extra_param ) {
+      my $bind_type = { TYPE => SQL_VARCHAR };
+      my $value = $param;
+      if ( ref($param) ) {
+        $value = $param->[0];
+        my $type = $param->[1];
+        $bind_type = _bind_type($type, $value);
+      }
+      push @value, $value;
+      push @bind_type, $bind_type;
     }
+  }
+
+  my $statement = join( ' ) UNION ( ', @statement );
+  $statement = "( $statement )" if scalar(@statement) > 1;
+  $statement .= " $union_options{order_by}" if $union_options{order_by};
+
+  my $sth = $dbh->prepare($statement)
+    or croak "$dbh->errstr doing $statement";
+
+  my $bind = 1;
+  foreach my $value ( @value ) {
+    my $bind_type = shift @bind_type;
     $sth->bind_param($bind++, $value, $bind_type );
   }
 
@@ -407,13 +452,10 @@ sub qsearch {
 
   $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr;
 
-  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 $table = $stable[0];
+  my $pkey = '';
+  $table = '' if grep { $_ ne $table } @stable;
+  $pkey = dbdef->table($table)->primary_key if $table;
 
   my %result;
   tie %result, "Tie::IxHash";
@@ -426,28 +468,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 ) {
@@ -475,6 +495,11 @@ sub qsearch {
          && eval 'defined(@FS::'. $table . '::encrypted_fields)' ) {
       foreach my $record (@return) {
         foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
+          next if $field eq 'payinfo' 
+                    && ($record->isa('FS::payinfo_transaction_Mixin') 
+                        || $record->isa('FS::payinfo_Mixin') )
+                    && $record->payby
+                    && !grep { $record->payby eq $_ } @encrypt_payby;
           # Set it directly... This may cause a problem in the future...
           $record->setfield($field, $record->decrypt($record->getfield($field)));
         }
@@ -492,50 +517,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;
@@ -743,6 +724,17 @@ sub setfield {
   $self->set(@_);
 }
 
+=item exists COLUMN
+
+Returns true if the column/field/key COLUMN exists.
+
+=cut
+
+sub exists {
+  my($self,$field) = @_;
+  exists($self->{Hash}->{$field});
+}
+
 =item AUTLOADED METHODS
 
 $record->column is a synonym for $record->get('column');
@@ -910,12 +902,12 @@ sub insert {
   my $db_seq = 0;
   if ( $primary_key ) {
     my $col = $self->dbdef_table->column($primary_key);
-    
+
     $db_seq =
       uc($col->type) =~ /^(BIG)?SERIAL\d?/
       || ( driver_name eq 'Pg'
              && defined($col->default)
-             && $col->default =~ /^nextval\(/i
+             && $col->quoted_default =~ /^nextval\(/i
          )
       || ( driver_name eq 'mysql'
              && defined($col->local)
@@ -932,6 +924,11 @@ sub insert {
        && $conf->exists('encryption')
   ) {
     foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
+      next if $field eq 'payinfo' 
+                && ($self->isa('FS::payinfo_transaction_Mixin') 
+                    || $self->isa('FS::payinfo_Mixin') )
+                && $self->payby
+                && !grep { $self->payby eq $_ } @encrypt_payby;
       $self->{'saved'} = $self->getfield($field);
       $self->setfield($field, $self->encrypt($self->getfield($field)));
     }
@@ -980,7 +977,7 @@ sub insert {
       #my $oid = $sth->{'pg_oid_status'};
       #my $i_sql = "SELECT $primary_key FROM $table WHERE oid = ?";
 
-      my $default = $self->dbdef_table->column($primary_key)->default;
+      my $default = $self->dbdef_table->column($primary_key)->quoted_default;
       unless ( $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i ) {
         dbh->rollback if $FS::UID::AutoCommit;
         return "can't parse $table.$primary_key default value".
@@ -1030,34 +1027,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');
@@ -1129,17 +1098,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';
@@ -1151,9 +1109,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;
 
@@ -1207,8 +1162,16 @@ sub replace {
   
   # Encrypt for replace
   my $saved = {};
-  if ($conf->exists('encryption') && defined(eval '@FS::'. $new->table . '::encrypted_fields')) {
+  if (    $conf->exists('encryption')
+       && defined(eval '@FS::'. $new->table . '::encrypted_fields')
+       && scalar( eval '@FS::'. $new->table . '::encrypted_fields')
+  ) {
     foreach my $field (eval '@FS::'. $new->table . '::encrypted_fields') {
+      next if $field eq 'payinfo' 
+                && ($new->isa('FS::payinfo_transaction_Mixin') 
+                    || $new->isa('FS::payinfo_Mixin') )
+                && $new->payby
+                && !grep { $new->payby eq $_ } @encrypt_payby;
       $saved->{$field} = $new->getfield($field);
       $new->setfield($field, $new->encrypt($new->getfield($field)));
     }
@@ -1274,44 +1237,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'; 
@@ -1324,23 +1249,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 
@@ -1382,35 +1290,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;
+    }
+    '';
+}
 
-(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?)
+=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 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
@@ -1492,7 +1414,7 @@ sub process_batch_import {
   my($job, $opt) = ( shift, shift );
 
   my $table = $opt->{table};
-  my @pass_params = @{ $opt->{params} };
+  my @pass_params = $opt->{params} ? @{ $opt->{params} } : ();
   my %formats = %{ $opt->{formats} };
 
   my $param = thaw(decode_base64(shift));
@@ -1506,24 +1428,33 @@ sub process_batch_import {
   my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
   my $file = $dir. $files{'file'};
 
-  my $error =
-    FS::Record::batch_import( {
-      #class-static
-      table                      => $table,
-      formats                    => \%formats,
-      format_types               => $opt->{format_types},
-      format_headers             => $opt->{format_headers},
-      format_sep_chars           => $opt->{format_sep_chars},
-      format_fixedlength_formats => $opt->{format_fixedlength_formats},
-      #per-import
-      job                        => $job,
-      file                       => $file,
-      #type                       => $type,
-      format                     => $param->{format},
-      params                     => { map { $_ => $param->{$_} } @pass_params },
-      #?
-      default_csv                => $opt->{default_csv},
-    } );
+  my %iopt = (
+    #class-static
+    table                      => $table,
+    formats                    => \%formats,
+    format_types               => $opt->{format_types},
+    format_headers             => $opt->{format_headers},
+    format_sep_chars           => $opt->{format_sep_chars},
+    format_fixedlength_formats => $opt->{format_fixedlength_formats},
+    format_xml_formats         => $opt->{format_xml_formats},
+    format_row_callbacks       => $opt->{format_row_callbacks},
+    #per-import
+    job                        => $job,
+    file                       => $file,
+    #type                       => $type,
+    format                     => $param->{format},
+    params                     => { map { $_ => $param->{$_} } @pass_params },
+    #?
+    default_csv                => $opt->{default_csv},
+    postinsert_callback        => $opt->{postinsert_callback},
+  );
+
+  if ( $opt->{'batch_namecol'} ) {
+    $iopt{'batch_namevalue'} = $param->{ $opt->{'batch_namecol'} };
+    $iopt{$_} = $opt->{$_} foreach qw( batch_keycol batch_table batch_namecol );
+  }
+
+  my $error = FS::Record::batch_import( \%iopt );
 
   unlink $file;
 
@@ -1538,6 +1469,8 @@ Class method for batch imports.  Available params:
 
 =item table
 
+=item format - usual way to specify import, with this format string selecting data from the formats and format_* info hashes
+
 =item formats
 
 =item format_types
@@ -1548,6 +1481,14 @@ Class method for batch imports.  Available params:
 
 =item format_fixedlength_formats
 
+=item format_row_callbacks
+
+=item fields - Alternate way to specify import, specifying import fields directly as a listref
+
+=item preinsert_callback
+
+=item postinsert_callback
+
 =item params
 
 =item job
@@ -1558,9 +1499,7 @@ FS::queue object, will be updated with progress
 
 =item type
 
-csv, xls or fixedlength
-
-=item format
+csv, xls, fixedlength, xml
 
 =item empty_ok
 
@@ -1575,18 +1514,71 @@ sub batch_import {
     if $DEBUG;
 
   my $table   = $param->{table};
-  my $formats = $param->{formats};
 
   my $job     = $param->{job};
   my $file    = $param->{file};
-  my $format  = $param->{'format'};
   my $params  = $param->{params} || {};
 
-  die "unknown format $format" unless exists $formats->{ $format };
+  my( $type, $header, $sep_char, $fixedlength_format, 
+      $xml_format, $row_callback, @fields );
+
+  my $postinsert_callback = '';
+  $postinsert_callback = $param->{'postinsert_callback'}
+	  if $param->{'postinsert_callback'};
+  my $preinsert_callback = '';
+  $preinsert_callback = $param->{'preinsert_callback'}
+	  if $param->{'preinsert_callback'};
+
+  if ( $param->{'format'} ) {
+
+    my $format  = $param->{'format'};
+    my $formats = $param->{formats};
+    die "unknown format $format" unless exists $formats->{ $format };
+
+    $type = $param->{'format_types'}
+            ? $param->{'format_types'}{ $format }
+            : $param->{type} || 'csv';
+
 
-  my $type = $param->{'format_types'}
-             ? $param->{'format_types'}{ $format }
-             : $param->{type} || 'csv';
+    $header = $param->{'format_headers'}
+               ? $param->{'format_headers'}{ $param->{'format'} }
+               : 0;
+
+    $sep_char = $param->{'format_sep_chars'}
+                  ? $param->{'format_sep_chars'}{ $param->{'format'} }
+                  : ',';
+
+    $fixedlength_format =
+      $param->{'format_fixedlength_formats'}
+        ? $param->{'format_fixedlength_formats'}{ $param->{'format'} }
+        : '';
+
+    $xml_format =
+      $param->{'format_xml_formats'}
+        ? $param->{'format_xml_formats'}{ $param->{'format'} }
+        : '';
+
+    $row_callback =
+      $param->{'format_row_callbacks'}
+        ? $param->{'format_row_callbacks'}{ $param->{'format'} }
+        : '';
+
+    @fields = @{ $formats->{ $format } };
+
+  } elsif ( $param->{'fields'} ) {
+
+    $type = ''; #infer from filename
+    $header = 0;
+    $sep_char = ',';
+    $fixedlength_format = '';
+    $row_callback = '';
+    @fields = @{ $param->{'fields'} };
+
+  } else {
+    die "neither format nor fields specified";
+  }
+
+  #my $file    = $param->{file};
 
   unless ( $type ) {
     if ( $file =~ /\.(\w+)$/i ) {
@@ -1600,20 +1592,6 @@ sub batch_import {
       if $param->{'default_csv'} && $type ne 'xls';
   }
 
-  my $header = $param->{'format_headers'}
-                 ? $param->{'format_headers'}{ $param->{'format'} }
-                 : 0;
-
-  my $sep_char = $param->{'format_sep_chars'}
-                   ? $param->{'format_sep_chars'}{ $param->{'format'} }
-                   : ',';
-
-  my $fixedlength_format =
-    $param->{'format_fixedlength_formats'}
-      ? $param->{'format_fixedlength_formats'}{ $param->{'format'} }
-      : '';
-
-  my @fields = @{ $formats->{ $format } };
 
   my $row = 0;
   my $count;
@@ -1631,9 +1609,10 @@ sub batch_import {
 
       eval "use Parse::FixedLength;";
       die $@ if $@;
-      $parser = new Parse::FixedLength $fixedlength_format;
- 
-    } else {
+      $parser = Parse::FixedLength->new($fixedlength_format);
+
+    }
+    else {
       die "Unknown file type $type\n";
     }
 
@@ -1659,7 +1638,22 @@ sub batch_import {
     $count++;
 
     $row = $header || 0;
-
+  } elsif ( $type eq 'xml' ) {
+    # FS::pay_batch
+    eval "use XML::Simple;";
+    die $@ if $@;
+    my $xmlrow = $xml_format->{'xmlrow'};
+    $parser = $xml_format->{'xmlkeys'};
+    die 'no xmlkeys specified' unless ref $parser eq 'ARRAY';
+    my $data = XML::Simple::XMLin(
+      $file,
+      'SuppressEmpty' => '', #sets empty values to ''
+      'KeepRoot'      => 1,
+    );
+    my $rows = $data;
+    $rows = $rows->{$_} foreach @$xmlrow;
+    $rows = [ $rows ] if ref($rows) ne 'ARRAY';
+    $count = @buffer = @$rows;
   } else {
     die "Unknown file type $type\n";
   }
@@ -1676,7 +1670,27 @@ sub batch_import {
   my $oldAutoCommit = $FS::UID::AutoCommit;
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
-  
+
+  #my $params  = $param->{params} || {};
+  if ( $param->{'batch_namecol'} && $param->{'batch_namevalue'} ) {
+    my $batch_col   = $param->{'batch_keycol'};
+
+    my $batch_class = 'FS::'. $param->{'batch_table'};
+    my $batch = $batch_class->new({
+      $param->{'batch_namecol'} => $param->{'batch_namevalue'}
+    });
+    my $error = $batch->insert;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "can't insert batch record: $error";
+    }
+    #primary key via dbdef? (so the column names don't have to match)
+    my $batch_value = $batch->get( $param->{'batch_keycol'} );
+
+    $params->{ $batch_col } = $batch_value;
+  }
+
+  #my $job     = $param->{job};
   my $line;
   my $imported = 0;
   my( $last, $min_sec ) = ( time, 5 ); #progressbar foo
@@ -1688,14 +1702,23 @@ sub batch_import {
       last unless scalar(@buffer);
       $line = shift(@buffer);
 
+      next if $line =~ /^\s*$/; #skip empty lines
+
+      $line = &{$row_callback}($line) if $row_callback;
+      
+      next if $line =~ /^\s*$/; #skip empty lines
+
       $parser->parse($line) or do {
         $dbh->rollback if $oldAutoCommit;
-        return "can't parse: ". $parser->error_input();
+        return "can't parse: ". $parser->error_input() . " " . $parser->error_diag;
       };
       @columns = $parser->fields();
 
     } elsif ( $type eq 'fixedlength' ) {
 
+      last unless scalar(@buffer);
+      $line = shift(@buffer);
+
       @columns = $parser->parse($line);
 
     } elsif ( $type eq 'xls' ) {
@@ -1709,6 +1732,11 @@ sub batch_import {
       #my $z = 'A';
       #warn $z++. ": $_\n" for @columns;
 
+    } elsif ( $type eq 'xml' ) {
+      # $parser = [ 'Column0Key', 'Column1Key' ... ]
+      last unless scalar(@buffer);
+      my $row = shift @buffer;
+      @columns = @{ $row }{ @$parser };
     } else {
       die "Unknown file type $type\n";
     }
@@ -1730,6 +1758,7 @@ sub batch_import {
 
     }
 
+    #my $table   = $param->{table};
     my $class = "FS::$table";
 
     my $record = $class->new( \%hash );
@@ -1738,11 +1767,27 @@ sub batch_import {
     while ( scalar(@later) ) {
       my $sub = shift @later;
       my $data = shift @later;
-      &{$sub}($record, $data, $conf, $param); # $record->&{$sub}($data, $conf);
+      eval {
+        &{$sub}($record, $data, $conf, $param); # $record->&{$sub}($data, $conf)
+      };
+      if ( $@ ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "can't insert record". ( $line ? " for $line" : '' ). ": $@";
+      }
       last if exists( $param->{skiprow} );
     }
     next if exists( $param->{skiprow} );
 
+    if ( $preinsert_callback ) {
+      my $error = &{$preinsert_callback}($record, $param);
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "preinsert_callback error". ( $line ? " for $line" : '' ).
+               ": $error";
+      }
+      next if exists $param->{skiprow} && $param->{skiprow};
+    }
+
     my $error = $record->insert;
 
     if ( $error ) {
@@ -1753,6 +1798,15 @@ sub batch_import {
     $row++;
     $imported++;
 
+    if ( $postinsert_callback ) {
+      my $error = &{$postinsert_callback}($record, $param);
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "postinsert_callback error". ( $line ? " for $line" : '' ).
+               ": $error";
+      }
+    }
+
     if ( $job && time - $min_sec > $last ) { #progress bar
       $job->update_statustext( int(100 * $imported / $count) );
       $last = time;
@@ -1760,9 +1814,12 @@ sub batch_import {
 
   }
 
-  $dbh->commit or die $dbh->errstr if $oldAutoCommit;;
+  unless ( $imported || $param->{empty_ok} ) {
+    $dbh->rollback if $oldAutoCommit;
+    return "Empty file!";
+  }
 
-  return "Empty file!" unless $imported || $param->{empty_ok};
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;;
 
   ''; #no error
 
@@ -2019,7 +2076,7 @@ sub ut_text {
   #warn "notexist ". \&notexist. "\n";
   #warn "AUTOLOAD ". \&AUTOLOAD. "\n";
   $self->getfield($field)
-    =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>]+)$/
+    =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>$money_char]+)$/
       or return gettext('illegal_or_empty_text'). " $field: ".
                  $self->getfield($field);
   $self->setfield($field,$1);
@@ -2036,11 +2093,8 @@ May be null.  If there is an error, returns the error, otherwise returns false.
 
 sub ut_textn {
   my($self,$field)=@_;
-  $self->getfield($field)
-    =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]*)$/
-      or return gettext('illegal_text'). " $field: ". $self->getfield($field);
-  $self->setfield($field,$1);
-  '';
+  return $self->setfield($field, '') if $self->getfield($field) =~ /^$/;
+  $self->ut_text($field);
 }
 
 =item ut_alpha COLUMN
@@ -2059,7 +2113,7 @@ sub ut_alpha {
   '';
 }
 
-=item ut_alpha COLUMN
+=item ut_alphan COLUMN
 
 Check/untaint alphanumeric strings (no spaces).  May be null.  If there is an
 error, returns the error, otherwise returns false.
@@ -2074,6 +2128,22 @@ sub ut_alphan {
   '';
 }
 
+=item ut_alphasn COLUMN
+
+Check/untaint alphanumeric strings, spaces allowed.  May be null.  If there is
+an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_alphasn {
+  my($self,$field)=@_;
+  $self->getfield($field) =~ /^([\w ]*)$/ 
+    or return "Illegal (alphanumeric) $field: ". $self->getfield($field);
+  $self->setfield($field,$1);
+  '';
+}
+
+
 =item ut_alpha_lower COLUMN
 
 Check/untaint lowercase alphanumeric strings (no spaces).  May not be null.  If
@@ -2149,12 +2219,14 @@ sub ut_hexn {
 }
 =item ut_ip COLUMN
 
-Check/untaint ip addresses.  IPv4 only for now.
+Check/untaint ip addresses.  IPv4 only for now, though ::1 is auto-translated
+to 127.0.0.1.
 
 =cut
 
 sub ut_ip {
   my( $self, $field ) = @_;
+  $self->setfield($field, '127.0.0.1') if $self->getfield($field) eq '::1';
   $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; }
@@ -2164,7 +2236,8 @@ sub ut_ip {
 
 =item ut_ipn COLUMN
 
-Check/untaint ip addresses.  IPv4 only for now.  May be null.
+Check/untaint ip addresses.  IPv4 only for now, though ::1 is auto-translated
+to 127.0.0.1.  May be null.
 
 =cut
 
@@ -2178,6 +2251,35 @@ sub ut_ipn {
   }
 }
 
+=item ut_ip46 COLUMN
+
+Check/untaint IPv4 or IPv6 address.
+
+=cut
+
+sub ut_ip46 {
+  my( $self, $field ) = @_;
+  my $ip = NetAddr::IP->new($self->getfield($field))
+    or return "Illegal (IP address) $field: ".$self->getfield($field);
+  $self->setfield($field, lc($ip->addr));
+  return '';
+}
+
+=item ut_ip46n
+
+Check/untaint IPv6 or IPv6 address.  May be null.
+
+=cut
+
+sub ut_ip46n {
+  my( $self, $field ) = @_;
+  if ( $self->getfield($field) =~ /^$/ ) {
+    $self->setfield($field, '');
+    return '';
+  }
+  $self->ut_ip46($field);
+}
+
 =item ut_coord COLUMN [ LOWER [ UPPER ] ]
 
 Check/untaint coordinates.
@@ -2290,6 +2392,7 @@ May not be null.
 
 sub ut_name {
   my( $self, $field ) = @_;
+#  warn "ut_name allowed alphanumerics: +(sort grep /\w/, map { chr() } 0..255), "\n";
   $self->getfield($field) =~ /^([\w \,\.\-\']+)$/
     or return gettext('illegal_name'). " $field: ". $self->getfield($field);
   $self->setfield($field,$1);
@@ -2391,6 +2494,20 @@ sub ut_enum {
   return "Illegal (enum) field $field: ". $self->getfield($field);
 }
 
+=item ut_enumn COLUMN CHOICES_ARRAYREF
+
+Like ut_enum, except the null value is also allowed.
+
+=cut
+
+sub ut_enumn {
+  my( $self, $field, $choices ) = @_;
+  $self->getfield($field)
+    ? $self->ut_enum($field, $choices)
+    : '';
+}
+
+
 =item ut_foreign_key COLUMN FOREIGN_TABLE FOREIGN_COLUMN
 
 Check/untaint a foreign column key.  Call a regular ut_ method (like ut_number)
@@ -2454,40 +2571,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
@@ -2501,48 +2587,9 @@ sub fields {
     $table = $something;
     $something = "FS::$table";
   }
-  return (real_fields($table), $something->virtual_fields());
+  return (real_fields($table));
 }
 
-=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 } );
-  }
-  ''
-}
-
-=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)
 
@@ -2622,7 +2669,7 @@ sub loadRSA {
     #Initialize the Module
     $rsa_module = 'Crypt::OpenSSL::RSA'; # The Default
 
-    if ($conf->exists('encryptionmodule') && $conf->config_binary('encryptionmodule') ne '') {
+    if ($conf->exists('encryptionmodule') && $conf->config('encryptionmodule') ne '') {
       $rsa_module = $conf->config('encryptionmodule');
     }
 
@@ -2631,13 +2678,13 @@ sub loadRSA {
 	$rsa_loaded++;
     }
     # Initialize Encryption
-    if ($conf->exists('encryptionpublickey') && $conf->config_binary('encryptionpublickey') ne '') {
+    if ($conf->exists('encryptionpublickey') && $conf->config('encryptionpublickey') ne '') {
       my $public_key = join("\n",$conf->config('encryptionpublickey'));
       $rsa_encrypt = $rsa_module->new_public_key($public_key);
     }
     
     # Intitalize Decryption
-    if ($conf->exists('encryptionprivatekey') && $conf->config_binary('encryptionprivatekey') ne '') {
+    if ($conf->exists('encryptionprivatekey') && $conf->config('encryptionprivatekey') ne '') {
       my $private_key = join("\n",$conf->config('encryptionprivatekey'));
       $rsa_decrypt = $rsa_module->new_private_key($private_key);
     }
@@ -2680,6 +2727,28 @@ sub h_date {
   $h ? $h->history_date : '';
 }
 
+=item scalar_sql SQL [ PLACEHOLDER, ... ]
+
+A class or object method.  Executes the sql statement represented by SQL and
+returns a scalar representing the result: the first column of the first row.
+
+Dies on bogus SQL.  Returns an empty string if no row is returned.
+
+Typically used for statments which return a single value such as "SELECT
+COUNT(*) FROM table WHERE something" OR "SELECT column FROM table WHERE key = ?"
+
+=cut
+
+sub scalar_sql {
+  my($self, $sql) = (shift, shift);
+  my $sth = dbh->prepare($sql) or die dbh->errstr;
+  $sth->execute(@_)
+    or die "Unexpected error executing statement $sql: ". $sth->errstr;
+  my $row = $sth->fetchrow_arrayref or return '';
+  my $scalar = $row->[0];
+  defined($scalar) ? $scalar : '';
+}
+
 =back
 
 =head1 SUBROUTINES
@@ -2701,6 +2770,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
@@ -2823,6 +2915,71 @@ sub str2time_sql_closing {
   return ' ) ';
 }
 
+=item regexp_sql [ DRIVER_NAME ]
+
+Returns the operator to do a regular expression comparison based on database
+type, such as '~' for Pg or 'REGEXP' for mysql.
+
+You can pass an optional driver name such as "Pg", "mysql" or
+$dbh->{Driver}->{Name} to return a function for that database instead of
+the current database.
+
+=cut
+
+sub regexp_sql {
+  my $driver = shift || driver_name;
+
+  return '~'      if $driver =~ /^Pg/i;
+  return 'REGEXP' if $driver =~ /^mysql/i;
+
+  die "don't know how to use regular expressions in ". driver_name." databases";
+
+}
+
+=item not_regexp_sql [ DRIVER_NAME ]
+
+Returns the operator to do a regular expression negation based on database
+type, such as '!~' for Pg or 'NOT REGEXP' for mysql.
+
+You can pass an optional driver name such as "Pg", "mysql" or
+$dbh->{Driver}->{Name} to return a function for that database instead of
+the current database.
+
+=cut
+
+sub not_regexp_sql {
+  my $driver = shift || driver_name;
+
+  return '!~'         if $driver =~ /^Pg/i;
+  return 'NOT REGEXP' if $driver =~ /^mysql/i;
+
+  die "don't know how to use regular expressions in ". driver_name." databases";
+
+}
+
+=item concat_sql [ DRIVER_NAME ] ITEMS_ARRAYREF
+
+Returns the items concatendated based on database type, using "CONCAT()" for
+mysql and " || " for Pg and other databases.
+
+You can pass an optional driver name such as "Pg", "mysql" or
+$dbh->{Driver}->{Name} to return a function for that database instead of
+the current database.
+
+=cut
+
+sub concat_sql {
+  my $driver = ref($_[0]) ? driver_name : shift;
+  my $items = shift;
+
+  if ( $driver =~ /^mysql/i ) {
+    'CONCAT('. join(',', @$items). ')';
+  } else {
+    join('||', @$items);
+  }
+
+}
+
 =back
 
 =head1 BUGS