X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=755cef8303175f90a9bf5976b97c57d4c746ae9b;hb=69c6e80a7253f927af1780a3e0dd3fcf50110599;hp=6c7a321e6bfea476a3a0cc1c9214c7cd61cd3c4c;hpb=45b4365687be864c68b1daa0ee7787a6a0933589;p=freeside.git diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 6c7a321e6..755cef830 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -1,12 +1,14 @@ package FS::Record; use strict; -use vars qw($dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG); +use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG + $me ); use subs qw(reload_dbdef); use Exporter; use Carp qw(carp cluck croak confess); use File::CounterFile; use Locale::Country; +use DBI qw(:sql_types); use DBIx::DBSchema 0.19; use FS::UID qw(dbh checkruid getotaker datasrc driver_name); use FS::SearchCache; @@ -15,6 +17,7 @@ use FS::SearchCache; @EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch); $DEBUG = 0; +$me = '[FS::Record]'; #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::Record'} = sub { @@ -121,7 +124,10 @@ sub new { my $self = {}; bless ($self, $class); - $self->{'Table'} = shift unless defined ( $self->table ); + unless ( defined ( $self->table ) ) { + $self->{'Table'} = shift; + carp "warning: FS::Record::new called with table name ". $self->{'Table'}; + } my $hashref = $self->{'Hash'} = shift; @@ -210,7 +216,7 @@ sub qsearch { $statement .= ' WHERE '. join(' AND ', map { if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) { if ( driver_name =~ /^Pg$/i ) { - "$_ IS NULL"; + qq-( $_ IS NULL OR $_ = '' )-; } else { qq-( $_ IS NULL OR $_ = "" )-; } @@ -221,13 +227,30 @@ sub qsearch { } $statement .= " $extra_sql" if defined($extra_sql); - warn $statement if $DEBUG; + warn "[debug]$me $statement\n" if $DEBUG; my $sth = $dbh->prepare($statement) or croak "$dbh->errstr doing $statement"; - $sth->execute( map $record->{$_}, + my $bind = 1; + + foreach my $field ( grep defined( $record->{$_} ) && $record->{$_} ne '', @fields - ) or croak "Error executing \"$statement\": ". $dbh->errstr; + ) { + if ( $record->{$field} =~ /^\d+(\.\d+)?$/ + && $dbdef->table($table)->column($field)->type =~ /(int)/i + ) { + $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_INTEGER } ); + } else { + $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_VARCHAR } ); + } + } + +# $sth->execute( map $record->{$_}, +# grep defined( $record->{$_} ) && $record->{$_} ne '', @fields +# ) or croak "Error executing \"$statement\": ". $sth->errstr; + + $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr; + $dbh->commit or croak $dbh->errstr if $FS::UID::AutoCommit; if ( eval 'scalar(@FS::'. $table. '::ISA);' ) { @@ -257,13 +280,15 @@ sub qsearch { } -=item jsearch +=item jsearch TABLE, HASHREF, SELECT, EXTRA_SQL, PRIMARY_TABLE, PRIMARY_KEY Experimental JOINed search method. Using this method, you can execute a single SELECT spanning multiple tables, and cache the results for subsequent method calls. Interface will almost definately change in an incompatible fashion. +Arguments: + =cut sub jsearch { @@ -451,6 +476,7 @@ sub insert { join(', ',map(_quote($self->getfield($_),$self->table,$_), @fields)). ")" ; + warn "[debug]$me $statement\n" if $DEBUG; my $sth = dbh->prepare($statement) or return dbh->errstr; local $SIG{HUP} = 'IGNORE'; @@ -500,6 +526,7 @@ sub delete { ? ( $self->dbdef_table->primary_key) : $self->fields ); + warn "[debug]$me $statement\n" if $DEBUG; my $sth = dbh->prepare($statement) or return dbh->errstr; local $SIG{HUP} = 'IGNORE'; @@ -538,11 +565,11 @@ returns the error, otherwise returns false. sub replace { my ( $new, $old ) = ( shift, shift ); - warn "[debug][FS::Record] $new ->replace $old\n" if $DEBUG; + warn "[debug]$me $new ->replace $old\n" if $DEBUG; my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields; unless ( @diff ) { - carp "[warning][FS::Record] $new -> replace $old: records identical"; + carp "[warning]$me $new -> replace $old: records identical"; return ''; } @@ -573,6 +600,7 @@ sub replace { } ( $primary_key ? ( $primary_key ) : $old->fields ) ) ; + warn "[debug]$me $statement\n" if $DEBUG; my $sth = dbh->prepare($statement) or return dbh->errstr; local $SIG{HUP} = 'IGNORE'; @@ -986,7 +1014,8 @@ 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; + $dbdef = load DBIx::DBSchema $file + or die "can't load database schema from $file"; } =item dbdef