X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=5cf77d3e71a3997fe2419721a7046279ffaecb5b;hb=refs%2Ftags%2Ffreeside_1_4_1rc2;hp=ed87b0c19009710fb63b4ff4cb0e39555210b236;hpb=f03d05cfbcc04564f8ce40e798c3d1a49dba71d8;p=freeside.git diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index ed87b0c19..5cf77d3e7 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') && @_; @@ -217,26 +210,54 @@ sub qsearch { $statement .= ' WHERE '. join(' AND ', map { my $op = '='; + my $column = $_; if ( ref($record->{$_}) ) { $op = $record->{$_}{'op'} if $record->{$_}{'op'}; - $op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name !~ /^Pg$/i; + #$op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name !~ /^Pg$/i; + if ( uc($op) eq 'ILIKE' ) { + $op = 'LIKE'; + $record->{$_}{'value'} = lc($record->{$_}{'value'}); + $column = "LOWER($_)"; + } $record->{$_} = $record->{$_}{'value'} } if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) { - if ( driver_name =~ /^Pg$/i ) { - qq-( $_ IS NULL OR $_ = '' )-; + if ( $op eq '=' ) { + if ( driver_name eq 'Pg' ) { + if ( $dbdef->table($table)->column($column)->type =~ /(int)/i ) { + qq-( $column IS NULL )-; + } else { + qq-( $column IS NULL OR $column = '' )-; + } + } else { + qq-( $column IS NULL OR $column = "" )-; + } + } elsif ( $op eq '!=' ) { + if ( driver_name eq 'Pg' ) { + if ( $dbdef->table($table)->column($column)->type =~ /(int)/i ) { + qq-( $column IS NOT NULL )-; + } else { + qq-( $column IS NOT NULL AND $column != '' )-; + } + } else { + qq-( $column IS NOT NULL AND $column != "" )-; + } } else { - qq-( $_ IS NULL OR $_ = "" )-; + if ( driver_name eq 'Pg' ) { + qq-( $column $op '' )-; + } else { + qq-( $column $op "" )-; + } } } else { - "$_ $op ?"; + "$column $op ?"; } } @fields ); } $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"; @@ -319,9 +340,11 @@ for a single item, or your data is corrupted. =cut sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash); + my $table = $_[0]; my(@result) = qsearch(@_); - carp "warning: Multiple records in scalar search!" if scalar(@result) > 1; - #should warn more vehemently if the search was on a primary key? + carp "warning: Multiple records in scalar search ($table)" + if scalar(@result) > 1; + #should warn more vehemently if the search was on a primary key? scalar(@result) ? ($result[0]) : (); } @@ -488,13 +511,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 +571,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 +656,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 +671,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 +744,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), @@ -923,7 +946,7 @@ sub ut_ip { $self->getfield($field) =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ or return "Illegal (IP address) $field: ". $self->getfield($field); for ( $1, $2, $3, $4 ) { return "Illegal (IP address) $field" if $_ > 255; } - $self->setfield($field, "$1.$2.$3.$3"); + $self->setfield($field, "$1.$2.$3.$4"); ''; } @@ -1116,8 +1139,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 @@ -1137,15 +1167,23 @@ type (see L) does not end in `char' or `binary'. =cut sub _quote { - my($value,$table,$field)=@_; - my($dbh)=dbh; - if ( $value =~ /^\d+(\.\d+)?$/ && -# ! ( datatype($table,$field) =~ /^char/ ) - ! ( $dbdef->table($table)->column($field)->type =~ /(char|binary)$/i ) - ) { + my($value, $table, $column) = @_; + my $column_obj = $dbdef->table($table)->column($column); + my $column_type = $column_obj->type; + + if ( $value eq '' && $column_type =~ /^int/ ) { + if ( $column_obj->null ) { + 'NULL'; + } else { + cluck "WARNING: Attempting to set non-null integer $table.$column null; ". + "using 0 instead"; + 0; + } + } elsif ( $value =~ /^\d+(\.\d+)?$/ && + ! $column_type =~ /(char|binary|text)$/i ) { $value; } else { - $dbh->quote($value); + dbh->quote($value); } }