X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=2540dd399f40eca00168f863cb83a125cd502209;hp=b950e306bfc847aaea3aaaeb1d2d6b28a1cbd2cd;hb=ec5603ae351d4ed8e4873dcd20bf71f8a4d549bb;hpb=729eaf2e7c8e110432a8f4953cba1e4b78e45db5

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index b950e306b..2540dd399 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -1,35 +1,54 @@
 package FS::Record;
 
 use strict;
-use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG
-             $me %dbdef_cache %virtual_fields_cache );
-use subs qw(reload_dbdef);
+use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG
+             $conf $me
+             %virtual_fields_cache
+             $nowarn_identical $no_update_diff $no_check_foreign
+           );
 use Exporter;
 use Carp qw(carp cluck croak confess);
+use Scalar::Util qw( blessed );
 use File::CounterFile;
 use Locale::Country;
 use DBI qw(:sql_types);
-use DBIx::DBSchema 0.21;
+use DBIx::DBSchema 0.33;
 use FS::UID qw(dbh getotaker datasrc driver_name);
+use FS::CurrentUser;
+use FS::Schema qw(dbdef);
 use FS::SearchCache;
 use FS::Msgcat qw(gettext);
+#use FS::Conf; #dependency loop bs, in install_callback below instead
 
 use FS::part_virtual_field;
 
 use Tie::IxHash;
 
 @ISA = qw(Exporter);
-@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 );
 
 $DEBUG = 0;
 $me = '[FS::Record]';
 
-#ask FS::UID to run this stuff for us later
-$FS::UID::callback{'FS::Record'} = sub { 
-  $File::CounterFile::DEFAULT_DIR = "/usr/local/etc/freeside/counters.". datasrc;
-  $dbdef_file = "/usr/local/etc/freeside/dbdef.". datasrc;
-  &reload_dbdef unless $setup_hack; #$setup_hack needed now?
-};
+$nowarn_identical = 0;
+$no_update_diff = 0;
+$no_check_foreign = 0;
+
+my $rsa_module;
+my $rsa_loaded;
+my $rsa_encrypt;
+my $rsa_decrypt;
+
+FS::UID->install_callback( sub {
+  eval "use FS::Conf;";
+  die $@ if $@;
+  $conf = FS::Conf->new; 
+  $File::CounterFile::DEFAULT_DIR = $conf->base_dir . "/counters.". datasrc;
+} );
+
 
 =head1 NAME
 
@@ -38,7 +57,7 @@ FS::Record - Database record objects
 =head1 SYNOPSIS
 
     use FS::Record;
-    use FS::Record qw(dbh fields qsearch qsearchs dbdef);
+    use FS::Record qw(dbh fields qsearch qsearchs);
 
     $record = new FS::Record 'table', \%hash;
     $record = new FS::Record 'table', { 'column' => 'value', ... };
@@ -73,8 +92,11 @@ FS::Record - Database record objects
     $value = $record->unique('column');
 
     $error = $record->ut_float('column');
+    $error = $record->ut_floatn('column');
     $error = $record->ut_number('column');
     $error = $record->ut_numbern('column');
+    $error = $record->ut_snumber('column');
+    $error = $record->ut_snumbern('column');
     $error = $record->ut_money('column');
     $error = $record->ut_text('column');
     $error = $record->ut_textn('column');
@@ -84,10 +106,6 @@ FS::Record - Database record objects
     $error = $record->ut_anything('column');
     $error = $record->ut_name('column');
 
-    $dbdef = reload_dbdef;
-    $dbdef = reload_dbdef "/non/standard/filename";
-    $dbdef = dbdef;
-
     $quoted_value = _quote($value,'table','field');
 
     #deprecated
@@ -131,14 +149,18 @@ sub new {
     $self->{'Table'} = shift;
     carp "warning: FS::Record::new called with table name ". $self->{'Table'};
   }
+  
+  $self->{'Hash'} = shift;
 
-  my $hashref = $self->{'Hash'} = shift;
-
-  foreach my $field ( grep !defined($hashref->{$_}), $self->fields ) { 
-    $hashref->{$field}='';
+  foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) { 
+    $self->{'Hash'}{$field}='';
   }
 
-  $self->_cache($hashref, shift) if $self->can('_cache') && @_;
+  $self->_rebless if $self->can('_rebless');
+
+  $self->{'modified'} = 0;
+
+  $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_;
 
   $self;
 }
@@ -176,13 +198,38 @@ sub create {
   }
 }
 
-=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ
+=item qsearch PARAMS_HASHREF | TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM
 
 Searches the database for all records matching (at least) the key/value pairs
 in HASHREF.  Returns all the records found as `FS::TABLE' objects if that
 module is loaded (i.e. via `use FS::cust_main;'), otherwise returns FS::Record
 objects.
 
+The preferred usage is to pass a hash reference of named parameters:
+
+  my @records = qsearch( {
+                           'table'     => 'table_name',
+                           'hashref'   => { 'field' => 'value'
+                                            'field' => { 'op'    => '<',
+                                                         'value' => '420',
+                                                       },
+                                          },
+
+                           #these are optional...
+                           'select'    => '*',
+                           'extra_sql' => 'AND field ',
+                           'order_by'  => 'ORDER BY something',
+                           #'cache_obj' => '', #optional
+                           'addl_from' => 'LEFT JOIN othtable USING ( field )',
+                           'debug'     => 1,
+                         }
+                       );
+
+Much code still uses old-style positional parameters, this is also probably
+fine in the common case where there are only two parameters:
+
+  my @records = qsearch( 'table', { 'field' => 'value' } );
+
 ###oops, argh, FS::Record::new only lets us create database fields.
 #Normal behaviour if SELECT is not specified is `*', as in
 #C<SELECT * FROM table WHERE ...>.  However, there is an experimental new
@@ -194,114 +241,60 @@ objects.
 
 =cut
 
+my %TYPE = (); #for debugging
+
 sub qsearch {
-  my($stable, $record, $select, $extra_sql, $cache ) = @_;
+  my($stable, $record, $select, $extra_sql, $order_by, $cache, $addl_from );
+  my $debug = '';
+  if ( ref($_[0]) ) { #hashref for now, eventually maybe accept a list too
+    my $opt = shift;
+    $stable    = $opt->{'table'}     or die "table name is required";
+    $record    = $opt->{'hashref'}   || {};
+    $select    = $opt->{'select'}    || '*';
+    $extra_sql = $opt->{'extra_sql'} || '';
+    $order_by  = $opt->{'order_by'}  || '';
+    $cache     = $opt->{'cache_obj'} || '';
+    $addl_from = $opt->{'addl_from'} || '';
+    $debug     = $opt->{'debug'}     || '';
+  } else {
+    ($stable, $record, $select, $extra_sql, $cache, $addl_from ) = @_;
+    $select ||= '*';
+  }
+
   #$stable =~ /^([\w\_]+)$/ or die "Illegal table: $table";
   #for jsearch
   $stable =~ /^([\w\s\(\)\.\,\=]+)$/ or die "Illegal table: $stable";
   $stable = $1;
-  $select ||= '*';
   my $dbh = dbh;
 
   my $table = $cache ? $cache->table : $stable;
-  my $pkey = $dbdef->table($table)->primary_key;
+  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 @virtual_fields = grep exists($record->{$_}), "FS::$table"->virtual_fields;
+  my @virtual_fields;
+  if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
+    @virtual_fields = grep exists($record->{$_}), "FS::$table"->virtual_fields;
+  } else {
+    cluck "warning: FS::$table not loaded; virtual fields not searchable";
+    @virtual_fields = ();
+  }
 
   my $statement = "SELECT $select FROM $stable";
