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;
use Locale::Country;
use DBI qw(:sql_types);
use DBIx::DBSchema 0.25;
+#use DBIx::DBSchema 0.33; #when check for ->can('unique_singles') is sub insert
+ #is removed
use FS::UID qw(dbh getotaker datasrc driver_name);
use FS::CurrentUser;
use FS::Schema qw(dbdef);
$me = '[FS::Record]';
$nowarn_identical = 0;
+$no_update_diff = 0;
my $rsa_module;
my $rsa_loaded;
#single-field unique keys are given a value if false
#(like MySQL's AUTO_INCREMENT or Pg SERIAL)
- foreach ( $self->dbdef_table->unique->singles ) {
+ foreach ( $self->dbdef_table->can('unique_singles')
+ ? $self->dbdef_table->unique_singles
+ : $self->dbdef_table->unique->singles
+ ) {
$self->unique($_) unless $self->getfield($_);
}
# Encrypt before the database
+ my $conf = new FS::Conf;
if ($conf->exists('encryption') && defined(eval '@FS::'. $table . '::encrypted_fields')) {
foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
$self->{'saved'} = $self->getfield($field);
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 '';
# If we're encrypting then don't ever store the payinfo or CVV2 in the history....
# You can see if it changed by the paymask...
+ my $conf = new FS::Conf;
if ($conf->exists('encryption') ) {
@fields = grep $_ ne 'payinfo' && $_ ne 'cvv2', @fields;
}
}
}
+=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+\.\d+)$/ ||
+ $self->getfield($field) =~ /^(-?\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
Check/untaint signed numeric data (whole numbers). If there is an error,
}
}
+=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.