import rt 2.0.14

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

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 0bd7aed..e6126a1 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);
@@ -131,15 +132,8 @@ sub new {
 
   my $hashref = $self->{'Hash'} = shift;
 
-  foreach my $field ( $self->fields ) { 
-    $hashref->{$field}='' unless defined $hashref->{$field};
-    #trim the '$' and ',' from money fields for Pg (belong HERE?)
-    #(what about Pg i18n?)
-    if ( driver_name =~ /^Pg$/i
-         && $self->dbdef_table->column($field)->type eq 'money' ) {
-      ${$hashref}{$field} =~ s/^\$//;
-      ${$hashref}{$field} =~ s/\,//;
-    }
+  foreach my $field ( grep !defined($hashref->{$_}), $self->fields ) { 
+    $hashref->{$field}='';
   }
 
   $self->_cache($hashref, shift) if $self->can('_cache') && @_;
@@ -223,10 +217,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 ?";
@@ -235,7 +243,7 @@ sub qsearch {
   }
   $statement .= " $extra_sql" if defined($extra_sql);
 
-  warn "[debug]$me $statement\n" if $DEBUG;
+  warn "[debug]$me $statement\n" if $DEBUG > 1;
   my $sth = $dbh->prepare($statement)
     or croak "$dbh->errstr doing $statement";
 
@@ -398,32 +406,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.
@@ -487,13 +495,13 @@ sub insert {
       join( ', ', @values ).
     ")"
   ;
-  warn "[debug]$me $statement\n" if $DEBUG;
+  warn "[debug]$me $statement\n" if $DEBUG > 1;
   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;
+    warn "[debug]$me $h_statement\n" if $DEBUG > 2;
     $h_sth = dbh->prepare($h_statement) or return dbh->errstr;
   } else {
     $h_sth = '';
@@ -547,13 +555,13 @@ sub delete {
           ? ( $self->dbdef_table->primary_key)
           : $self->fields
   );
-  warn "[debug]$me $statement\n" if $DEBUG;
+  warn "[debug]$me $statement\n" if $DEBUG > 1;
   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;
+    warn "[debug]$me $h_statement\n" if $DEBUG > 2;
     $h_sth = dbh->prepare($h_statement) or return dbh->errstr;
   } else {
     $h_sth = '';
@@ -571,7 +579,7 @@ sub delete {
   $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
+  #no need to needlessly destoy the data either (causes problems actually)
   #undef $self; #no need to keep object!
 
   '';
@@ -632,13 +640,13 @@ sub replace {
       } ( $primary_key ? ( $primary_key ) : $old->fields )
     )
   ;
-  warn "[debug]$me $statement\n" if $DEBUG;
+  warn "[debug]$me $statement\n" if $DEBUG > 1;
   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;
+    warn "[debug]$me $h_old_statement\n" if $DEBUG > 2;
     $h_old_sth = dbh->prepare($h_old_statement) or return dbh->errstr;
   } else {
     $h_old_sth = '';
@@ -647,7 +655,7 @@ sub replace {
   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;
+    warn "[debug]$me $h_new_statement\n" if $DEBUG > 2;
     $h_new_sth = dbh->prepare($h_new_statement) or return dbh->errstr;
   } else {
     $h_new_sth = '';
@@ -720,7 +728,7 @@ sub unique {
   my($self,$field) = @_;
   my($table)=$self->table;
 
-  croak("&FS::UID::checkruid failed") unless &checkruid;
+  #croak("&FS::UID::checkruid failed") unless &checkruid;
 
   croak "Unique called on field $field, but it is ",
         $self->getfield($field),
@@ -816,7 +824,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.
 
@@ -824,8 +832,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);
   '';
 }
@@ -840,8 +852,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);
   '';
 }
@@ -896,7 +908,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);
@@ -947,7 +959,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);
   '';
@@ -965,7 +977,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);
   '';
 }
@@ -980,12 +992,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);
   }
   '';
@@ -1111,8 +1123,15 @@ 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";
+
+  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";
+  } else {
+    warn "[debug]$me re-using cached dbdef for $file\n" if $DEBUG;
+  }
+  $dbdef = $dbdef_cache{$file};
 }
 
 =item dbdef
@@ -1136,7 +1155,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 {