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);
@ISA = qw(Exporter);
@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch);
-$DEBUG = 2;
+$DEBUG = 0;
$me = '[FS::Record]';
#ask FS::UID to run this stuff for us later
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 ) {
if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
if ( $op eq '=' ) {
if ( driver_name eq 'Pg' ) {
- if ( $dbdef->table($table)->column($column)->type =~ /(int)/i ) {
+ my $type = $dbdef->table($table)->column($column)->type;
+ if ( $type =~ /(int|serial)/i ) {
qq-( $column IS NULL )-;
} else {
qq-( $column IS NULL OR $column = '' )-;
}
} elsif ( $op eq '!=' ) {
if ( driver_name eq 'Pg' ) {
- if ( $dbdef->table($table)->column($column)->type =~ /(int)/i ) {
+ my $type = $dbdef->table($table)->column($column)->type;
+ if ( $type =~ /(int|serial)/i ) {
qq-( $column IS NOT NULL )-;
} else {
qq-( $column IS NOT NULL AND $column != '' )-;
grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields
) {
if ( $record->{$field} =~ /^\d+(\.\d+)?$/
- && $dbdef->table($table)->column($field)->type =~ /(int)/i
+ && $dbdef->table($table)->column($field)->type =~ /(int|serial)/i
) {
$sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_INTEGER } );
} else {
$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;
}
$sth->finish;
+
if ( keys(%result) and @virtual_fields ) {
$statement =
"SELECT virtual_field.recnum, part_virtual_field.name, ".
sub hash {
my($self) = @_;
+ confess $self. ' -> hash: Hash attribute is undefined'
+ unless defined($self->{'Hash'});
%{ $self->{'Hash'} };
}
=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;
$old->getfield($_) eq ''
#? "( $_ IS NULL OR $_ = \"\" )"
? ( driver_name eq 'Pg'
- ? "$_ IS NULL"
+ ? "( $_ IS NULL OR $_ = '' )"
: "( $_ IS NULL OR $_ = \"\" )"
)
: "$_ = ". _quote($old->getfield($_),$old->table,$_)
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, $_);
}
}
'';
}
+=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
$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);
+ }
}
'';
}
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;
}
projects / freeside.git / blobdiff