use strict;
use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG
%virtual_fields_cache
- $conf $conf_encryption $money_char $lat_lower $lon_upper
+ $money_char $lat_lower $lon_upper
$me
$nowarn_identical $nowarn_classload
- $no_update_diff $no_history $no_check_foreign
+ $no_update_diff $no_history $qsearch_qualify_columns
+ $no_check_foreign
@encrypt_payby
);
use Exporter;
#export dbdef for now... everything else expects to find it here
@EXPORT_OK = qw(
dbh fields hfields qsearch qsearchs dbdef jsearch
- str2time_sql str2time_sql_closing regexp_sql not_regexp_sql concat_sql
+ str2time_sql str2time_sql_closing regexp_sql not_regexp_sql
+ concat_sql group_concat_sql
midnight_sql
);
$nowarn_classload = 0;
$no_update_diff = 0;
$no_history = 0;
+
+$qsearch_qualify_columns = 0;
+
$no_check_foreign = 0;
my $rsa_module;
my $rsa_encrypt;
my $rsa_decrypt;
-$conf = '';
-$conf_encryption = '';
+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->exists('encryptionmodule');
+ $conf_encryptionpublickey = $conf->exists('encryptionpublickey');
+ $conf_encryptionprivatekey = $conf->exists('encryptionprivatekey');
$money_char = $conf->config('money_char') || '$';
my $nw_coords = $conf->exists('geocode-require_nw_coordinates');
$lat_lower = $nw_coords ? 1 : -90;
$error = $record->ut_floatn('column');
$error = $record->ut_number('column');
$error = $record->ut_numbern('column');
+ $error = $record->ut_decimal('column');
+ $error = $record->ut_decimaln('column');
$error = $record->ut_snumber('column');
$error = $record->ut_snumbern('column');
$error = $record->ut_money('column');
return @return;
}
-## makes this easier to read
-
sub get_real_fields {
my $table = shift;
my $record = shift;
my $real_fields = shift;
- ## this huge map was previously inline, just broke it out to help read the qsearch method, should be optimized for readability
- return (
- map {
+ ## could be optimized more for readability
+ return (
+ map {
my $op = '=';
my $column = $_;
+ my $table_column = $qsearch_qualify_columns ? "$table.$column" : $column;
my $type = dbdef->table($table)->column($column)->type;
my $value = $record->{$column};
$value = $value->{'value'} if ref($value);
- if ( ref($record->{$_}) ) {
- $op = $record->{$_}{'op'} if $record->{$_}{'op'};
+
+ if ( ref($record->{$column}) ) {
+ $op = $record->{$column}{'op'} if $record->{$column}{'op'};
#$op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name ne 'Pg';
if ( uc($op) eq 'ILIKE' ) {
$op = 'LIKE';
- $record->{$_}{'value'} = lc($record->{$_}{'value'});
- $column = "LOWER($_)";
+ $record->{$column}{'value'} = lc($record->{$column}{'value'});
+ $table_column = "LOWER($table_column)";
}
- $record->{$_} = $record->{$_}{'value'}
+ $record->{$column} = $record->{$column}{'value'}
}
- if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
+ if ( ! defined( $record->{$column} ) || $record->{$column} eq '' ) {
if ( $op eq '=' ) {
if ( driver_name eq 'Pg' ) {
if ( $type =~ /(int|numeric|real|float4|(big)?serial)/i ) {
- qq-( $column IS NULL )-;
+ qq-( $table_column IS NULL )-;
} else {
- qq-( $column IS NULL OR $column = '' )-;
+ qq-( $table_column IS NULL OR $table_column = '' )-;
}
} else {
- qq-( $column IS NULL OR $column = "" )-;
+ qq-( $table_column IS NULL OR $table_column = "" )-;
}
} elsif ( $op eq '!=' ) {
if ( driver_name eq 'Pg' ) {
if ( $type =~ /(int|numeric|real|float4|(big)?serial)/i ) {
- qq-( $column IS NOT NULL )-;
+ qq-( $table_column IS NOT NULL )-;
} else {
- qq-( $column IS NOT NULL AND $column != '' )-;
+ qq-( $table_column IS NOT NULL AND $table_column != '' )-;
}
} else {
- qq-( $column IS NOT NULL AND $column != "" )-;
+ qq-( $table_column IS NOT NULL AND $table_column != "" )-;
}
} else {
if ( driver_name eq 'Pg' ) {
- qq-( $column $op '' )-;
+ qq-( $table_column $op '' )-;
} else {
- qq-( $column $op "" )-;
+ qq-( $table_column $op "" )-;
}
}
} elsif ( $op eq '!=' ) {
- qq-( $column IS NULL OR $column != ? )-;
+ qq-( $table_column IS NULL OR $table_column != ? )-;
#if this needs to be re-enabled, it needs to use a custom op like
#"APPROX=" or something (better name?, not '=', to avoid affecting other
# searches
#} elsif ( $op eq 'APPROX=' && _is_fs_float( $type, $value ) ) {
- # ( "$column <= ?", "$column >= ?" );
+ # ( "$table_column <= ?", "$table_column >= ?" );
} else {
- "$column $op ?";
+ "$table_column $op ?";
}
- } @{ $real_fields } );
+
+ } @{ $real_fields }
+ );
}
=item by_key PRIMARY_KEY_VALUE
# Encrypt before the database
if ( defined(eval '@FS::'. $table . '::encrypted_fields')
&& scalar( eval '@FS::'. $table . '::encrypted_fields')
- && $conf->exists('encryption')
+ && $conf_encryption
) {
foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
next if $field eq 'payinfo'
# Encrypt for replace
my $saved = {};
- if ( $conf->exists('encryption')
+ if ( $conf_encryption
&& defined(eval '@FS::'. $new->table . '::encrypted_fields')
&& scalar( eval '@FS::'. $new->table . '::encrypted_fields')
) {
=item params
-Listref of field names for static fields. They will be given values from the
+Arrayref of field names for static fields. They will be given values from the
PARAMS hashref and passed as a "params" hashref to batch_import.
=item formats
=back
-PARAMS is a base64-encoded Storable string containing the POSTed data as
-a hash ref. It normally contains at least one field, "uploaded files",
-generated by /elements/file-upload.html and containing the list of uploaded
-files. Currently only supports a single file named "file".
+PARAMS is a hashref (or base64-encoded Storable hashref) containing the
+POSTed data. It must contain the field "uploaded files", generated by
+/elements/file-upload.html and containing the list of uploaded files.
+Currently only supports a single file named "file".
=cut
+# uploaded_files is kind of bizarre; fix that some time
+
use Storable qw(thaw);
use Data::Dumper;
use MIME::Base64;
my @pass_params = $opt->{params} ? @{ $opt->{params} } : ();
my %formats = %{ $opt->{formats} };
- my $param = thaw(decode_base64(shift));
+ my $param = shift;
+ # because some job-spawning code (JSRPC) pre-freezes the arguments,
+ # and then the 'frozen' attribute doesn't get set, and thus $job->args
+ # doesn't know to thaw them, we have to do this everywhere.
+ if (!ref $param) {
+ $param = thaw(decode_base64($param));
+ }
warn Dumper($param) if $DEBUG;
my $files = $param->{'uploaded_files'}
format_xml_formats => $opt->{format_xml_formats},
format_asn_formats => $opt->{format_asn_formats},
format_row_callbacks => $opt->{format_row_callbacks},
+ format_hash_callbacks => $opt->{format_hash_callbacks},
#per-import
job => $job,
file => $file,
params => { map { $_ => $param->{$_} } @pass_params },
#?
default_csv => $opt->{default_csv},
+ preinsert_callback => $opt->{preinsert_callback},
postinsert_callback => $opt->{postinsert_callback},
+ insert_args_callback => $opt->{insert_args_callback},
);
if ( $opt->{'batch_namecol'} ) {
=item format_row_callbacks
+=item format_hash_callbacks - After parsing, before object creation
+
=item fields - Alternate way to specify import, specifying import fields directly as a listref
=item preinsert_callback
my( $type, $header, $sep_char,
$fixedlength_format, $xml_format, $asn_format,
- $row_callback, @fields );
+ $parser_opt, $row_callback, $hash_callback, @fields );
my $postinsert_callback = '';
$postinsert_callback = $param->{'postinsert_callback'}
my $preinsert_callback = '';
$preinsert_callback = $param->{'preinsert_callback'}
if $param->{'preinsert_callback'};
+ my $insert_args_callback = '';
+ $insert_args_callback = $param->{'insert_args_callback'}
+ if $param->{'insert_args_callback'};
if ( $param->{'format'} ) {
? $param->{'format_fixedlength_formats'}{ $param->{'format'} }
: '';
+ $parser_opt =
+ $param->{'format_parser_opts'}
+ ? $param->{'format_parser_opts'}{ $param->{'format'} }
+ : {};
+
$xml_format =
$param->{'format_xml_formats'}
? $param->{'format_xml_formats'}{ $param->{'format'} }
? $param->{'format_row_callbacks'}{ $param->{'format'} }
: '';
+ $hash_callback =
+ $param->{'format_hash_callbacks'}
+ ? $param->{'format_hash_callbacks'}{ $param->{'format'} }
+ : '';
+
@fields = @{ $formats->{ $format } };
} elsif ( $param->{'fields'} ) {
$sep_char = ',';
$fixedlength_format = '';
$row_callback = '';
+ $hash_callback = '';
@fields = @{ $param->{'fields'} };
} else {
if ( $type eq 'csv' ) {
- my %attr = ( 'binary' => 1, );
- $attr{sep_char} = $sep_char if $sep_char;
- $parser = new Text::CSV_XS \%attr;
+ $parser_opt->{'binary'} = 1;
+ $parser_opt->{'sep_char'} = $sep_char if $sep_char;
+ $parser = Text::CSV_XS->new($parser_opt);
} elsif ( $type eq 'fixedlength' ) {
eval "use Parse::FixedLength;";
die $@ if $@;
- $parser = Parse::FixedLength->new($fixedlength_format);
+ $parser = Parse::FixedLength->new($fixedlength_format, $parser_opt);
- }
- else {
+ } else {
die "Unknown file type $type\n";
}
$hash{custnum} = $2;
}
+ %hash = &{$hash_callback}(%hash) if $hash_callback;
+
#my $table = $param->{table};
my $class = "FS::$table";
next if exists $param->{skiprow} && $param->{skiprow};
}
- my $error = $record->insert;
+ my @insert_args = ();
+ if ( $insert_args_callback ) {
+ @insert_args = &{$insert_args_callback}($record, $param);
+ }
+
+ my $error = $record->insert(@insert_args);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
;
# 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;
}
'';
}
+=item ut_decimal COLUMN[, DIGITS]
+
+Check/untaint decimal numbers (up to DIGITS decimal places. If there is an
+error, returns the error, otherwise returns false.
+
+=item ut_decimaln COLUMN[, DIGITS]
+
+Check/untaint decimal numbers. May be null. If there is an error, returns
+the error, otherwise returns false.
+
+=cut
+
+sub ut_decimal {
+ my($self, $field, $digits) = @_;
+ $digits ||= '';
+ $self->getfield($field) =~ /^\s*(\d+(\.\d{0,$digits})?)\s*$/
+ or return "Illegal or empty (decimal) $field: ".$self->getfield($field);
+ $self->setfield($field, $1);
+ '';
+}
+
+sub ut_decimaln {
+ my($self, $field, $digits) = @_;
+ $self->getfield($field) =~ /^\s*(\d*(\.\d{0,$digits})?)\s*$/
+ or return "Illegal (decimal) $field: ".$self->getfield($field);
+ $self->setfield($field, $1);
+ '';
+}
+
=item ut_money COLUMN
Check/untaint monetary numbers. May be negative. Set to 0 if null. If there
#warn "msgcat ". \&msgcat. "\n";
#warn "notexist ". \¬exist. "\n";
#warn "AUTOLOAD ". \&AUTOLOAD. "\n";
+ # \p{Word} = alphanumerics, marks (diacritics), and connectors
+ # see perldoc perluniprops
$self->getfield($field)
- =~ /^([\wô \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>$money_char]+)$/
+ =~ /^([\p{Word} \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>$money_char]+)$/
or return gettext('illegal_or_empty_text'). " $field: ".
$self->getfield($field);
$self->setfield($field,$1);
Check/untaint phone numbers. May be null. If there is an error, returns
the error, otherwise returns false.
-Takes an optional two-letter ISO country code; without it or with unsupported
-countries, ut_phonen simply calls ut_alphan.
+Takes an optional two-letter ISO 3166-1 alpha-2 country code; without
+it or with unsupported countries, ut_phonen simply calls ut_alphan.
=cut
sub ut_name {
my( $self, $field ) = @_;
# warn "ut_name allowed alphanumerics: +(sort grep /\w/, map { chr() } 0..255), "\n";
- $self->getfield($field) =~ /^([\w \,\.\-\']+)$/
+ $self->getfield($field) =~ /^([\p{Word} \,\.\-\']+)$/
or return gettext('illegal_name'). " $field: ". $self->getfield($field);
my $name = $1;
$name =~ s/^\s+//;
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;
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);
#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) {
$rsa_loaded++;
}
# Initialize Encryption
- if ($conf->exists('encryptionpublickey') && $conf->config('encryptionpublickey') ne '') {
- my $public_key = join("\n",$conf->config('encryptionpublickey'));
+ if ($conf_encryptionpublickey && $conf_encryptionpublickey ne '') {
+ my $public_key = join("\n",$conf_encryptionpublickey);
$rsa_encrypt = $rsa_module->new_public_key($public_key);
}
# Intitalize Decryption
- if ($conf->exists('encryptionprivatekey') && $conf->config('encryptionprivatekey') ne '') {
- my $private_key = join("\n",$conf->config('encryptionprivatekey'));
+ if ($conf_encryptionprivatekey && $conf_encryptionprivatekey ne '') {
+ my $private_key = join("\n",$conf_encryptionprivatekey);
$rsa_decrypt = $rsa_module->new_private_key($private_key);
}
}
defined($scalar) ? $scalar : '';
}
-=item count [ WHERE ]
+=item count [ WHERE [, PLACEHOLDER ...] ]
Convenience method for the common case of "SELECT COUNT(*) FROM table",
with optional WHERE. Must be called as method on a class with an
my $table = $self->table or die 'count called on object of class '.ref($self);
my $sql = "SELECT COUNT(*) FROM $table";
$sql .= " WHERE $where" if $where;
- $self->scalar_sql($sql);
+ $self->scalar_sql($sql, @_);
+}
+
+=item row_exists [ WHERE [, PLACEHOLDER ...] ]
+
+Convenience method for the common case of "SELECT 1 FROM table ... LIMIT 1"
+with optional (but almost always needed) WHERE.
+
+=cut
+
+sub row_exists {
+ my($self, $where) = (shift, shift);
+ my $table = $self->table or die 'row_exists called on object of class '.ref($self);
+ my $sql = "SELECT 1 FROM $table";
+ $sql .= " WHERE $where" if $where;
+ $sql .= " LIMIT 1";
+ $self->scalar_sql($sql, @_);
}
=back
my $column_type = $column_obj->type;
my $nullable = $column_obj->null;
+ utf8::upgrade($value);
+
warn " $table.$column: $value ($column_type".
( $nullable ? ' NULL' : ' NOT NULL' ).
")\n" if $DEBUG > 2;
}
+=item group_concat_sql COLUMN, DELIMITER
+
+Returns an SQL expression to concatenate an aggregate column, using
+GROUP_CONCAT() for mysql and array_to_string() and array_agg() for Pg.
+
+=cut
+
+sub group_concat_sql {
+ my ($col, $delim) = @_;
+ $delim = dbh->quote($delim);
+ if ( driver_name() =~ /^mysql/i ) {
+ # DISTINCT(foo) is valid as $col
+ return "GROUP_CONCAT($col SEPARATOR $delim)";
+ } else {
+ return "array_to_string(array_agg($col), $delim)";
+ }
+}
+
=item midnight_sql DATE
Returns an SQL expression to convert DATE (a unix timestamp) to midnight
projects / freeside.git / blobdiff