fix multi-database installs, while hopefully keeping performance improvement

[freeside.git] / FS / FS / Record.pm

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 3c8e9ba..7d5ff05 100644 (file)
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -1,20 +1,24 @@
 package FS::Record;
 
 use strict;
 package FS::Record;
 
 use strict;

-use vars qw($dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG);
+use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG
+             $me %dbdef_cache );

 use subs qw(reload_dbdef);
 use Exporter;
 use Carp qw(carp cluck croak confess);
 use File::CounterFile;
 use Locale::Country;
 use subs qw(reload_dbdef);
 use Exporter;
 use Carp qw(carp cluck croak confess);
 use File::CounterFile;
 use Locale::Country;

+use DBI qw(:sql_types);

 use DBIx::DBSchema 0.19;
 use FS::UID qw(dbh checkruid getotaker datasrc driver_name);
 use FS::SearchCache;
 use DBIx::DBSchema 0.19;
 use FS::UID qw(dbh checkruid getotaker datasrc driver_name);
 use FS::SearchCache;

+use FS::Msgcat qw(gettext);

 
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch);
 
 $DEBUG = 0;
 
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch);
 
 $DEBUG = 0;

+$me = '[FS::Record]';

 
 #ask FS::UID to run this stuff for us later
 $FS::UID::callback{'FS::Record'} = sub { 
 
 #ask FS::UID to run this stuff for us later
 $FS::UID::callback{'FS::Record'} = sub { 


@@ -56,13 +60,13 @@ FS::Record - Database record objects
     $hashref = $record->hashref;
 
     $error = $record->insert;
     $hashref = $record->hashref;
 
     $error = $record->insert;

-    #$error = $record->add; #depriciated
+    #$error = $record->add; #deprecated

 
     $error = $record->delete;
 
     $error = $record->delete;

-    #$error = $record->del; #depriciated
+    #$error = $record->del; #deprecated

 
     $error = $new_record->replace($old_record);
 
     $error = $new_record->replace($old_record);

-    #$error = $new_record->rep($old_record); #depriciated
+    #$error = $new_record->rep($old_record); #deprecated

 
     $value = $record->unique('column');
 
 
     $value = $record->unique('column');
 


@@ -121,7 +125,10 @@ sub new {
   my $self = {};
   bless ($self, $class);
 
   my $self = {};
   bless ($self, $class);
 

-  $self->{'Table'} = shift unless defined ( $self->table );
+  unless ( defined ( $self->table ) ) {
+    $self->{'Table'} = shift;
+    carp "warning: FS::Record::new called with table name ". $self->{'Table'};
+  }

 
   my $hashref = $self->{'Hash'} = shift;
 
 
   my $hashref = $self->{'Hash'} = shift;
 


@@ -174,7 +181,7 @@ sub create {
   }
 }
 
   }
 }
 

-=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL
+=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ

 
 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
 
 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


