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 7dc19cc..7d5ff05 100644 (file)
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -2,7 +2,7 @@ package FS::Record;
 
 use strict;
 use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG
-             $me );
+             $me %dbdef_cache );
 use subs qw(reload_dbdef);
 use Exporter;
 use Carp qw(carp cluck croak confess);
@@ -12,6 +12,7 @@ use DBI qw(:sql_types);
 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);
@@ -223,10 +224,24 @@ sub qsearch {
       }
 
       if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
-        if ( driver_name =~ /^Pg$/i ) {
-          qq-( $_ IS NULL OR $_ = '' )-;
+        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 {
-          qq-( $_ IS NULL OR $_ = "" )-;
+          if ( driver_name =~ /^Pg$/i ) {
+            qq-( $_ $op '' )-;
+          } else {
+            qq-( $_ $op "" )-;
+          }
         }
       } else {
         "$_ $op ?";
@@ -398,32 +413,32 @@ $record->column('value') is a synonym for $record->set('column','value');
 =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 {
-  my $field = $AUTOLOAD;
+  my($self,$value)=@_;
+  my($field)=$AUTOLOAD;
   $field =~ s/.*://;
-  if ( defined($_[1]) ) {
-    $_[0]->setfield($field, $_[1]);
+  if ( defined($value) ) {
+    confess "errant AUTOLOAD $field for $self (arg $value)"
+      unless $self->can('setfield');
+    $self->setfield($field,$value);
   } 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.
@@ -490,9 +505,14 @@ sub insert {
   warn "[debug]$me $statement\n" if $DEBUG;
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
-  my $h_statement = $self->_h_statement('insert');
-  warn "[debug]$me $h_statement\n" if $DEBUG;
-  my $h_sth = dbh->prepare($h_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';
@@ -502,7 +522,7 @@ sub insert {
   local $SIG{PIPE} = 'IGNORE';
 
   $sth->execute or return $sth->errstr;
-  $h_sth->execute or return $h_sth->errstr;
+  $h_sth->execute or return $h_sth->errstr if $h_sth;
   dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
 
   '';
@@ -545,9 +565,14 @@ sub delete {
   warn "[debug]$me $statement\n" if $DEBUG;
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
-  my $h_statement = $self->_h_statement('delete');
-  warn "[debug]$me $h_statement\n" if $DEBUG;
-  my $h_sth = dbh->prepare($h_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';
@@ -558,10 +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";
-  $h_sth->execute or return $h_sth->errstr;
+  $h_sth->execute or return $h_sth->errstr if $h_sth;
   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!
 
   '';
 }
@@ -624,13 +650,23 @@ sub replace {
   warn "[debug]$me $statement\n" if $DEBUG;
   my $sth = dbh->prepare($statement) or return dbh->errstr;
 
-  my $h_old_statement = $old->_h_statement('replace_old');
-  warn "[debug]$me $h_old_statement\n" if $DEBUG;
-  my $h_old_sth = dbh->prepare($h_old_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_statement = $new->_h_statement('replace_new');
-  warn "[debug]$me $h_new_statement\n" if $DEBUG;
-  my $h_new_sth = dbh->prepare($h_new_statement) or return dbh->errstr;
+  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';
@@ -641,8 +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";
-  $h_old_sth->execute or return $h_old_sth->errstr;
-  $h_new_sth->execute or return $h_new_sth->errstr;
+  $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;
 
   '';
@@ -795,7 +831,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.
 
@@ -803,8 +839,12 @@ false.
 
 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);
   '';
 }
@@ -819,8 +859,8 @@ 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 "Illegal (text) $field: ". $self->getfield($field);
+  $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]*)$/
+    or return gettext('illegal_text'). " $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
 }
@@ -875,7 +915,7 @@ sub ut_phonen {
   } 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);
@@ -926,7 +966,7 @@ Check/untaint host and domain names.
 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);
   '';
@@ -944,7 +984,7 @@ May not be null.
 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);
   '';
 }
@@ -959,12 +999,12 @@ sub ut_zip {
   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*$/
-      or return "Illegal (zip) $field: ". $self->getfield($field);
+      or return gettext('illegal_zip'). " $field: ". $self->getfield($field);
     $self->setfield($field,$1);
   }
   '';
@@ -1090,8 +1130,10 @@ I<$FS::Record::setup_hack> is true.  Returns a DBIx::DBSchema object.
 
 sub reload_dbdef {
   my $file = shift || $dbdef_file;
-  $dbdef = load DBIx::DBSchema $file
-    or die "can't load database schema from $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
@@ -1115,7 +1157,7 @@ sub _quote {
   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 {