X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=b620c0114653f74b20e25728ad2493e28a64f9f7;hb=60324b718d6170400e891bdd008c6062df2d3b3b;hp=0ffd90951479bbb653464868b02d528e30183d9a;hpb=009bca4e236c30bce3e40db4c12f304ecf8bf695;p=freeside.git

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 0ffd90951..b620c0114 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.19;
+use DBIx::DBSchema 0.23;
 use FS::UID qw(dbh checkruid getotaker datasrc driver_name);
 use FS::SearchCache;
 use FS::Msgcat qw(gettext);
@@ -224,19 +224,29 @@ sub qsearch {
 
       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 "" )-;
@@ -259,7 +269,7 @@ sub qsearch {
     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 {
@@ -332,9 +342,11 @@ for a single item, or your data is corrupted.
 =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]) : ();
 }
 
@@ -418,11 +430,11 @@ sub AUTOLOAD {
   $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);
   }    
 }
@@ -450,6 +462,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'} }; 
 }
 
@@ -610,7 +624,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;
@@ -639,7 +670,7 @@ sub replace {
         $old->getfield($_) eq ''
           #? "( $_ IS NULL OR $_ = \"\" )"
           ? ( driver_name =~ /^Pg$/i
-                ? "$_ IS NULL"
+                ? "( $_ IS NULL OR $_ = '' ) "
                 : "( $_ IS NULL OR $_ = \"\" )"
             )
           : "$_ = ". _quote($old->getfield($_),$old->table,$_)
@@ -780,6 +811,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
@@ -1002,9 +1048,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);
+    }
   }
   '';
 }
@@ -1157,15 +1207,23 @@ type (see L<DBIx::DBSchema::Column>) does not end in `char' or `binary'.
 =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);
   }
 }