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 0810a7e..f4bf2a2 100644 (file)
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -2,9 +2,11 @@ package FS::Record;
 use base qw( Exporter );
 
 use strict;
 use base qw( Exporter );
 
 use strict;

+use charnames ':full';

 use vars qw( $AUTOLOAD
 use vars qw( $AUTOLOAD

-             %virtual_fields_cache %fk_method_cache
-             $money_char $lat_lower $lon_upper
+             %virtual_fields_cache %fk_method_cache $fk_table_cache
+             %virtual_fields_hash_cache $money_char $lat_lower $lon_upper
+             $use_placeholders

            );
 use Carp qw(carp cluck croak confess);
 use Scalar::Util qw( blessed );
            );
 use Carp qw(carp cluck croak confess);
 use Scalar::Util qw( blessed );


@@ -16,12 +18,14 @@ use DBIx::DBSchema 0.43; #0.43 for foreign keys
 use Locale::Country;
 use Locale::Currency;
 use NetAddr::IP; # for validation
 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::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 Email::Valid;

 
 use FS::part_virtual_field;
 
 
 use FS::part_virtual_field;
 


@@ -34,34 +38,40 @@ 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
   dbh fields hfields qsearch qsearchs dbdef jsearch
   str2time_sql str2time_sql_closing regexp_sql not_regexp_sql
   concat_sql group_concat_sql

-  midnight_sql
+  midnight_sql fk_methods_init

 );
 
 our $DEBUG = 0;
 our $me = '[FS::Record]';
 
 );
 
 our $DEBUG = 0;
 our $me = '[FS::Record]';
 

+$use_placeholders = 0;
+

 our $nowarn_identical = 0;
 our $nowarn_classload = 0;
 our $no_update_diff = 0;
 our $no_history = 0;
 
 our $nowarn_identical = 0;
 our $nowarn_classload = 0;
 our $no_update_diff = 0;
 our $no_history = 0;
 

-our $qsearch_qualify_columns = 0;
+our $qsearch_qualify_columns = 1;

 
 our $no_check_foreign = 1; #well, not inefficiently in perl by default anymore
 
 
 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;
 
 our $conf = '';
 our $conf_encryption = '';
 my $rsa_encrypt;
 my $rsa_decrypt;
 
 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;


@@ -76,9 +86,7 @@ FS::UID->install_callback( sub {
     eval "sub PG_BYTEA { die 'guru meditation #9: calling PG_BYTEA when not running Pg?'; }";
   }
 
     eval "sub PG_BYTEA { die 'guru meditation #9: calling PG_BYTEA when not running Pg?'; }";
   }
 

-  foreach my $table ( dbdef->tables ) {
-    $fk_method_cache{$table} = fk_methods($table);
-  }
+  #fk_methods_init();

 
 } );
 
 
 } );
 


@@ -96,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;


@@ -166,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 = {};


@@ -184,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}='';
   }
 


@@ -195,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;


@@ -278,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


@@ -399,10 +413,17 @@ sub qsearch {
     my @real_fields = grep exists($record->{$_}), real_fields($table);
 
     my $statement .= "SELECT $select FROM $stable";
     my @real_fields = grep exists($record->{$_}), real_fields($table);
 
     my $statement .= "SELECT $select FROM $stable";

-    $statement .= " $addl_from" if $addl_from;
+    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 ',
     if ( @real_fields ) {
       $statement .= ' WHERE '. join(' AND ',

-        get_real_fields($table, $record, \@real_fields));
+        get_real_fields($table, $record, \@real_fields, $alias_main));

     }
 
     $statement .= " $extra_sql" if defined($extra_sql);
     }
 
     $statement .= " $extra_sql" if defined($extra_sql);


@@ -473,6 +494,26 @@ sub qsearch {
     croak $error;
   }
 
     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 = '';
   $table = '' if grep { $_ ne $table } @stable;
   my $table = $stable[0];
   my $pkey = '';
   $table = '' if grep { $_ ne $table } @stable;


