RT# 31208 Docs $FS::Record::qsearch_qualify_columns
[freeside.git] / FS / FS / Record.pm
index dfc2abf..12e2d31 100644 (file)
@@ -1,12 +1,14 @@
 package FS::Record;
 
 use strict;
 package FS::Record;
 
 use strict;
+use charnames ':full';
 use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG
              %virtual_fields_cache
 use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG
              %virtual_fields_cache
-             $conf $conf_encryption $money_char $lat_lower $lon_upper
+             $money_char $lat_lower $lon_upper
              $me
              $nowarn_identical $nowarn_classload
              $me
              $nowarn_identical $nowarn_classload
-             $no_update_diff $no_check_foreign
+             $no_update_diff $no_history $qsearch_qualify_columns
+             $no_check_foreign
              @encrypt_payby
            );
 use Exporter;
              @encrypt_payby
            );
 use Exporter;
@@ -38,7 +40,9 @@ use Tie::IxHash;
 #export dbdef for now... everything else expects to find it here
 @EXPORT_OK = qw(
   dbh fields hfields qsearch qsearchs dbdef jsearch
 #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 regexp_sql not_regexp_sql concat_sql
+  str2time_sql str2time_sql_closing regexp_sql not_regexp_sql
+  concat_sql group_concat_sql
+  midnight_sql
 );
 
 $DEBUG = 0;
 );
 
 $DEBUG = 0;
@@ -47,6 +51,10 @@ $me = '[FS::Record]';
 $nowarn_identical = 0;
 $nowarn_classload = 0;
 $no_update_diff = 0;
 $nowarn_identical = 0;
 $nowarn_classload = 0;
 $no_update_diff = 0;
+$no_history = 0;
+
+$qsearch_qualify_columns = 0;
+
 $no_check_foreign = 0;
 
 my $rsa_module;
 $no_check_foreign = 0;
 
 my $rsa_module;
