X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=479f9b1f18ec02b9cd4f9e82e286bdd5675f911b;hb=5f7c4a6025b9e3a49bee72dbc06cac37a45e6f10;hp=0f3685bfa56153b9bd4d0ead70cd3fac237cc31e;hpb=1ac4a177bd93ad7a97a45aacb66aa0bc9c23726b;p=freeside.git diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 0f3685bfa..479f9b1f1 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -2,9 +2,11 @@ package FS::Record; use base qw( Exporter ); use strict; +use charnames ':full'; use vars qw( $AUTOLOAD - %virtual_fields_cache %fk_method_cache + %virtual_fields_cache %fk_method_cache $fk_table_cache $money_char $lat_lower $lon_upper + $use_placeholders ); use Carp qw(carp cluck croak confess); use Scalar::Util qw( blessed ); @@ -34,12 +36,14 @@ our @EXPORT_OK = qw( dbh fields hfields qsearch qsearchs dbdef jsearch str2time_sql str2time_sql_closing regexp_sql not_regexp_sql concat_sql group_concat_sql - midnight_sql + midnight_sql fk_methods_init ); our $DEBUG = 0; our $me = '[FS::Record]'; +$use_placeholders = 0; + our $nowarn_identical = 0; our $nowarn_classload = 0; our $no_update_diff = 0; @@ -56,12 +60,18 @@ my $rsa_decrypt; our $conf = ''; our $conf_encryption = ''; +our $conf_encryptionmodule = ''; +our $conf_encryptionpublickey = ''; +our $conf_encryptionprivatekey = ''; FS::UID->install_callback( sub { eval "use FS::Conf;"; die $@ if $@; $conf = FS::Conf->new; - $conf_encryption = $conf->exists('encryption'); + $conf_encryption = $conf->exists('encryption'); + $conf_encryptionmodule = $conf->config('encryptionmodule'); + $conf_encryptionpublickey = join("\n",$conf->config('encryptionpublickey')); + $conf_encryptionprivatekey = join("\n",$conf->config('encryptionprivatekey')); $money_char = $conf->config('money_char') || '$'; my $nw_coords = $conf->exists('geocode-require_nw_coordinates'); $lat_lower = $nw_coords ? 1 : -90; @@ -76,9 +86,7 @@ FS::UID->install_callback( sub { eval "sub PG_BYTEA { die 'guru meditation #9: calling PG_BYTEA when not running Pg?'; }"; } - foreach my $table ( dbdef->tables ) { - $fk_method_cache{$table} = fk_methods($table); - } + #fk_methods_init(); } ); @@ -195,6 +203,7 @@ sub new { $self->{'modified'} = 0; + $self->_simplecache($self->{'Hash'}) if $self->can('_simplecache'); $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_; $self; @@ -399,10 +408,17 @@ sub qsearch { my @real_fields = grep exists($record->{$_}), real_fields($table); my $statement .= "SELECT $select FROM $stable"; - $statement .= " $addl_from" if $addl_from; + my $alias_main; + if ( $addl_from ) { + $statement .= " $addl_from"; + # detect aliasing of the main table + if ( $addl_from =~ /^\s*AS\s+(\w+)/i ) { + $alias_main = $1; + } + } if ( @real_fields ) { $statement .= ' WHERE '. join(' AND ', - get_real_fields($table, $record, \@real_fields)); + get_real_fields($table, $record, \@real_fields, $alias_main)); } $statement .= " $extra_sql" if defined($extra_sql); @@ -514,6 +530,7 @@ 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 '@FS::'. $table . '::encrypted_fields' ) { foreach my $record (@return) { @@ -751,6 +768,8 @@ sub get_real_fields { my $table = shift; my $record = shift; my $real_fields = shift; + my $alias_main = shift; # defaults to undef + $alias_main ||= $table; ## could be optimized more for readability return ( @@ -758,7 +777,7 @@ sub get_real_fields { my $op = '='; my $column = $_; - my $table_column = $qsearch_qualify_columns ? "$table.$column" : $column; + my $table_column = $qsearch_qualify_columns ? "$alias_main.$column" : $column; my $type = dbdef->table($table)->column($column)->type; my $value = $record->{$column}; $value = $value->{'value'} if ref($value); @@ -972,7 +991,7 @@ sub exists { exists($self->{Hash}->{$field}); } -=item AUTLOADED METHODS +=item AUTOLOADED METHODS $record->column is a synonym for $record->get('column'); @@ -994,10 +1013,8 @@ sub AUTOLOAD { confess "errant AUTOLOAD $field for $self (arg $value)" unless blessed($self) && $self->can('setfield'); - #$fk_method_cache{$self->table} ||= fk_methods($self->table); - if ( exists($fk_method_cache{$self->table}->{$field}) ) { + if ( my $fk_info = get_fk_method($self->table, $field) ) { - my $fk_info = $fk_method_cache{$self->table}->{$field}; my $method = $fk_info->{method} || 'qsearchs'; my $table = $fk_info->{table} || $field; my $column = $fk_info->{column}; @@ -1040,6 +1057,37 @@ sub AUTOLOAD { # } #} +# get_fk_method(TABLE, FIELD) +# Internal subroutine for fetching the foreign key descriptor for TABLE.FIELD +# if there is one. If not, returns undef. +# This will initialize fk_method_cache if it hasn't happened yet. It is the +# _only_ allowed way to access the contents of %fk_method_cache. + +# if we wanted to be even more efficient we'd create the fk methods in the +# symbol table instead of relying on AUTOLOAD every time + +sub get_fk_method { + my ($table, $field) = @_; + + # maybe should only load one table at a time? + fk_methods_init() unless exists($fk_method_cache{$table}); + + if ( exists($fk_method_cache{$table}) and + exists($fk_method_cache{$table}{$field}) ) { + return $fk_method_cache{$table}{$field}; + } else { + return undef; + } + +} + +sub fk_methods_init { + warn "[fk_methods_init]\n" if $DEBUG; + foreach my $table ( dbdef->tables ) { + $fk_method_cache{$table} = fk_methods($table); + } +} + sub fk_methods { my $table = shift; @@ -1077,11 +1125,15 @@ sub fk_methods { # (alas. why we're cached. still, might this loop better be done once at # schema load time insetad of every time we AUTOLOAD a method on a new # class?) - foreach my $f_table ( dbdef->tables ) { - foreach my $fk (dbdef->table($f_table)->foreign_keys) { - - next unless $fk->table eq $table; - + if (! defined $fk_table_cache) { + foreach my $f_table ( dbdef->tables ) { + foreach my $fk (dbdef->table($f_table)->foreign_keys) { + push @{$fk_table_cache->{$fk->table}},[$f_table,$fk]; + } + } + } + foreach my $fks (@{$fk_table_cache->{$table}}) { + my ($f_table,$fk) = @$fks; my $method = ''; if ( scalar( @{$fk->columns} ) == 1 ) { if ( ! defined($fk->references) @@ -1104,9 +1156,6 @@ sub fk_methods { } } - - } - } \%hash; @@ -1284,9 +1333,8 @@ sub insert { my $table = $self->table; # Encrypt before the database - if ( defined(eval '@FS::'. $table . '::encrypted_fields') - && scalar( eval '@FS::'. $table . '::encrypted_fields') - && $conf->exists('encryption') + if ( scalar( eval '@FS::'. $table . '::encrypted_fields') + && $conf_encryption ) { foreach my $field (eval '@FS::'. $table . '::encrypted_fields') { next if $field eq 'payinfo' @@ -1304,21 +1352,44 @@ sub insert { grep { defined($self->getfield($_)) && $self->getfield($_) ne "" } real_fields($table) ; - my @values = map { _quote( $self->getfield($_), $table, $_) } @real_fields; - #eslaf my $statement = "INSERT INTO $table "; - if ( @real_fields ) { - $statement .= - "( ". - join( ', ', @real_fields ). - ") VALUES (". - join( ', ', @values ). - ")" - ; - } else { + my @bind_values = (); + + if ( ! @real_fields ) { + $statement .= 'DEFAULT VALUES'; + + } else { + + if ( $use_placeholders ) { + + @bind_values = map $self->getfield($_), @real_fields; + + $statement .= + "( ". + join( ', ', @real_fields ). + ") VALUES (". + join( ', ', map '?', @real_fields ). # @bind_values ). + ")" + ; + + } else { + + my @values = map { _quote( $self->getfield($_), $table, $_) } @real_fields; + + $statement .= + "( ". + join( ', ', @real_fields ). + ") VALUES (". + join( ', ', @values ). + ")" + ; + + } + } + warn "[debug]$me $statement\n" if $DEBUG > 1; my $sth = dbh->prepare($statement) or return dbh->errstr; @@ -1329,7 +1400,7 @@ sub insert { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; - $sth->execute or return $sth->errstr; + $sth->execute(@bind_values) or return $sth->errstr; # get inserted id from the database, if applicable & needed if ( $db_seq && ! $self->getfield($primary_key) ) { @@ -1527,9 +1598,8 @@ sub replace { # Encrypt for replace my $saved = {}; - if ( $conf->exists('encryption') - && defined(eval '@FS::'. $new->table . '::encrypted_fields') - && scalar( eval '@FS::'. $new->table . '::encrypted_fields') + if ( scalar( eval '@FS::'. $new->table . '::encrypted_fields') + && $conf_encryption ) { foreach my $field (eval '@FS::'. $new->table . '::encrypted_fields') { next if $field eq 'payinfo' @@ -2109,6 +2179,7 @@ sub batch_import { #my $job = $param->{job}; my $line; my $imported = 0; + my $unique_skip = 0; #lines skipped because they're already in the system my( $last, $min_sec ) = ( time, 5 ); #progressbar foo while (1) { @@ -2211,6 +2282,7 @@ sub batch_import { } last if exists( $param->{skiprow} ); } + $unique_skip++ if $param->{unique_skip}; #line is already in the system next if exists( $param->{skiprow} ); if ( $preinsert_callback ) { @@ -2256,7 +2328,8 @@ sub batch_import { unless ( $imported || $param->{empty_ok} ) { $dbh->rollback if $oldAutoCommit; - return "Empty file!"; + # freeside-cdr-conexiant-import is sensitive to the text of this message + return $unique_skip ? "All records in file were previously imported" : "Empty file!"; } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -2278,7 +2351,7 @@ sub _h_statement { ; # If we're encrypting then don't store the payinfo in the history - if ( $conf && $conf->exists('encryption') && $self->table ne 'banned_pay' ) { + if ( $conf_encryption && $self->table ne 'banned_pay' ) { @fields = grep { $_ ne 'payinfo' } @fields; } @@ -2574,7 +2647,7 @@ sub ut_currency { =item ut_text COLUMN Check/untaint text. Alphanumerics, spaces, and the following punctuation -symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / = [ ] < > +symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / = [ ] < > ~ May not be null. If there is an error, returns the error, otherwise returns false. @@ -2588,7 +2661,7 @@ sub ut_text { # \p{Word} = alphanumerics, marks (diacritics), and connectors # see perldoc perluniprops $self->getfield($field) - =~ /^([\p{Word} \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>$money_char]+)$/ + =~ /^([\p{Word} \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>\~$money_char]+)$/ or return gettext('illegal_or_empty_text'). " $field: ". $self->getfield($field); $self->setfield($field,$1); @@ -2867,6 +2940,10 @@ sub ut_coord { my $coord = $self->getfield($field); my $neg = $coord =~ s/^(-)//; + # ignore degree symbol at the end, + # but not otherwise supporting degree/minutes/seconds symbols + $coord =~ s/\N{DEGREE SIGN}\s*$//; + my ($d, $m, $s) = (0, 0, 0); if ( @@ -2961,7 +3038,6 @@ May not be null. sub ut_name { my( $self, $field ) = @_; -# warn "ut_name allowed alphanumerics: +(sort grep /\w/, map { chr() } 0..255), "\n"; $self->getfield($field) =~ /^([\p{Word} \,\.\-\']+)$/ or return gettext('illegal_name'). " $field: ". $self->getfield($field); my $name = $1; @@ -3012,6 +3088,13 @@ sub ut_zip { $self->getfield($field); $self->setfield($field, "$1 $2"); + } elsif ( $country eq 'AU' ) { + + $self->getfield($field) =~ /^\s*(\d{4})\s*$/ + or return gettext('illegal_zip'). " $field for country $country: ". + $self->getfield($field); + $self->setfield($field, $1); + } else { if ( $self->getfield($field) =~ /^\s*$/ @@ -3175,6 +3258,22 @@ sub ut_agentnum_acl { } +=item trim_whitespace FIELD[, FIELD ... ] + +Strip leading and trailing spaces from the value in the named FIELD(s). + +=cut + +sub trim_whitespace { + my $self = shift; + foreach my $field (@_) { + my $value = $self->get($field); + $value =~ s/^\s+//; + $value =~ s/\s+$//; + $self->set($field, $value); + } +} + =item fields [ TABLE ] This is a wrapper for real_fields. Code that called @@ -3209,7 +3308,7 @@ sub encrypt { my ($self, $value) = @_; my $encrypted = $value; - if ($conf->exists('encryption')) { + if ($conf_encryption) { if ($self->is_encrypted($value)) { # Return the original value if it isn't plaintext. $encrypted = $value; @@ -3252,7 +3351,7 @@ You should generally not have to worry about calling this, as the system handles sub decrypt { my ($self,$value) = @_; my $decrypted = $value; # Will return the original value if it isn't encrypted or can't be decrypted. - if ($conf->exists('encryption') && $self->is_encrypted($value)) { + if ($conf_encryption && $self->is_encrypted($value)) { $self->loadRSA; if (ref($rsa_decrypt) =~ /::RSA/) { my $encrypted = unpack ("u*", $value); @@ -3268,8 +3367,8 @@ sub loadRSA { #Initialize the Module $rsa_module = 'Crypt::OpenSSL::RSA'; # The Default - if ($conf->exists('encryptionmodule') && $conf->config('encryptionmodule') ne '') { - $rsa_module = $conf->config('encryptionmodule'); + if ($conf_encryptionmodule && $conf_encryptionmodule ne '') { + $rsa_module = $conf_encryptionmodule; } if (!$rsa_loaded) { @@ -3277,15 +3376,13 @@ sub loadRSA { $rsa_loaded++; } # Initialize Encryption - if ($conf->exists('encryptionpublickey') && $conf->config('encryptionpublickey') ne '') { - my $public_key = join("\n",$conf->config('encryptionpublickey')); - $rsa_encrypt = $rsa_module->new_public_key($public_key); + if ($conf_encryptionpublickey && $conf_encryptionpublickey ne '') { + $rsa_encrypt = $rsa_module->new_public_key($conf_encryptionpublickey); } # Intitalize Decryption - if ($conf->exists('encryptionprivatekey') && $conf->config('encryptionprivatekey') ne '') { - my $private_key = join("\n",$conf->config('encryptionprivatekey')); - $rsa_decrypt = $rsa_module->new_private_key($private_key); + if ($conf_encryptionprivatekey && $conf_encryptionprivatekey ne '') { + $rsa_decrypt = $rsa_module->new_private_key($conf_encryptionprivatekey); } } @@ -3457,11 +3554,7 @@ sub _quote { && driver_name eq 'Pg' ) { - no strict 'subs'; -# dbh->quote($value, { pg_type => PG_BYTEA() }); # doesn't work right - # Pg binary string quoting: convert each character to 3-digit octal prefixed with \\, - # single-quote the whole mess, and put an "E" in front. - return ("E'" . join('', map { sprintf('\\\\%03o', ord($_)) } split(//, $value) ) . "'"); + dbh->quote($value, { pg_type => PG_BYTEA() }); } else { dbh->quote($value); }