projects / freeside.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
eliminate some false laziness in FS::Misc::send_email vs. msg_template/email.pm send_...
[freeside.git] / FS / FS / Record.pm
diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index f17b240..f4bf2a2 100644 (file)
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -1,65 +1,93 @@
 package FS::Record;
 package FS::Record;
+use base qw( Exporter );
 
 use strict;
 
 use strict;
-use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG
-             $conf $conf_encryption $me
-             %virtual_fields_cache
-             $nowarn_identical $nowarn_classload
-             $no_update_diff $no_check_foreign
+use charnames ':full';
+use vars qw( $AUTOLOAD
+             %virtual_fields_cache %fk_method_cache $fk_table_cache
+             %virtual_fields_hash_cache $money_char $lat_lower $lon_upper
+             $use_placeholders
            );
            );
-use Exporter;
 use Carp qw(carp cluck croak confess);
 use Scalar::Util qw( blessed );
 use Carp qw(carp cluck croak confess);
 use Scalar::Util qw( blessed );
+use File::Slurp qw( slurp );
 use File::CounterFile;
 use File::CounterFile;
-use Locale::Country;
 use Text::CSV_XS;
 use Text::CSV_XS;
-use File::Slurp qw( slurp );
 use DBI qw(:sql_types);
 use DBI qw(:sql_types);
-use DBIx::DBSchema 0.33;
-use FS::UID qw(dbh getotaker datasrc driver_name);
+use DBIx::DBSchema 0.43; #0.43 for foreign keys
+use Locale::Country;
+use Locale::Currency;
+use NetAddr::IP; # for validation
+use Crypt::OpenSSL::RSA;
+use FS::UID qw(dbh datasrc driver_name);
 use FS::CurrentUser;
 use FS::Schema qw(dbdef);
 use FS::SearchCache;
 use FS::Msgcat qw(gettext);
 #use FS::Conf; #dependency loop bs, in install_callback below instead
 use FS::CurrentUser;
 use FS::Schema qw(dbdef);
 use FS::SearchCache;
 use FS::Msgcat qw(gettext);
 #use FS::Conf; #dependency loop bs, in install_callback below instead
+use Email::Valid;
 
 use FS::part_virtual_field;
 
 use Tie::IxHash;
 
 
 use FS::part_virtual_field;
 
 use Tie::IxHash;
 
-@ISA = qw(Exporter);
+our @encrypt_payby = qw( CARD DCRD CHEK DCHK );
 
 #export dbdef for now... everything else expects to find it here
 
 #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 );
+our @EXPORT_OK = qw(
+  dbh fields hfields qsearch qsearchs dbdef jsearch
+  str2time_sql str2time_sql_closing regexp_sql not_regexp_sql
+  concat_sql group_concat_sql
+  midnight_sql fk_methods_init
+);
 
 
-$DEBUG = 0;
-$me = '[FS::Record]';
+our $DEBUG = 0;
+our $me = '[FS::Record]';
 
 
-$nowarn_identical = 0;
-$nowarn_classload = 0;
-$no_update_diff = 0;
-$no_check_foreign = 0;
+$use_placeholders = 0;
+
+our $nowarn_identical = 0;
+our $nowarn_classload = 0;
+our $no_update_diff = 0;
+our $no_history = 0;
+
+our $qsearch_qualify_columns = 1;
+
+our $no_check_foreign = 1; #well, not inefficiently in perl by default anymore
 
 
-my $rsa_module;
-my $rsa_loaded;
 my $rsa_encrypt;
 my $rsa_decrypt;
 
 my $rsa_encrypt;
 my $rsa_decrypt;
 
-$conf = '';
-$conf_encryption = '';
+our $conf = '';
+our $conf_encryption = '';
+our $conf_encryptionmodule = '';
+our $conf_encryptionpublickey = '';
+our $conf_encryptionprivatekey = '';
 FS::UID->install_callback( sub {
 FS::UID->install_callback( sub {
+
   eval "use FS::Conf;";
   die $@ if $@;
   eval "use FS::Conf;";
   die $@ if $@;
-  $conf = FS::Conf->new; 
-  $conf_encryption = $conf->exists('encryption');
+  $conf = FS::Conf->new;
+  $conf_encryption           = $conf->exists('encryption');
+  $conf_encryptionmodule     = $conf->config('encryptionmodule');
+  $conf_encryptionpublickey  = join("\n",$conf->config('encryptionpublickey'));
+  $conf_encryptionprivatekey = join("\n",$conf->config('encryptionprivatekey'));
+  $money_char = $conf->config('money_char') || '$';
+  my $nw_coords = $conf->exists('geocode-require_nw_coordinates');
+  $lat_lower = $nw_coords ? 1 : -90;
+  $lon_upper = $nw_coords ? -1 : 180;
+
   $File::CounterFile::DEFAULT_DIR = $conf->base_dir . "/counters.". datasrc;
   $File::CounterFile::DEFAULT_DIR = $conf->base_dir . "/counters.". datasrc;
+
   if ( driver_name eq 'Pg' ) {
     eval "use DBD::Pg ':pg_types'";
     die $@ if $@;
   } else {
     eval "sub PG_BYTEA { die 'guru meditation #9: calling PG_BYTEA when not running Pg?'; }";
   }
   if ( driver_name eq 'Pg' ) {
     eval "use DBD::Pg ':pg_types'";
     die $@ if $@;
   } else {
     eval "sub PG_BYTEA { die 'guru meditation #9: calling PG_BYTEA when not running Pg?'; }";
   }
+
+  #fk_methods_init();
+
 } );
 
 =head1 NAME
 } );
 
 =head1 NAME
@@ -76,7 +104,7 @@ FS::Record - Database record objects
 
     $record  = qsearchs FS::Record 'table', \%hash;
     $record  = qsearchs FS::Record 'table', { 'column' => 'value', ... };
 
     $record  = qsearchs FS::Record 'table', \%hash;
     $record  = qsearchs FS::Record 'table', { 'column' => 'value', ... };
-    @records = qsearch  FS::Record 'table', \%hash; 
+    @records = qsearch  FS::Record 'table', \%hash;
     @records = qsearch  FS::Record 'table', { 'column' => 'value', ... };
 
     $table = $record->table;
     @records = qsearch  FS::Record 'table', { 'column' => 'value', ... };
 
     $table = $record->table;
@@ -107,6 +135,8 @@ FS::Record - Database record objects
     $error = $record->ut_floatn('column');
     $error = $record->ut_number('column');
     $error = $record->ut_numbern('column');
     $error = $record->ut_floatn('column');
     $error = $record->ut_number('column');
     $error = $record->ut_numbern('column');
+    $error = $record->ut_decimal('column');
+    $error = $record->ut_decimaln('column');
     $error = $record->ut_snumber('column');
     $error = $record->ut_snumbern('column');
     $error = $record->ut_money('column');
     $error = $record->ut_snumber('column');
     $error = $record->ut_snumbern('column');
     $error = $record->ut_money('column');
@@ -144,14 +174,14 @@ Creates a new record.  It doesn't store it in the database, though.  See
 L<"insert"> for that.
 
 Note that the object stores this hash reference, not a distinct copy of the
 L<"insert"> for that.
 
 Note that the object stores this hash reference, not a distinct copy of the
-hash it points to.  You can ask the object for a copy with the I<hash> 
+hash it points to.  You can ask the object for a copy with the I<hash>
 method.
 
 TABLE can only be omitted when a dervived class overrides the table method.
 
 =cut
 
 method.
 
 TABLE can only be omitted when a dervived class overrides the table method.
 
 =cut
 
-sub new { 
+sub new {
   my $proto = shift;
   my $class = ref($proto) || $proto;
   my $self = {};
   my $proto = shift;
   my $class = ref($proto) || $proto;
   my $self = {};
@@ -162,10 +192,10 @@ sub new {
     carp "warning: FS::Record::new called with table name ". $self->{'Table'}
       unless $nowarn_classload;
   }
     carp "warning: FS::Record::new called with table name ". $self->{'Table'}
       unless $nowarn_classload;
   }
-  
+
   $self->{'Hash'} = shift;
 
   $self->{'Hash'} = shift;
 
-  foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) { 
+  foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) {
     $self->{'Hash'}{$field}='';
   }
 
     $self->{'Hash'}{$field}='';
   }
 
