X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=5fa0a466aca53e7a3694aa01d23a25519ea75d0a;hp=cb42b266c1070ee87b6a43bb49ab31fb89799bab;hb=6914db4bdd641adcab054b3aa0508d482f3dab9e;hpb=e6ea57971831f25d682d97a0ba508c39b66ecd8b diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index cb42b266c..5fa0a466a 100644 --- 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); @@ -224,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 ?"; @@ -236,7 +250,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"; @@ -488,13 +502,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 = ''; @@ -548,13 +562,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 = ''; @@ -633,13 +647,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 = ''; @@ -648,7 +662,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 = ''; @@ -721,7 +735,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), @@ -817,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. @@ -825,10 +839,10 @@ false. sub ut_text { my($self,$field)=@_; - warn "msgcat ". \&msgcat. "\n"; - warn "notexist ". \¬exist. "\n"; - warn "AUTOLOAD ". \&AUTOLOAD. "\n"; - $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]+)$/ + #warn "msgcat ". \&msgcat. "\n"; + #warn "notexist ". \¬exist. "\n"; + #warn "AUTOLOAD ". \&AUTOLOAD. "\n"; + $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]+)$/ or return gettext('illegal_or_empty_text'). " $field: ". $self->getfield($field); $self->setfield($field,$1); @@ -845,7 +859,7 @@ May be null. If there is an error, returns the error, otherwise returns false. sub ut_textn { my($self,$field)=@_; - $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]*)$/ + $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]*)$/ or return gettext('illegal_text'). " $field: ". $self->getfield($field); $self->setfield($field,$1); ''; @@ -1116,8 +1130,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 @@ -1141,7 +1162,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 {