X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=e6126a13bda8c6580eded78859806b0d8d833a13;hb=0da4c69a66e13410b0eff18966e13170d1306f22;hp=ed87b0c19009710fb63b4ff4cb0e39555210b236;hpb=f03d05cfbcc04564f8ce40e798c3d1a49dba71d8;p=freeside.git diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index ed87b0c19..e6126a13b 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); @@ -132,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') && @_; @@ -224,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 ?"; @@ -236,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"; @@ -488,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 = ''; @@ -548,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 = ''; @@ -633,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 = ''; @@ -648,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 = ''; @@ -721,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), @@ -1116,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 @@ -1141,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 {