@@ -173,6 +203,7 @@ sub new {
 
   $self->{'modified'} = 0;
 
 
   $self->{'modified'} = 0;
 
+  $self->_simplecache($self->{'Hash'})  if $self->can('_simplecache');
   $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_;
 
   $self;
   $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_;
 
   $self;
@@ -256,6 +287,11 @@ the individual PARAMS_HASHREF queries
 #regular FS::TABLE methods
 #on it.
 
 #regular FS::TABLE methods
 #on it.
 
+C<$FS::Record::qsearch_qualify_columns> package global is enabled by default.
+When enabled, the WHERE clause generated from the 'hashref' parameter has
+the table name prepended to each column name. WHERE column = 'value' becomes
+WHERE table.coumn = 'value'
+
 =cut
 
 my %TYPE = (); #for debugging
 =cut
 
 my %TYPE = (); #for debugging
@@ -265,7 +301,7 @@ sub _bind_type {
 
   my $bind_type = { TYPE => SQL_VARCHAR };
 
 
   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 };
 
 
     $bind_type = { TYPE => SQL_INTEGER };
 
@@ -350,7 +386,11 @@ sub qsearch {
   my @bind_type = ();
   my $dbh = dbh;
   foreach my $stable ( @stable ) {
   my @bind_type = ();
   my $dbh = dbh;
   foreach my $stable ( @stable ) {
-    my $record      = shift @record;
+
+    carp '->qsearch on cust_main called' if $stable eq 'cust_main' && $DEBUG;
+
+    #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 $select      = shift @select;
     my $extra_sql   = shift @extra_sql;
     my $extra_param = shift @extra_param;
@@ -371,22 +411,19 @@ sub qsearch {
     my $pkey = $dbdef_table->primary_key;
 
     my @real_fields = grep exists($record->{$_}), real_fields($table);
     my $pkey = $dbdef_table->primary_key;
 
     my @real_fields = grep exists($record->{$_}), real_fields($table);
-    my @virtual_fields;
-    if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
-      @virtual_fields = grep exists($record->{$_}), "FS::$table"->virtual_fields;
-    } else {
-      cluck "warning: FS::$table not loaded; virtual fields not searchable"
-        unless $nowarn_classload;
-      @virtual_fields = ();
-    }
 
     my $statement .= "SELECT $select FROM $stable";
 
     my $statement .= "SELECT $select FROM $stable";
-    $statement .= " $addl_from" if $addl_from;
-    if ( @real_fields or @virtual_fields ) {
+    my $alias_main;
+    if ( $addl_from ) {
+      $statement .= " $addl_from";
+      # detect aliasing of the main table
+      if ( $addl_from =~ /^\s*AS\s+(\w+)/i ) {
+        $alias_main = $1;
+      }
+    }
+    if ( @real_fields ) {
       $statement .= ' WHERE '. join(' AND ',
       $statement .= ' WHERE '. join(' AND ',
-        get_real_fields($table, $record, \@real_fields) ,
-        get_virtual_fields($table, $pkey, $record, \@virtual_fields),
-        );
+        get_real_fields($table, $record, \@real_fields, $alias_main));
     }
 
     $statement .= " $extra_sql" if defined($extra_sql);
     }
 
     $statement .= " $extra_sql" if defined($extra_sql);
@@ -395,7 +432,6 @@ sub qsearch {
     push @statement, $statement;
 
     warn "[debug]$me $statement\n" if $DEBUG > 1 || $debug;
     push @statement, $statement;
 
     warn "[debug]$me $statement\n" if $DEBUG > 1 || $debug;
- 
 
     foreach my $field (
       grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields
 
     foreach my $field (
       grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields
@@ -450,23 +486,39 @@ sub qsearch {
 #    grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
 #  ) or croak "Error executing \"$statement\": ". $sth->errstr;
 
 #    grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
 #  ) or croak "Error executing \"$statement\": ". $sth->errstr;
 
-  $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr;
+  my $ok = $sth->execute;
+  if (!$ok) {
+    my $error = "Error executing \"$statement\"";
+    $error .= ' (' . join(', ', map {"'$_'"} @value) . ')' if @value;
+    $error .= ': '. $sth->errstr;
+    croak $error;
+  }
+
+
+  # Determine how to format rows returned form a union query:
+  #
+  # * When all queries involved in the union are from the same table:
+  #   Return an array of FS::$table_name objects
+  #
+  # * When union query is performed on multiple tables,
+  #   Return an array of FS::Record objects
+  #   ! Note:  As far as I can tell, this functionality was broken, and
+  #   !        actually results in a crash.  Behavior is left intact
+  #   !        as-is, in case the results are in use somewhere
+  #
+  # * Union query is performed on multiple table,
+  #       and $union_options{classname_from_column} = 1
+  #   Return an array of FS::$classname objects, where $classname is
+  #   derived for each row from a static field inserted each returned
+  #   row of data.
+  #   e.g.: SELECT custnum,first,last,'cust_main' AS `__classname`'.
+
 
 
-  # virtual fields and blessings are nonsense in a heterogeneous UNION, right?
   my $table = $stable[0];
   my $pkey = '';
   $table = '' if grep { $_ ne $table } @stable;
   $pkey = dbdef->table($table)->primary_key if $table;
 
   my $table = $stable[0];
   my $pkey = '';
   $table = '' if grep { $_ ne $table } @stable;
   $pkey = dbdef->table($table)->primary_key if $table;
 
-  my @virtual_fields = ();
-  if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
-    @virtual_fields = "FS::$table"->virtual_fields;
-  } else {
-    cluck "warning: FS::$table not loaded; virtual fields not returned either"
-      unless $nowarn_classload;
-    @virtual_fields = ();
-  }
-
   my %result;
   tie %result, "Tie::IxHash";
   my @stuff = @{ $sth->fetchall_arrayref( {} ) };
   my %result;
   tie %result, "Tie::IxHash";
   my @stuff = @{ $sth->fetchall_arrayref( {} ) };
@@ -478,30 +530,24 @@ sub qsearch {
 
   $sth->finish;
 
 
   $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;
-      }
+  #below was refactored out to _from_hashref, this should use it at some point
+
+  my @return;
+  if ($union_options{classname_from_column}) {
+
+    # todo
+    # I'm not implementing the cache for this use case, at least not yet
+    # -mjackson
+
+    for my $row (@stuff) {
+      my $table_class = $row->{__classname}
+        or die "`__classname` column must be set when ".
+               "using \$union_options{classname_from_column}";
+      push @return, new("FS::$table_class",$row);
     }
     }
+
   }
   }
-  my @return;
-  if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
+  elsif ( 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 ) {
     if ( eval 'FS::'. $table. '->can(\'new\')' eq \&new ) {
       #derivied class didn't override new method, so this optimization is safe
       if ( $cache ) {
@@ -523,10 +569,16 @@ sub qsearch {
 
     # Check for encrypted fields and decrypt them.
    ## only in the local copy, not the cached object
 
     # Check for encrypted fields and decrypt them.
    ## only in the local copy, not the cached object
-    if ( $conf_encryption 
-         && eval 'defined(@FS::'. $table . '::encrypted_fields)' ) {
+    no warnings 'deprecated'; # XXX silence the warning for now
+    if ( $conf_encryption
+         && eval '@FS::'. $table . '::encrypted_fields' ) {
       foreach my $record (@return) {
         foreach my $field (eval '@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)));
         }
           # Set it directly... This may cause a problem in the future...
           $record->setfield($field, $record->decrypt($record->getfield($field)));
         }
@@ -542,114 +594,285 @@ sub qsearch {
   return @return;
 }
 
   return @return;
 }
 
-## makes this easier to read
+=item _query
 
 
-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'};
-      }
+Construct the SQL statement and parameter-binding list for qsearch.  Takes
+the qsearch parameters.
+
+Returns a hash containing:
+'table':      The primary table name (if there is one).
+'statement':  The SQL statement itself.
+'bind_type':  An arrayref of bind types.
+'value':      An arrayref of parameter values.
+'cache':      The cache object, if one was passed.
+
+=cut
+
+sub _query {
+  my( @stable, @record, @cache );
+  my( @select, @extra_sql, @extra_param, @order_by, @addl_from );
+  my @debug = ();
+  my $cursor = '';
+  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[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[0],
+      $record[0],
+      $select[0],
+      $extra_sql[0],
+      $cache[0],
+      $addl_from[0]
+    ) = @_;
+    $select[0] ||= '*';
+  }
+  my $cache = $cache[0];
+
+  my @statement = ();
+  my @value = ();
+  my @bind_type = ();
+
+  my $result_table = $stable[0];
+  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;
+
+    $result_table = '' if $result_table ne $stable;
+
+    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));
+    }
+
+    $statement .= " $extra_sql" if defined($extra_sql);
+    $statement .= " $order_by"  if defined($order_by);
+
+    push @statement, $statement;
+
+    warn "[debug]$me $statement\n" if $DEBUG > 1 || $debug;
+
+
+    foreach my $field (
+      grep defined( $record->{$_} ) && $record->{$_} ne '', @real_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->{$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";
+      #}
+
+      push @value, $value;
+      push @bind_type, $bind_type;
 
 
-      my $value = $record->{$_};
+    }
+
+    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 $subq;
+  return {
+    statement => $statement,
+    bind_type => \@bind_type,
+    value     => \@value,
+    table     => $result_table,
+    cache     => $cache,
+  };
+}
 
 
-      $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;
+# qsearch should eventually use this
+sub _from_hashref {
+  my ($table, $cache, @hashrefs) = @_;
+  my @return;
+  # XXX get rid of these string evals at some point
+  # (when we have time to test it)
+  # my $class = "FS::$table" if $table;
+  # if ( $class and $class->isa('FS::Record') )
+  #   if ( $class->can('new') eq \&new )
+  #
+  if ( $table && 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 ) {
+        @return = map {
+          new_or_cached( "FS::$table", { %{$_} }, $cache )
+        } @hashrefs;
+      } else {
+        @return = map {
+          new( "FS::$table", { %{$_} } )
+        } @hashrefs;
+      }
+    } else {
+      #okay, its been tested
+      # warn "untested code (class FS::$table uses custom new method)";
+      @return = map {
+        eval 'FS::'. $table. '->new( { %{$_} } )';
+      } @hashrefs;
+    }
 
 
-    } @{ $virtual_fields } ) ;
+    # Check for encrypted fields and decrypt them.
+   ## only in the local copy, not the cached object
+    if ( $conf_encryption
+         && eval '@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)));
+        }
+      }
+    }
+  } else {
+    cluck "warning: FS::$table not loaded; returning FS::Record objects"
+      unless $nowarn_classload;
+    @return = map {
+      FS::Record->new( $table, { %{$_} } );
+    } @hashrefs;
+  }
+  return @return;
 }
 
 sub get_real_fields {
   my $table = shift;
   my $record = shift;
   my $real_fields = shift;
 }
 
 sub get_real_fields {
   my $table = shift;
   my $record = shift;
   my $real_fields = shift;
+  my $alias_main = shift; # defaults to undef
+  $alias_main ||= $table;
 
 
-   ## this huge map was previously inline, just broke it out to help read the qsearch method, should be optimized for readability
-      return ( 
-      map {
+  ## could be optimized more for readability
+  return (
+    map {
 
       my $op = '=';
       my $column = $_;
 
       my $op = '=';
       my $column = $_;
+      my $table_column = $qsearch_qualify_columns ? "$alias_main.$column" : $column;
       my $type = dbdef->table($table)->column($column)->type;
       my $value = $record->{$column};
       $value = $value->{'value'} if ref($value);
       my $type = dbdef->table($table)->column($column)->type;
       my $value = $record->{$column};
       $value = $value->{'value'} if ref($value);
-      if ( ref($record->{$_}) ) {
-        $op = $record->{$_}{'op'} if $record->{$_}{'op'};
+
+      if ( ref($record->{$column}) ) {
+        $op = $record->{$column}{'op'} if $record->{$column}{'op'};
         #$op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name ne 'Pg';
         if ( uc($op) eq 'ILIKE' ) {
           $op = 'LIKE';
         #$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->{$column}{'value'} = lc($record->{$column}{'value'});
+          $table_column = "LOWER($table_column)";
         }
         }
-        $record->{$_} = $record->{$_}{'value'}
+        $record->{$column} = $record->{$column}{'value'}
       }
 
       }
 
-      if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
+      if ( ! defined( $record->{$column} ) || $record->{$column} eq '' ) {
         if ( $op eq '=' ) {
           if ( driver_name eq 'Pg' ) {
             if ( $type =~ /(int|numeric|real|float4|(big)?serial)/i ) {
         if ( $op eq '=' ) {
           if ( driver_name eq 'Pg' ) {
             if ( $type =~ /(int|numeric|real|float4|(big)?serial)/i ) {
-              qq-( $column IS NULL )-;
+              qq-( $table_column IS NULL )-;
             } else {
             } else {
-              qq-( $column IS NULL OR $column = '' )-;
+              qq-( $table_column IS NULL OR $table_column = '' )-;
             }
           } else {
             }
           } else {
-            qq-( $column IS NULL OR $column = "" )-;
+            qq-( $table_column IS NULL OR $table_column = "" )-;
           }
         } elsif ( $op eq '!=' ) {
           if ( driver_name eq 'Pg' ) {
             if ( $type =~ /(int|numeric|real|float4|(big)?serial)/i ) {
           }
         } elsif ( $op eq '!=' ) {
           if ( driver_name eq 'Pg' ) {
             if ( $type =~ /(int|numeric|real|float4|(big)?serial)/i ) {
-              qq-( $column IS NOT NULL )-;
+              qq-( $table_column IS NOT NULL )-;
             } else {
             } else {
-              qq-( $column IS NOT NULL AND $column != '' )-;
+              qq-( $table_column IS NOT NULL AND $table_column != '' )-;
             }
           } else {
             }
           } else {
-            qq-( $column IS NOT NULL AND $column != "" )-;
+            qq-( $table_column IS NOT NULL AND $table_column != "" )-;
           }
         } else {
           if ( driver_name eq 'Pg' ) {
           }
         } else {
           if ( driver_name eq 'Pg' ) {
-            qq-( $column $op '' )-;
+            qq-( $table_column $op '' )-;
           } else {
           } else {
-            qq-( $column $op "" )-;
+            qq-( $table_column $op "" )-;
           }
         }
           }
         }
+      } elsif ( $op eq '!=' ) {
+        qq-( $table_column IS NULL OR $table_column != ? )-;
       #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
       #} elsif ( $op eq 'APPROX=' && _is_fs_float( $type, $value ) ) {
       #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
       #} elsif ( $op eq 'APPROX=' && _is_fs_float( $type, $value ) ) {
-      #  ( "$column <= ?", "$column >= ?" );
+      #  ( "$table_column <= ?", "$table_column >= ?" );
       } else {
       } else {
-        "$column $op ?";
+        "$table_column $op ?";
       }
       }
-    } @{ $real_fields } );  
+
+    } @{ $real_fields }
+  );
 }
 
 =item by_key PRIMARY_KEY_VALUE
 }
 
 =item by_key PRIMARY_KEY_VALUE
