use File::CounterFile;
use Locale::Country;
use DBI qw(:sql_types);
-use DBIx::DBSchema 0.19;
+use DBIx::DBSchema 0.23;
use FS::UID qw(dbh checkruid getotaker datasrc driver_name);
use FS::SearchCache;
use FS::Msgcat qw(gettext);
if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
if ( $op eq '=' ) {
- if ( driver_name =~ /^Pg$/i ) {
- qq-( $column IS NULL OR $column = '' )-;
+ if ( driver_name eq 'Pg' ) {
+ my $type = $dbdef->table($table)->column($column)->type;
+ if ( $type =~ /(int|serial)/i ) {
+ qq-( $column IS NULL )-;
+ } else {
+ qq-( $column IS NULL OR $column = '' )-;
+ }
} else {
qq-( $column IS NULL OR $column = "" )-;
}
} elsif ( $op eq '!=' ) {
- if ( driver_name =~ /^Pg$/i ) {
- qq-( $column IS NOT NULL AND $column != '' )-;
+ if ( driver_name eq 'Pg' ) {
+ 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 != '' )-;
+ }
} else {
qq-( $column IS NOT NULL AND $column != "" )-;
}
} else {
- if ( driver_name =~ /^Pg$/i ) {
+ if ( driver_name eq 'Pg' ) {
qq-( $column $op '' )-;
} else {
qq-( $column $op "" )-;
grep defined( $record->{$_} ) && $record->{$_} ne '', @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 {
=cut
sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash);
+ my $table = $_[0];
my(@result) = qsearch(@_);
- carp "warning: Multiple records in scalar search!" if scalar(@result) > 1;
- #should warn more vehemently if the search was on a primary key?
+ carp "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]) : ();
}
$field =~ s/.*://;
if ( defined($value) ) {
confess "errant AUTOLOAD $field for $self (arg $value)"
- unless $self->can('setfield');
+ unless ref($self) && $self->can('setfield');
$self->setfield($field,$value);
} else {
confess "errant AUTOLOAD $field for $self (no args)"
- unless $self->can('getfield');
+ unless ref($self) && $self->can('getfield');
$self->getfield($field);
}
}
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 =~ /^Pg$/i
- ? "$_ IS NULL"
+ ? "( $_ IS NULL OR $_ = '' ) "
: "( $_ IS NULL OR $_ = \"\" )"
)
: "$_ = ". _quote($old->getfield($_),$old->table,$_)
'';
}
+=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);
+ }
}
'';
}
=cut
sub _quote {
- my($value,$table,$field)=@_;
- my($dbh)=dbh;
- if ( $value =~ /^\d+(\.\d+)?$/ &&
-# ! ( datatype($table,$field) =~ /^char/ )
- ! $dbdef->table($table)->column($field)->type =~ /(char|binary|text)$/i
- ) {
+ my($value, $table, $column) = @_;
+ my $column_obj = $dbdef->table($table)->column($column);
+ my $column_type = $column_obj->type;
+
+ if ( $value eq '' && $column_type =~ /^int/ ) {
+ if ( $column_obj->null ) {
+ 'NULL';
+ } else {
+ cluck "WARNING: Attempting to set non-null integer $table.$column null; ".
+ "using 0 instead";
+ 0;
+ }
+ } elsif ( $value =~ /^\d+(\.\d+)?$/ &&
+ ! $column_type =~ /(char|binary|text)$/i ) {
$value;
} else {
- $dbh->quote($value);
+ dbh->quote($value);
}
}