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;
$me = '[FS::Record]';
$nowarn_identical = 0;
+$no_update_diff = 0;
my $rsa_module;
my $rsa_loaded;
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.
$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,
my $self = shift;
my $saved = {};
+ warn "$self -> insert" if $DEBUG;
+
my $error = $self->check;
return $error if $error;
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;
};
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 '';
=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
}
}
+=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.