@@ -687,7 +910,7 @@ single SELECT spanning multiple tables, and cache the results for subsequent
 method calls.  Interface will almost definately change in an incompatible
 fashion.
 
 method calls.  Interface will almost definately change in an incompatible
 fashion.
 
-Arguments: 
+Arguments:
 
 =cut
 
 
 =cut
 
@@ -713,6 +936,7 @@ sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash);
   my $table = $_[0];
   my(@result) = qsearch(@_);
   cluck "warning: Multiple records in scalar search ($table)"
   my $table = $_[0];
   my(@result) = qsearch(@_);
   cluck "warning: Multiple records in scalar search ($table)"
+        #.join(' / ', map "$_=>".$_[1]->{$_}, keys %{ $_[1] } )
     if scalar(@result) > 1;
   #should warn more vehemently if the search was on a primary key?
   scalar(@result) ? ($result[0]) : ();
     if scalar(@result) > 1;
   #should warn more vehemently if the search was on a primary key?
   scalar(@result) ? ($result[0]) : ();
@@ -770,7 +994,7 @@ sub get {
   # to avoid "Use of unitialized value" errors
   if ( defined ( $self->{Hash}->{$field} ) ) {
     $self->{Hash}->{$field};
   # to avoid "Use of unitialized value" errors
   if ( defined ( $self->{Hash}->{$field} ) ) {
     $self->{Hash}->{$field};
-  } else { 
+  } else {
     '';
   }
 }
     '';
   }
 }
@@ -785,7 +1009,7 @@ Sets the value of the column/field/key COLUMN to VALUE.  Returns VALUE.
 
 =cut
 
 
 =cut
 
-sub set { 
+sub set {
   my($self,$field,$value) = @_;
   $self->{'modified'} = 1;
   $self->{'Hash'}->{$field} = $value;
   my($self,$field,$value) = @_;
   $self->{'modified'} = 1;
   $self->{'Hash'}->{$field} = $value;
@@ -795,12 +1019,28 @@ sub setfield {
   $self->set(@_);
 }
 
   $self->set(@_);
 }
 
-=item AUTLOADED METHODS
+=item exists COLUMN
+
+Returns true if the column/field/key COLUMN exists.
+
+=cut
+
+sub exists {
+  my($self,$field) = @_;
+  exists($self->{Hash}->{$field});
+}
+
+=item AUTOLOADED METHODS
 
 $record->column is a synonym for $record->get('column');
 
 $record->column('value') is a synonym for $record->set('column','value');
 
 
 $record->column is a synonym for $record->get('column');
 
 $record->column('value') is a synonym for $record->set('column','value');
 
+$record->foreign_table_name calls qsearchs and returns a single
+FS::foreign_table record (for tables referenced by a column of this table) or
+qsearch and returns an array of FS::foreign_table records (for tables
+referenced by a column in the foreign table).
+
 =cut
 
 # readable/safe
 =cut
 
 # readable/safe
@@ -808,18 +1048,44 @@ sub AUTOLOAD {
   my($self,$value)=@_;
   my($field)=$AUTOLOAD;
   $field =~ s/.*://;
   my($self,$value)=@_;
   my($field)=$AUTOLOAD;
   $field =~ s/.*://;
+
+  confess "errant AUTOLOAD $field for $self (arg $value)"
+    unless blessed($self) && $self->can('setfield');
+
+  if ( my $fk_info = get_fk_method($self->table, $field) ) {
+
+    my $method = $fk_info->{method} || 'qsearchs';
+    my $table = $fk_info->{table} || $field;
+    my $column = $fk_info->{column};
+    my $foreign_column = $fk_info->{references} || $column;
+
+    eval "use FS::$table";
+    die $@ if $@;
+
+    carp '->cust_main called' if $table eq 'cust_main' && $DEBUG;
+
+    my $pkey_value = $self->$column();
+    my %search = ( $foreign_column => $pkey_value );
+
+    # FS::Record->$method() ?  they're actually just subs :/
+    if ( $method eq 'qsearchs' ) {
+      return $pkey_value ? qsearchs( $table, \%search ) : '';
+    } elsif ( $method eq 'qsearch' ) {
+      return $pkey_value ? qsearch(  $table, \%search ) : ();
+    } else {
+      die "unknown method $method";
+    }
+
+  }
+
   if ( defined($value) ) {
   if ( defined($value) ) {
-    confess "errant AUTOLOAD $field for $self (arg $value)"
-      unless blessed($self) && $self->can('setfield');
     $self->setfield($field,$value);
   } else {
     $self->setfield($field,$value);
   } else {
-    confess "errant AUTOLOAD $field for $self (no args)"
-      unless blessed($self) && $self->can('getfield');
     $self->getfield($field);
     $self->getfield($field);
-  }    
+  }
 }
 
 }
 
-# efficient
+# efficient (also, old, doesn't support FK stuff)
 #sub AUTOLOAD {
 #  my $field = $AUTOLOAD;
 #  $field =~ s/.*://;
 #sub AUTOLOAD {
 #  my $field = $AUTOLOAD;
 #  $field =~ s/.*://;
@@ -827,48 +1093,173 @@ sub AUTOLOAD {
 #    $_[0]->setfield($field, $_[1]);
 #  } else {
 #    $_[0]->getfield($field);
 #    $_[0]->setfield($field, $_[1]);
 #  } else {
 #    $_[0]->getfield($field);
-#  }    
+#  }
 #}
 
 #}
 
-=item hash
+# get_fk_method(TABLE, FIELD)
+# Internal subroutine for fetching the foreign key descriptor for TABLE.FIELD
+# if there is one. If not, returns undef.
+# This will initialize fk_method_cache if it hasn't happened yet. It is the
+# _only_ allowed way to access the contents of %fk_method_cache.
 
 
-Returns a list of the column/value pairs, usually for assigning to a new hash.
+# if we wanted to be even more efficient we'd create the fk methods in the
+# symbol table instead of relying on AUTOLOAD every time
 
 
-To make a distinct duplicate of an FS::Record object, you can do:
+sub get_fk_method {
+  my ($table, $field) = @_;
 
 
-    $new = new FS::Record ( $old->table, { $old->hash } );
+  # maybe should only load one table at a time?
+  fk_methods_init() unless exists($fk_method_cache{$table});
 
 
-=cut
+  if ( exists($fk_method_cache{$table}) and
+       exists($fk_method_cache{$table}{$field}) ) {
+    return $fk_method_cache{$table}{$field};
+  } else {
+    return undef;
+  }
 
 
-sub hash {
-  my($self) = @_;
-  confess $self. ' -> hash: Hash attribute is undefined'
-    unless defined($self->{'Hash'});
-  %{ $self->{'Hash'} }; 
 }
 
 }
 
-=item hashref
+sub fk_methods_init {
+  warn "[fk_methods_init]\n" if $DEBUG;
+  foreach my $table ( dbdef->tables ) {
+    $fk_method_cache{$table} = fk_methods($table);
+  }
+}
 
 
-Returns a reference to the column/value hash.  This may be deprecated in the
-future; if there's a reason you can't just use the autoloaded or get/set
-methods, speak up.
+sub fk_methods {
+  my $table = shift;
 
 
-=cut
+  my %hash = ();
 
 
-sub hashref {
-  my($self) = @_;
-  $self->{'Hash'};
-}
+  # foreign keys we reference in other tables
+  foreach my $fk (dbdef->table($table)->foreign_keys) {
 
 
-=item modified
+    my $method = '';
+    if ( scalar( @{$fk->columns} ) == 1 ) {
+      if (    ! defined($fk->references)
+           || ! @{$fk->references}
+           || $fk->columns->[0] eq $fk->references->[0]
+      ) {
+        $method = $fk->table;
+      } else {
+        #some sort of hint in the table.pm or schema for methods not named
+        # after their foreign table (well, not a whole lot different than
+        # just providing a small subroutine...)
+      }
 
 
-Returns true if any of this object's values have been modified with set (or via
-an autoloaded method).  Doesn't yet recognize when you retreive a hashref and
-modify that.
+      if ( $method ) {
+        $hash{$method} = { #fk_info
+                           'method' => 'qsearchs',
+                           'column' => $fk->columns->[0],
+                           #'references' => $fk->references->[0],
+                         };
+      }
 
 
-=cut
+    }
 
 
-sub modified {
+  }
+
+  # foreign keys referenced in other tables to us
+  #  (alas.  why we're cached.  still, might this loop better be done once at
+  #   schema load time insetad of every time we AUTOLOAD a method on a new
+  #   class?)
+  if (! defined $fk_table_cache) {
+    foreach my $f_table ( dbdef->tables ) {
+      foreach my $fk (dbdef->table($f_table)->foreign_keys) {
+        push @{$fk_table_cache->{$fk->table}},[$f_table,$fk];
+      }
+    }
+  }
+  foreach my $fks (@{$fk_table_cache->{$table}}) {
+      my ($f_table,$fk) = @$fks;
+      my $method = '';
+      if ( scalar( @{$fk->columns} ) == 1 ) {
+        if (    ! defined($fk->references)
+             || ! @{$fk->references}
+             || $fk->columns->[0] eq $fk->references->[0]
+        ) {
+          $method = $f_table;
+        } else {
+          #some sort of hint in the table.pm or schema for methods not named
+          # after their foreign table (well, not a whole lot different than
+          # just providing a small subroutine...)
+        }
+
+        if ( $method ) {
+          $hash{$method} = { #fk_info
+                             'method' => 'qsearch',
+                             'column' => $fk->columns->[0], #references||column
+                             #'references' => $fk->column->[0],
+                           };
+        }
+
+      }
+  }
+
+  \%hash;
+}
+
+=item hash
+
+Returns a list of the column/value pairs, usually for assigning to a new hash.
+
+To make a distinct duplicate of an FS::Record object, you can do:
+
+    $new = new FS::Record ( $old->table, { $old->hash } );
+
+=cut
+
+sub hash {
+  my($self) = @_;
+  confess $self. ' -> hash: Hash attribute is undefined'
+    unless defined($self->{'Hash'});
+  %{ $self->{'Hash'} };
+}
+
+=item hashref
+
+Returns a reference to the column/value hash.  This may be deprecated in the
+future; if there's a reason you can't just use the autoloaded or get/set
+methods, speak up.
+
+=cut
+
+sub hashref {
+  my($self) = @_;
+  $self->{'Hash'};
+}
+
+#fallbacks/generics
+
+sub API_getinfo {
+  my $self = shift;
+  +{ ( map { $_=>$self->$_ } $self->fields ),
+   };
+}
+
+sub API_insert {
+  my( $class, %opt ) = @_;
+  my $table = $class->table;
+  my $self = $class->new( { map { $_ => $opt{$_} } fields($table) } );
+  my $error = $self->insert;
+  return +{ 'error' => $error } if $error;
+  my $pkey = $self->pkey;
+  return +{ 'error'       => '',
+            'primary_key' => $pkey,
+            $pkey         => $self->$pkey,
+          };
+}
+
+=item modified
+
+Returns true if any of this object's values have been modified with set (or via
+an autoloaded method).  Doesn't yet recognize when you retreive a hashref and
+modify that.
+
+=cut
+
+sub modified {
   my $self = shift;
   $self->{'modified'};
 }
   my $self = shift;
   $self->{'modified'};
 }