+  $statement .= " $addl_from" if $addl_from;
   if ( @real_fields or @virtual_fields ) {
     $statement .= ' WHERE '. join(' AND ',
-      ( map {
-
-      my $op = '=';
-      my $column = $_;
-      if ( ref($record->{$_}) ) {
-        $op = $record->{$_}{'op'} if $record->{$_}{'op'};
-        #$op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name ne 'Pg';
-        if ( uc($op) eq 'ILIKE' ) {
-          $op = 'LIKE';
-          $record->{$_}{'value'} = lc($record->{$_}{'value'});
-          $column = "LOWER($_)";
-        }
-        $record->{$_} = $record->{$_}{'value'}
-      }
-
-      if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
-        if ( $op eq '=' ) {
-          if ( driver_name eq 'Pg' ) {
-            my $type = $dbdef->table($table)->column($column)->type;
-            if ( $type =~ /(int|serial)/i ) {
-              qq-( $column IS NULL )-;
-            } else {
-              qq-( $column IS NULL OR $column = '' )-;
-            }
-          } else {
-            qq-( $column IS NULL OR $column = "" )-;
-          }
-        } elsif ( $op eq '!=' ) {
-          if ( driver_name eq 'Pg' ) {
-            my $type = $dbdef->table($table)->column($column)->type;
-            if ( $type =~ /(int|serial)/i ) {
-              qq-( $column IS NOT NULL )-;
-            } else {
-              qq-( $column IS NOT NULL AND $column != '' )-;
-            }
-          } else {
-            qq-( $column IS NOT NULL AND $column != "" )-;
-          }
-        } else {
-          if ( driver_name eq 'Pg' ) {
-            qq-( $column $op '' )-;
-          } else {
-            qq-( $column $op "" )-;
-          }
-        }
-      } else {
-        "$column $op ?";
-      }
-    } @real_fields ), 
-    ( map {
-      my $op = '=';
-      my $column = $_;
-      if ( ref($record->{$_}) ) {
-        $op = $record->{$_}{'op'} if $record->{$_}{'op'};
-	if ( uc($op) eq 'ILIKE' ) {
-	  $op = 'LIKE';
-	  $record->{$_}{'value'} = lc($record->{$_}{'value'});
-	  $column = "LOWER($_)";
-	}
-	$record->{$_} = $record->{$_}{'value'};
-      }
-
-      # ... EXISTS ( SELECT name, value FROM part_virtual_field
-      #              JOIN virtual_field
-      #              ON part_virtual_field.vfieldpart = virtual_field.vfieldpart
-      #              WHERE recnum = svc_acct.svcnum
-      #              AND (name, value) = ('egad', 'brain') )
-
-      my $value = $record->{$_};
-
-      my $subq;
-
-      $subq = ($value ? 'EXISTS ' : 'NOT EXISTS ') .
-      "( SELECT part_virtual_field.name, virtual_field.value ".
-      "FROM part_virtual_field JOIN virtual_field ".
-      "ON part_virtual_field.vfieldpart = virtual_field.vfieldpart ".
-      "WHERE virtual_field.recnum = ${table}.${pkey} ".
-      "AND part_virtual_field.name = '${column}'".
-      ($value ? 
-        " AND virtual_field.value ${op} '${value}'"
-      : "") . ")";
-      $subq;
-
-    } @virtual_fields ) );
-
+      get_real_fields($table, $record, \@real_fields) ,
+      get_virtual_fields($table, $pkey, $record, \@virtual_fields),
+      );
   }
 
   $statement .= " $extra_sql" if defined($extra_sql);
+  $statement .= " $order_by"  if defined($order_by);
 
-  warn "[debug]$me $statement\n" if $DEBUG > 1;
+  warn "[debug]$me $statement\n" if $DEBUG > 1 || $debug;
   my $sth = $dbh->prepare($statement)
     or croak "$dbh->errstr doing $statement";
 
@@ -310,13 +303,33 @@ sub qsearch {
   foreach my $field (
     grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields
   ) {
-    if ( $record->{$field} =~ /^\d+(\.\d+)?$/
-         && $dbdef->table($table)->column($field)->type =~ /(int|serial)/i
-    ) {
-      $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_INTEGER } );
-    } else {
-      $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_VARCHAR } );
+
+    my $value = $record->{$field};
+    $value = $value->{'value'} if ref($value);
+    my $type = dbdef->table($table)->column($field)->type;
+
+    my $TYPE = SQL_VARCHAR;
+    if ( $type =~ /(int|(big)?serial)/i && $value =~ /^\d+(\.\d+)?$/ ) {
+      $TYPE = SQL_INTEGER;
+
+    #DBD::Pg 1.49: Cannot bind ... unknown sql_type 6
+    #} elsif (    ( $type =~ /(numeric)/i     && $value =~ /^[+-]?\d+(\.\d+)?$/)
+    #          || ( $type =~ /(real|float4)/i
+    #                 && $value =~ /[-+]?\d*\.?\d+([eE][-+]?\d+)?/
+    #             )
+    #        ) {
+    #  $TYPE = SQL_FLOAT;
+    }
+
+    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";
     }
+
+    $sth->bind_param($bind++, $value, { TYPE => $TYPE } );
+
   }
 
 #  $sth->execute( map $record->{$_},
@@ -325,18 +338,24 @@ sub qsearch {
 
   $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr;
 
+  if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
+    @virtual_fields = "FS::$table"->virtual_fields;
+  } else {
+    cluck "warning: FS::$table not loaded; virtual fields not returned either";
+    @virtual_fields = ();
+  }
+
   my %result;
   tie %result, "Tie::IxHash";
-  @virtual_fields = "FS::$table"->virtual_fields;
-
   my @stuff = @{ $sth->fetchall_arrayref( {} ) };
-  if($pkey) {
+  if ( $pkey && scalar(@stuff) && $stuff[0]->{$pkey} ) {
     %result = map { $_->{$pkey}, $_ } @stuff;
   } else {
     @result{@stuff} = @stuff;
   }
 
   $sth->finish;
+
   if ( keys(%result) and @virtual_fields ) {
     $statement =
       "SELECT virtual_field.recnum, part_virtual_field.name, ".
@@ -359,32 +378,179 @@ sub qsearch {
       }
     }
   }
