Added $FS::Record::no_update_diff flag to update "identical" records anyway.

[freeside.git] / FS / FS / Record.pm

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index ba03091..0afe3ec 100644 (file)
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -3,7 +3,7 @@ package FS::Record;
 use strict;
 use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG
              $conf $me
-             %virtual_fields_cache $nowarn_identical );
+             %virtual_fields_cache $nowarn_identical $no_update_diff );
 use Exporter;
 use Carp qw(carp cluck croak confess);
 use File::CounterFile;
@@ -30,6 +30,7 @@ $DEBUG = 0;
 $me = '[FS::Record]';
 
 $nowarn_identical = 0;
+$no_update_diff = 0;
 
 my $rsa_module;
 my $rsa_loaded;
@@ -563,6 +564,17 @@ sub dbdef_table {
   dbdef->table($table);
 }
 
+=item primary_key
+
+Returns the primary key for the table.
+
+=cut
+
+sub primary_key {
+  my $self = shift;
+  my $pkey = $self->dbdef_table->primary_key;
+}
+
 =item get, getfield COLUMN
 
 Returns the value of the column/field/key COLUMN.
@@ -677,6 +689,24 @@ sub modified {
   $self->{'modified'};
 }
 
+=item select_for_update
+
+Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
+a mutex.
+
+=cut
+
+sub select_for_update {
+  my $self = shift;
+  my $primary_key = $self->primary_key;
+  qsearchs( {
+    'select'    => '*',
+    'table'     => $self->table,
+    'hashref'   => { $primary_key => $self->$primary_key() },
+    'extra_sql' => 'FOR UPDATE',
+  } );
+}
+
 =item insert
 
 Inserts this record to the database.  If there is an error, returns the error,
@@ -688,6 +718,8 @@ sub insert {
   my $self = shift;
   my $saved = {};
 
+  warn "$self -> insert" if $DEBUG;
+
   my $error = $self->check;
   return $error if $error;
 
@@ -784,8 +816,7 @@ sub insert {
         dbh->rollback if $FS::UID::AutoCommit;
         return dbh->errstr;
       };
-      #$i_sth->execute($oid) or do {
-      $i_sth->execute() or do {
+      $i_sth->execute() or do { #$i_sth->execute($oid)
         dbh->rollback if $FS::UID::AutoCommit;
         return $i_sth->errstr;
       };
@@ -1011,7 +1042,7 @@ sub replace {
   my %diff = map { ($new->getfield($_) ne $old->getfield($_))
                    ? ($_, $new->getfield($_)) : () } $old->fields;
                    
-  unless ( keys(%diff) ) {
+  unless (keys(%diff) || $no_update_diff ) {
     carp "[warning]$me $new -> replace $old: records identical"
       unless $nowarn_identical;
     return '';
@@ -1297,17 +1328,51 @@ null.  If there is an error, returns the error, otherwise returns false.
 
 =cut
 
+#false laziness w/ut_ipn
 sub ut_floatn {
+  my( $self, $field ) = @_;
+  if ( $self->getfield($field) =~ /^()$/ ) {
+    $self->setfield($field,'');
+    '';
+  } else {
+    $self->ut_float($field);
+  }
+}
+
+=item ut_sfloat COLUMN
+
+Check/untaint signed floating point numeric data: 1.1, 1, 1.1e10, 1e10.
+May not be null.  If there is an error, returns the error, otherwise returns
+false.
+
+=cut
+
+sub ut_sfloat {
   my($self,$field)=@_ ;
-  ($self->getfield($field) =~ /^(\d*)$/ ||
-   $self->getfield($field) =~ /^(-?\d+\.\d+)$/ ||
+  ($self->getfield($field) =~ /^(-?\d+\.\d+)$/ ||
    $self->getfield($field) =~ /^(-?\d+)$/ ||
-   $self->getfield($field) =~ /^(-?\d+\.\d+e\d+)$/ ||
-   $self->getfield($field) =~ /^(-?\d+e\d+)$/)
+   $self->getfield($field) =~ /^(-?\d+\.\d+[eE]-?\d+)$/ ||
+   $self->getfield($field) =~ /^(-?\d+[eE]-?\d+)$/)
     or return "Illegal or empty (float) $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
 }
+=item ut_sfloatn COLUMN
+
+Check/untaint signed floating point numeric data: 1.1, 1, 1.1e10, 1e10.  May be
+null.  If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_sfloatn {
+  my( $self, $field ) = @_;
+  if ( $self->getfield($field) =~ /^()$/ ) {
+    $self->setfield($field,'');
+    '';
+  } else {
+    $self->ut_sfloat($field);
+  }
+}
 
 =item ut_snumber COLUMN
 
@@ -1548,6 +1613,92 @@ sub ut_ipn {
   }
 }
 
+=item ut_coord COLUMN [ LOWER [ UPPER ] ]
+
+Check/untaint coordinates.
+Accepts the following forms:
+DDD.DDDDD
+-DDD.DDDDD
+DDD MM.MMM
+-DDD MM.MMM
+DDD MM SS
+-DDD MM SS
+DDD MM MMM
+-DDD MM MMM
+
+The "DDD MM SS" and "DDD MM MMM" are potentially ambiguous.
+The latter form (that is, the MMM are thousands of minutes) is
+assumed if the "MMM" is exactly three digits or two digits > 59.
+
+To be safe, just use the DDD.DDDDD form.
+
+If LOWER or UPPER are specified, then the coordinate is checked
+for lower and upper bounds, respectively.
+
+=cut
+
+sub ut_coord {
+
+  my ($self, $field) = (shift, shift);
+
+  my $lower = shift if scalar(@_);
+  my $upper = shift if scalar(@_);
+  my $coord = $self->getfield($field);
+  my $neg = $coord =~ s/^(-)//;
+
+  my ($d, $m, $s) = (0, 0, 0);
+
+  if (
+    (($d) = ($coord =~ /^(\s*\d{1,3}(?:\.\d+)?)\s*$/)) ||
+    (($d, $m) = ($coord =~ /^(\s*\d{1,3})\s+(\d{1,2}(?:\.\d+))\s*$/)) ||
+    (($d, $m, $s) = ($coord =~ /^(\s*\d{1,3})\s+(\d{1,2})\s+(\d{1,3})\s*$/))
+  ) {
+    $s = (((($s =~ /^\d{3}$/) or $s > 59) ? ($s / 1000) : ($s / 60)) / 60);
+    $m = $m / 60;
+    if ($m > 59) {
+      return "Invalid (coordinate with minutes > 59) $field: "
+             . $self->getfield($field);
+    }
+
+    $coord = ($neg ? -1 : 1) * sprintf('%.8f', $d + $m + $s);
+
+    if (defined($lower) and ($coord < $lower)) {
+      return "Invalid (coordinate < $lower) $field: "
+             . $self->getfield($field);;
+    }
+
+    if (defined($upper) and ($coord > $upper)) {
+      return "Invalid (coordinate > $upper) $field: "
+             . $self->getfield($field);;
+    }
+
+    $self->setfield($field, $coord);
+    return '';
+  }
+
+  return "Invalid (coordinate) $field: " . $self->getfield($field);
+
+}
+
+=item ut_coordn COLUMN [ LOWER [ UPPER ] ]
+
+Same as ut_coord, except optionally null.
+
+=cut
+
+sub ut_coordn {
+
+  my ($self, $field) = (shift, shift);
+
+  if ($self->getfield($field) =~ /^$/) {
+    return '';
+  } else {
+    return $self->ut_coord($field, @_);
+  }
+
+}
+
+
 =item ut_domain COLUMN
 
 Check/untaint host and domain names.