@@ -951,10 +1342,12 @@ sub insert {
   my $error = $self->check;
   return $error if $error;
 
   my $error = $self->check;
   return $error if $error;
 
-  #single-field unique keys are given a value if false
+  #single-field non-null unique keys are given a value if empty
   #(like MySQL's AUTO_INCREMENT or Pg SERIAL)
   foreach ( $self->dbdef_table->unique_singles) {
   #(like MySQL's AUTO_INCREMENT or Pg SERIAL)
   foreach ( $self->dbdef_table->unique_singles) {
-    $self->unique($_) unless $self->getfield($_);
+    next if $self->getfield($_);
+    next if $self->dbdef_table->column($_)->null eq 'NULL';
+    $self->unique($_);
   }
 
   #and also the primary key, if the database isn't going to
   }
 
   #and also the primary key, if the database isn't going to
@@ -962,12 +1355,12 @@ sub insert {
   my $db_seq = 0;
   if ( $primary_key ) {
     my $col = $self->dbdef_table->column($primary_key);
   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)
     $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)
          )
       || ( driver_name eq 'mysql'
              && defined($col->local)
@@ -977,14 +1370,18 @@ sub insert {
   }
 
   my $table = $self->table;
   }
 
   my $table = $self->table;
-  
+
   # Encrypt before the database
   # Encrypt before the database
-  if (    defined(eval '@FS::'. $table . '::encrypted_fields')
-       && scalar( eval '@FS::'. $table . '::encrypted_fields')
-       && $conf->exists('encryption')
+  if (    scalar( eval '@FS::'. $table . '::encrypted_fields')
+       && $conf_encryption
   ) {
     foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
   ) {
     foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
-      $self->{'saved'} = $self->getfield($field);
+      next if $field eq 'payinfo'
+                && ($self->isa('FS::payinfo_transaction_Mixin')
+                    || $self->isa('FS::payinfo_Mixin') )
+                && $self->payby
+                && !grep { $self->payby eq $_ } @encrypt_payby;
+      $saved->{$field} = $self->getfield($field);
       $self->setfield($field, $self->encrypt($self->getfield($field)));
     }
   }
       $self->setfield($field, $self->encrypt($self->getfield($field)));
     }
   }