-  
+  my @return;
   if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
     if ( eval 'FS::'. $table. '->can(\'new\')' eq \&new ) {
       #derivied class didn't override new method, so this optimization is safe
       if ( $cache ) {
-        map {
+        @return = map {
           new_or_cached( "FS::$table", { %{$_} }, $cache )
         } values(%result);
       } else {
-        map {
+        @return = map {
           new( "FS::$table", { %{$_} } )
         } values(%result);
       }
     } else {
-      warn "untested code (class FS::$table uses custom new method)";
-      map {
+      #okay, its been tested
+      # warn "untested code (class FS::$table uses custom new method)";
+      @return = map {
         eval 'FS::'. $table. '->new( { %{$_} } )';
       } values(%result);
     }
+
+    # Check for encrypted fields and decrypt them.
+   ## only in the local copy, not the cached object
+    if ( $conf && $conf->exists('encryption') # $conf doesn't exist when doing
+                                              # the initial search for
+                                              # access_user
+         && eval 'defined(@FS::'. $table . '::encrypted_fields)') {
+      foreach my $record (@return) {
+        foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
+          # 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";
-    map {
+    @return = map {
       FS::Record->new( $table, { %{$_} } );
     } values(%result);
   }
+  return @return;
+}
+
+## makes this easier to read
+
+sub get_virtual_fields {
+   my $table = shift;
+   my $pkey = shift;
+   my $record = shift;
+   my $virtual_fields = shift;
+   
+   return
+    ( map {
+      my $op = '=';
+      my $column = $_;
+      if ( ref($record->{$_}) ) {
+        $op = $record->{$_}{'op'} if $record->{$_}{'op'};
+	if ( uc($op) eq 'ILIKE' ) {
+	  $op = 'LIKE';
+	  $record->{$_}{'value'} = lc($record->{$_}{'value'});
+	  $column = "LOWER($_)";
+	}
+	$record->{$_} = $record->{$_}{'value'};
+      }
+
+      # ... EXISTS ( SELECT name, value FROM part_virtual_field
+      #              JOIN virtual_field
+      #              ON part_virtual_field.vfieldpart = virtual_field.vfieldpart
+      #              WHERE recnum = svc_acct.svcnum
+      #              AND (name, value) = ('egad', 'brain') )
+
+      my $value = $record->{$_};
+
+      my $subq;
+
+      $subq = ($value ? 'EXISTS ' : 'NOT EXISTS ') .
+      "( SELECT part_virtual_field.name, virtual_field.value ".
+      "FROM part_virtual_field JOIN virtual_field ".
+      "ON part_virtual_field.vfieldpart = virtual_field.vfieldpart ".
+      "WHERE virtual_field.recnum = ${table}.${pkey} ".
+      "AND part_virtual_field.name = '${column}'".
+      ($value ? 
+        " AND virtual_field.value ${op} '${value}'"
+      : "") . ")";
+      $subq;
+
+    } @{ $virtual_fields } ) ;
+}
 
+sub get_real_fields {
+  my $table = shift;
+  my $record = shift;
+  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 {
+
+      my $op = '=';
+      my $column = $_;
+      if ( ref($record->{$_}) ) {
+        $op = $record->{$_}{'op'} if $record->{$_}{'op'};
+        #$op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name ne 'Pg';
+        if ( uc($op) eq 'ILIKE' ) {
+          $op = 'LIKE';
+          $record->{$_}{'value'} = lc($record->{$_}{'value'});
+          $column = "LOWER($_)";
+        }
+        $record->{$_} = $record->{$_}{'value'}
+      }
+
+      if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
+        if ( $op eq '=' ) {
+          if ( driver_name eq 'Pg' ) {
+            my $type = dbdef->table($table)->column($column)->type;
+            if ( $type =~ /(int|(big)?serial)/i ) {
+              qq-( $column IS NULL )-;
+            } else {
+              qq-( $column IS NULL OR $column = '' )-;
+            }
+          } else {
+            qq-( $column IS NULL OR $column = "" )-;
+          }
+        } elsif ( $op eq '!=' ) {
+          if ( driver_name eq 'Pg' ) {
+            my $type = dbdef->table($table)->column($column)->type;
+            if ( $type =~ /(int|(big)?serial)/i ) {
+              qq-( $column IS NOT NULL )-;
+            } else {
+              qq-( $column IS NOT NULL AND $column != '' )-;
+            }
+          } else {
+            qq-( $column IS NOT NULL AND $column != "" )-;
+          }
+        } else {
+          if ( driver_name eq 'Pg' ) {
+            qq-( $column $op '' )-;
+          } else {
+            qq-( $column $op "" )-;
+          }
+        }
+      } else {
+        "$column $op ?";
+      }
+    } @{ $real_fields } );  
+}
+
+=item by_key PRIMARY_KEY_VALUE
+
+This is a class method that returns the record with the given primary key
+value.  This method is only useful in FS::Record subclasses.  For example:
+
+  my $cust_main = FS::cust_main->by_key(1); # retrieve customer with custnum 1
+
+is equivalent to:
+
+  my $cust_main = qsearchs('cust_main', { 'custnum' => 1 } );
+
+=cut
+
+sub by_key {
+  my ($class, $pkey_value) = @_;
+
+  my $table = $class->table
+    or croak "No table for $class found";
+
+  my $dbdef_table = dbdef->table($table)
+    or die "No schema for table $table found - ".
+           "do you need to create it or run dbdef-create?";
+  my $pkey = $dbdef_table->primary_key
+    or die "No primary key for table $table";
+
+  return qsearchs($table, { $pkey => $pkey_value });
 }
 
 =item jsearch TABLE, HASHREF, SELECT, EXTRA_SQL, PRIMARY_TABLE, PRIMARY_KEY
@@ -408,7 +574,7 @@ sub jsearch {
   );
 }
 
-=item qsearchs TABLE, HASHREF
+=item qsearchs PARAMS_HASHREF | TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM
 
 Same as qsearch, except that if more than one record matches, it B<carp>s but
 returns the first.  If this happens, you either made a logic error in asking
@@ -419,7 +585,7 @@ for a single item, or your data is corrupted.
 sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash);
   my $table = $_[0];
   my(@result) = qsearch(@_);
-  carp "warning: Multiple records in scalar search ($table)"
+  cluck "warning: Multiple records in scalar search ($table)"
     if scalar(@result) > 1;
   #should warn more vehemently if the search was on a primary key?
   scalar(@result) ? ($result[0]) : ();
@@ -452,7 +618,18 @@ Returns the DBIx::DBSchema::Table object for the table.
 sub dbdef_table {
   my($self)=@_;
   my($table)=$self->table;
-  $dbdef->table($table);
+  dbdef->table($table);
+}
+
+=item primary_key
+
+Returns the primary key for the table.
+
+=cut
+
+sub primary_key {
+  my $self = shift;
+  my $pkey = $self->dbdef_table->primary_key;
 }
 
 =item get, getfield COLUMN
@@ -483,6 +660,7 @@ Sets the value of the column/field/key COLUMN to VALUE.  Returns VALUE.
 
 sub set { 
   my($self,$field,$value) = @_;
+  $self->{'modified'} = 1;
   $self->{'Hash'}->{$field} = $value;
 }
 sub setfield {
@@ -505,11 +683,11 @@ sub AUTOLOAD {
   $field =~ s/.*://;
   if ( defined($value) ) {
     confess "errant AUTOLOAD $field for $self (arg $value)"
-      unless ref($self) && $self->can('setfield');
+      unless blessed($self) && $self->can('setfield');
     $self->setfield($field,$value);
   } else {
     confess "errant AUTOLOAD $field for $self (no args)"
-      unless ref($self) && $self->can('getfield');
+      unless blessed($self) && $self->can('getfield');
     $self->getfield($field);
   }    
 }
@@ -537,12 +715,16 @@ To make a distinct duplicate of an FS::Record object, you can do:
 
 sub hash {
   my($self) = @_;
+  confess $self. ' -> hash: Hash attribute is undefined'
+    unless defined($self->{'Hash'});
   %{ $self->{'Hash'} }; 
 }
 
 =item hashref
 
-Returns a reference to the column/value hash.
+Returns a reference to the column/value hash.  This may be deprecated in the
+future; if there's a reason you can't just use the autoloaded or get/set
+methods, speak up.
 
 =cut
 
@@ -551,6 +733,37 @@ sub hashref {
   $self->{'Hash'};
 }
 
+=item modified
+
+Returns true if any of this object's values have been modified with set (or via
+an autoloaded method).  Doesn't yet recognize when you retreive a hashref and
+modify that.
+
+=cut
+
+sub modified {
+  my $self = shift;
+  $self->{'modified'};
+}
+
+=item select_for_update
+
+Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
+a mutex.
+
+=cut
+
+sub select_for_update {
+  my $self = shift;
+  my $primary_key = $self->primary_key;
+  qsearchs( {
+    'select'    => '*',
+    'table'     => $self->table,
+    'hashref'   => { $primary_key => $self->$primary_key() },
+    'extra_sql' => 'FOR UPDATE',
+  } );
+}
+
 =item insert
 
 Inserts this record to the database.  If there is an error, returns the error,
