X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=4e5e18a846ede4a9e26a80fff87a41f87ac6b100;hp=14dfca2cb72f272e1bdb2321236e4ee775ff551c;hb=dc91892bd1c4567013bbaf11dcb0c6064899a357;hpb=3f0c721ee27ead3504df80addd947057e4fc4c14 diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 14dfca2cb..4e5e18a84 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -2,14 +2,14 @@ package FS::Record; use strict; use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG - $me %dbdef_cache ); + $me %dbdef_cache %virtual_fields_cache ); 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.21; +use DBIx::DBSchema 0.23; use FS::UID qw(dbh getotaker datasrc driver_name); use FS::SearchCache; use FS::Msgcat qw(gettext); @@ -204,10 +204,19 @@ sub qsearch { my $dbh = dbh; my $table = $cache ? $cache->table : $stable; - my $pkey = $dbdef->table($table)->primary_key; + my $dbdef_table = $dbdef->table($table) + or die "No schema for table $table found - ". + "do you need to create it or run dbdef-create?"; + my $pkey = $dbdef_table->primary_key; my @real_fields = grep exists($record->{$_}), real_fields($table); - my @virtual_fields = grep exists($record->{$_}), "FS::$table"->virtual_fields; + my @virtual_fields; + if ( eval 'scalar(@FS::'. $table. '::ISA);' ) { + @virtual_fields = grep exists($record->{$_}), "FS::$table"->virtual_fields; + } else { + cluck "warning: FS::$table not loaded; virtual fields not searchable"; + @virtual_fields = (); + } my $statement = "SELECT $select FROM $stable"; if ( @real_fields or @virtual_fields ) { @@ -325,10 +334,15 @@ sub qsearch { $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr; + if ( eval 'scalar(@FS::'. $table. '::ISA);' ) { + @virtual_fields = "FS::$table"->virtual_fields; + } else { + cluck "warning: FS::$table not loaded; virtual fields not returned either"; + @virtual_fields = (); + } + my %result; tie %result, "Tie::IxHash"; - @virtual_fields = "FS::$table"->virtual_fields; - my @stuff = @{ $sth->fetchall_arrayref( {} ) }; if($pkey) { %result = map { $_->{$pkey}, $_ } @stuff; @@ -337,6 +351,7 @@ sub qsearch { } $sth->finish; + if ( keys(%result) and @virtual_fields ) { $statement = "SELECT virtual_field.recnum, part_virtual_field.name, ". @@ -537,6 +552,8 @@ To make a distinct duplicate of an FS::Record object, you can do: sub hash { my($self) = @_; + confess $self. ' -> hash: Hash attribute is undefined' + unless defined($self->{'Hash'}); %{ $self->{'Hash'} }; } @@ -806,7 +823,24 @@ returns the error, otherwise returns false. =cut sub replace { - my ( $new, $old ) = ( shift, shift ); + my $new = shift; + + my $old; + if ( @_ ) { + $old = shift; + } else { + warn "[debug]$me replace called with no arguments; autoloading old record\n" + if $DEBUG; + my $primary_key = $new->dbdef_table->primary_key; + if ( $primary_key ) { + $old = qsearchs($new->table, { $primary_key => $new->$primary_key() } ) + or croak "can't find ". $new->table. ".$primary_key ". + $new->$primary_key(); + } else { + croak $new->table. " has no primary key; pass old record as argument"; + } + } + warn "[debug]$me $new ->replace $old\n" if $DEBUG; return "Records not in same table!" unless $new->table eq $old->table; @@ -838,7 +872,7 @@ sub replace { $old->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" ? ( driver_name eq 'Pg' - ? "$_ IS NULL" + ? "( $_ IS NULL OR $_ = '' )" : "( $_ IS NULL OR $_ = \"\" )" ) : "$_ = ". _quote($old->getfield($_),$old->table,$_) @@ -969,7 +1003,14 @@ sub check { for ($self->getfield($field)) { # See notes on check_block in FS::part_virtual_field. eval $self->pvf($field)->check_block; - return $@ if $@; + if ( $@ ) { + #this is bad, probably want to follow the stack backtrace up and see + #wtf happened + my $err = "Fatal error checking $field for $self"; + cluck "$err: $@"; + return "$err (see log for backtrace): $@"; + + } $self->setfield($field, $_); } } @@ -1053,6 +1094,21 @@ sub ut_float { ''; } +=item ut_snumber COLUMN + +Check/untaint signed numeric data (whole numbers). May not be null. If there +is an error, returns the error, otherwise returns false. + +=cut + +sub ut_snumber { + my($self, $field) = @_; + $self->getfield($field) =~ /^(-?)\s*(\d+)$/ + or return "Illegal or empty (numeric) $field: ". $self->getfield($field); + $self->setfield($field, "$1$2"); + ''; +} + =item ut_number COLUMN Check/untaint simple numeric data (whole numbers). May not be null. If there @@ -1275,9 +1331,13 @@ sub ut_zip { $self->getfield($field); $self->setfield($field,$1); } else { - $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/ - or return gettext('illegal_zip'). " $field: ". $self->getfield($field); - $self->setfield($field,$1); + if ( $self->getfield($field) =~ /^\s*$/ ) { + $self->setfield($field,''); + } else { + $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/ + or return gettext('illegal_zip'). " $field: ". $self->getfield($field); + $self->setfield($field,$1); + } } ''; } @@ -1379,14 +1439,17 @@ sub virtual_fields { return () unless $self->dbdef->table('part_virtual_field'); - # This should be smart enough to cache results. + unless ( $virtual_fields_cache{$table} ) { + my $query = 'SELECT name from part_virtual_field ' . + "WHERE dbtable = '$table'"; + my $dbh = dbh; + my $result = $dbh->selectcol_arrayref($query); + confess $dbh->errstr if $dbh->err; + $virtual_fields_cache{$table} = $result; + } + + @{$virtual_fields_cache{$table}}; - my $query = 'SELECT name from part_virtual_field ' . - "WHERE dbtable = '$table'"; - my $dbh = dbh; - my $result = $dbh->selectcol_arrayref($query); - confess $dbh->errstr if $dbh->err; - return @$result; }