X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=af8c101960ccbf9ba237eab1d51ae2363c434308;hb=0df2eac272aa26a62431f5cd830c1cb7b1018e32;hp=e646b399e6ca0c46c82ec5b8252e73e30e7c26dc;hpb=f3729cae00c3282bb34ff071f0dd5f9bcd5ce9e1;p=freeside.git diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index e646b399e..af8c10196 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -4,7 +4,7 @@ use strict; use charnames ':full'; use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG %virtual_fields_cache - $money_char $lat_lower $lon_upper + %virtual_fields_hash_cache $money_char $lat_lower $lon_upper $me $nowarn_identical $nowarn_classload $no_update_diff $no_history $qsearch_qualify_columns @@ -28,6 +28,7 @@ use FS::Msgcat qw(gettext); use NetAddr::IP; # for validation use Data::Dumper; #use FS::Conf; #dependency loop bs, in install_callback below instead +use Email::Valid; use FS::part_virtual_field; @@ -289,6 +290,11 @@ the individual PARAMS_HASHREF queries #regular FS::TABLE methods #on it. +C<$FS::Record::qsearch_qualify_columns> package global is disabled by default. +When enabled, the WHERE clause generated from the 'hashref' parameter has +the table name prepended to each column name. WHERE column = 'value' becomes +WHERE table.coumn = 'value' + =cut my %TYPE = (); #for debugging @@ -556,8 +562,8 @@ sub qsearch { # Check for encrypted fields and decrypt them. ## only in the local copy, not the cached object no warnings 'deprecated'; # XXX silence the warning for now - if ( $conf_encryption - && eval 'defined(@FS::'. $table . '::encrypted_fields)' ) { + if ( $conf_encryption + && eval '@FS::'. $table . '::encrypted_fields' ) { foreach my $record (@return) { foreach my $field (eval '@FS::'. $table . '::encrypted_fields') { next if $field eq 'payinfo' @@ -765,8 +771,8 @@ sub _from_hashref { # Check for encrypted fields and decrypt them. ## only in the local copy, not the cached object - if ( $conf_encryption - && eval 'defined(@FS::'. $table . '::encrypted_fields)' ) { + if ( $conf_encryption + && eval '@FS::'. $table . '::encrypted_fields' ) { foreach my $record (@return) { foreach my $field (eval '@FS::'. $table . '::encrypted_fields') { next if $field eq 'payinfo' @@ -1615,6 +1621,41 @@ sub virtual_fields { } +=item virtual_fields_hash [ TABLE ] + +Returns a list of virtual field records as a hash defined for the table. This should not +be exported, and should only be called as an instance or class method. + +=cut + +sub virtual_fields_hash { + my $self = shift; + my $table; + $table = $self->table or confess "virtual_fields called on non-table"; + + confess "Unknown table $table" unless dbdef->table($table); + + return () unless dbdef->table('part_virtual_field'); + + unless ( $virtual_fields_hash_cache{$table} ) { + $virtual_fields_hash_cache{$table} = []; + my $concat = [ "'cf_'", "name" ]; + my $select = concat_sql($concat).' as name, label, length'; + my @vfields = qsearch({ + select => $select, + table => 'part_virtual_field', + hashref => { 'dbtable' => $table, }, + }); + + foreach (@vfields) { + push @{ $virtual_fields_hash_cache{$table} }, $_->{Hash}; + } + } + + @{$virtual_fields_hash_cache{$table}}; + +} + =item process_batch_import JOB OPTIONS_HASHREF PARAMS Processes a batch import as a queued JSRPC job @@ -2210,7 +2251,11 @@ sub _h_statement { "INSERT INTO h_". $self->table. " ( ". join(', ', qw(history_date history_user history_action), @fields ). ") VALUES (". - join(', ', $time, dbh->quote(getotaker()), dbh->quote($action), @values). + join(', ', $time, + dbh->quote($FS::CurrentUser::CurrentUser->username), + dbh->quote($action), + @values + ). ")" ; } @@ -2667,7 +2712,7 @@ sub ut_ip { $self->getfield($field) =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ or return "Illegal (IP address) $field: ". $self->getfield($field); for ( $1, $2, $3, $4 ) { return "Illegal (IP address) $field" if $_ > 255; } - $self->setfield($field, "$1.$2.$3.$4"); + $self->setfield( $field, $self->_ut_ip_strip_leading_zeros( "$1.$2.$3.$4" )); ''; } @@ -2696,8 +2741,9 @@ Check/untaint IPv4 or IPv6 address. sub ut_ip46 { my( $self, $field ) = @_; - my $ip = NetAddr::IP->new($self->getfield($field)) - or return "Illegal (IP address) $field: ".$self->getfield($field); + my $ip = NetAddr::IP->new( + $self->_ut_ip_strip_leading_zeros( $self->getfield($field) ) + ) or return "Illegal (IP address) $field: ".$self->getfield($field); $self->setfield($field, lc($ip->addr)); return ''; } @@ -2717,6 +2763,20 @@ sub ut_ip46n { $self->ut_ip46($field); } +sub _ut_ip_strip_leading_zeros { + # strip user-entered leading 0's from IP addresses + # so parsers like NetAddr::IP don't mangle the address + # e.g. NetAddr::IP converts 10.0.022.220 into 10.0.18.220 + + my ( $self, $ip ) = @_; + + return join '.', map int, split /\./, $ip + if $ip + && $ip =~ /\./ + && $ip =~ /[\.^]0/; + $ip; +} + =item ut_coord COLUMN [ LOWER [ UPPER ] ] Check/untaint coordinates. @@ -2995,6 +3055,60 @@ sub ut_enumn { : ''; } +=item ut_date COLUMN + +Check/untaint a column containing a date string. + +Date will be normalized to YYYY-MM-DD format + +=cut + +sub ut_date { + my ( $self, $field ) = @_; + my $value = $self->getfield( $field ); + + my @date = split /[\-\/]/, $value; + if ( scalar(@date) == 3 ) { + @date = @date[2,0,1] if $date[2] >= 1900; + + local $@; + my $ymd; + eval { + # DateTime will die given invalid date + $ymd = DateTime->new( + year => $date[0], + month => $date[1], + day => $date[2], + )->ymd('-'); + }; + + unless( $@ ) { + $self->setfield( $field, $ymd ) unless $value eq $ymd; + return ''; + } + + } + return "Illegal (date) field $field: $value"; +} + +=item ut_daten COLUMN + +Check/untaint a column containing a date string. + +Column may be null. + +Date will be normalized to YYYY-MM-DD format + +=cut + +sub ut_daten { + my ( $self, $field ) = @_; + + $self->getfield( $field ) =~ /^()$/ + ? $self->setfield( $field, '' ) + : $self->ut_date( $field ); +} + =item ut_flag COLUMN Check/untaint a column if it contains either an empty string or 'Y'. This @@ -3075,6 +3189,36 @@ sub ut_agentnum_acl { } + +=item ut_email COLUMN + +Check column contains a valid E-Mail address + +=cut + +sub ut_email { + my ( $self, $field ) = @_; + Email::Valid->address( $self->getfield( $field ) ) + ? '' + : "Illegal (email) field $field: ". $self->getfield( $field ); +} + +=item ut_emailn COLUMN + +Check column contains a valid E-Mail address + +May be null + +=cut + +sub ut_emailn { + my ( $self, $field ) = @_; + + $self->getfield( $field ) =~ /^$/ + ? $self->getfield( $field, '' ) + : $self->ut_email( $field ); +} + =item trim_whitespace FIELD[, FIELD ... ] Strip leading and trailing spaces from the value in the named FIELD(s). @@ -3376,7 +3520,19 @@ sub _quote { && driver_name eq 'Pg' ) { - dbh->quote($value, { pg_type => PG_BYTEA() }); + local $@; + + eval { $value = dbh->quote($value, { pg_type => PG_BYTEA() }); }; + + if ( $@ && $@ =~ /Wide character/i ) { + warn 'Correcting malformed UTF-8 string for binary quote()' + if $DEBUG; + utf8::decode($value); + utf8::encode($value); + $value = dbh->quote($value, { pg_type => PG_BYTEA() }); + } + + $value; } else { dbh->quote($value); }