X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=f8711d021eda78ad2c06a63af2ca34b33653c020;hb=9509e5bfb7f9331303153cac24d7bfecbe2ea9f1;hp=29f2dc6180f55300968040df8302d15311cd0d02;hpb=dcdf657e77ec7b46dc69e19a849a9c133123db7c;p=freeside.git diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 29f2dc618..f8711d021 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -3,13 +3,15 @@ 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; 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); @@ -30,6 +32,7 @@ $DEBUG = 0; $me = '[FS::Record]'; $nowarn_identical = 0; +$no_update_diff = 0; my $rsa_module; my $rsa_loaded; @@ -84,6 +87,7 @@ FS::Record - Database record objects $value = $record->unique('column'); $error = $record->ut_float('column'); + $error = $record->ut_floatn('column'); $error = $record->ut_number('column'); $error = $record->ut_numbern('column'); $error = $record->ut_snumber('column'); @@ -209,6 +213,7 @@ The preferred usage is to pass a hash reference of named parameters: #these are optional... 'select' => '*', 'extra_sql' => 'AND field ', + 'order_by' => 'ORDER BY something', #'cache_obj' => '', #optional 'addl_from' => 'LEFT JOIN othtable USING ( field )', } @@ -231,13 +236,14 @@ fine in the common case where there are only two parameters: =cut sub qsearch { - my($stable, $record, $select, $extra_sql, $cache, $addl_from ); + my($stable, $record, $select, $extra_sql, $order_by, $cache, $addl_from ); if ( ref($_[0]) ) { #hashref for now, eventually maybe accept a list too my $opt = shift; $stable = $opt->{'table'} or die "table name is required"; $record = $opt->{'hashref'} || {}; $select = $opt->{'select'} || '*'; $extra_sql = $opt->{'extra_sql'} || ''; + $order_by = $opt->{'order_by'} || ''; $cache = $opt->{'cache_obj'} || ''; $addl_from = $opt->{'addl_from'} || ''; } else { @@ -358,6 +364,7 @@ sub qsearch { } $statement .= " $extra_sql" if defined($extra_sql); + $statement .= " $order_by" if defined($order_by); warn "[debug]$me $statement\n" if $DEBUG > 1; my $sth = $dbh->prepare($statement) @@ -562,6 +569,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. @@ -676,6 +694,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, @@ -687,12 +723,17 @@ sub insert { my $self = shift; my $saved = {}; + warn "$self -> insert" if $DEBUG; + my $error = $self->check; return $error if $error; #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($_); } @@ -719,6 +760,7 @@ sub insert { # 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); @@ -783,8 +825,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; }; @@ -973,21 +1014,9 @@ returns the error, otherwise returns false. =cut sub replace { - my $new = shift; - my $old = shift; - - if (!defined($old)) { - 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"; - } - } + my ($new, $old) = (shift, shift); + + $old = $new->replace_old unless defined($old); warn "[debug]$me $new ->replace $old\n" if $DEBUG; @@ -1022,7 +1051,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 ''; @@ -1157,6 +1186,22 @@ sub replace { } +sub replace_old { + my( $self ) = shift; + warn "[$me] replace called with no arguments; autoloading old record\n" + if $DEBUG; + + my $primary_key = $self->dbdef_table->primary_key; + if ( $primary_key ) { + $self->by_key( $self->$primary_key() ) #this is what's returned + or croak "can't find ". $self->table. ".$primary_key ". + $self->$primary_key(); + } else { + croak $self->table. " has no primary key; pass old record as argument"; + } + +} + =item rep Depriciated (use replace instead). @@ -1213,6 +1258,7 @@ sub _h_statement { # 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; } @@ -1285,11 +1331,63 @@ sub ut_float { $self->setfield($field,$1); ''; } +=item ut_floatn COLUMN + +Check/untaint 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 + +#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+\.\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). May not be null. If there -is an error, returns the error, otherwise returns false. +Check/untaint signed numeric data (whole numbers). If there is an error, +returns the error, otherwise returns false. =cut @@ -1525,6 +1623,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. @@ -1962,7 +2146,7 @@ sub loadRSA { $rsa_module = 'Crypt::OpenSSL::RSA'; # The Default my $conf = new FS::Conf; - if ($conf->exists('encryptionmodule') && $conf->config('encryptionmodule') ne '') { + if ($conf->exists('encryptionmodule') && $conf->config_binary('encryptionmodule') ne '') { $rsa_module = $conf->config('encryptionmodule'); } @@ -1971,13 +2155,13 @@ sub loadRSA { $rsa_loaded++; } # Initialize Encryption - if ($conf->exists('encryptionpublickey') && $conf->config('encryptionpublickey') ne '') { + if ($conf->exists('encryptionpublickey') && $conf->config_binary('encryptionpublickey') ne '') { my $public_key = join("\n",$conf->config('encryptionpublickey')); $rsa_encrypt = $rsa_module->new_public_key($public_key); } # Intitalize Decryption - if ($conf->exists('encryptionprivatekey') && $conf->config('encryptionprivatekey') ne '') { + if ($conf->exists('encryptionprivatekey') && $conf->config_binary('encryptionprivatekey') ne '') { my $private_key = join("\n",$conf->config('encryptionprivatekey')); $rsa_decrypt = $rsa_module->new_private_key($private_key); }