@@ -54,14 +62,20 @@ 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 {
 
   eval "use FS::Conf;";
   die $@ if $@;
 FS::UID->install_callback( sub {
 
   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;
   $money_char = $conf->config('money_char') || '$';
   my $nw_coords = $conf->exists('geocode-require_nw_coordinates');
   $lat_lower = $nw_coords ? 1 : -90;
@@ -92,7 +106,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;
@@ -123,6 +137,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');
@@ -160,14 +176,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 = {};
@@ -178,10 +194,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}='';
   }
 
@@ -189,6 +205,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;
@@ -272,6 +289,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 disabled 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
@@ -402,7 +424,7 @@ 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
@@ -457,7 +479,33 @@ 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`'.
+
 
   my $table = $stable[0];
   my $pkey = '';
 
   my $table = $stable[0];
   my $pkey = '';
@@ -476,7 +524,21 @@ sub qsearch {
   $sth->finish;
 
   my @return;
   $sth->finish;
 
   my @return;
-  if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
+  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);
+    }
+
+  }
+  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 ) {
@@ -498,12 +560,13 @@ 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
+    no warnings 'deprecated'; # XXX silence the warning for now
     if ( $conf_encryption 
     if ( $conf_encryption 
-         && eval 'defined(@FS::'. $table . '::encrypted_fields)' ) {
+         && 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') 
+          next if $field eq 'payinfo'
+                    && ($record->isa('FS::payinfo_transaction_Mixin')
                         || $record->isa('FS::payinfo_Mixin') )
                     && $record->payby
                     && !grep { $record->payby eq $_ } @encrypt_payby;
                         || $record->isa('FS::payinfo_Mixin') )
                     && $record->payby
                     && !grep { $record->payby eq $_ } @encrypt_payby;
@@ -522,72 +585,283 @@ sub qsearch {
   return @return;
 }
 
   return @return;
 }
 
-## makes this easier to read
+=item _query
+
+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
+    ) {
+
+      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;
+
+    }
+
+    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};
+
+  return {
+    statement => $statement,
+    bind_type => \@bind_type,
+    value     => \@value,
+    table     => $result_table,
+    cache     => $cache,
+  };
+}
+
+# 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;
+    }
+
+    # 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;
 
-   ## 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 ? "$table.$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 '!=' ) {
           }
         }
       } elsif ( $op eq '!=' ) {
-        qq-( $column IS NULL OR $column != ? )-;
+        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
@@ -625,7 +899,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
 
@@ -708,7 +982,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 {
     '';
   }
 }
     '';
   }
 }
@@ -723,7 +997,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;
@@ -765,7 +1039,7 @@ sub AUTOLOAD {
     confess "errant AUTOLOAD $field for $self (no args)"
       unless blessed($self) && $self->can('getfield');
     $self->getfield($field);
     confess "errant AUTOLOAD $field for $self (no args)"
       unless blessed($self) && $self->can('getfield');
     $self->getfield($field);
-  }    
+  }
 }
 
 # efficient
 }
 
 # efficient
@@ -776,7 +1050,7 @@ sub AUTOLOAD {
 #    $_[0]->setfield($field, $_[1]);
 #  } else {
 #    $_[0]->getfield($field);
 #    $_[0]->setfield($field, $_[1]);
 #  } else {
 #    $_[0]->getfield($field);
-#  }    
+#  }
 #}
 
 =item hash
 #}
 
 =item hash
@@ -793,7 +1067,7 @@ sub hash {
   my($self) = @_;
   confess $self. ' -> hash: Hash attribute is undefined'
     unless defined($self->{'Hash'});
   my($self) = @_;
   confess $self. ' -> hash: Hash attribute is undefined'
     unless defined($self->{'Hash'});
-  %{ $self->{'Hash'} }; 
+  %{ $self->{'Hash'} };
 }
 
 =item hashref
 }
 
 =item hashref
@@ -928,15 +1202,14 @@ 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') {
-      next if $field eq 'payinfo' 
-                && ($self->isa('FS::payinfo_transaction_Mixin') 
+      next if $field eq 'payinfo'
+                && ($self->isa('FS::payinfo_transaction_Mixin')
                     || $self->isa('FS::payinfo_Mixin') )
                 && $self->payby
                 && !grep { $self->payby eq $_ } @encrypt_payby;
                     || $self->isa('FS::payinfo_Mixin') )
                 && $self->payby
                 && !grep { $self->payby eq $_ } @encrypt_payby;
@@ -970,7 +1243,7 @@ sub insert {
 
   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';
@@ -980,7 +1253,7 @@ sub insert {
   # 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' ) {
@@ -1029,7 +1302,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?)";
 
     }
@@ -1039,7 +1312,7 @@ sub insert {
   }
 
   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 {
@@ -1053,7 +1326,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});
@@ -1112,7 +1385,7 @@ sub delete {
 
   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';
@@ -1120,7 +1393,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;
-  
+
   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)
@@ -1170,16 +1443,15 @@ 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') 
+      next if $field eq 'payinfo'
+                && ($new->isa('FS::payinfo_transaction_Mixin')
                     || $new->isa('FS::payinfo_Mixin') )
                 && $new->payby
                 && !grep { $new->payby eq $_ } @encrypt_payby;
                     || $new->isa('FS::payinfo_Mixin') )
                 && $new->payby
                 && !grep { $new->payby eq $_ } @encrypt_payby;
@@ -1191,7 +1463,7 @@ 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 ) {
     carp "[warning]$me ". ref($new)."->replace ".
            ( $primary_key ? "$primary_key ".$new->get($primary_key) : '' ).
   unless (keys(%diff) || $no_update_diff ) {
     carp "[warning]$me ". ref($new)."->replace ".
            ( $primary_key ? "$primary_key ".$new->get($primary_key) : '' ).
@@ -1202,7 +1474,7 @@ sub replace {
 
   my $statement = "UPDATE ". $old->table. " SET ". join(', ',
     map {
 
   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 ',
@@ -1252,7 +1524,7 @@ sub replace {
 
   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';
@@ -1264,7 +1536,7 @@ sub replace {
 
   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});
@@ -1308,7 +1580,7 @@ non-custom fields, foreign keys, etc., and call this method via $self->SUPER::ch
 
 =cut
 
 
 =cut
 
-sub check { 
+sub check {
     my $self = shift;
     foreach my $field ($self->virtual_fields) {
         my $error = $self->ut_textn($field);
     my $self = shift;
     foreach my $field ($self->virtual_fields) {
         my $error = $self->ut_textn($field);
@@ -1319,7 +1591,7 @@ sub check {
 
 =item virtual_fields [ TABLE ]
 
 
 =item virtual_fields [ TABLE ]
 
-Returns a list of virtual fields defined for the table.  This should not 
+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
 be exported, and should only be called as an instance or class method.
 
 =cut
@@ -1364,7 +1636,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
@@ -1413,13 +1685,15 @@ 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
 
+# uploaded_files is kind of bizarre; fix that some time
+
 use Storable qw(thaw);
 use Data::Dumper;
 use MIME::Base64;
 use Storable qw(thaw);
 use Data::Dumper;
 use MIME::Base64;
@@ -1430,9 +1704,15 @@ sub process_batch_import {
   my @pass_params = $opt->{params} ? @{ $opt->{params} } : ();
   my %formats = %{ $opt->{formats} };
 
   my @pass_params = $opt->{params} ? @{ $opt->{params} } : ();
   my %formats = %{ $opt->{formats} };
 
-  my $param = thaw(decode_base64(shift));
+  my $param = shift;
+  # because some job-spawning code (JSRPC) pre-freezes the arguments,
+  # and then the 'frozen' attribute doesn't get set, and thus $job->args
+  # doesn't know to thaw them, we have to do this everywhere.
+  if (!ref $param) {
+    $param = thaw(decode_base64($param));
+  }
   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";
 
@@ -1450,7 +1730,9 @@ sub process_batch_import {
     format_sep_chars           => $opt->{format_sep_chars},
     format_fixedlength_formats => $opt->{format_fixedlength_formats},
     format_xml_formats         => $opt->{format_xml_formats},
     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_row_callbacks       => $opt->{format_row_callbacks},
+    format_hash_callbacks      => $opt->{format_hash_callbacks},
     #per-import
     job                        => $job,
     file                       => $file,
     #per-import
     job                        => $job,
     file                       => $file,
@@ -1459,7 +1741,9 @@ sub process_batch_import {
     params                     => { map { $_ => $param->{$_} } @pass_params },
     #?
     default_csv                => $opt->{default_csv},
     params                     => { map { $_ => $param->{$_} } @pass_params },
     #?
     default_csv                => $opt->{default_csv},
+    preinsert_callback         => $opt->{preinsert_callback},
     postinsert_callback        => $opt->{postinsert_callback},
     postinsert_callback        => $opt->{postinsert_callback},
+    insert_args_callback       => $opt->{insert_args_callback},
   );
 
   if ( $opt->{'batch_namecol'} ) {
   );
 
   if ( $opt->{'batch_namecol'} ) {
@@ -1496,6 +1780,8 @@ Class method for batch imports.  Available params:
 
 =item format_row_callbacks
 
 
 =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 fields - Alternate way to specify import, specifying import fields directly as a listref
 
 =item preinsert_callback
@@ -1532,8 +1818,12 @@ sub batch_import {
   my $file    = $param->{file};
   my $params  = $param->{params} || {};
 
   my $file    = $param->{file};
   my $params  = $param->{params} || {};
 
-  my( $type, $header, $sep_char, $fixedlength_format, 
-      $xml_format, $row_callback, @fields );
+  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'}
 
   my $postinsert_callback = '';
   $postinsert_callback = $param->{'postinsert_callback'}
@@ -1541,6 +1831,9 @@ sub batch_import {
   my $preinsert_callback = '';
   $preinsert_callback = $param->{'preinsert_callback'}
          if $param->{'preinsert_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'} ) {
 
 
   if ( $param->{'format'} ) {
 
@@ -1566,16 +1859,31 @@ sub batch_import {
         ? $param->{'format_fixedlength_formats'}{ $param->{'format'} }
         : '';
 
         ? $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'} }
         : '';
 
     $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'} }
         : '';
 
     $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'} ) {
     @fields = @{ $formats->{ $format } };
 
   } elsif ( $param->{'fields'} ) {
@@ -1585,6 +1893,7 @@ sub batch_import {
     $sep_char = ',';
     $fixedlength_format = '';
     $row_callback = '';
     $sep_char = ',';
     $fixedlength_format = '';
     $row_callback = '';
+    $hash_callback = '';
     @fields = @{ $param->{'fields'} };
 
   } else {
     @fields = @{ $param->{'fields'} };
 
   } else {
@@ -1610,22 +1919,22 @@ sub batch_import {
   my $count;
   my $parser;
   my @buffer = ();
   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 = Parse::FixedLength->new($fixedlength_format);
+      $parser = Parse::FixedLength->new($fixedlength_format, $parser_opt);
 
 
-    }
-    else {
+    } else {
       die "Unknown file type $type\n";
     }
 
       die "Unknown file type $type\n";
     }
 
@@ -1651,7 +1960,9 @@ sub batch_import {
     $count++;
 
     $row = $header || 0;
     $count++;
 
     $row = $header || 0;
+
   } elsif ( $type eq 'xml' ) {
   } elsif ( $type eq 'xml' ) {
+
     # FS::pay_batch
     eval "use XML::Simple;";
     die $@ if $@;
     # FS::pay_batch
     eval "use XML::Simple;";
     die $@ if $@;
@@ -1667,6 +1978,26 @@ sub batch_import {
     $rows = $rows->{$_} foreach @$xmlrow;
     $rows = [ $rows ] if ref($rows) ne 'ARRAY';
     $count = @buffer = @$rows;
     $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";
   }
@@ -1710,6 +2041,7 @@ sub batch_import {
   while (1) {
 
     my @columns = ();
   while (1) {
 
     my @columns = ();
+    my %hash = %$params;
     if ( $type eq 'csv' ) {
 
       last unless scalar(@buffer);
     if ( $type eq 'csv' ) {
 
       last unless scalar(@buffer);
@@ -1718,7 +2050,7 @@ sub batch_import {
       next if $line =~ /^\s*$/; #skip empty lines
 
       $line = &{$row_callback}($line) if $row_callback;
       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 {
       next if $line =~ /^\s*$/; #skip empty lines
 
       $parser->parse($line) or do {
@@ -1746,21 +2078,32 @@ sub batch_import {
       #warn $z++. ": $_\n" for @columns;
 
     } elsif ( $type eq 'xml' ) {
       #warn $z++. ": $_\n" for @columns;
 
     } elsif ( $type eq 'xml' ) {
+
       # $parser = [ 'Column0Key', 'Column1Key' ... ]
       last unless scalar(@buffer);
       my $row = shift @buffer;
       @columns = @{ $row }{ @$parser };
       # $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;
@@ -1771,6 +2114,13 @@ 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 $table   = $param->{table};
     my $class = "FS::$table";
 
@@ -1801,7 +2151,12 @@ sub batch_import {
       next if exists $param->{skiprow} && $param->{skiprow};
     }
 
       next if exists $param->{skiprow} && $param->{skiprow};
     }
 
-    my $error = $record->insert;
+    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;
@@ -1832,7 +2187,7 @@ sub batch_import {
     return "Empty file!";
   }
 
     return "Empty file!";
   }
 
-  $dbh->commit or die $dbh->errstr if $oldAutoCommit;;
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   ''; #no error
 
 
   ''; #no error
 
@@ -1851,7 +2206,7 @@ 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') && $self->table ne 'banned_pay' ) {
+  if ( $conf_encryption && $self->table ne 'banned_pay' ) {
     @fields = grep { $_ ne 'payinfo' } @fields;
   }
 
     @fields = grep { $_ ne 'payinfo' } @fields;
   }
 
@@ -1860,14 +2215,18 @@ sub _h_statement {
   "INSERT INTO h_". $self->table. " ( ".
       join(', ', qw(history_date history_user history_action), @fields ).
     ") VALUES (".
   "INSERT INTO h_". $self->table. " ( ".
       join(', ', qw(history_date history_user history_action), @fields ).
     ") VALUES (".
-      join(', ', $time, dbh->quote(getotaker()), dbh->quote($action), @values).
+      join(', ', $time,
+                 dbh->quote($FS::CurrentUser::CurrentUser->username),
+                 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
@@ -2041,6 +2400,35 @@ sub ut_numbern {
   '';
 }
 
   '';
 }
 
+=item ut_decimal COLUMN[, DIGITS]
+
+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
+
+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
 =item ut_money COLUMN
 
 Check/untaint monetary numbers.  May be negative.  Set to 0 if null.  If there
@@ -2050,11 +2438,18 @@ is an error, returns the error, otherwise returns false.
 
 sub ut_money {
   my($self,$field)=@_;
 
 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);
+
+  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);
+  }
+
   '';
 }
 
   '';
 }
 
@@ -2077,7 +2472,7 @@ sub ut_moneyn {
 =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.
 
@@ -2088,8 +2483,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ô \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>$money_char]+)$/
+    =~ /^([\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);
@@ -2135,7 +2532,7 @@ 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);
   '';
     or return "Illegal (alphanumeric) $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
@@ -2150,7 +2547,7 @@ an error, returns the error, otherwise returns false.
 
 sub ut_alphasn {
   my($self,$field)=@_;
 
 sub ut_alphasn {
   my($self,$field)=@_;
-  $self->getfield($field) =~ /^([\w ]*)$/ 
+  $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);
   '';
@@ -2176,8 +2573,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
 
@@ -2368,6 +2765,10 @@ sub ut_coord {
   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 (
@@ -2420,10 +2821,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
 
@@ -2431,11 +2831,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
@@ -2448,12 +2864,31 @@ May not be null.
 sub ut_name {
   my( $self, $field ) = @_;
 #  warn "ut_name allowed alphanumerics: +(sort grep /\w/, map { chr() } 0..255), "\n";
 sub ut_name {
   my( $self, $field ) = @_;
 #  warn "ut_name allowed alphanumerics: +(sort grep /\w/, map { chr() } 0..255), "\n";
-  $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.
@@ -2479,6 +2914,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*$/
@@ -2507,7 +2949,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)));
     }
@@ -2562,6 +3004,76 @@ sub ut_enumn {
     : '';
 }
 
     : '';
 }
 
+=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
 
 
 =item ut_foreign_key COLUMN FOREIGN_TABLE FOREIGN_COLUMN
 
@@ -2626,6 +3138,22 @@ sub ut_agentnum_acl {
 
 }
 
 
 }
 
+=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 ]
 
 This is a wrapper for real_fields.  Code that called
 =item fields [ TABLE ]
 
 This is a wrapper for real_fields.  Code that called
@@ -2658,9 +3186,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;
@@ -2708,7 +3236,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);
@@ -2724,8 +3252,8 @@ sub loadRSA {
     #Initialize the Module
     $rsa_module = 'Crypt::OpenSSL::RSA'; # The Default
 
     #Initialize the Module
     $rsa_module = 'Crypt::OpenSSL::RSA'; # The Default
 
-    if ($conf->exists('encryptionmodule') && $conf->config('encryptionmodule') ne '') {
-      $rsa_module = $conf->config('encryptionmodule');
+    if ($conf_encryptionmodule && $conf_encryptionmodule ne '') {
+      $rsa_module = $conf_encryptionmodule;
     }
 
     if (!$rsa_loaded) {
     }
 
     if (!$rsa_loaded) {
@@ -2733,15 +3261,13 @@ sub loadRSA {
        $rsa_loaded++;
     }
     # Initialize Encryption
        $rsa_loaded++;
     }
     # Initialize Encryption
-    if ($conf->exists('encryptionpublickey') && $conf->config('encryptionpublickey') ne '') {
-      my $public_key = join("\n",$conf->config('encryptionpublickey'));
-      $rsa_encrypt = $rsa_module->new_public_key($public_key);
+    if ($conf_encryptionpublickey && $conf_encryptionpublickey ne '') {
+      $rsa_encrypt = $rsa_module->new_public_key($conf_encryptionpublickey);
     }
     }
-    
+
     # Intitalize Decryption
     # Intitalize Decryption
-    if ($conf->exists('encryptionprivatekey') && $conf->config('encryptionprivatekey') ne '') {
-      my $private_key = join("\n",$conf->config('encryptionprivatekey'));
-      $rsa_decrypt = $rsa_module->new_private_key($private_key);
+    if ($conf_encryptionprivatekey && $conf_encryptionprivatekey ne '') {
+      $rsa_decrypt = $rsa_module->new_private_key($conf_encryptionprivatekey);
     }
 }
 
     }
 }
 
@@ -2804,10 +3330,10 @@ sub scalar_sql {
   defined($scalar) ? $scalar : '';
 }
 
   defined($scalar) ? $scalar : '';
 }
 
-=item count [ WHERE ]
+=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 
+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
 associated table.
 
 =cut
@@ -2817,7 +3343,23 @@ sub count {
   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;
   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);
+  $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
 }
 
 =back
@@ -2828,7 +3370,7 @@ sub count {
 
 =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
@@ -2843,7 +3385,7 @@ sub real_fields {
 
 =item pvf FIELD_NAME
 
 
 =item pvf FIELD_NAME
 
-Returns the FS::part_virtual_field object corresponding to a field in the 
+Returns the FS::part_virtual_field object corresponding to a field in the
 record (specified by FIELD_NAME).
 
 =cut
 record (specified by FIELD_NAME).
 
 =cut
@@ -2856,7 +3398,7 @@ sub pvf {
     my $concat = [ "'cf_'", "name" ];
     return qsearchs({   table   =>  'part_virtual_field',
                         hashref =>  { dbtable => $self->table,
     my $concat = [ "'cf_'", "name" ];
     return qsearchs({   table   =>  'part_virtual_field',
                         hashref =>  { dbtable => $self->table,
-                                      name    => $name 
+                                      name    => $name
                                     },
                         select  =>  'vfieldpart, dbtable, length, label, '.concat_sql($concat).' as name',
                     });
                                     },
                         select  =>  'vfieldpart, dbtable, length, label, '.concat_sql($concat).' as name',
                     });
@@ -2878,6 +3420,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;
@@ -2888,18 +3432,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);
   }
@@ -2956,7 +3508,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;
@@ -2979,7 +3531,7 @@ the current database.
 
 =cut
 
 
 =cut
 
-sub str2time_sql_closing { 
+sub str2time_sql_closing {
   my $driver = shift || driver_name;
 
   return ' )::INTEGER ' if $driver =~ /^Pg/i;
   my $driver = shift || driver_name;
 
   return ' )::INTEGER ' if $driver =~ /^Pg/i;
@@ -3030,7 +3582,7 @@ sub not_regexp_sql {
 
 =item concat_sql [ DRIVER_NAME ] ITEMS_ARRAYREF
 
 
 =item concat_sql [ DRIVER_NAME ] ITEMS_ARRAYREF
 
-Returns the items concatendated based on database type, using "CONCAT()" for
+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
 mysql and " || " for Pg and other databases.
 
 You can pass an optional driver name such as "Pg", "mysql" or
@@ -3051,6 +3603,42 @@ sub concat_sql {
 
 }
 
 
 }
 
+=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
@@ -3107,4 +3695,3 @@ http://poop.sf.net/
 =cut
 
 1;
 =cut
 
 1;
-