X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=f4bf2a21c6339bc270e3ff84acc58c782f2d8951;hp=5de4ca7520a092d78176714a7daf46fd25c9ad61;hb=ffa18709ee8a4d05e18d2d406cf73afe79e52524;hpb=d2e3299a0af2b5122d73b9f3ca0814a36919b1da diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 5de4ca752..f4bf2a21c 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -5,7 +5,7 @@ use strict; use charnames ':full'; use vars qw( $AUTOLOAD %virtual_fields_cache %fk_method_cache $fk_table_cache - $money_char $lat_lower $lon_upper + %virtual_fields_hash_cache $money_char $lat_lower $lon_upper $use_placeholders ); use Carp qw(carp cluck croak confess); @@ -25,6 +25,7 @@ use FS::Schema qw(dbdef); use FS::SearchCache; use FS::Msgcat qw(gettext); #use FS::Conf; #dependency loop bs, in install_callback below instead +use Email::Valid; use FS::part_virtual_field; @@ -286,6 +287,11 @@ the individual PARAMS_HASHREF queries #regular FS::TABLE methods #on it. +C<$FS::Record::qsearch_qualify_columns> package global is enabled 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 @@ -1805,6 +1811,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 @@ -2881,11 +2922,9 @@ to 127.0.0.1. sub ut_ip { my( $self, $field ) = @_; $self->setfield($field, '127.0.0.1') if $self->getfield($field) eq '::1'; - $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"); - ''; + return "Illegal (IP address) $field: ".$self->getfield($field) + unless $self->getfield($field) =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/; + $self->ut_ip46($field); } =item ut_ipn COLUMN @@ -2913,8 +2952,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 ''; } @@ -2934,6 +2974,21 @@ 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. @@ -3211,6 +3266,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 @@ -3291,6 +3400,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). @@ -3579,7 +3718,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); }