@@ -994,37 +1391,60 @@ sub insert {
     grep { defined($self->getfield($_)) && $self->getfield($_) ne "" }
     real_fields($table)
   ;
     grep { defined($self->getfield($_)) && $self->getfield($_) ne "" }
     real_fields($table)
   ;
-  my @values = map { _quote( $self->getfield($_), $table, $_) } @real_fields;
-  #eslaf
 
   my $statement = "INSERT INTO $table ";
 
   my $statement = "INSERT INTO $table ";
-  if ( @real_fields ) {
-    $statement .=
-      "( ".
-        join( ', ', @real_fields ).
-      ") VALUES (".
-        join( ', ', @values ).
-       ")"
-    ;
-  } else {
+  my @bind_values = ();
+
+  if ( ! @real_fields ) {
+
     $statement .= 'DEFAULT VALUES';
     $statement .= 'DEFAULT VALUES';
+
+  } else {
+
+    if ( $use_placeholders ) {
+
+      @bind_values = map $self->getfield($_), @real_fields;
+
+      $statement .=
+        "( ".
+          join( ', ', @real_fields ).
+        ") VALUES (".
+          join( ', ', map '?', @real_fields ). # @bind_values ).
+         ")"
+      ;
+
+    } else {
+
+      my @values = map { _quote( $self->getfield($_), $table, $_) } @real_fields;
+
+      $statement .=
+        "( ".
+          join( ', ', @real_fields ).
+        ") VALUES (".
+          join( ', ', @values ).
+         ")"
+      ;
+
+   }
+
   }
   }
+
   warn "[debug]$me $statement\n" if $DEBUG > 1;
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   warn "[debug]$me $statement\n" if $DEBUG > 1;
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
-  local $SIG{QUIT} = 'IGNORE'; 
+  local $SIG{QUIT} = 'IGNORE';
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
-  $sth->execute or return $sth->errstr;
+  $sth->execute(@bind_values) or return $sth->errstr;
 
   # get inserted id from the database, if applicable & needed
   if ( $db_seq && ! $self->getfield($primary_key) ) {
     warn "[debug]$me retreiving sequence from database\n" if $DEBUG;
 
   # get inserted id from the database, if applicable & needed
   if ( $db_seq && ! $self->getfield($primary_key) ) {
     warn "[debug]$me retreiving sequence from database\n" if $DEBUG;
-  
+
     my $insertid = '';
 
     if ( driver_name eq 'Pg' ) {
     my $insertid = '';
 
     if ( driver_name eq 'Pg' ) {
@@ -1032,7 +1452,7 @@ sub insert {
       #my $oid = $sth->{'pg_oid_status'};
       #my $i_sql = "SELECT $primary_key FROM $table WHERE oid = ?";
 
       #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".
       unless ( $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i ) {
         dbh->rollback if $FS::UID::AutoCommit;
         return "can't parse $table.$primary_key default value".
@@ -1073,7 +1493,7 @@ sub insert {
     } else {
 
       dbh->rollback if $FS::UID::AutoCommit;
     } else {
 
       dbh->rollback if $FS::UID::AutoCommit;
-      return "don't know how to retreive inserted ids from ". driver_name. 
+      return "don't know how to retreive inserted ids from ". driver_name.
              ", try using counterfiles (maybe run dbdef-create?)";
 
     }
              ", try using counterfiles (maybe run dbdef-create?)";
 
     }
@@ -1082,36 +1502,8 @@ 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;
   my $h_sth;
-  if ( defined dbdef->table('h_'. $table) ) {
+  if ( defined( dbdef->table('h_'. $table) ) && ! $no_history ) {
     my $h_statement = $self->_h_statement('insert');
     warn "[debug]$me $h_statement\n" if $DEBUG > 2;
     $h_sth = dbh->prepare($h_statement) or do {
     my $h_statement = $self->_h_statement('insert');
     warn "[debug]$me $h_statement\n" if $DEBUG > 2;
     $h_sth = dbh->prepare($h_statement) or do {
@@ -1125,7 +1517,7 @@ sub insert {
 
   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
 
   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
-  # Now that it has been saved, reset the encrypted fields so that $new 
+  # Now that it has been saved, reset the encrypted fields so that $new
   # can still be used.
   foreach my $field (keys %{$saved}) {
     $self->setfield($field, $saved->{$field});
   # can still be used.
   foreach my $field (keys %{$saved}) {
     $self->setfield($field, $saved->{$field});
@@ -1181,21 +1573,10 @@ sub delete {
   }
 
   my $primary_key = $self->dbdef_table->primary_key;
   }
 
   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{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
-  local $SIG{QUIT} = 'IGNORE'; 
+  local $SIG{QUIT} = 'IGNORE';
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
@@ -1203,10 +1584,7 @@ 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;
   my $rc = $sth->execute or return $sth->errstr;
   #not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0";
   $h_sth->execute or return $h_sth->errstr if $h_sth;
-  $v_sth->execute($self->getfield($primary_key), $vfp->{$_}) 
-    or return $v_sth->errstr 
-        foreach (@del_vfields);
-  
+
   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
   #no need to needlessly destoy the data either (causes problems actually)
   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
   #no need to needlessly destoy the data either (causes problems actually)
@@ -1256,14 +1634,18 @@ sub replace {
 
   my $error = $new->check;
   return $error if $error;
 
   my $error = $new->check;
   return $error if $error;
-  
+
   # Encrypt for replace
   my $saved = {};
   # Encrypt for replace
   my $saved = {};
-  if (    $conf->exists('encryption')
-       && defined(eval '@FS::'. $new->table . '::encrypted_fields')
-       && scalar( eval '@FS::'. $new->table . '::encrypted_fields')
+  if (    scalar( eval '@FS::'. $new->table . '::encrypted_fields')
+       && $conf_encryption
   ) {
     foreach my $field (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)));
     }
       $saved->{$field} = $new->getfield($field);
       $new->setfield($field, $new->encrypt($new->getfield($field)));
     }
@@ -1272,16 +1654,18 @@ sub replace {
   #my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields;
   my %diff = map { ($new->getfield($_) ne $old->getfield($_))
                    ? ($_, $new->getfield($_)) : () } $old->fields;
   #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) || $no_update_diff ) {
   unless (keys(%diff) || $no_update_diff ) {
-    carp "[warning]$me $new -> replace $old: records identical"
+    carp "[warning]$me ". ref($new)."->replace ".
+           ( $primary_key ? "$primary_key ".$new->get($primary_key) : '' ).
+         ": records identical"
       unless $nowarn_identical;
     return '';
   }
 
   my $statement = "UPDATE ". $old->table. " SET ". join(', ',
     map {
       unless $nowarn_identical;
     return '';
   }
 
   my $statement = "UPDATE ". $old->table. " SET ". join(', ',
     map {
-      "$_ = ". _quote($new->getfield($_),$old->table,$_) 
+      "$_ = ". _quote($new->getfield($_),$old->table,$_)
     } real_fields($old->table)
   ). ' WHERE '.
     join(' AND ',
     } real_fields($old->table)
   ). ' WHERE '.
     join(' AND ',
@@ -1329,47 +1713,9 @@ sub replace {
     $h_new_sth = '';
   }
 
     $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{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
-  local $SIG{QUIT} = 'IGNORE'; 
+  local $SIG{QUIT} = 'IGNORE';
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
@@ -1379,26 +1725,9 @@ 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;
 
   $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;
 
-  # Now that it has been saved, reset the encrypted fields so that $new 
+  # Now that it has been saved, reset the encrypted fields so that $new
   # can still be used.
   foreach my $field (keys %{$saved}) {
     $new->setfield($field, $saved->{$field});
   # can still be used.
   foreach my $field (keys %{$saved}) {
     $new->setfield($field, $saved->{$field});
@@ -1437,35 +1766,84 @@ sub rep {
 
 =item check
 
 
 =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.
-
-(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?)
+Checks custom fields. Subclasses should still provide a check method to validate
+non-custom fields, etc., and call this method via $self->SUPER::check.
 
 =cut
 
 sub check {
 
 =cut
 
 sub check {
-  #confess "FS::Record::check not implemented; supply one in subclass!";
+    my $self = shift;
+    foreach my $field ($self->virtual_fields) {
+        my $error = $self->ut_textn($field);
+        return $error if $error;
+    }
+    '';
+}
+
+=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 $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 virtual_fields_hash [ TABLE ]
+
+Returns a list of virtual field records as a hash defined for the table.  This should not
+be exported, and should only be called as an instance or class method.
+
+=cut
+
+sub virtual_fields_hash {
+  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_hash_cache{$table} ) {
+    $virtual_fields_hash_cache{$table} = [];
+    my $concat = [ "'cf_'", "name" ];
+    my $select = concat_sql($concat).' as name, label, length';
+    my @vfields = qsearch({
+      select => $select,
+      table => 'part_virtual_field',
+      hashref => { 'dbtable' => $table, },
+    });
+
+    foreach (@vfields) {
+      push @{ $virtual_fields_hash_cache{$table} }, $_->{Hash};
     }
   }
     }
   }
-  '';
+
+  @{$virtual_fields_hash_cache{$table}};
+
 }
 
 =item process_batch_import JOB OPTIONS_HASHREF PARAMS
 }
 
 =item process_batch_import JOB OPTIONS_HASHREF PARAMS
@@ -1484,7 +1862,7 @@ Table name (required).
 
 =item params
 
 
 =item params
 
-Listref of field names for static fields.  They will be given values from the
+Arrayref of field names for static fields.  They will be given values from the
 PARAMS hashref and passed as a "params" hashref to batch_import.
 
 =item formats
 PARAMS hashref and passed as a "params" hashref to batch_import.
 
 =item formats
@@ -1533,26 +1911,23 @@ format_types).
 
 =back
 
 
 =back
 
-PARAMS is a base64-encoded Storable string containing the POSTed data as
-a hash ref.  It normally contains at least one field, "uploaded files",
-generated by /elements/file-upload.html and containing the list of uploaded
-files.  Currently only supports a single file named "file".
+PARAMS is a hashref (or base64-encoded Storable hashref) containing the
+POSTed data.  It must contain the field "uploaded files", generated by
+/elements/file-upload.html and containing the list of uploaded files.
+Currently only supports a single file named "file".
 
 =cut
 
 
 =cut
 
-use Storable qw(thaw);
 use Data::Dumper;
 use Data::Dumper;
-use MIME::Base64;
 sub process_batch_import {
 sub process_batch_import {
-  my($job, $opt) = ( shift, shift );
+  my($job, $opt, $param) = @_;
 
   my $table = $opt->{table};
 
   my $table = $opt->{table};
-  my @pass_params = @{ $opt->{params} };
+  my @pass_params = $opt->{params} ? @{ $opt->{params} } : ();
   my %formats = %{ $opt->{formats} };
 
   my %formats = %{ $opt->{formats} };
 
-  my $param = thaw(decode_base64(shift));
   warn Dumper($param) if $DEBUG;
   warn Dumper($param) if $DEBUG;
-  
+
   my $files = $param->{'uploaded_files'}
     or die "No files provided.\n";
 
   my $files = $param->{'uploaded_files'}
     or die "No files provided.\n";
 
@@ -1561,24 +1936,37 @@ sub process_batch_import {
   my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
   my $file = $dir. $files{'file'};
 
   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_asn_formats         => $opt->{format_asn_formats},
+    format_row_callbacks       => $opt->{format_row_callbacks},
+    format_hash_callbacks      => $opt->{format_hash_callbacks},
+    #per-import
+    job                        => $job,
+    file                       => $file,
+    #type                       => $type,
+    format                     => $param->{format},
+    params                     => { map { $_ => $param->{$_} } @pass_params },
+    #?
+    default_csv                => $opt->{default_csv},
+    preinsert_callback         => $opt->{preinsert_callback},
+    postinsert_callback        => $opt->{postinsert_callback},
+    insert_args_callback       => $opt->{insert_args_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;
 
 
   unlink $file;
 
@@ -1593,6 +1981,8 @@ Class method for batch imports.  Available params:
 
 =item table
 
 
 =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
 =item formats
 
 =item format_types
@@ -1603,6 +1993,16 @@ Class method for batch imports.  Available params:
 
 =item format_fixedlength_formats
 
 
 =item format_fixedlength_formats
 
+=item format_row_callbacks
+
+=item format_hash_callbacks - After parsing, before object creation
+
+=item fields - Alternate way to specify import, specifying import fields directly as a listref
+
+=item preinsert_callback
+
+=item postinsert_callback
+
 =item params
 
 =item job
 =item params
 
 =item job
@@ -1613,9 +2013,7 @@ FS::queue object, will be updated with progress
 
 =item type
 
 
 =item type
 
-csv, xls or fixedlength
-
-=item format
+csv, xls, fixedlength, xml
 
 =item empty_ok
 
 
 =item empty_ok
 
@@ -1623,6 +2021,7 @@ csv, xls or fixedlength
 
 =cut
 
 
 =cut
 
+use Data::Dumper;
 sub batch_import {
   my $param = shift;
 
 sub batch_import {
   my $param = shift;
 
@@ -1630,18 +2029,94 @@ sub batch_import {
     if $DEBUG;
 
   my $table   = $param->{table};
     if $DEBUG;
 
   my $table   = $param->{table};
-  my $formats = $param->{formats};
 
   my $job     = $param->{job};
   my $file    = $param->{file};
 
   my $job     = $param->{job};
   my $file    = $param->{file};
-  my $format  = $param->{'format'};
   my $params  = $param->{params} || {};
 
   my $params  = $param->{params} || {};
 
-  die "unknown format $format" unless exists $formats->{ $format };
+  my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
+  my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
+
+  my( $type, $header, $sep_char,
+      $fixedlength_format, $xml_format, $asn_format,
+      $parser_opt, $row_callback, $hash_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'};
+  my $insert_args_callback = '';
+  $insert_args_callback = $param->{'insert_args_callback'}
+         if $param->{'insert_args_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';
+
+
+    $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'} }
+        : '';
+
+    $parser_opt =
+      $param->{'format_parser_opts'}
+        ? $param->{'format_parser_opts'}{ $param->{'format'} }
+        : {};
+
+    $xml_format =
+      $param->{'format_xml_formats'}
+        ? $param->{'format_xml_formats'}{ $param->{'format'} }
+        : '';
+
+    $asn_format =
+      $param->{'format_asn_formats'}
+        ? $param->{'format_asn_formats'}{ $param->{'format'} }
+        : '';
+
+    $row_callback =
+      $param->{'format_row_callbacks'}
+        ? $param->{'format_row_callbacks'}{ $param->{'format'} }
+        : '';
+
+    $hash_callback =
+      $param->{'format_hash_callbacks'}
+        ? $param->{'format_hash_callbacks'}{ $param->{'format'} }
+        : '';
+
+    @fields = @{ $formats->{ $format } };
+
+  } elsif ( $param->{'fields'} ) {
+
+    $type = ''; #infer from filename
+    $header = 0;
+    $sep_char = ',';
+    $fixedlength_format = '';
+    $row_callback = '';
+    $hash_callback = '';
+    @fields = @{ $param->{'fields'} };
+
+  } else {
+    die "neither format nor fields specified";
+  }
 
 
-  my $type = $param->{'format_types'}
-             ? $param->{'format_types'}{ $format }
-             : $param->{type} || 'csv';
+  #my $file    = $param->{file};
 
   unless ( $type ) {
     if ( $file =~ /\.(\w+)$/i ) {
 
   unless ( $type ) {
     if ( $file =~ /\.(\w+)$/i ) {
@@ -1655,39 +2130,26 @@ sub batch_import {
       if $param->{'default_csv'} && $type ne 'xls';
   }
 
       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;
   my $parser;
   my @buffer = ();
 
   my $row = 0;
   my $count;
   my $parser;
   my @buffer = ();
+  my $asn_header_buffer;
   if ( $type eq 'csv' || $type eq 'fixedlength' ) {
 
     if ( $type eq 'csv' ) {
 
   if ( $type eq 'csv' || $type eq 'fixedlength' ) {
 
     if ( $type eq 'csv' ) {
 
-      my %attr = ();
-      $attr{sep_char} = $sep_char if $sep_char;
-      $parser = new Text::CSV_XS \%attr;
+      $parser_opt->{'binary'} = 1;
+      $parser_opt->{'sep_char'} = $sep_char if $sep_char;
+      $parser = Text::CSV_XS->new($parser_opt);
 
     } elsif ( $type eq 'fixedlength' ) {
 
       eval "use Parse::FixedLength;";
       die $@ if $@;
 
     } elsif ( $type eq 'fixedlength' ) {
 
       eval "use Parse::FixedLength;";
       die $@ if $@;
-      $parser = new Parse::FixedLength $fixedlength_format;
- 
+      $parser = Parse::FixedLength->new($fixedlength_format, $parser_opt);
+
     } else {
       die "Unknown file type $type\n";
     }
     } else {
       die "Unknown file type $type\n";
     }
@@ -1715,6 +2177,43 @@ sub batch_import {
 
     $row = $header || 0;
 
 
     $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;
+
+  } elsif ( $type eq 'asn.1' ) {
+
+    eval "use Convert::ASN1";
+    die $@ if $@;
+
+    my $asn = Convert::ASN1->new;
+    $asn->prepare( $asn_format->{'spec'} ) or die $asn->error;
+
+    $parser = $asn->find( $asn_format->{'macro'} ) or die $asn->error;
+
+    my $data = slurp($file);
+    my $asn_output = $parser->decode( $data )
+      or return "No ". $asn_format->{'macro'}. " found\n";
+
+    $asn_header_buffer = &{ $asn_format->{'header_buffer'} }( $asn_output );
+
+    my $rows = &{ $asn_format->{'arrayref'} }( $asn_output );
+    $count = @buffer = @$rows;
+
   } else {
     die "Unknown file type $type\n";
   }
   } else {
     die "Unknown file type $type\n";
   }
@@ -1731,26 +2230,57 @@ sub batch_import {
   my $oldAutoCommit = $FS::UID::AutoCommit;
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
   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 $line;
   my $imported = 0;
+  my $unique_skip = 0; #lines skipped because they're already in the system
   my( $last, $min_sec ) = ( time, 5 ); #progressbar foo
   while (1) {
 
     my @columns = ();
   my( $last, $min_sec ) = ( time, 5 ); #progressbar foo
   while (1) {
 
     my @columns = ();
+    my %hash = %$params;
     if ( $type eq 'csv' ) {
 
       last unless scalar(@buffer);
       $line = shift(@buffer);
 
     if ( $type eq 'csv' ) {
 
       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;
       $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' ) {
 
       };
       @columns = $parser->fields();
 
     } elsif ( $type eq 'fixedlength' ) {
 
+      last unless scalar(@buffer);
+      $line = shift(@buffer);
+
       @columns = $parser->parse($line);
 
     } elsif ( $type eq 'xls' ) {
       @columns = $parser->parse($line);
 
     } elsif ( $type eq 'xls' ) {
@@ -1764,17 +2294,33 @@ sub batch_import {
       #my $z = 'A';
       #warn $z++. ": $_\n" for @columns;
 
       #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 };
+
+    } elsif ( $type eq 'asn.1' ) {
+
+      last unless scalar(@buffer);
+      my $row = shift @buffer;
+      &{ $asn_format->{row_callback} }( $row, $asn_header_buffer )
+        if $asn_format->{row_callback};
+      foreach my $key ( keys %{ $asn_format->{map} } ) {
+        $hash{$key} = &{ $asn_format->{map}{$key} }( $row, $asn_header_buffer );
+      }
+
     } else {
       die "Unknown file type $type\n";
     }
 
     my @later = ();
     } else {
       die "Unknown file type $type\n";
     }
 
     my @later = ();
-    my %hash = %$params;
 
     foreach my $field ( @fields ) {
 
       my $value = shift @columns;
 
     foreach my $field ( @fields ) {
 
       my $value = shift @columns;
-     
+
       if ( ref($field) eq 'CODE' ) {
         #&{$field}(\%hash, $value);
         push @later, $field, $value;
       if ( ref($field) eq 'CODE' ) {
         #&{$field}(\%hash, $value);
         push @later, $field, $value;
@@ -1785,6 +2331,14 @@ sub batch_import {
 
     }
 
 
     }
 
+    if ( $custnum_prefix && $hash{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
+                         && length($1) == $custnum_length ) {
+      $hash{custnum} = $2;
+    }
+
+    %hash = &{$hash_callback}(%hash) if $hash_callback;
+
+    #my $table   = $param->{table};
     my $class = "FS::$table";
 
     my $record = $class->new( \%hash );
     my $class = "FS::$table";
 
     my $record = $class->new( \%hash );
@@ -1793,12 +2347,34 @@ sub batch_import {
     while ( scalar(@later) ) {
       my $sub = shift @later;
       my $data = shift @later;
     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} );
     }
       last if exists( $param->{skiprow} );
     }
+    $unique_skip++ if $param->{unique_skip}; #line is already in the system
     next if exists( $param->{skiprow} );
 
     next if exists( $param->{skiprow} );
 
-    my $error = $record->insert;
+    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 @insert_args = ();
+    if ( $insert_args_callback ) {
+      @insert_args = &{$insert_args_callback}($record, $param);
+    }
+
+    my $error = $record->insert(@insert_args);
 
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
 
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
@@ -1808,6 +2384,15 @@ sub batch_import {
     $row++;
     $imported++;
 
     $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;
     if ( $job && time - $min_sec > $last ) { #progress bar
       $job->update_statustext( int(100 * $imported / $count) );
       $last = time;
@@ -1815,9 +2400,13 @@ sub batch_import {
 
   }
 
 
   }
 
-  $dbh->commit or die $dbh->errstr if $oldAutoCommit;;
+  unless ( $imported || $param->{empty_ok} ) {
+    $dbh->rollback if $oldAutoCommit;
+    # freeside-cdr-conexiant-import is sensitive to the text of this message
+    return $unique_skip ? "All records in file were previously imported" : "Empty file!";
+  }
 
 
-  return "Empty file!" unless $imported || $param->{empty_ok};
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   ''; #no error
 
 
   ''; #no error
 
@@ -1836,23 +2425,27 @@ sub _h_statement {
   ;
 
   # If we're encrypting then don't store the payinfo in the history
   ;
 
   # If we're encrypting then don't store the payinfo in the history
-  if ( $conf && $conf->exists('encryption') ) {
+  if ( $conf_encryption && $self->table ne 'banned_pay' ) {
     @fields = grep { $_ ne 'payinfo' } @fields;
   }
 
   my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields;
 
   "INSERT INTO h_". $self->table. " ( ".
     @fields = grep { $_ ne 'payinfo' } @fields;
   }
 
   my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields;
 
   "INSERT INTO h_". $self->table. " ( ".
-      join(', ', qw(history_date history_user history_action), @fields ).
+      join(', ', qw(history_date history_usernum history_action), @fields ).
     ") VALUES (".
     ") VALUES (".
-      join(', ', $time, dbh->quote(getotaker()), dbh->quote($action), @values).
+      join(', ', $time,
+                 $FS::CurrentUser::CurrentUser->usernum,
+                 dbh->quote($action),
+                 @values
+      ).
     ")"
   ;
 }
 
 =item unique COLUMN
 
     ")"
   ;
 }
 
 =item unique COLUMN
 
-B<Warning>: External use is B<deprecated>.  
+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
 
 Replaces COLUMN in record with a unique number, using counters in the
 filesystem.  Used by the B<insert> method on single-field unique columns
@@ -1876,11 +2469,6 @@ sub unique {
   #warn "field $field is tainted" if is_tainted($field);
 
   my($counter) = new File::CounterFile "$table.$field",0;
   #warn "field $field is tainted" if is_tainted($field);
 
   my($counter) = new File::CounterFile "$table.$field",0;
-# hack for web demo
-#  getotaker() =~ /^([\w\-]{1,16})$/ or die "Illegal CGI REMOTE_USER!";
-#  my($user)=$1;
-#  my($counter) = new File::CounterFile "$user/$table.$field",0;
-# endhack
 
   my $index = $counter->inc;
   $index = $counter->inc while qsearchs($table, { $field=>$index } );
 
   my $index = $counter->inc;
   $index = $counter->inc while qsearchs($table, { $field=>$index } );
@@ -2026,20 +2614,56 @@ sub ut_numbern {
   '';
 }
 
   '';
 }
 
-=item ut_money COLUMN
+=item ut_decimal COLUMN[, DIGITS]
 
 
-Check/untaint monetary numbers.  May be negative.  Set to 0 if null.  If there
-is an error, returns the error, otherwise returns false.
+Check/untaint decimal numbers (up to DIGITS decimal places.  If there is an
+error, returns the error, otherwise returns false.
+
+=item ut_decimaln COLUMN[, DIGITS]
+
+Check/untaint decimal numbers.  May be null.  If there is an error, returns
+the error, otherwise returns false.
 
 =cut
 
 
 =cut
 
-sub ut_money {
-  my($self,$field)=@_;
-  $self->setfield($field, 0) if $self->getfield($field) eq '';
-  $self->getfield($field) =~ /^\s*(\-)?\s*(\d*)(\.\d{2})?\s*$/
-    or return "Illegal (money) $field: ". $self->getfield($field);
-  #$self->setfield($field, "$1$2$3" || 0);
-  $self->setfield($field, ( ($1||''). ($2||''). ($3||'') ) || 0);
+sub ut_decimal {
+  my($self, $field, $digits) = @_;
+  $digits ||= '';
+  $self->getfield($field) =~ /^\s*(\d+(\.\d{0,$digits})?)\s*$/
+    or return "Illegal or empty (decimal) $field: ".$self->getfield($field);
+  $self->setfield($field, $1);
+  '';
+}
+
+sub ut_decimaln {
+  my($self, $field, $digits) = @_;
+  $self->getfield($field) =~ /^\s*(\d*(\.\d{0,$digits})?)\s*$/
+    or return "Illegal (decimal) $field: ".$self->getfield($field);
+  $self->setfield($field, $1);
+  '';
+}
+
+=item ut_money COLUMN
+
+Check/untaint monetary numbers.  May be negative.  Set to 0 if null.  If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_money {
+  my($self,$field)=@_;
+
+  if ( $self->getfield($field) eq '' ) {
+    $self->setfield($field, 0);
+  } elsif ( $self->getfield($field) =~ /^\s*(\-)?\s*(\d*)(\.\d{1})\s*$/ ) {
+    #handle one decimal place without barfing out
+    $self->setfield($field, ( ($1||''). ($2||''). ($3.'0') ) || 0);
+  } elsif ( $self->getfield($field) =~ /^\s*(\-)?\s*(\d*)(\.\d{2})?\s*$/ ) {
+    $self->setfield($field, ( ($1||''). ($2||''). ($3||'') ) || 0);
+  } else {
+    return "Illegal (money) $field: ". $self->getfield($field);
+  }
+
   '';
 }
 
   '';
 }
 
@@ -2059,10 +2683,45 @@ sub ut_moneyn {
   $self->ut_money($field);
 }
 
   $self->ut_money($field);
 }
 
+=item ut_currencyn COLUMN
+
+Check/untaint currency indicators, such as USD or EUR.  May be null.  If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_currencyn {
+  my($self, $field) = @_;
+  if ($self->getfield($field) eq '') { #can be null
+    $self->setfield($field, '');
+    return '';
+  }
+  $self->ut_currency($field);
+}
+
+=item ut_currency COLUMN
+
+Check/untaint currency indicators, such as USD or EUR.  May not be null.  If
+there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_currency {
+  my($self, $field) = @_;
+  my $value = uc( $self->getfield($field) );
+  if ( code2currency($value) ) {
+    $self->setfield($value);
+  } else {
+    return "Unknown currency $value";
+  }
+
+  '';
+}
+
 =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.
 
@@ -2073,8 +2732,10 @@ sub ut_text {
   #warn "msgcat ". \&msgcat. "\n";
   #warn "notexist ". \&notexist. "\n";
   #warn "AUTOLOAD ". \&AUTOLOAD. "\n";
   #warn "msgcat ". \&msgcat. "\n";
   #warn "notexist ". \&notexist. "\n";
   #warn "AUTOLOAD ". \&AUTOLOAD. "\n";
+  # \p{Word} = alphanumerics, marks (diacritics), and connectors
+  # see perldoc perluniprops
   $self->getfield($field)
   $self->getfield($field)
-    =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>]+)$/
+    =~ /^([\p{Word} \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>\~$money_char]+)$/
       or return gettext('illegal_or_empty_text'). " $field: ".
                  $self->getfield($field);
   $self->setfield($field,$1);
       or return gettext('illegal_or_empty_text'). " $field: ".
                  $self->getfield($field);
   $self->setfield($field,$1);
@@ -2084,18 +2745,15 @@ sub ut_text {
 =item ut_textn COLUMN
 
 Check/untaint text.  Alphanumerics, spaces, and the following punctuation
 =item ut_textn COLUMN
 
 Check/untaint text.  Alphanumerics, spaces, and the following punctuation
-symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? /
+symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / = [ ] < >
 May be null.  If there is an error, returns the error, otherwise returns false.
 
 =cut
 
 sub ut_textn {
   my($self,$field)=@_;
 May be null.  If there is an error, returns the error, otherwise returns false.
 
 =cut
 
 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
 }
 
 =item ut_alpha COLUMN
@@ -2114,7 +2772,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.
 
 Check/untaint alphanumeric strings (no spaces).  May be null.  If there is an
 error, returns the error, otherwise returns false.
@@ -2123,12 +2781,28 @@ error, returns the error, otherwise returns false.
 
 sub ut_alphan {
   my($self,$field)=@_;
 
 sub ut_alphan {
   my($self,$field)=@_;
-  $self->getfield($field) =~ /^(\w*)$/ 
+  $self->getfield($field) =~ /^(\w*)$/
+    or return "Illegal (alphanumeric) $field: ". $self->getfield($field);
+  $self->setfield($field,$1);
+  '';
+}
+
+=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);
   '';
 }
 
     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
 =item ut_alpha_lower COLUMN
 
 Check/untaint lowercase alphanumeric strings (no spaces).  May not be null.  If
@@ -2148,8 +2822,8 @@ sub ut_alpha_lower {
 Check/untaint phone numbers.  May be null.  If there is an error, returns
 the error, otherwise returns false.
 
 Check/untaint phone numbers.  May be null.  If there is an error, returns
 the error, otherwise returns false.
 
-Takes an optional two-letter ISO country code; without it or with unsupported
-countries, ut_phonen simply calls ut_alphan.
+Takes an optional two-letter ISO 3166-1 alpha-2 country code; without
+it or with unsupported countries, ut_phonen simply calls ut_alphan.
 
 =cut
 
 
 =cut
 
@@ -2202,24 +2876,61 @@ sub ut_hexn {
   $self->setfield($field, uc($1));
   '';
 }
   $self->setfield($field, uc($1));
   '';
 }
+
+=item ut_mac_addr COLUMN
+
+Check/untaint mac addresses.  May be null.
+
+=cut
+
+sub ut_mac_addr {
+  my($self, $field) = @_;
+
+  my $mac = $self->get($field);
+  $mac =~ s/\s+//g;
+  $mac =~ s/://g;
+  $self->set($field, $mac);
+
+  my $e = $self->ut_hex($field);
+  return $e if $e;
+
+  return "Illegal (mac address) $field: ". $self->getfield($field)
+    unless length($self->getfield($field)) == 12;
+
+  '';
+
+}
+
+=item ut_mac_addrn COLUMN
+
+Check/untaint mac addresses.  May be null.
+
+=cut
+
+sub ut_mac_addrn {
+  my($self, $field) = @_;
+  ($self->getfield($field) eq '') ? '' : $self->ut_mac_addr($field);
+}
+
 =item ut_ip COLUMN
 
 =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 ) = @_;
 
 =cut
 
 sub ut_ip {
   my( $self, $field ) = @_;
-  $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.$4");
-  '';
+  $self->setfield($field, '127.0.0.1') if $self->getfield($field) eq '::1';
+  return "Illegal (IP address) $field: ".$self->getfield($field)
+    unless $self->getfield($field) =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/;
+  $self->ut_ip46($field);
 }
 
 =item ut_ipn COLUMN
 
 }
 
 =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
 
 
 =cut
 
@@ -2233,6 +2944,51 @@ 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->_ut_ip_strip_leading_zeros( $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);
+}
+
+sub _ut_ip_strip_leading_zeros {
+  # strip user-entered leading 0's from IP addresses
+  # so parsers like NetAddr::IP don't mangle the address
+  # e.g. NetAddr::IP converts 10.0.022.220 into 10.0.18.220
+
+  my ( $self, $ip ) = @_;
+
+  return join '.', map int, split /\./, $ip
+    if $ip
+    && $ip =~ /\./
+    && $ip =~ /[\.^]0/;
+  $ip;
+}
+
+
 =item ut_coord COLUMN [ LOWER [ UPPER ] ]
 
 Check/untaint coordinates.
 =item ut_coord COLUMN [ LOWER [ UPPER ] ]
 
 Check/untaint coordinates.
@@ -2258,14 +3014,24 @@ for lower and upper bounds, respectively.
 =cut
 
 sub ut_coord {
 =cut
 
 sub ut_coord {
-
   my ($self, $field) = (shift, shift);
 
   my ($self, $field) = (shift, shift);
 
-  my $lower = shift if scalar(@_);
-  my $upper = shift if scalar(@_);
+  my($lower, $upper);
+  if ( $field =~ /latitude/ ) {
+    $lower = $lat_lower;
+    $upper = 90;
+  } elsif ( $field =~ /longitude/ ) {
+    $lower = -180;
+    $upper = $lon_upper;
+  }
+
   my $coord = $self->getfield($field);
   my $neg = $coord =~ s/^(-)//;
 
   my $coord = $self->getfield($field);
   my $neg = $coord =~ s/^(-)//;
 
+  # ignore degree symbol at the end,
+  #   but not otherwise supporting degree/minutes/seconds symbols
+  $coord =~ s/\N{DEGREE SIGN}\s*$//;
+
   my ($d, $m, $s) = (0, 0, 0);
 
   if (
   my ($d, $m, $s) = (0, 0, 0);
 
   if (
@@ -2310,7 +3076,7 @@ sub ut_coordn {
 
   my ($self, $field) = (shift, shift);
 
 
   my ($self, $field) = (shift, shift);
 
-  if ($self->getfield($field) =~ /^$/) {
+  if ($self->getfield($field) =~ /^\s*$/) {
     return '';
   } else {
     return $self->ut_coord($field, @_);
     return '';
   } else {
     return $self->ut_coord($field, @_);
@@ -2318,10 +3084,9 @@ sub ut_coordn {
 
 }
 
 
 }
 
-
 =item ut_domain COLUMN
 
 =item ut_domain COLUMN
 
-Check/untaint host and domain names.
+Check/untaint host and domain names.  May not be null.
 
 =cut
 
 
 =cut
 
@@ -2329,11 +3094,27 @@ sub ut_domain {
   my( $self, $field ) = @_;
   #$self->getfield($field) =~/^(\w+\.)*\w+$/
   $self->getfield($field) =~/^(([\w\-]+\.)*\w+)$/
   my( $self, $field ) = @_;
   #$self->getfield($field) =~/^(\w+\.)*\w+$/
   $self->getfield($field) =~/^(([\w\-]+\.)*\w+)$/
-    or return "Illegal (domain) $field: ". $self->getfield($field);
+    or return "Illegal (hostname) $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
 }
 
   $self->setfield($field,$1);
   '';
 }
 
+=item ut_domainn COLUMN
+
+Check/untaint host and domain names.  May be null.
+
+=cut
+
+sub ut_domainn {
+  my( $self, $field ) = @_;
+  if ( $self->getfield($field) =~ /^()$/ ) {
+    $self->setfield($field,'');
+    '';
+  } else {
+    $self->ut_domain($field);
+  }
+}
+
 =item ut_name COLUMN
 
 Check/untaint proper names; allows alphanumerics, spaces and the following
 =item ut_name COLUMN
 
 Check/untaint proper names; allows alphanumerics, spaces and the following
@@ -2345,12 +3126,31 @@ May not be null.
 
 sub ut_name {
   my( $self, $field ) = @_;
 
 sub ut_name {
   my( $self, $field ) = @_;
-  $self->getfield($field) =~ /^([\w \,\.\-\']+)$/
+  $self->getfield($field) =~ /^([\p{Word} \,\.\-\']+)$/
     or return gettext('illegal_name'). " $field: ". $self->getfield($field);
     or return gettext('illegal_name'). " $field: ". $self->getfield($field);
-  $self->setfield($field,$1);
+  my $name = $1;
+  $name =~ s/^\s+//;
+  $name =~ s/\s+$//;
+  $name =~ s/\s+/ /g;
+  $self->setfield($field, $name);
   '';
 }
 
   '';
 }
 
+=item ut_namen COLUMN
+
+Check/untaint proper names; allows alphanumerics, spaces and the following
+punctuation: , . - '
+
+May not be null.
+
+=cut
+
+sub ut_namen {
+  my( $self, $field ) = @_;
+  return $self->setfield($field, '') if $self->getfield($field) =~ /^$/;
+  $self->ut_name($field);
+}
+
 =item ut_zip COLUMN
 
 Check/untaint zip codes.
 =item ut_zip COLUMN
 
 Check/untaint zip codes.
@@ -2376,6 +3176,13 @@ sub ut_zip {
                 $self->getfield($field);
     $self->setfield($field, "$1 $2");
 
                 $self->getfield($field);
     $self->setfield($field, "$1 $2");
 
+  } elsif ( $country eq 'AU' ) {
+
+    $self->getfield($field) =~ /^\s*(\d{4})\s*$/
+      or return gettext('illegal_zip'). " $field for country $country: ".
+                $self->getfield($field);
+    $self->setfield($field, $1);
+
   } else {
 
     if ( $self->getfield($field) =~ /^\s*$/
   } else {
 
     if ( $self->getfield($field) =~ /^\s*$/
@@ -2384,7 +3191,7 @@ sub ut_zip {
     {
       $self->setfield($field,'');
     } else {
     {
       $self->setfield($field,'');
     } else {
-      $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
+      $self->getfield($field) =~ /^\s*(\w[\w\-\s]{0,8}\w)\s*$/
         or return gettext('illegal_zip'). " $field: ". $self->getfield($field);
       $self->setfield($field,$1);
     }
         or return gettext('illegal_zip'). " $field: ". $self->getfield($field);
       $self->setfield($field,$1);
     }
@@ -2404,7 +3211,7 @@ see L<Locale::Country>.
 sub ut_country {
   my( $self, $field ) = @_;
   unless ( $self->getfield($field) =~ /^(\w\w)$/ ) {
 sub ut_country {
   my( $self, $field ) = @_;
   unless ( $self->getfield($field) =~ /^(\w\w)$/ ) {
-    if ( $self->getfield($field) =~ /^([\w \,\.\(\)\']+)$/ 
+    if ( $self->getfield($field) =~ /^([\w \,\.\(\)\']+)$/
          && country2code($1) ) {
       $self->setfield($field,uc(country2code($1)));
     }
          && country2code($1) ) {
       $self->setfield($field,uc(country2code($1)));
     }
@@ -2446,6 +3253,90 @@ sub ut_enum {
   return "Illegal (enum) field $field: ". $self->getfield($field);
 }
 
   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_date COLUMN
+
+Check/untaint a column containing a date string.
+
+Date will be normalized to YYYY-MM-DD format
+
+=cut
+
+sub ut_date {
+  my ( $self, $field ) = @_;
+  my $value = $self->getfield( $field );
+
+  my @date = split /[\-\/]/, $value;
+  if ( scalar(@date) == 3 ) {
+    @date = @date[2,0,1] if $date[2] >= 1900;
+
+    local $@;
+    my $ymd;
+    eval {
+      # DateTime will die given invalid date
+      $ymd = DateTime->new(
+        year  => $date[0],
+        month => $date[1],
+        day   => $date[2],
+      )->ymd('-');
+    };
+
+    unless( $@ ) {
+      $self->setfield( $field, $ymd ) unless $value eq $ymd;
+      return '';
+    }
+
+  }
+  return "Illegal (date) field $field: $value";
+}
+
+=item ut_daten COLUMN
+
+Check/untaint a column containing a date string.
+
+Column may be null.
+
+Date will be normalized to YYYY-MM-DD format
+
+=cut
+
+sub ut_daten {
+  my ( $self, $field ) = @_;
+
+  $self->getfield( $field ) =~ /^()$/
+  ? $self->setfield( $field, '' )
+  : $self->ut_date( $field );
+}
+
+=item ut_flag COLUMN
+
+Check/untaint a column if it contains either an empty string or 'Y'.  This
+is the standard form for boolean flags in Freeside.
+
+=cut
+
+sub ut_flag {
+  my( $self, $field ) = @_;
+  my $value = uc($self->getfield($field));
+  if ( $value eq '' or $value eq 'Y' ) {
+    $self->setfield($field, $value);
+    return '';
+  }
+  return "Illegal (flag) field $field: $value";
+}
+
 =item ut_foreign_key COLUMN FOREIGN_TABLE FOREIGN_COLUMN
 
 Check/untaint a foreign column key.  Call a regular ut_ method (like ut_number)
 =item ut_foreign_key COLUMN FOREIGN_TABLE FOREIGN_COLUMN
 
 Check/untaint a foreign column key.  Call a regular ut_ method (like ut_number)
@@ -2455,7 +3346,7 @@ on the column first.
 
 sub ut_foreign_key {
   my( $self, $field, $table, $foreign ) = @_;
 
 sub ut_foreign_key {
   my( $self, $field, $table, $foreign ) = @_;
-  return '' if $no_check_foreign;
+  return $self->ut_number($field) if $no_check_foreign;
   qsearchs($table, { $foreign => $self->getfield($field) })
     or return "Can't find ". $self->table. ".$field ". $self->getfield($field).
               " in $table.$foreign";
   qsearchs($table, { $foreign => $self->getfield($field) })
     or return "Can't find ". $self->table. ".$field ". $self->getfield($field).
               " in $table.$foreign";
@@ -2495,12 +3386,12 @@ sub ut_agentnum_acl {
 
   if ( $self->$field() ) {
 
 
   if ( $self->$field() ) {
 
-    return "Access denied"
+    return 'Access denied to agent '. $self->$field()
       unless $curuser->agentnum($self->$field());
 
   } else {
 
       unless $curuser->agentnum($self->$field());
 
   } else {
 
-    return "Access denied"
+    return 'Access denied to global'
       unless grep $curuser->access_right($_), @$null_acl;
 
   }
       unless grep $curuser->access_right($_), @$null_acl;
 
   }
@@ -2509,40 +3400,55 @@ 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.
+=item ut_email COLUMN
+
+Check column contains a valid E-Mail address
 
 =cut
 
 
 =cut
 
-sub virtual_fields {
-  my $self = shift;
-  my $table;
-  $table = $self->table or confess "virtual_fields called on non-table";
+sub ut_email {
+  my ( $self, $field ) = @_;
+  Email::Valid->address( $self->getfield( $field ) )
+    ? ''
+    : "Illegal (email) field $field: ". $self->getfield( $field );
+}
 
 
-  confess "Unknown table $table" unless dbdef->table($table);
+=item ut_emailn COLUMN
 
 
-  return () unless dbdef->table('part_virtual_field');
+Check column contains a valid E-Mail address
 
 
-  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;
-  }
+May be null
 
 
-  @{$virtual_fields_cache{$table}};
+=cut
 
 
+sub ut_emailn {
+  my ( $self, $field ) = @_;
+
+  $self->getfield( $field ) =~ /^$/
+    ? $self->getfield( $field, '' )
+    : $self->ut_email( $field );
 }
 
 }
 
+=item trim_whitespace FIELD[, FIELD ... ]
+
+Strip leading and trailing spaces from the value in the named FIELD(s).
+
+=cut
+
+sub trim_whitespace {
+  my $self = shift;
+  foreach my $field (@_) {
+    my $value = $self->get($field);
+    $value =~ s/^\s+//;
+    $value =~ s/\s+$//;
+    $self->set($field, $value);
+  }
+}
 
 =item fields [ 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
 fields before should probably continue to call fields.
 
 =cut
@@ -2554,50 +3460,11 @@ sub fields {
     $table = $something->table;
   } else {
     $table = $something;
     $table = $something->table;
   } else {
     $table = $something;
-    $something = "FS::$table";
-  }
-  return (real_fields($table), $something->virtual_fields());
-}
-
-=item pvf FIELD_NAME
-
-Returns the FS::part_virtual_field object corresponding to a field in the 
-record (specified by FIELD_NAME).
-
-=cut
-
-sub pvf {
-  my ($self, $name) = (shift, shift);
-
-  if(grep /^$name$/, $self->virtual_fields) {
-    return qsearchs('part_virtual_field', { dbtable => $self->table,
-                                            name    => $name } );
+    #$something = "FS::$table";
   }
   }
-  ''
+  return (real_fields($table));
 }
 
 }
 
-=item vfieldpart_hashref TABLE
-
-Returns a hashref of virtual field names and vfieldparts applicable to the given
-TABLE.
-
-=cut
-
-sub vfieldpart_hashref {
-  my $self = shift;
-  my $table = $self->table;
-
-  return {} unless dbdef->table('part_virtual_field');
-
-  my $dbh = dbh;
-  my $statement = "SELECT vfieldpart, name FROM part_virtual_field WHERE ".
-                  "dbtable = '$table'";
-  my $sth = $dbh->prepare($statement);
-  $sth->execute or croak "Execution of '$statement' failed: ".$dbh->errstr;
-  return { map { $_->{name}, $_->{vfieldpart} } 
-    @{$sth->fetchall_arrayref({})} };
-
-}
 
 =item encrypt($value)
 
 
 =item encrypt($value)
 
@@ -2611,9 +3478,9 @@ You should generally not have to worry about calling this, as the system handles
 
 sub encrypt {
   my ($self, $value) = @_;
 
 sub encrypt {
   my ($self, $value) = @_;
-  my $encrypted;
+  my $encrypted = $value;
 
 
-  if ($conf->exists('encryption')) {
+  if ($conf_encryption) {
     if ($self->is_encrypted($value)) {
       # Return the original value if it isn't plaintext.
       $encrypted = $value;
     if ($self->is_encrypted($value)) {
       # Return the original value if it isn't plaintext.
       $encrypted = $value;
@@ -2641,13 +3508,8 @@ Checks to see if the string is encrypted and returns true or false (1/0) to indi
 
 sub is_encrypted {
   my ($self, $value) = @_;
 
 sub is_encrypted {
   my ($self, $value) = @_;
-  # Possible Bug - Some work may be required here....
-
-  if ($value =~ /^M/ && length($value) > 80) {
-    return 1;
-  } else {
-    return 0;
-  }
+  # could be more precise about it, but this will do for now
+  $value =~ /^M/ && length($value) > 80;
 }
 
 =item decrypt($value)
 }
 
 =item decrypt($value)
@@ -2661,7 +3523,7 @@ You should generally not have to worry about calling this, as the system handles
 sub decrypt {
   my ($self,$value) = @_;
   my $decrypted = $value; # Will return the original value if it isn't encrypted or can't be decrypted.
 sub decrypt {
   my ($self,$value) = @_;
   my $decrypted = $value; # Will return the original value if it isn't encrypted or can't be decrypted.
-  if ($conf->exists('encryption') && $self->is_encrypted($value)) {
+  if ($conf_encryption && $self->is_encrypted($value)) {
     $self->loadRSA;
     if (ref($rsa_decrypt) =~ /::RSA/) {
       my $encrypted = unpack ("u*", $value);
     $self->loadRSA;
     if (ref($rsa_decrypt) =~ /::RSA/) {
       my $encrypted = unpack ("u*", $value);
@@ -2673,29 +3535,19 @@ sub decrypt {
 }
 
 sub loadRSA {
 }
 
 sub loadRSA {
-    my $self = shift;
-    #Initialize the Module
-    $rsa_module = 'Crypt::OpenSSL::RSA'; # The Default
+  my $self = shift;
 
 
-    if ($conf->exists('encryptionmodule') && $conf->config_binary('encryptionmodule') ne '') {
-      $rsa_module = $conf->config('encryptionmodule');
-    }
+  my $rsa_module = $conf_encryptionmodule || 'Crypt::OpenSSL::RSA';
 
 
-    if (!$rsa_loaded) {
-       eval ("require $rsa_module"); # No need to import the namespace
-       $rsa_loaded++;
-    }
-    # Initialize Encryption
-    if ($conf->exists('encryptionpublickey') && $conf->config_binary('encryptionpublickey') ne '') {
-      my $public_key = join("\n",$conf->config('encryptionpublickey'));
-      $rsa_encrypt = $rsa_module->new_public_key($public_key);
-    }
+  # Initialize Encryption
+  if ($conf_encryptionpublickey && $conf_encryptionpublickey ne '') {
+    $rsa_encrypt = $rsa_module->new_public_key($conf_encryptionpublickey);
+  }
     
     
-    # Intitalize Decryption
-    if ($conf->exists('encryptionprivatekey') && $conf->config_binary('encryptionprivatekey') ne '') {
-      my $private_key = join("\n",$conf->config('encryptionprivatekey'));
-      $rsa_decrypt = $rsa_module->new_private_key($private_key);
-    }
+  # Intitalize Decryption
+  if ($conf_encryptionprivatekey && $conf_encryptionprivatekey ne '') {
+    $rsa_decrypt = $rsa_module->new_private_key($conf_encryptionprivatekey);
+  }
 }
 
 =item h_search ACTION
 }
 
 =item h_search ACTION
@@ -2735,6 +3587,60 @@ sub h_date {
   $h ? $h->history_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 : '';
+}
+
+=item count [ WHERE [, PLACEHOLDER ...] ]
+
+Convenience method for the common case of "SELECT COUNT(*) FROM table",
+with optional WHERE.  Must be called as method on a class with an
+associated table.
+
+=cut
+
+sub count {
+  my($self, $where) = (shift, shift);
+  my $table = $self->table or die 'count called on object of class '.ref($self);
+  my $sql = "SELECT COUNT(*) FROM $table";
+  $sql .= " WHERE $where" if $where;
+  $self->scalar_sql($sql, @_);
+}
+
+=item row_exists [ WHERE [, PLACEHOLDER ...] ]
+
+Convenience method for the common case of "SELECT 1 FROM table ... LIMIT 1"
+with optional (but almost always needed) WHERE.
+
+=cut
+
+sub row_exists {
+  my($self, $where) = (shift, shift);
+  my $table = $self->table or die 'row_exists called on object of class '.ref($self);
+  my $sql = "SELECT 1 FROM $table";
+  $sql .= " WHERE $where" if $where;
+  $sql .= " LIMIT 1";
+  $self->scalar_sql($sql, @_);
+}
+
 =back
 
 =head1 SUBROUTINES
 =back
 
 =head1 SUBROUTINES
@@ -2743,7 +3649,7 @@ sub h_date {
 
 =item real_fields [ TABLE ]
 
 
 =item real_fields [ TABLE ]
 
-Returns a list of the real columns in the specified table.  Called only by 
+Returns a list of the real columns in the specified table.  Called only by
 fields() and other subroutines elsewhere in FS::Record.
 
 =cut
 fields() and other subroutines elsewhere in FS::Record.
 
 =cut
@@ -2756,6 +3662,29 @@ sub real_fields {
   $table_obj->columns;
 }
 
   $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
 =item _quote VALUE, TABLE, COLUMN
 
 This is an internal function used to construct SQL statements.  It returns
@@ -2770,6 +3699,8 @@ sub _quote {
   my $column_type = $column_obj->type;
   my $nullable = $column_obj->null;
 
   my $column_type = $column_obj->type;
   my $nullable = $column_obj->null;
 
+  utf8::upgrade($value);
+
   warn "  $table.$column: $value ($column_type".
        ( $nullable ? ' NULL' : ' NOT NULL' ).
        ")\n" if $DEBUG > 2;
   warn "  $table.$column: $value ($column_type".
        ( $nullable ? ' NULL' : ' NOT NULL' ).
        ")\n" if $DEBUG > 2;
@@ -2780,18 +3711,26 @@ sub _quote {
     cluck "WARNING: Attempting to set non-null integer $table.$column null; ".
           "using 0 instead";
     0;
     cluck "WARNING: Attempting to set non-null integer $table.$column null; ".
           "using 0 instead";
     0;
-  } elsif ( $value =~ /^\d+(\.\d+)?$/ && 
+  } elsif ( $value =~ /^\d+(\.\d+)?$/ &&
             ! $column_type =~ /(char|binary|text)$/i ) {
     $value;
   } elsif (( $column_type =~ /^bytea$/i || $column_type =~ /(blob|varbinary)/i )
            && driver_name eq 'Pg'
           )
   {
             ! $column_type =~ /(char|binary|text)$/i ) {
     $value;
   } elsif (( $column_type =~ /^bytea$/i || $column_type =~ /(blob|varbinary)/i )
            && driver_name eq 'Pg'
           )
   {
-    no strict 'subs';
-#    dbh->quote($value, { pg_type => PG_BYTEA() }); # doesn't work right
-    # Pg binary string quoting: convert each character to 3-digit octal prefixed with \\, 
-    # single-quote the whole mess, and put an "E" in front.
-    return ("E'" . join('', map { sprintf('\\\\%03o', ord($_)) } split(//, $value) ) . "'");
+    local $@;
+
+    eval { $value = dbh->quote($value, { pg_type => PG_BYTEA() }); };
+
+    if ( $@ && $@ =~ /Wide character/i ) {
+      warn 'Correcting malformed UTF-8 string for binary quote()'
+        if $DEBUG;
+      utf8::decode($value);
+      utf8::encode($value);
+      $value = dbh->quote($value, { pg_type => PG_BYTEA() });
+    }
+
+    $value;
   } else {
     dbh->quote($value);
   }
   } else {
     dbh->quote($value);
   }
@@ -2848,7 +3787,7 @@ the current database.
 
 =cut
 
 
 =cut
 
-sub str2time_sql { 
+sub str2time_sql {
   my $driver = shift || driver_name;
 
   return 'UNIX_TIMESTAMP('      if $driver =~ /^mysql/i;
   my $driver = shift || driver_name;
 
   return 'UNIX_TIMESTAMP('      if $driver =~ /^mysql/i;
@@ -2871,13 +3810,114 @@ the current database.
 
 =cut
 
 
 =cut
 
-sub str2time_sql_closing { 
+sub str2time_sql_closing {
   my $driver = shift || driver_name;
 
   return ' )::INTEGER ' if $driver =~ /^Pg/i;
   return ' ) ';
 }
 
   my $driver = shift || driver_name;
 
   return ' )::INTEGER ' if $driver =~ /^Pg/i;
   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 concatenated 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);
+  }
+
+}
+
+=item group_concat_sql COLUMN, DELIMITER
+
+Returns an SQL expression to concatenate an aggregate column, using
+GROUP_CONCAT() for mysql and array_to_string() and array_agg() for Pg.
+
+=cut
+
+sub group_concat_sql {
+  my ($col, $delim) = @_;
+  $delim = dbh->quote($delim);
+  if ( driver_name() =~ /^mysql/i ) {
+    # DISTINCT(foo) is valid as $col
+    return "GROUP_CONCAT($col SEPARATOR $delim)";
+  } else {
+    return "array_to_string(array_agg($col), $delim)";
+  }
+}
+
+=item midnight_sql DATE
+
+Returns an SQL expression to convert DATE (a unix timestamp) to midnight
+on that day in the system timezone, using the default driver name.
+
+=cut
+
+sub midnight_sql {
+  my $driver = driver_name;
+  my $expr = shift;
+  if ( $driver =~ /^mysql/i ) {
+    "UNIX_TIMESTAMP(DATE(FROM_UNIXTIME($expr)))";
+  }
+  else {
+    "EXTRACT( EPOCH FROM DATE(TO_TIMESTAMP($expr)) )";
+  }
+}
+
 =back
 
 =head1 BUGS
 =back
 
 =head1 BUGS
@@ -2934,4 +3974,3 @@ http://poop.sf.net/
 =cut
 
 1;
 =cut
 
 1;
-
Freeside billing, trouble ticketing, network monitoring and provisioning