@@ -489,8 +530,24 @@ sub qsearch {
 
   $sth->finish;
 
 
   $sth->finish;
 

+  #below was refactored out to _from_hashref, this should use it at some point
+

   my @return;
   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 ) {


@@ -512,12 +569,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

-    if ( $conf_encryption 
+    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') {
          && 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;


@@ -638,7 +696,7 @@ sub _query {
     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


@@ -721,12 +779,12 @@ sub _from_hashref {
 
     # 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 
+    if ( $conf_encryption

          && eval '@FS::'. $table . '::encrypted_fields' ) {
       foreach my $record (@return) {
         foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
          && 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;


@@ -749,14 +807,16 @@ sub get_real_fields {
   my $table = shift;
   my $record = shift;
   my $real_fields = shift;
   my $table = shift;
   my $record = shift;
   my $real_fields = shift;

+  my $alias_main = shift; # defaults to undef
+  $alias_main ||= $table;

 
   ## could be optimized more for readability
 
   ## could be optimized more for readability

-  return ( 
+  return (

     map {
 
       my $op = '=';
       my $column = $_;
     map {
 
       my $op = '=';
       my $column = $_;

-      my $table_column = $qsearch_qualify_columns ? "$table.$column" : $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);


@@ -812,7 +872,7 @@ sub get_real_fields {
       }
 
     } @{ $real_fields }
       }
 
     } @{ $real_fields }

-  );  
+  );

 }
 
 =item by_key PRIMARY_KEY_VALUE
 }
 
 =item by_key PRIMARY_KEY_VALUE


@@ -850,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
 


@@ -876,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]) : ();


@@ -933,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 {

     '';
   }
 }
     '';
   }
 }


@@ -948,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;


@@ -969,7 +1030,7 @@ sub exists {
   exists($self->{Hash}->{$field});
 }
 
   exists($self->{Hash}->{$field});
 }
 

-=item AUTLOADED METHODS
+=item AUTOLOADED METHODS

 
 $record->column is a synonym for $record->get('column');
 
 
 $record->column is a synonym for $record->get('column');
 


