X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=e24c0eb9a83eb54eb45e155d92d8628b48253876;hb=c62991706722410987b249893f1323b4ba0e7a5f;hp=4e5e18a846ede4a9e26a80fff87a41f87ac6b100;hpb=dc91892bd1c4567013bbaf11dcb0c6064899a357;p=freeside.git diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 4e5e18a84..e24c0eb9a 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -131,14 +131,18 @@ sub new { $self->{'Table'} = shift; carp "warning: FS::Record::new called with table name ". $self->{'Table'}; } + + $self->{'Hash'} = shift; - my $hashref = $self->{'Hash'} = shift; - - foreach my $field ( grep !defined($hashref->{$_}), $self->fields ) { - $hashref->{$field}=''; + foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) { + $self->{'Hash'}{$field}=''; } - $self->_cache($hashref, shift) if $self->can('_cache') && @_; + $self->_rebless if $self->can('_rebless'); + + $self->{'modified'} = 0; + + $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_; $self; } @@ -176,7 +180,7 @@ sub create { } } -=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ +=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM Searches the database for all records matching (at least) the key/value pairs in HASHREF. Returns all the records found as `FS::TABLE' objects if that @@ -195,7 +199,7 @@ objects. =cut sub qsearch { - my($stable, $record, $select, $extra_sql, $cache ) = @_; + my($stable, $record, $select, $extra_sql, $cache, $addl_from ) = @_; #$stable =~ /^([\w\_]+)$/ or die "Illegal table: $table"; #for jsearch $stable =~ /^([\w\s\(\)\.\,\=]+)$/ or die "Illegal table: $stable"; @@ -219,6 +223,7 @@ sub qsearch { } my $statement = "SELECT $select FROM $stable"; + $statement .= " $addl_from" if $addl_from; if ( @real_fields or @virtual_fields ) { $statement .= ' WHERE '. join(' AND ', ( map { @@ -423,7 +428,7 @@ sub jsearch { ); } -=item qsearchs TABLE, HASHREF +=item qsearchs TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM Same as qsearch, except that if more than one record matches, it Bs but returns the first. If this happens, you either made a logic error in asking @@ -434,7 +439,7 @@ for a single item, or your data is corrupted. sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash); my $table = $_[0]; my(@result) = qsearch(@_); - carp "warning: Multiple records in scalar search ($table)" + cluck "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]) : (); @@ -498,6 +503,7 @@ Sets the value of the column/field/key COLUMN to VALUE. Returns VALUE. sub set { my($self,$field,$value) = @_; + $self->{'modified'} = 1; $self->{'Hash'}->{$field} = $value; } sub setfield { @@ -559,7 +565,9 @@ sub hash { =item hashref -Returns a reference to the column/value hash. +Returns a reference to the column/value hash. This may be deprecated in the +future; if there's a reason you can't just use the autoloaded or get/set +methods, speak up. =cut @@ -568,6 +576,19 @@ sub hashref { $self->{'Hash'}; } +=item modified + +Returns true if any of this object's values have been modified with set (or via +an autoloaded method). Doesn't yet recognize when you retreive a hashref and +modify that. + +=cut + +sub modified { + my $self = shift; + $self->{'modified'}; +} + =item insert Inserts this record to the database. If there is an error, returns the error, @@ -869,13 +890,25 @@ sub replace { ). ' WHERE '. join(' AND ', map { - $old->getfield($_) eq '' - #? "( $_ IS NULL OR $_ = \"\" )" - ? ( driver_name eq 'Pg' - ? "( $_ IS NULL OR $_ = '' )" - : "( $_ IS NULL OR $_ = \"\" )" - ) - : "$_ = ". _quote($old->getfield($_),$old->table,$_) + + if ( $old->getfield($_) eq '' ) { + + #false laziness w/qsearch + if ( driver_name eq 'Pg' ) { + my $type = $old->dbdef_table->column($_)->type; + if ( $type =~ /(int|serial)/i ) { + qq-( $_ IS NULL )-; + } else { + qq-( $_ IS NULL OR $_ = '' )-; + } + } else { + qq-( $_ IS NULL OR $_ = "" )-; + } + + } else { + "$_ = ". _quote($old->getfield($_),$old->table,$_); + } + } ( $primary_key ? ( $primary_key ) : real_fields($old->table) ) ) ; @@ -1404,7 +1437,7 @@ on the column first. sub ut_foreign_key { my( $self, $field, $table, $foreign ) = @_; qsearchs($table, { $foreign => $self->getfield($field) }) - or return "Can't find $field ". $self->getfield($field). + or return "Can't find ". $self->table. ".$field ". $self->getfield($field). " in $table.$foreign"; ''; } @@ -1551,9 +1584,14 @@ sub _quote { my($value, $table, $column) = @_; my $column_obj = $dbdef->table($table)->column($column); my $column_type = $column_obj->type; + my $nullable = $column_obj->null; + + warn " $table.$column: $value ($column_type". + ( $nullable ? ' NULL' : ' NOT NULL' ). + ")\n" if $DEBUG > 2; if ( $value eq '' && $column_type =~ /^int/ ) { - if ( $column_obj->null ) { + if ( $nullable ) { 'NULL'; } else { cluck "WARNING: Attempting to set non-null integer $table.$column null; ". @@ -1681,6 +1719,8 @@ L, L, L Adapter::DBI from Ch. 11 of Advanced Perl Programming by Sriram Srinivasan. +http://poop.sf.net/ + =cut 1;