@@ -560,13 +773,16 @@ otherwise returns false.
 
 sub insert {
   my $self = shift;
+  my $saved = {};
+
+  warn "$self -> insert" if $DEBUG;
 
   my $error = $self->check;
   return $error if $error;
 
   #single-field unique keys are given a value if false
   #(like MySQL's AUTO_INCREMENT or Pg SERIAL)
-  foreach ( $self->dbdef_table->unique->singles ) {
+  foreach ( $self->dbdef_table->unique_singles) {
     $self->unique($_) unless $self->getfield($_);
   }
 
@@ -577,7 +793,7 @@ sub insert {
     my $col = $self->dbdef_table->column($primary_key);
     
     $db_seq =
-      uc($col->type) eq 'SERIAL'
+      uc($col->type) =~ /^(BIG)?SERIAL\d?/
       || ( driver_name eq 'Pg'
              && defined($col->default)
              && $col->default =~ /^nextval\(/i
@@ -590,20 +806,38 @@ sub insert {
   }
 
   my $table = $self->table;
+  
+  # Encrypt before the database
+  if (    defined(eval '@FS::'. $table . '::encrypted_fields')
+       && scalar( eval '@FS::'. $table . '::encrypted_fields')
+       && $conf->exists('encryption')
+  ) {
+    foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
+      $self->{'saved'} = $self->getfield($field);
+      $self->setfield($field, $self->encrypt($self->getfield($field)));
+    }
+  }
+
   #false laziness w/delete
   my @real_fields =
-    grep defined($self->getfield($_)) && $self->getfield($_) ne "",
+    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 ( ".
-      join( ', ', @real_fields ).
-    ") VALUES (".
-      join( ', ', @values ).
-    ")"
-  ;
+  my $statement = "INSERT INTO $table ";
+  if ( @real_fields ) {
+    $statement .=
+      "( ".
+        join( ', ', @real_fields ).
+      ") VALUES (".
+        join( ', ', @values ).
+       ")"
+    ;
+  } else {
+    $statement .= 'DEFAULT VALUES';
+  }
   warn "[debug]$me $statement\n" if $DEBUG > 1;
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
@@ -616,18 +850,31 @@ sub insert {
 
   $sth->execute or return $sth->errstr;
 
-  my $insertid = '';
-  if ( $db_seq ) { # get inserted id from the database, if applicable
+  # 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 $oid = $sth->{'pg_oid_status'};
-      my $i_sql = "SELECT $primary_key FROM $table WHERE oid = ?";
+      #my $oid = $sth->{'pg_oid_status'};
+      #my $i_sql = "SELECT $primary_key FROM $table WHERE oid = ?";
+
+      my $default = $self->dbdef_table->column($primary_key)->default;
+      unless ( $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i ) {
+        dbh->rollback if $FS::UID::AutoCommit;
+        return "can't parse $table.$primary_key default value".
+               " for sequence name: $default";
+      }
+      my $sequence = $1;
+
+      my $i_sql = "SELECT currval('$sequence')";
       my $i_sth = dbh->prepare($i_sql) or do {
         dbh->rollback if $FS::UID::AutoCommit;
         return dbh->errstr;
       };
-      $i_sth->execute($oid) or do {
+      $i_sth->execute() or do { #$i_sth->execute($oid)
         dbh->rollback if $FS::UID::AutoCommit;
         return $i_sth->errstr;
       };
@@ -653,11 +900,15 @@ sub insert {
       }
 
     } else {
+
       dbh->rollback if $FS::UID::AutoCommit;
       return "don't know how to retreive inserted ids from ". driver_name. 
              ", try using counterfiles (maybe run dbdef-create?)";
+
     }
+
     $self->setfield($primary_key, $insertid);
+
   }
 
   my @virtual_fields = 
@@ -689,7 +940,7 @@ sub insert {
 
 
   my $h_sth;
-  if ( defined $dbdef->table('h_'. $table) ) {
+  if ( defined dbdef->table('h_'. $table) ) {
     my $h_statement = $self->_h_statement('insert');
     warn "[debug]$me $h_statement\n" if $DEBUG > 2;
     $h_sth = dbh->prepare($h_statement) or do {
@@ -703,6 +954,12 @@ sub insert {
 
   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
+  # 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});
+  }
+
   '';
 }
 
@@ -744,7 +1001,7 @@ sub delete {
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
   my $h_sth;
-  if ( defined $dbdef->table('h_'. $self->table) ) {
+  if ( defined dbdef->table('h_'. $self->table) ) {
     my $h_statement = $self->_h_statement('delete');
     warn "[debug]$me $h_statement\n" if $DEBUG > 2;
     $h_sth = dbh->prepare($h_statement) or return dbh->errstr;
@@ -806,25 +1063,45 @@ returns the error, otherwise returns false.
 =cut
 
 sub replace {
-  my ( $new, $old ) = ( shift, shift );
+  my ($new, $old) = (shift, shift);
+
+  $old = $new->replace_old unless defined($old);
+
   warn "[debug]$me $new ->replace $old\n" if $DEBUG;
 
+  if ( $new->can('replace_check') ) {
+    my $error = $new->replace_check($old);
+    return $error if $error;
+  }
+
   return "Records not in same table!" unless $new->table eq $old->table;
 
   my $primary_key = $old->dbdef_table->primary_key;
-  return "Can't change $primary_key"
+  return "Can't change primary key $primary_key ".
+         'from '. $old->getfield($primary_key).
+         ' to ' . $new->getfield($primary_key)
     if $primary_key
        && ( $old->getfield($primary_key) ne $new->getfield($primary_key) );
 
   my $error = $new->check;
   return $error if $error;
+  
+  # Encrypt for replace
+  my $saved = {};
+  if ($conf->exists('encryption') && defined(eval '@FS::'. $new->table . '::encrypted_fields')) {
+    foreach my $field (eval '@FS::'. $new->table . '::encrypted_fields') {
+      $saved->{$field} = $new->getfield($field);
+      $new->setfield($field, $new->encrypt($new->getfield($field)));
+    }
+  }
 
   #my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields;
   my %diff = map { ($new->getfield($_) ne $old->getfield($_))
                    ? ($_, $new->getfield($_)) : () } $old->fields;
                    
-  unless ( keys(%diff) ) {
-    carp "[warning]$me $new -> replace $old: records identical";
+  unless (keys(%diff) || $no_update_diff ) {
+    carp "[warning]$me $new -> replace $old: records identical"
+      unless $nowarn_identical;
     return '';
   }
 
@@ -835,13 +1112,25 @@ sub replace {
   ). ' WHERE '.
     join(' AND ',
       map {
-        $old->getfield($_) eq ''
-          #? "( $_ IS NULL OR $_ = \"\" )"
-          ? ( driver_name eq 'Pg'
-                ? "( $_ IS NULL OR $_ = '' )"
-                : "( $_ IS NULL OR $_ = \"\" )"
-            )
-          : "$_ = ". _quote($old->getfield($_),$old->table,$_)
+
+        if ( $old->getfield($_) eq '' ) {
+
+         #false laziness w/qsearch
+         if ( driver_name eq 'Pg' ) {
+            my $type = $old->dbdef_table->column($_)->type;
+            if ( $type =~ /(int|(big)?serial)/i ) {
+              qq-( $_ IS NULL )-;
+            } else {
+              qq-( $_ IS NULL OR $_ = '' )-;
+            }
+          } else {
+            qq-( $_ IS NULL OR $_ = "" )-;
+          }
+
+        } else {
+          "$_ = ". _quote($old->getfield($_),$old->table,$_);
+        }
+
       } ( $primary_key ? ( $primary_key ) : real_fields($old->table) )
     )
   ;
@@ -849,7 +1138,7 @@ sub replace {
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
   my $h_old_sth;
-  if ( defined $dbdef->table('h_'. $old->table) ) {
+  if ( defined dbdef->table('h_'. $old->table) ) {
     my $h_old_statement = $old->_h_statement('replace_old');
     warn "[debug]$me $h_old_statement\n" if $DEBUG > 2;
     $h_old_sth = dbh->prepare($h_old_statement) or return dbh->errstr;
@@ -858,7 +1147,7 @@ sub replace {
   }
 
   my $h_new_sth;
-  if ( defined $dbdef->table('h_'. $new->table) ) {
+  if ( defined dbdef->table('h_'. $new->table) ) {
     my $h_new_statement = $new->_h_statement('replace_new');
     warn "[debug]$me $h_new_statement\n" if $DEBUG > 2;
     $h_new_sth = dbh->prepare($h_new_statement) or return dbh->errstr;
@@ -935,10 +1224,32 @@ sub replace {
 
   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
+  # 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});
+  }
+
   '';
 
 }
 
+sub replace_old {
+  my( $self ) = shift;
+  warn "[$me] replace called with no arguments; autoloading old record\n"
+    if $DEBUG;
+
+  my $primary_key = $self->dbdef_table->primary_key;
+  if ( $primary_key ) {
+    $self->by_key( $self->$primary_key() ) #this is what's returned
+      or croak "can't find ". $self->table. ".$primary_key ".
+        $self->$primary_key();
+  } else {
+    croak $self->table. " has no primary key; pass old record as argument";
+  }
+
+}
+
 =item rep
 
 Depriciated (use replace instead).
@@ -969,7 +1280,14 @@ sub check {
     for ($self->getfield($field)) {
       # See notes on check_block in FS::part_virtual_field.
       eval $self->pvf($field)->check_block;
-      return $@ if $@;
+      if ( $@ ) {
+        #this is bad, probably want to follow the stack backtrace up and see
+        #wtf happened
+        my $err = "Fatal error checking $field for $self";
+        cluck "$err: $@";
+        return "$err (see log for backtrace): $@";
+
+      }
       $self->setfield($field, $_);
     }
   }
@@ -977,18 +1295,26 @@ sub check {
 }
 
 sub _h_statement {
-  my( $self, $action ) = @_;
+  my( $self, $action, $time ) = @_;
+
+  $time ||= time;
 
   my @fields =
-    grep defined($self->getfield($_)) && $self->getfield($_) ne "",
+    grep { defined($self->getfield($_)) && $self->getfield($_) ne "" }
     real_fields($self->table);
   ;
+
+  # If we're encrypting then don't ever store the payinfo or CVV2 in the history....
+  # You can see if it changed by the paymask...
+  if ($conf && $conf->exists('encryption') ) {
+    @fields = grep  $_ ne 'payinfo' && $_ ne 'cvv2', @fields;
+  }
   my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields;
 
   "INSERT INTO h_". $self->table. " ( ".
       join(', ', qw(history_date history_user history_action), @fields ).
     ") VALUES (".
-      join(', ', time, dbh->quote(getotaker()), dbh->quote($action), @values).
+      join(', ', $time, dbh->quote(getotaker()), dbh->quote($action), @values).
     ")"
   ;
 }
@@ -1042,32 +1368,103 @@ null.  If there is an error, returns the error, otherwise returns false.
 
 =cut
 
-sub ut_float {
+sub ut_float {
+  my($self,$field)=@_ ;
+  ($self->getfield($field) =~ /^\s*(\d+\.\d+)\s*$/ ||
+   $self->getfield($field) =~ /^\s*(\d+)\s*$/ ||
+   $self->getfield($field) =~ /^\s*(\d+\.\d+e\d+)\s*$/ ||
+   $self->getfield($field) =~ /^\s*(\d+e\d+)\s*$/)
+    or return "Illegal or empty (float) $field: ". $self->getfield($field);
+  $self->setfield($field,$1);
+  '';
+}
+=item ut_floatn COLUMN
+
+Check/untaint floating point numeric data: 1.1, 1, 1.1e10, 1e10.  May be
+null.  If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+#false laziness w/ut_ipn
+sub ut_floatn {
+  my( $self, $field ) = @_;
+  if ( $self->getfield($field) =~ /^()$/ ) {
+    $self->setfield($field,'');
+    '';
+  } else {
+    $self->ut_float($field);
+  }
+}
+
+=item ut_sfloat COLUMN
+
+Check/untaint signed floating point numeric data: 1.1, 1, 1.1e10, 1e10.
+May not be null.  If there is an error, returns the error, otherwise returns
+false.
+
+=cut
+
+sub ut_sfloat {
   my($self,$field)=@_ ;
-  ($self->getfield($field) =~ /^(\d+\.\d+)$/ ||
-   $self->getfield($field) =~ /^(\d+)$/ ||
-   $self->getfield($field) =~ /^(\d+\.\d+e\d+)$/ ||
-   $self->getfield($field) =~ /^(\d+e\d+)$/)
+  ($self->getfield($field) =~ /^\s*(-?\d+\.\d+)\s*$/ ||
+   $self->getfield($field) =~ /^\s*(-?\d+)\s*$/ ||
+   $self->getfield($field) =~ /^\s*(-?\d+\.\d+[eE]-?\d+)\s*$/ ||
+   $self->getfield($field) =~ /^\s*(-?\d+[eE]-?\d+)\s*$/)
     or return "Illegal or empty (float) $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
 }
+=item ut_sfloatn COLUMN
+
+Check/untaint signed floating point numeric data: 1.1, 1, 1.1e10, 1e10.  May be
+null.  If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_sfloatn {
+  my( $self, $field ) = @_;
+  if ( $self->getfield($field) =~ /^()$/ ) {
+    $self->setfield($field,'');
+    '';
+  } else {
+    $self->ut_sfloat($field);
+  }
+}
 
 =item ut_snumber COLUMN
 
-Check/untaint signed numeric data (whole numbers).  May not be null.  If there
-is an error, returns the error, otherwise returns false.
+Check/untaint signed numeric data (whole numbers).  If there is an error,
+returns the error, otherwise returns false.
 
 =cut
 
 sub ut_snumber {
   my($self, $field) = @_;
-  $self->getfield($field) =~ /^(-?)\s*(\d+)$/
+  $self->getfield($field) =~ /^\s*(-?)\s*(\d+)\s*$/
     or return "Illegal or empty (numeric) $field: ". $self->getfield($field);
   $self->setfield($field, "$1$2");
   '';
 }
 
+=item ut_snumbern COLUMN
+
+Check/untaint signed numeric data (whole numbers).  If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+sub ut_snumbern {
+  my($self, $field) = @_;
+  $self->getfield($field) =~ /^\s*(-?)\s*(\d*)\s*$/
+    or return "Illegal (numeric) $field: ". $self->getfield($field);
+  if ($1) {
+    return "Illegal (numeric) $field: ". $self->getfield($field)
+      unless $2;
+  }
+  $self->setfield($field, "$1$2");
+  '';
+}
+
 =item ut_number COLUMN
 
 Check/untaint simple numeric data (whole numbers).  May not be null.  If there
@@ -1077,7 +1474,7 @@ is an error, returns the error, otherwise returns false.
 
 sub ut_number {
   my($self,$field)=@_;
-  $self->getfield($field) =~ /^(\d+)$/
+  $self->getfield($field) =~ /^\s*(\d+)\s*$/
     or return "Illegal or empty (numeric) $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
@@ -1092,7 +1489,7 @@ an error, returns the error, otherwise returns false.
 
 sub ut_numbern {
   my($self,$field)=@_;
-  $self->getfield($field) =~ /^(\d*)$/
+  $self->getfield($field) =~ /^\s*(\d*)\s*$/
     or return "Illegal (numeric) $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
@@ -1108,7 +1505,7 @@ is an error, returns the error, otherwise returns false.
 sub ut_money {
   my($self,$field)=@_;
   $self->setfield($field, 0) if $self->getfield($field) eq '';
-  $self->getfield($field) =~ /^(\-)? ?(\d*)(\.\d{2})?$/
+  $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);
@@ -1118,7 +1515,7 @@ sub ut_money {
 =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.
 
@@ -1129,9 +1526,10 @@ sub ut_text {
   #warn "msgcat ". \&msgcat. "\n";
   #warn "notexist ". \&notexist. "\n";
   #warn "AUTOLOAD ". \&AUTOLOAD. "\n";
-  $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]+)$/
-    or return gettext('illegal_or_empty_text'). " $field: ".
-               $self->getfield($field);
+  $self->getfield($field)
+    =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]+)$/
+      or return gettext('illegal_or_empty_text'). " $field: ".
+                 $self->getfield($field);
   $self->setfield($field,$1);
   '';
 }
@@ -1146,8 +1544,9 @@ May be null.  If there is an error, returns the error, otherwise returns false.
 
 sub ut_textn {
   my($self,$field)=@_;
-  $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]*)$/
-    or return gettext('illegal_text'). " $field: ". $self->getfield($field);
+  $self->getfield($field)
+    =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]*)$/
+      or return gettext('illegal_text'). " $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
 }
@@ -1183,6 +1582,20 @@ sub ut_alphan {
   '';
 }
 
+=item ut_alpha_lower COLUMN
+
+Check/untaint lowercase alphanumeric strings (no spaces).  May not be null.  If
+there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_alpha_lower {
+  my($self,$field)=@_;
+  $self->getfield($field) =~ /[[:upper:]]/
+    and return "Uppercase characters are not permitted in $field";
+  $self->ut_alpha($field);
+}
+
 =item ut_phonen COLUMN [ COUNTRY ]
 
 Check/untaint phone numbers.  May be null.  If there is an error, returns
@@ -1201,6 +1614,8 @@ sub ut_phonen {
     $self->setfield($field,'');
   } elsif ( $country eq 'US' || $country eq 'CA' ) {
     $phonen =~ s/\D//g;
+    $phonen = $conf->config('cust_main-default_areacode').$phonen
+      if length($phonen)==7 && $conf->config('cust_main-default_areacode');
     $phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/
       or return gettext('illegal_phone'). " $field: ". $self->getfield($field);
     $phonen = "$1-$2-$3";
@@ -1213,6 +1628,33 @@ sub ut_phonen {
   '';
 }
 
+=item ut_hex COLUMN
+
+Check/untaint hexadecimal values.
+
+=cut
+
+sub ut_hex {
+  my($self, $field) = @_;
+  $self->getfield($field) =~ /^([\da-fA-F]+)$/
+    or return "Illegal (hex) $field: ". $self->getfield($field);
+  $self->setfield($field, uc($1));
+  '';
+}
+
+=item ut_hexn COLUMN
+
+Check/untaint hexadecimal values.  May be null.
+
+=cut
+
+sub ut_hexn {
+  my($self, $field) = @_;
+  $self->getfield($field) =~ /^([\da-fA-F]*)$/
+    or return "Illegal (hex) $field: ". $self->getfield($field);
+  $self->setfield($field, uc($1));
+  '';
+}
 =item ut_ip COLUMN
 
 Check/untaint ip addresses.  IPv4 only for now.
@@ -1244,6 +1686,92 @@ sub ut_ipn {
   }
 }
 
+=item ut_coord COLUMN [ LOWER [ UPPER ] ]
+
+Check/untaint coordinates.
+Accepts the following forms:
+DDD.DDDDD
+-DDD.DDDDD
+DDD MM.MMM
+-DDD MM.MMM
+DDD MM SS
+-DDD MM SS
+DDD MM MMM
+-DDD MM MMM
+
+The "DDD MM SS" and "DDD MM MMM" are potentially ambiguous.
+The latter form (that is, the MMM are thousands of minutes) is
+assumed if the "MMM" is exactly three digits or two digits > 59.
+
+To be safe, just use the DDD.DDDDD form.
+
+If LOWER or UPPER are specified, then the coordinate is checked
+for lower and upper bounds, respectively.
+
+=cut
+
+sub ut_coord {
+
+  my ($self, $field) = (shift, shift);
+
+  my $lower = shift if scalar(@_);
+  my $upper = shift if scalar(@_);
+  my $coord = $self->getfield($field);
+  my $neg = $coord =~ s/^(-)//;
+
+  my ($d, $m, $s) = (0, 0, 0);
+
+  if (
+    (($d) = ($coord =~ /^(\s*\d{1,3}(?:\.\d+)?)\s*$/)) ||
+    (($d, $m) = ($coord =~ /^(\s*\d{1,3})\s+(\d{1,2}(?:\.\d+))\s*$/)) ||
+    (($d, $m, $s) = ($coord =~ /^(\s*\d{1,3})\s+(\d{1,2})\s+(\d{1,3})\s*$/))
+  ) {
+    $s = (((($s =~ /^\d{3}$/) or $s > 59) ? ($s / 1000) : ($s / 60)) / 60);
+    $m = $m / 60;
+    if ($m > 59) {
+      return "Invalid (coordinate with minutes > 59) $field: "
+             . $self->getfield($field);
+    }
+
+    $coord = ($neg ? -1 : 1) * sprintf('%.8f', $d + $m + $s);
+
+    if (defined($lower) and ($coord < $lower)) {
+      return "Invalid (coordinate < $lower) $field: "
+             . $self->getfield($field);;
+    }
+
+    if (defined($upper) and ($coord > $upper)) {
+      return "Invalid (coordinate > $upper) $field: "
+             . $self->getfield($field);;
+    }
+
+    $self->setfield($field, $coord);
+    return '';
+  }
+
+  return "Invalid (coordinate) $field: " . $self->getfield($field);
+
+}
+
+=item ut_coordn COLUMN [ LOWER [ UPPER ] ]
+
+Same as ut_coord, except optionally null.
+
+=cut
+
+sub ut_coordn {
+
+  my ($self, $field) = (shift, shift);
+
+  if ($self->getfield($field) =~ /^$/) {
+    return '';
+  } else {
+    return $self->ut_coord($field, @_);
+  }
+
+}
+
+
 =item ut_domain COLUMN
 
 Check/untaint host and domain names.
@@ -1282,18 +1810,40 @@ Check/untaint zip codes.
 
 =cut
 
+my @zip_reqd_countries = qw( AU CA US ); #CA, US implicit...
+
 sub ut_zip {
   my( $self, $field, $country ) = @_;
+
   if ( $country eq 'US' ) {
-    $self->getfield($field) =~ /\s*(\d{5}(\-\d{4})?)\s*$/
+
+    $self->getfield($field) =~ /^\s*(\d{5}(\-\d{4})?)\s*$/
+      or return gettext('illegal_zip'). " $field for country $country: ".
+                $self->getfield($field);
+    $self->setfield($field, $1);
+
+  } elsif ( $country eq 'CA' ) {
+
+    $self->getfield($field) =~ /^\s*([A-Z]\d[A-Z])\s*(\d[A-Z]\d)\s*$/i
       or return gettext('illegal_zip'). " $field for country $country: ".
                 $self->getfield($field);
-    $self->setfield($field,$1);
+    $self->setfield($field, "$1 $2");
+
   } else {
-    $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
-      or return gettext('illegal_zip'). " $field: ". $self->getfield($field);
-    $self->setfield($field,$1);
+
+    if ( $self->getfield($field) =~ /^\s*$/
+         && ( !$country || ! grep { $_ eq $country } @zip_reqd_countries )
+       )
+    {
+      $self->setfield($field,'');
+    } else {
+      $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
+        or return gettext('illegal_zip'). " $field: ". $self->getfield($field);
+      $self->setfield($field,$1);
+    }
+
   }
+
   '';
 }
 
@@ -1358,8 +1908,9 @@ on the column first.
 
 sub ut_foreign_key {
   my( $self, $field, $table, $foreign ) = @_;
+  return '' if $no_check_foreign;
   qsearchs($table, { $foreign => $self->getfield($field) })
-    or return "Can't find $field ". $self->getfield($field).
+    or return "Can't find ". $self->table. ".$field ". $self->getfield($field).
               " in $table.$foreign";
   '';
 }
@@ -1377,6 +1928,36 @@ sub ut_foreign_keyn {
     : '';
 }
 
+=item ut_agentnum_acl
+
+Checks this column as an agentnum, taking into account the current users's
+ACLs.
+
+=cut
+
+sub ut_agentnum_acl {
+  my( $self, $field, $null_acl ) = @_;
+
+  my $error = $self->ut_foreign_keyn($field, 'agent', 'agentnum');
+  return "Illegal agentnum: $error" if $error;
+
+  my $curuser = $FS::CurrentUser::CurrentUser;
+
+  if ( $self->$field() ) {
+
+    return "Access denied"
+      unless $curuser->agentnum($self->$field());
+
+  } else {
+
+    return "Access denied"
+      unless $curuser->access_right($null_acl);
+
+  }
+
+  '';
+
+}
 
 =item virtual_fields [ TABLE ]
 
@@ -1390,16 +1971,17 @@ sub virtual_fields {
   my $table;
   $table = $self->table or confess "virtual_fields called on non-table";
 
-  confess "Unknown table $table" unless $dbdef->table($table);
+  confess "Unknown table $table" unless dbdef->table($table);
 
-  return () unless $self->dbdef->table('part_virtual_field');
+  return () unless dbdef->table('part_virtual_field');
 
   unless ( $virtual_fields_cache{$table} ) {
     my $query = 'SELECT name from part_virtual_field ' .
                 "WHERE dbtable = '$table'";
     my $dbh = dbh;
     my $result = $dbh->selectcol_arrayref($query);
-    confess $dbh->errstr if $dbh->err;
+    confess "Error executing virtual fields query: $query: ". $dbh->errstr
+      if $dbh->err;
     $virtual_fields_cache{$table} = $result;
   }
 
@@ -1427,8 +2009,6 @@ sub fields {
   return (real_fields($table), $something->virtual_fields());
 }
 
-=back
-
 =item pvf FIELD_NAME
 
 Returns the FS::part_virtual_field object corresponding to a field in the 
@@ -1446,53 +2026,185 @@ sub pvf {
   ''
 }
 
-=head1 SUBROUTINES
+=item vfieldpart_hashref TABLE
 
-=over 4
+Returns a hashref of virtual field names and vfieldparts applicable to the given
+TABLE.
 
-=item real_fields [ TABLE ]
+=cut
 
-Returns a list of the real columns in the specified table.  Called only by 
-fields() and other subroutines elsewhere in FS::Record.
+sub vfieldpart_hashref {
+  my $self = shift;
+  my $table = $self->table;
+
+  return {} unless dbdef->table('part_virtual_field');
+
+  my $dbh = dbh;
+  my $statement = "SELECT vfieldpart, name FROM part_virtual_field WHERE ".
+                  "dbtable = '$table'";
+  my $sth = $dbh->prepare($statement);
+  $sth->execute or croak "Execution of '$statement' failed: ".$dbh->errstr;
+  return { map { $_->{name}, $_->{vfieldpart} } 
+    @{$sth->fetchall_arrayref({})} };
+
+}
+
+=item encrypt($value)
+
+Encrypts the credit card using a combination of PK to encrypt and uuencode to armour.
+
+Returns the encrypted string.
+
+You should generally not have to worry about calling this, as the system handles this for you.
 
 =cut
 
-sub real_fields {
-  my $table = shift;
+sub encrypt {
+  my ($self, $value) = @_;
+  my $encrypted;
 
-  my($table_obj) = $dbdef->table($table);
-  confess "Unknown table $table" unless $table_obj;
-  $table_obj->columns;
+  if ($conf->exists('encryption')) {
+    if ($self->is_encrypted($value)) {
+      # Return the original value if it isn't plaintext.
+      $encrypted = $value;
+    } else {
+      $self->loadRSA;
+      if (ref($rsa_encrypt) =~ /::RSA/) { # We Can Encrypt
+        # RSA doesn't like the empty string so let's pack it up
+        # The database doesn't like the RSA data so uuencode it
+        my $length = length($value)+1;
+        $encrypted = pack("u*",$rsa_encrypt->encrypt(pack("Z$length",$value)));
+      } else {
+        die ("You can't encrypt w/o a valid RSA engine - Check your installation or disable encryption");
+      }
+    }
+  }
+  return $encrypted;
 }
 
-=item reload_dbdef([FILENAME])
+=item is_encrypted($value)
 
-Load a database definition (see L<DBIx::DBSchema>), optionally from a
-non-default filename.  This command is executed at startup unless
-I<$FS::Record::setup_hack> is true.  Returns a DBIx::DBSchema object.
+Checks to see if the string is encrypted and returns true or false (1/0) to indicate it's status.
 
 =cut
 
-sub reload_dbdef {
-  my $file = shift || $dbdef_file;
 
-  unless ( exists $dbdef_cache{$file} ) {
-    warn "[debug]$me loading dbdef for $file\n" if $DEBUG;
-    $dbdef_cache{$file} = DBIx::DBSchema->load( $file )
-                            or die "can't load database schema from $file";
+sub is_encrypted {
+  my ($self, $value) = @_;
+  # Possible Bug - Some work may be required here....
+
+  if ($value =~ /^M/ && length($value) > 80) {
+    return 1;
   } else {
-    warn "[debug]$me re-using cached dbdef for $file\n" if $DEBUG;
+    return 0;
   }
-  $dbdef = $dbdef_cache{$file};
 }
 
-=item dbdef
+=item decrypt($value)
+
+Uses the private key to decrypt the string. Returns the decryoted string or undef on failure.
+
+You should generally not have to worry about calling this, as the system handles this for you.
+
+=cut
+
+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)) {
+    $self->loadRSA;
+    if (ref($rsa_decrypt) =~ /::RSA/) {
+      my $encrypted = unpack ("u*", $value);
+      $decrypted =  unpack("Z*", eval{$rsa_decrypt->decrypt($encrypted)});
+      if ($@) {warn "Decryption Failed"};
+    }
+  }
+  return $decrypted;
+}
+
+sub loadRSA {
+    my $self = shift;
+    #Initialize the Module
+    $rsa_module = 'Crypt::OpenSSL::RSA'; # The Default
+
+    if ($conf->exists('encryptionmodule') && $conf->config_binary('encryptionmodule') ne '') {
+      $rsa_module = $conf->config('encryptionmodule');
+    }
+
+    if (!$rsa_loaded) {
+	eval ("require $rsa_module"); # No need to import the namespace
+	$rsa_loaded++;
+    }
+    # Initialize Encryption
+    if ($conf->exists('encryptionpublickey') && $conf->config_binary('encryptionpublickey') ne '') {
+      my $public_key = join("\n",$conf->config('encryptionpublickey'));
+      $rsa_encrypt = $rsa_module->new_public_key($public_key);
+    }
+    
+    # Intitalize Decryption
+    if ($conf->exists('encryptionprivatekey') && $conf->config_binary('encryptionprivatekey') ne '') {
+      my $private_key = join("\n",$conf->config('encryptionprivatekey'));
+      $rsa_decrypt = $rsa_module->new_private_key($private_key);
+    }
+}
+
+=item h_search ACTION
+
+Given an ACTION, either "insert", or "delete", returns the appropriate history
+record corresponding to this record, if any.
+
+=cut
+
+sub h_search {
+  my( $self, $action ) = @_;
+
+  my $table = $self->table;
+  $table =~ s/^h_//;
+
+  my $primary_key = dbdef->table($table)->primary_key;
+
+  qsearchs({
+    'table'   => "h_$table",
+    'hashref' => { $primary_key     => $self->$primary_key(),
+                   'history_action' => $action,
+                 },
+  });
+
+}
+
+=item h_date ACTION
+
+Given an ACTION, either "insert", or "delete", returns the timestamp of the
+appropriate history record corresponding to this record, if any.
+
+=cut
+
+sub h_date {
+  my($self, $action) = @_;
+  my $h = $self->h_search($action);
+  $h ? $h->history_date : '';
+}
+
+=back
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item real_fields [ TABLE ]
 
-Returns the current database definition.  See L<DBIx::DBSchema>.
+Returns a list of the real columns in the specified table.  Called only by 
+fields() and other subroutines elsewhere in FS::Record.
 
 =cut
 
-sub dbdef { $dbdef; }
+sub real_fields {
+  my $table = shift;
+
+  my($table_obj) = dbdef->table($table);
+  confess "Unknown table $table" unless $table_obj;
+  $table_obj->columns;
+}
 
 =item _quote VALUE, TABLE, COLUMN
 
@@ -1504,17 +2216,20 @@ type (see L<DBIx::DBSchema::Column>) does not end in `char' or `binary'.
 
 sub _quote {
   my($value, $table, $column) = @_;
-  my $column_obj = $dbdef->table($table)->column($column);
+  my $column_obj = dbdef->table($table)->column($column);
   my $column_type = $column_obj->type;
-
-  if ( $value eq '' && $column_type =~ /^int/ ) {
-    if ( $column_obj->null ) {
-      'NULL';
-    } else {
-      cluck "WARNING: Attempting to set non-null integer $table.$column null; ".
-            "using 0 instead";
-      0;
-    }
+  my $nullable = $column_obj->null;
+
+  warn "  $table.$column: $value ($column_type".
+       ( $nullable ? ' NULL' : ' NOT NULL' ).
+       ")\n" if $DEBUG > 2;
+
+  if ( $value eq '' && $nullable ) {
+    'NULL'
+  } elsif ( $value eq '' && $column_type =~ /^(int|numeric)/ ) {
+    cluck "WARNING: Attempting to set non-null integer $table.$column null; ".
+          "using 0 instead";
+    0;
   } elsif ( $value =~ /^\d+(\.\d+)?$/ && 
             ! $column_type =~ /(char|binary|text)$/i ) {
     $value;
@@ -1523,30 +2238,6 @@ sub _quote {
   }
 }
 
-=item vfieldpart_hashref TABLE
-
-Returns a hashref of virtual field names and vfieldparts applicable to the given
-TABLE.
-
-=cut
-
-sub vfieldpart_hashref {
-  my $self = shift;
-  my $table = $self->table;
-
-  return {} unless $self->dbdef->table('part_virtual_field');
-
-  my $dbh = dbh;
-  my $statement = "SELECT vfieldpart, name FROM part_virtual_field WHERE ".
-                  "dbtable = '$table'";
-  my $sth = $dbh->prepare($statement);
-  $sth->execute or croak "Execution of '$statement' failed: ".$dbh->errstr;
-  return { map { $_->{name}, $_->{vfieldpart} } 
-    @{$sth->fetchall_arrayref({})} };
-
-}
-
-
 =item hfields TABLE
 
 This is deprecated.  Don't use it.
@@ -1585,6 +2276,49 @@ sub DESTROY { return; }
 #             return ! eval { join('',@_), kill 0; 1; };
 #         }
 
+=item str2time_sql [ DRIVER_NAME ]
+
+Returns a function to convert to unix time based on database type, such as
+"EXTRACT( EPOCH FROM" for Pg or "UNIX_TIMESTAMP(" for mysql.  See
+the str2time_sql_closing method to return a closing string rather than just
+using a closing parenthesis as previously suggested.
+
+You can pass an optional driver name such as "Pg", "mysql" or
+$dbh->{Driver}->{Name} to return a function for that database instead of
+the current database.
+
+=cut
+
+sub str2time_sql { 
+  my $driver = shift || driver_name;
+
+  return 'UNIX_TIMESTAMP('      if $driver =~ /^mysql/i;
+  return 'EXTRACT( EPOCH FROM ' if $driver =~ /^Pg/i;
+
+  warn "warning: unknown database type $driver; guessing how to convert ".
+       "dates to UNIX timestamps";
+  return 'EXTRACT(EPOCH FROM ';
+
+}
+
+=item str2time_sql_closing [ DRIVER_NAME ]
+
+Returns the closing suffix of a function to convert to unix time based on
+database type, such as ")::integer" for Pg or ")" for mysql.
+
+You can pass an optional driver name such as "Pg", "mysql" or
+$dbh->{Driver}->{Name} to return a function for that database instead of
+the current database.
+
+=cut
+
+sub str2time_sql_closing { 
+  my $driver = shift || driver_name;
+
+  return ' )::INTEGER ' if $driver =~ /^Pg/i;
+  return ' ) ';
+}
+
 =back
 
 =head1 BUGS
@@ -1636,6 +2370,8 @@ L<DBIx::DBSchema>, L<FS::UID>, L<DBI>
 
 Adapter::DBI from Ch. 11 of Advanced Perl Programming by Sriram Srinivasan.
 
+http://poop.sf.net/
+
 =cut
 
 1;