@@ -991,10 +1052,8 @@ sub AUTOLOAD {
   confess "errant AUTOLOAD $field for $self (arg $value)"
     unless blessed($self) && $self->can('setfield');
 
   confess "errant AUTOLOAD $field for $self (arg $value)"
     unless blessed($self) && $self->can('setfield');
 

-  #$fk_method_cache{$self->table} ||= fk_methods($self->table);
-  if ( exists($fk_method_cache{$self->table}->{$field}) ) {
+  if ( my $fk_info = get_fk_method($self->table, $field) ) {

 
 

-    my $fk_info = $fk_method_cache{$self->table}->{$field};

     my $method = $fk_info->{method} || 'qsearchs';
     my $table = $fk_info->{table} || $field;
     my $column = $fk_info->{column};
     my $method = $fk_info->{method} || 'qsearchs';
     my $table = $fk_info->{table} || $field;
     my $column = $fk_info->{column};


@@ -1009,7 +1068,7 @@ sub AUTOLOAD {
     my %search = ( $foreign_column => $pkey_value );
 
     # FS::Record->$method() ?  they're actually just subs :/
     my %search = ( $foreign_column => $pkey_value );
 
     # FS::Record->$method() ?  they're actually just subs :/

-    if ( $method eq 'qsearchs' ) { 
+    if ( $method eq 'qsearchs' ) {

       return $pkey_value ? qsearchs( $table, \%search ) : '';
     } elsif ( $method eq 'qsearch' ) {
       return $pkey_value ? qsearch(  $table, \%search ) : ();
       return $pkey_value ? qsearchs( $table, \%search ) : '';
     } elsif ( $method eq 'qsearch' ) {
       return $pkey_value ? qsearch(  $table, \%search ) : ();


@@ -1023,7 +1082,7 @@ sub AUTOLOAD {
     $self->setfield($field,$value);
   } else {
     $self->getfield($field);
     $self->setfield($field,$value);
   } else {
     $self->getfield($field);

-  }    
+  }

 }
 
 # efficient (also, old, doesn't support FK stuff)
 }
 
 # efficient (also, old, doesn't support FK stuff)


@@ -1034,9 +1093,40 @@ sub AUTOLOAD {
 #    $_[0]->setfield($field, $_[1]);
 #  } else {
 #    $_[0]->getfield($field);
 #    $_[0]->setfield($field, $_[1]);
 #  } else {
 #    $_[0]->getfield($field);

-#  }    
+#  }

 #}
 
 #}
 

+# 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.
+
+# 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
+
+sub get_fk_method {
+  my ($table, $field) = @_;
+
+  # maybe should only load one table at a time?
+  fk_methods_init() unless exists($fk_method_cache{$table});
+
+  if ( exists($fk_method_cache{$table}) and
+       exists($fk_method_cache{$table}{$field}) ) {
+    return $fk_method_cache{$table}{$field};
+  } else {
+    return undef;
+  }
+
+}
+
+sub fk_methods_init {
+  warn "[fk_methods_init]\n" if $DEBUG;
+  foreach my $table ( dbdef->tables ) {
+    $fk_method_cache{$table} = fk_methods($table);
+  }
+}
+

 sub fk_methods {
   my $table = shift;
 
 sub fk_methods {
   my $table = shift;
 


@@ -1074,11 +1164,15 @@ sub fk_methods {
   #  (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?)
   #  (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?)

-  foreach my $f_table ( dbdef->tables ) {
-    foreach my $fk (dbdef->table($f_table)->foreign_keys) {
-
-      next unless $fk->table eq $table;
-
+  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)
       my $method = '';
       if ( scalar( @{$fk->columns} ) == 1 ) {
         if (    ! defined($fk->references)


@@ -1101,9 +1195,6 @@ sub fk_methods {
         }
 
       }
         }
 
       }

-
-    }
-

   }
 
   \%hash;
   }
 
   \%hash;


@@ -1123,7 +1214,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


@@ -1279,15 +1370,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;


@@ -1301,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' ) {


@@ -1380,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?)";
 
     }


@@ -1404,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});


@@ -1463,7 +1576,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';


@@ -1471,7 +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;

-  
+

   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)


@@ -1521,16 +1634,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;


@@ -1542,7 +1654,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) : '' ).


@@ -1553,7 +1665,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 ',


@@ -1603,7 +1715,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';


@@ -1615,7 +1727,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});


@@ -1659,7 +1771,7 @@ non-custom fields, etc., and call this method via $self->SUPER::check.
 
 =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);


@@ -1670,7 +1782,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


@@ -1699,6 +1811,41 @@ sub virtual_fields {
 
 }
 
 
 }
 

+=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
 
 Processes a batch import as a queued JSRPC job
 =item process_batch_import JOB OPTIONS_HASHREF PARAMS
 
 Processes a batch import as a queued JSRPC job


@@ -1764,8 +1911,8 @@ format_types).
 
 =back
 
 
 =back
 

-PARAMS is a hashref (or base64-encoded Storable hashref) containing the 
-POSTed data.  It must contain the field "uploaded files", generated by 
+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".
 
 /elements/file-upload.html and containing the list of uploaded files.
 Currently only supports a single file named "file".
 