@@ -208,26 +215,65 @@ sub qsearch {
   my $statement = "SELECT $select FROM $stable";
   if ( @fields ) {
     $statement .= ' WHERE '. join(' AND ', map {
   my $statement = "SELECT $select FROM $stable";
   if ( @fields ) {
     $statement .= ' WHERE '. join(' AND ', map {

+
+      my $op = '=';
+      if ( ref($record->{$_}) ) {
+        $op = $record->{$_}{'op'} if $record->{$_}{'op'};
+        $op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name !~ /^Pg$/i;
+        $record->{$_} = $record->{$_}{'value'}
+      }
+

       if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
       if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {

-        if ( driver_name =~ /^Pg$/i ) {
-          "$_ IS NULL";
+        if ( $op eq '=' ) {
+          if ( driver_name =~ /^Pg$/i ) {
+            qq-( $_ IS NULL OR $_ = '' )-;
+          } else {
+            qq-( $_ IS NULL OR $_ = "" )-;
+          }
+        } elsif ( $op eq '!=' ) {
+          if ( driver_name =~ /^Pg$/i ) {
+            qq-( $_ IS NOT NULL AND $_ != '' )-;
+          } else {
+            qq-( $_ IS NOT NULL AND $_ != "" )-;
+          }

         } else {
         } else {

-          qq-( $_ IS NULL OR $_ = "" )-;
+          if ( driver_name =~ /^Pg$/i ) {
+            qq-( $_ $op '' )-;
+          } else {
+            qq-( $_ $op "" )-;
+          }

         }
       } else {
         }
       } else {

-        "$_ = ?";
+        "$_ $op ?";

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

-  warn $statement if $DEBUG;
+  warn "[debug]$me $statement\n" if $DEBUG;

   my $sth = $dbh->prepare($statement)
     or croak "$dbh->errstr doing $statement";
 
   my $sth = $dbh->prepare($statement)
     or croak "$dbh->errstr doing $statement";
 

-  $sth->execute( map $record->{$_},
+  my $bind = 1;
+
+  foreach my $field (

     grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
     grep defined( $record->{$_} ) && $record->{$_} ne '', @fields

-  ) or croak "Error executing \"$statement\": ". $dbh->errstr;
+  ) {
+    if ( $record->{$field} =~ /^\d+(\.\d+)?$/
+         && $dbdef->table($table)->column($field)->type =~ /(int)/i
+    ) {
+      $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_INTEGER } );
+    } else {
+      $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_VARCHAR } );
+    }
+  }
+
+#  $sth->execute( map $record->{$_},
+#    grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
+#  ) or croak "Error executing \"$statement\": ". $sth->errstr;
+
+  $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr;
+

   $dbh->commit or croak $dbh->errstr if $FS::UID::AutoCommit;
 
   if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
   $dbh->commit or croak $dbh->errstr if $FS::UID::AutoCommit;
 
   if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {


@@ -257,13 +303,15 @@ sub qsearch {
 
 }
 
 
 }
 

-=item jsearch
+=item jsearch TABLE, HASHREF, SELECT, EXTRA_SQL, PRIMARY_TABLE, PRIMARY_KEY

 
 Experimental JOINed search method.  Using this method, you can execute a
 single SELECT spanning multiple tables, and cache the results for subsequent
 method calls.  Interface will almost definately change in an incompatible
 fashion.
 
 
 Experimental JOINed search method.  Using this method, you can execute a
 single SELECT spanning multiple tables, and cache the results for subsequent
 method calls.  Interface will almost definately change in an incompatible
 fashion.
 

+Arguments: 
+

 =cut
 
 sub jsearch {
 =cut
 
 sub jsearch {


@@ -311,7 +359,7 @@ sub table {
 
 =item dbdef_table
 
 
 =item dbdef_table
 

-Returns the FS::dbdef_table object for the table.
+Returns the DBIx::DBSchema::Table object for the table.

 
 =cut
 
 
 =cut
 


@@ -365,32 +413,32 @@ $record->column('value') is a synonym for $record->set('column','value');
 =cut
 
 # readable/safe
 =cut
 
 # readable/safe

-#sub AUTOLOAD {
-#  my($self,$value)=@_;
-#  my($field)=$AUTOLOAD;
-#  $field =~ s/.*://;
-#  if ( defined($value) ) {
-#    confess "errant AUTOLOAD $field for $self (arg $value)"
-#      unless $self->can('setfield');
-#    $self->setfield($field,$value);
-#  } else {
-#    confess "errant AUTOLOAD $field for $self (no args)"
-#      unless $self->can('getfield');
-#    $self->getfield($field);
-#  }    
-#}
-
-# efficient

 sub AUTOLOAD {
 sub AUTOLOAD {

-  my $field = $AUTOLOAD;
+  my($self,$value)=@_;
+  my($field)=$AUTOLOAD;

   $field =~ s/.*://;
   $field =~ s/.*://;

-  if ( scalar(@_) == 2 ) {
-    $_[0]->setfield($field, $_[1]);
+  if ( defined($value) ) {
+    confess "errant AUTOLOAD $field for $self (arg $value)"
+      unless $self->can('setfield');
+    $self->setfield($field,$value);

   } else {
   } else {

-    $_[0]->getfield($field);
+    confess "errant AUTOLOAD $field for $self (no args)"
+      unless $self->can('getfield');
+    $self->getfield($field);

   }    
 }
 
   }    
 }
 

+# efficient
+#sub AUTOLOAD {
+#  my $field = $AUTOLOAD;
+#  $field =~ s/.*://;
+#  if ( defined($_[1]) ) {
+#    $_[0]->setfield($field, $_[1]);
+#  } else {
+#    $_[0]->getfield($field);
+#  }    
+#}
+

 =item hash
 
 Returns a list of the column/value pairs, usually for assigning to a new hash.
 =item hash
 
 Returns a list of the column/value pairs, usually for assigning to a new hash.


@@ -440,19 +488,32 @@ sub insert {
   $self->unique($primary_key) 
     if $primary_key && ! $self->getfield($primary_key);
 
   $self->unique($primary_key) 
     if $primary_key && ! $self->getfield($primary_key);
 

+  #false laziness w/delete

   my @fields =
     grep defined($self->getfield($_)) && $self->getfield($_) ne "",
     $self->fields
   ;
   my @fields =
     grep defined($self->getfield($_)) && $self->getfield($_) ne "",
     $self->fields
   ;

+  my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields;
+  #eslaf

 
   my $statement = "INSERT INTO ". $self->table. " ( ".
 
   my $statement = "INSERT INTO ". $self->table. " ( ".

-      join(', ',@fields ).
+      join( ', ', @fields ).

     ") VALUES (".
     ") VALUES (".

-      join(', ',map(_quote($self->getfield($_),$self->table,$_), @fields)).
+      join( ', ', @values ).

     ")"
   ;
     ")"
   ;

+  warn "[debug]$me $statement\n" if $DEBUG;

   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 

+  my $h_sth;
+  if ( defined $dbdef->table('h_'. $self->table) ) {
+    my $h_statement = $self->_h_statement('insert');
+    warn "[debug]$me $h_statement\n" if $DEBUG;
+    $h_sth = dbh->prepare($h_statement) or return dbh->errstr;
+  } else {
+    $h_sth = '';
+  }
+

   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE'; 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE'; 


@@ -461,6 +522,7 @@ sub insert {
   local $SIG{PIPE} = 'IGNORE';
 
   $sth->execute or return $sth->errstr;
   local $SIG{PIPE} = 'IGNORE';
 
   $sth->execute or return $sth->errstr;

+  $h_sth->execute or return $h_sth->errstr if $h_sth;

   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
   '';
   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
   '';


@@ -487,7 +549,7 @@ otherwise returns false.
 sub delete {
   my $self = shift;
 
 sub delete {
   my $self = shift;
 

-  my($statement)="DELETE FROM ". $self->table. " WHERE ". join(' AND ',
+  my $statement = "DELETE FROM ". $self->table. " WHERE ". join(' AND ',

     map {
       $self->getfield($_) eq ''
         #? "( $_ IS NULL OR $_ = \"\" )"
     map {
       $self->getfield($_) eq ''
         #? "( $_ IS NULL OR $_ = \"\" )"


@@ -500,8 +562,18 @@ sub delete {
           ? ( $self->dbdef_table->primary_key)
           : $self->fields
   );
           ? ( $self->dbdef_table->primary_key)
           : $self->fields
   );

+  warn "[debug]$me $statement\n" if $DEBUG;

   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 

+  my $h_sth;
+  if ( defined $dbdef->table('h_'. $self->table) ) {
+    my $h_statement = $self->_h_statement('delete');
+    warn "[debug]$me $h_statement\n" if $DEBUG;
+    $h_sth = dbh->prepare($h_statement) or return dbh->errstr;
+  } else {
+    $h_sth = '';
+  }
+

   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE'; 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE'; 


@@ -511,9 +583,11 @@ sub delete {
 
   my $rc = $sth->execute or return $sth->errstr;
   #not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0";
 
   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;
 
   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 

-  undef $self; #no need to keep object!
+  #no need to needlessly destoy the data either (causes problems actually)
+  #undef $self; #no need to keep object!

 
   '';
 }
 
   '';
 }


@@ -538,13 +612,7 @@ returns the error, otherwise returns false.
 
 sub replace {
   my ( $new, $old ) = ( shift, shift );
 
 sub replace {
   my ( $new, $old ) = ( shift, shift );

-  warn "[debug][FS::Record] $new ->replace $old\n" if $DEBUG;
-
-  my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields;
-  unless ( @diff ) {
-    carp "[warning][FS::Record] $new -> replace $old: records identical";
-    return '';
-  }
+  warn "[debug]$me $new ->replace $old\n" if $DEBUG;

 
   return "Records not in same table!" unless $new->table eq $old->table;
 
 
   return "Records not in same table!" unless $new->table eq $old->table;
 


@@ -556,6 +624,12 @@ sub replace {
   my $error = $new->check;
   return $error if $error;
 
   my $error = $new->check;
   return $error if $error;
 

+  my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields;
+  unless ( @diff ) {
+    carp "[warning]$me $new -> replace $old: records identical";
+    return '';
+  }
+

   my $statement = "UPDATE ". $old->table. " SET ". join(', ',
     map {
       "$_ = ". _quote($new->getfield($_),$old->table,$_) 
   my $statement = "UPDATE ". $old->table. " SET ". join(', ',
     map {
       "$_ = ". _quote($new->getfield($_),$old->table,$_) 


@@ -573,8 +647,27 @@ sub replace {
       } ( $primary_key ? ( $primary_key ) : $old->fields )
     )
   ;
       } ( $primary_key ? ( $primary_key ) : $old->fields )
     )
   ;

+  warn "[debug]$me $statement\n" if $DEBUG;

   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 

+  my $h_old_sth;
+  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;
+    $h_old_sth = dbh->prepare($h_old_statement) or return dbh->errstr;
+  } else {
+    $h_old_sth = '';
+  }
+
+  my $h_new_sth;
+  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;
+    $h_new_sth = dbh->prepare($h_new_statement) or return dbh->errstr;
+  } else {
+    $h_new_sth = '';
+  }
+

   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE'; 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE'; 


@@ -584,6 +677,8 @@ sub replace {
 
   my $rc = $sth->execute or return $sth->errstr;
   #not portable #return "Record not found (or records identical)." if $rc eq "0E0";
 
   my $rc = $sth->execute or return $sth->errstr;
   #not portable #return "Record not found (or records identical)." if $rc eq "0E0";

+  $h_old_sth->execute or return $h_old_sth->errstr if $h_old_sth;
+  $h_new_sth->execute or return $h_new_sth->errstr if $h_new_sth;

   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
   '';
   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
   '';


@@ -611,6 +706,23 @@ sub check {
   confess "FS::Record::check not implemented; supply one in subclass!";
 }
 
   confess "FS::Record::check not implemented; supply one in subclass!";
 }
 

+sub _h_statement {
+  my( $self, $action ) = @_;
+
+  my @fields =
+    grep defined($self->getfield($_)) && $self->getfield($_) ne "",
+    $self->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).
+    ")"
+  ;
+}
+

 =item unique COLUMN
 
 Replaces COLUMN in record with a unique number.  Called by the B<add> method
 =item unique COLUMN
 
 Replaces COLUMN in record with a unique number.  Called by the B<add> method


@@ -719,7 +831,7 @@ sub ut_money {
 =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.
 


@@ -727,8 +839,12 @@ false.
 
 sub ut_text {
   my($self,$field)=@_;
 
 sub ut_text {
   my($self,$field)=@_;

-  $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]+)$/
-    or return "Illegal or empty (text) $field: ". $self->getfield($field);
+  #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->setfield($field,$1);
   '';
 }
   $self->setfield($field,$1);
   '';
 }


@@ -743,8 +859,8 @@ May be null.  If there is an error, returns the error, otherwise returns false.
 
 sub ut_textn {
   my($self,$field)=@_;
 
 sub ut_textn {
   my($self,$field)=@_;

-  $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]*)$/
-    or return "Illegal (text) $field: ". $self->getfield($field);
+  $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]*)$/
+    or return gettext('illegal_text'). " $field: ". $self->getfield($field);

   $self->setfield($field,$1);
   '';
 }
   $self->setfield($field,$1);
   '';
 }


@@ -799,12 +915,12 @@ sub ut_phonen {
   } elsif ( $country eq 'US' || $country eq 'CA' ) {
     $phonen =~ s/\D//g;
     $phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/
   } elsif ( $country eq 'US' || $country eq 'CA' ) {
     $phonen =~ s/\D//g;
     $phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/

-      or return "Illegal (phone) $field: ". $self->getfield($field);
+      or return gettext('illegal_phone'). " $field: ". $self->getfield($field);

     $phonen = "$1-$2-$3";
     $phonen .= " x$4" if $4;
     $self->setfield($field,$phonen);
   } else {
     $phonen = "$1-$2-$3";
     $phonen .= " x$4" if $4;
     $self->setfield($field,$phonen);
   } else {

-    warn "don't know how to check phone numbers for country $country";
+    warn "warning: don't know how to check phone numbers for country $country";

     return $self->ut_textn($field);
   }
   '';
     return $self->ut_textn($field);
   }
   '';


@@ -850,7 +966,7 @@ Check/untaint host and domain names.
 sub ut_domain {
   my( $self, $field ) = @_;
   #$self->getfield($field) =~/^(\w+\.)*\w+$/
 sub ut_domain {
   my( $self, $field ) = @_;
   #$self->getfield($field) =~/^(\w+\.)*\w+$/

-  $self->getfield($field) =~/^(\w+\.)*\w+$/
+  $self->getfield($field) =~/^(([\w\-]+\.)*\w+)$/

     or return "Illegal (domain) $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
     or return "Illegal (domain) $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';


@@ -868,7 +984,7 @@ May not be null.
 sub ut_name {
   my( $self, $field ) = @_;
   $self->getfield($field) =~ /^([\w \,\.\-\']+)$/
 sub ut_name {
   my( $self, $field ) = @_;
   $self->getfield($field) =~ /^([\w \,\.\-\']+)$/

-    or return "Illegal (name) $field: ". $self->getfield($field);
+    or return gettext('illegal_name'). " $field: ". $self->getfield($field);

   $self->setfield($field,$1);
   '';
 }
   $self->setfield($field,$1);
   '';
 }


@@ -883,12 +999,12 @@ sub ut_zip {
   my( $self, $field, $country ) = @_;
   if ( $country eq 'US' ) {
     $self->getfield($field) =~ /\s*(\d{5}(\-\d{4})?)\s*$/
   my( $self, $field, $country ) = @_;
   if ( $country eq 'US' ) {
     $self->getfield($field) =~ /\s*(\d{5}(\-\d{4})?)\s*$/

-      or return "Illegal (zip) $field for country $country: ".
+      or return gettext('illegal_zip'). " $field for country $country: ".

                 $self->getfield($field);
     $self->setfield($field,$1);
   } else {
     $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
                 $self->getfield($field);
     $self->setfield($field,$1);
   } else {
     $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/

-      or return "Illegal (zip) $field: ". $self->getfield($field);
+      or return gettext('illegal_zip'). " $field: ". $self->getfield($field);

     $self->setfield($field,$1);
   }
   '';
     $self->setfield($field,$1);
   }
   '';


@@ -946,6 +1062,34 @@ sub ut_enum {
   return "Illegal (enum) field $field: ". $self->getfield($field);
 }
 
   return "Illegal (enum) field $field: ". $self->getfield($field);
 }
 

+=item ut_foreign_key COLUMN FOREIGN_TABLE FOREIGN_COLUMN
+
+Check/untaint a foreign column key.  Call a regular ut_ method (like ut_number)
+on the column first.
+
+=cut
+
+sub ut_foreign_key {
+  my( $self, $field, $table, $foreign ) = @_;
+  qsearchs($table, { $foreign => $self->getfield($field) })
+    or return "Can't find $field ". $self->getfield($field).
+              " in $table.$foreign";
+  '';
+}
+
+=item ut_foreign_keyn COLUMN FOREIGN_TABLE FOREIGN_COLUMN
+
+Like ut_foreign_key, except the null value is also allowed.
+
+=cut
+
+sub ut_foreign_keyn {
+  my( $self, $field, $table, $foreign ) = @_;
+  $self->getfield($field)
+    ? $self->ut_foreign_key($field, $table, $foreign)
+    : '';
+}
+

 =item fields [ TABLE ]
 
 This can be used as both a subroutine and a method call.  It returns a list
 =item fields [ TABLE ]
 
 This can be used as both a subroutine and a method call.  It returns a list


@@ -986,12 +1130,15 @@ I<$FS::Record::setup_hack> is true.  Returns a DBIx::DBSchema object.
 
 sub reload_dbdef {
   my $file = shift || $dbdef_file;
 
 sub reload_dbdef {
   my $file = shift || $dbdef_file;

-  $dbdef = load DBIx::DBSchema $file;
+  $dbdef = exists $dbdef_cache{$file}
+    ? $dbdef_cache{$file}
+    : $dbdef_cache{$file} = DBIx::DBSchema->load( $file )
+                              or die "can't load database schema from $file";

 }
 
 =item dbdef
 
 }
 
 =item dbdef
 

-Returns the current database definition.  See L<FS::dbdef>.
+Returns the current database definition.  See L<DBIx::DBSchema>.

 
 =cut
 
 
 =cut
 


@@ -1001,7 +1148,7 @@ sub dbdef { $dbdef; }
 
 This is an internal function used to construct SQL statements.  It returns
 VALUE DBI-quoted (see L<DBI/"quote">) unless VALUE is a number and the column
 
 This is an internal function used to construct SQL statements.  It returns
 VALUE DBI-quoted (see L<DBI/"quote">) unless VALUE is a number and the column

-type (see L<FS::dbdef_column>) does not end in `char' or `binary'.
+type (see L<DBIx::DBSchema::Column>) does not end in `char' or `binary'.

 
 =cut
 
 
 =cut
 


@@ -1010,7 +1157,7 @@ sub _quote {
   my($dbh)=dbh;
   if ( $value =~ /^\d+(\.\d+)?$/ && 
 #       ! ( datatype($table,$field) =~ /^char/ ) 
   my($dbh)=dbh;
   if ( $value =~ /^\d+(\.\d+)?$/ && 
 #       ! ( datatype($table,$field) =~ /^char/ ) 

-       ! ( $dbdef->table($table)->column($field)->type =~ /(char|binary)$/i ) 
+       ! $dbdef->table($table)->column($field)->type =~ /(char|binary|text)$/i 

   ) {
     $value;
   } else {
   ) {
     $value;
   } else {


@@ -1036,12 +1183,12 @@ sub hfields {
   \%hash;
 }
 
   \%hash;
 }
 

-#sub _dump {
-#  my($self)=@_;
-#  join("\n", map {
-#    "$_: ". $self->getfield($_). "|"
-#  } (fields($self->table)) );
-#}
+sub _dump {
+  my($self)=@_;
+  join("\n", map {
+    "$_: ". $self->getfield($_). "|"
+  } (fields($self->table)) );
+}

 
 sub DESTROY { return; }
 
 
 sub DESTROY { return; }
 


@@ -1071,7 +1218,7 @@ The whole fields / hfields mess should be removed.
 
 The various WHERE clauses should be subroutined.
 
 
 The various WHERE clauses should be subroutined.
 

-table string should be depriciated in favor of FS::dbdef_table.
+table string should be depriciated in favor of DBIx::DBSchema::Table.

 
 No doubt we could benefit from a Tied hash.  Documenting how exists / defined
 true maps to the database (and WHERE clauses) would also help.
 
 No doubt we could benefit from a Tied hash.  Documenting how exists / defined
 true maps to the database (and WHERE clauses) would also help.