X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=946e39dd551d11c3b0ed84b717d88d33d6657d55;hb=f1e474e3ea4c658b9a1f84af108f09a65886055c;hp=2517d18412adda88ebd0be8a1dc73c77c537e6e2;hpb=3dc9375300fa2b9706e2b5707694022962f65b4d;p=freeside.git diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 2517d1841..946e39dd5 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -9,7 +9,7 @@ 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); @@ -806,7 +806,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 +855,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 +986,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 +1077,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 +1314,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); + } } ''; }