@@ -1780,7 +1927,7 @@ sub process_batch_import {
   my %formats = %{ $opt->{formats} };
 
   warn Dumper($param) if $DEBUG;
   my %formats = %{ $opt->{formats} };
 
   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";
 


@@ -1800,6 +1947,7 @@ sub process_batch_import {
     format_xml_formats         => $opt->{format_xml_formats},
     format_asn_formats         => $opt->{format_asn_formats},
     format_row_callbacks       => $opt->{format_row_callbacks},
     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,
     #per-import
     job                        => $job,
     file                       => $file,


@@ -1808,7 +1956,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'} ) {


@@ -1845,6 +1995,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


@@ -1887,7 +2039,7 @@ sub batch_import {
 
   my( $type, $header, $sep_char,
       $fixedlength_format, $xml_format, $asn_format,
 
   my( $type, $header, $sep_char,
       $fixedlength_format, $xml_format, $asn_format,

-      $parser_opt, $row_callback, @fields );
+      $parser_opt, $row_callback, $hash_callback, @fields );

 
   my $postinsert_callback = '';
   $postinsert_callback = $param->{'postinsert_callback'}
 
   my $postinsert_callback = '';
   $postinsert_callback = $param->{'postinsert_callback'}


@@ -1895,6 +2047,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'} ) {
 


@@ -1940,6 +2095,11 @@ sub batch_import {
         ? $param->{'format_row_callbacks'}{ $param->{'format'} }
         : '';
 
         ? $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'} ) {


@@ -1949,6 +2109,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 {


@@ -2092,6 +2253,7 @@ sub batch_import {
   #my $job     = $param->{job};
   my $line;
   my $imported = 0;
   #my $job     = $param->{job};
   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( $last, $min_sec ) = ( time, 5 ); #progressbar foo
   while (1) {
 


@@ -2105,7 +2267,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 {


@@ -2158,7 +2320,7 @@ sub batch_import {
     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;


@@ -2174,6 +2336,8 @@ sub batch_import {
       $hash{custnum} = $2;
     }
 
       $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";
 


@@ -2192,6 +2356,7 @@ sub batch_import {
       }
       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} );
 
     if ( $preinsert_callback ) {
     next if exists( $param->{skiprow} );
 
     if ( $preinsert_callback ) {


@@ -2204,7 +2369,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;


@@ -2232,7 +2402,8 @@ sub batch_import {
 
   unless ( $imported || $param->{empty_ok} ) {
     $dbh->rollback if $oldAutoCommit;
 
   unless ( $imported || $param->{empty_ok} ) {
     $dbh->rollback if $oldAutoCommit;

-    return "Empty file!";
+    # freeside-cdr-conexiant-import is sensitive to the text of this message
+    return $unique_skip ? "All records in file were previously imported" : "Empty file!";

   }
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   }
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;


@@ -2254,7 +2425,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;
   }
 


@@ -2274,7 +2445,7 @@ sub _h_statement {
 
 =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


@@ -2445,7 +2616,7 @@ sub ut_numbern {
 
 =item ut_decimal COLUMN[, DIGITS]
 
 
 =item ut_decimal COLUMN[, DIGITS]
 

-Check/untaint decimal numbers (up to DIGITS decimal places.  If there is an 
+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]
 error, returns the error, otherwise returns false.
 
 =item ut_decimaln COLUMN[, DIGITS]


@@ -2550,7 +2721,7 @@ sub ut_currency {
 =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.
 


@@ -2564,7 +2735,7 @@ sub ut_text {
   # \p{Word} = alphanumerics, marks (diacritics), and connectors
   # see perldoc perluniprops
   $self->getfield($field)
   # \p{Word} = alphanumerics, marks (diacritics), and connectors
   # see perldoc perluniprops
   $self->getfield($field)

-    =~ /^([\p{Word} \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>$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);


@@ -2610,7 +2781,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);
   '';


@@ -2625,7 +2796,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);
   '';


@@ -2751,11 +2922,9 @@ to 127.0.0.1.
 sub ut_ip {
   my( $self, $field ) = @_;
   $self->setfield($field, '127.0.0.1') if $self->getfield($field) eq '::1';
 sub ut_ip {
   my( $self, $field ) = @_;
   $self->setfield($field, '127.0.0.1') if $self->getfield($field) eq '::1';

-  $self->getfield($field) =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/
-    or return "Illegal (IP address) $field: ". $self->getfield($field);
-  for ( $1, $2, $3, $4 ) { return "Illegal (IP address) $field" if $_ > 255; }
-  $self->setfield($field, "$1.$2.$3.$4");
-  '';
+  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


@@ -2783,8 +2952,9 @@ Check/untaint IPv4 or IPv6 address.
 
 sub ut_ip46 {
   my( $self, $field ) = @_;
 
 sub ut_ip46 {
   my( $self, $field ) = @_;

-  my $ip = NetAddr::IP->new($self->getfield($field))
-    or return "Illegal (IP address) $field: ".$self->getfield($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 '';
 }
   $self->setfield($field, lc($ip->addr));
   return '';
 }


@@ -2804,6 +2974,21 @@ sub ut_ip46n {
   $self->ut_ip46($field);
 }
 
   $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.


@@ -2843,6 +3028,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 (


@@ -2937,12 +3126,11 @@ May not be null.
 
 sub ut_name {
   my( $self, $field ) = @_;
 
 sub ut_name {
   my( $self, $field ) = @_;

-#  warn "ut_name allowed alphanumerics: +(sort grep /\w/, map { chr() } 0..255), "\n";

   $self->getfield($field) =~ /^([\p{Word} \,\.\-\']+)$/
     or return gettext('illegal_name'). " $field: ". $self->getfield($field);
   my $name = $1;
   $self->getfield($field) =~ /^([\p{Word} \,\.\-\']+)$/
     or return gettext('illegal_name'). " $field: ". $self->getfield($field);
   my $name = $1;

-  $name =~ s/^\s+//; 
-  $name =~ s/\s+$//; 
+  $name =~ s/^\s+//;
+  $name =~ s/\s+$//;

   $name =~ s/\s+/ /g;
   $self->setfield($field, $name);
   '';
   $name =~ s/\s+/ /g;
   $self->setfield($field, $name);
   '';


@@ -2988,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*$/


@@ -3016,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)));
     }


@@ -3071,6 +3266,60 @@ 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
 =item ut_flag COLUMN
 
 Check/untaint a column if it contains either an empty string or 'Y'.  This


@@ -3151,6 +3400,52 @@ sub ut_agentnum_acl {
 
 }
 
 
 }
 

+
+=item ut_email COLUMN
+
+Check column contains a valid E-Mail address
+
+=cut
+
+sub ut_email {
+  my ( $self, $field ) = @_;
+  Email::Valid->address( $self->getfield( $field ) )
+    ? ''
+    : "Illegal (email) field $field: ". $self->getfield( $field );
+}
+
+=item ut_emailn COLUMN
+
+Check column contains a valid E-Mail address
+
+May be null
+
+=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 ]
 
 This is a wrapper for real_fields.  Code that called
 =item fields [ TABLE ]
 
 This is a wrapper for real_fields.  Code that called


@@ -3185,7 +3480,7 @@ sub encrypt {
   my ($self, $value) = @_;
   my $encrypted = $value;
 
   my ($self, $value) = @_;
   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;


@@ -3228,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);


@@ -3240,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('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('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('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


@@ -3326,8 +3611,8 @@ sub scalar_sql {
 
 =item count [ WHERE [, PLACEHOLDER ...] ]
 
 
 =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


@@ -3364,7 +3649,7 @@ sub row_exists {
 
 =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


@@ -3379,7 +3664,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


@@ -3392,7 +3677,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',
                     });


@@ -3426,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);
   }


@@ -3494,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;


@@ -3517,7 +3810,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;


@@ -3591,7 +3884,7 @@ sub concat_sql {
 
 =item group_concat_sql COLUMN, DELIMITER
 
 
 =item group_concat_sql COLUMN, DELIMITER
 

-Returns an SQL expression to concatenate an aggregate column, using 
+Returns an SQL expression to concatenate an aggregate column, using

 GROUP_CONCAT() for mysql and array_to_string() and array_agg() for Pg.
 
 =cut
 GROUP_CONCAT() for mysql and array_to_string() and array_agg() for Pg.
 
 =cut


@@ -3609,7 +3902,7 @@ sub group_concat_sql {
 
 =item midnight_sql DATE
 
 
 =item midnight_sql DATE
 

-Returns an SQL expression to convert DATE (a unix timestamp) to midnight 
+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
 on that day in the system timezone, using the default driver name.
 
 =cut


@@ -3681,4 +3974,3 @@ http://poop.sf.net/
 =cut
 
 1;
 =cut
 
 1;

-