X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=0845cc6f3f4b3529bfde8e86a921627dc9c47c3c;hp=f17b240362d6b7ee9949218a787b9ef1cc152c32;hb=20f38e4c256094bd938b732950e8f93319f851a5;hpb=2b1f6ef77f0ef347897a060cfe94bbff2e3f6c76 diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index f17b24036..0845cc6f3 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -15,7 +15,7 @@ use Locale::Country; use Text::CSV_XS; use File::Slurp qw( slurp ); use DBI qw(:sql_types); -use DBIx::DBSchema 0.33; +use DBIx::DBSchema 0.38; use FS::UID qw(dbh getotaker datasrc driver_name); use FS::CurrentUser; use FS::Schema qw(dbdef); @@ -31,7 +31,7 @@ use Tie::IxHash; #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 ); + str2time_sql str2time_sql_closing regexp_sql not_regexp_sql ); $DEBUG = 0; $me = '[FS::Record]'; @@ -962,12 +962,12 @@ sub insert { my $db_seq = 0; if ( $primary_key ) { my $col = $self->dbdef_table->column($primary_key); - + $db_seq = uc($col->type) =~ /^(BIG)?SERIAL\d?/ || ( driver_name eq 'Pg' && defined($col->default) - && $col->default =~ /^nextval\(/i + && $col->quoted_default =~ /^nextval\(/i ) || ( driver_name eq 'mysql' && defined($col->local) @@ -1032,7 +1032,7 @@ sub insert { #my $oid = $sth->{'pg_oid_status'}; #my $i_sql = "SELECT $primary_key FROM $table WHERE oid = ?"; - my $default = $self->dbdef_table->column($primary_key)->default; + my $default = $self->dbdef_table->column($primary_key)->quoted_default; unless ( $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i ) { dbh->rollback if $FS::UID::AutoCommit; return "can't parse $table.$primary_key default value". @@ -1547,7 +1547,7 @@ sub process_batch_import { my($job, $opt) = ( shift, shift ); my $table = $opt->{table}; - my @pass_params = @{ $opt->{params} }; + my @pass_params = $opt->{params} ? @{ $opt->{params} } : (); my %formats = %{ $opt->{formats} }; my $param = thaw(decode_base64(shift)); @@ -1561,24 +1561,30 @@ sub process_batch_import { my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/'; my $file = $dir. $files{'file'}; - my $error = - FS::Record::batch_import( { - #class-static - table => $table, - formats => \%formats, - format_types => $opt->{format_types}, - format_headers => $opt->{format_headers}, - format_sep_chars => $opt->{format_sep_chars}, - format_fixedlength_formats => $opt->{format_fixedlength_formats}, - #per-import - job => $job, - file => $file, - #type => $type, - format => $param->{format}, - params => { map { $_ => $param->{$_} } @pass_params }, - #? - default_csv => $opt->{default_csv}, - } ); + my %iopt = ( + #class-static + table => $table, + formats => \%formats, + format_types => $opt->{format_types}, + format_headers => $opt->{format_headers}, + format_sep_chars => $opt->{format_sep_chars}, + format_fixedlength_formats => $opt->{format_fixedlength_formats}, + #per-import + job => $job, + file => $file, + #type => $type, + format => $param->{format}, + params => { map { $_ => $param->{$_} } @pass_params }, + #? + default_csv => $opt->{default_csv}, + ); + + if ( $opt->{'batch_namecol'} ) { + $iopt{'batch_namevalue'} = $param->{ $opt->{'batch_namecol'} }; + $iopt{$_} = $opt->{$_} foreach qw( batch_keycol batch_table batch_namecol ); + } + + my $error = FS::Record::batch_import( \%iopt ); unlink $file; @@ -1731,6 +1737,24 @@ sub batch_import { my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; + + if ( $param->{'batch_namecol'} && $param->{'batch_namevalue'} ) { + my $batch_col = $param->{'batch_keycol'}; + + my $batch_class = 'FS::'. $param->{'batch_table'}; + my $batch = $batch_class->new({ + $param->{'batch_namecol'} => $param->{'batch_namevalue'} + }); + my $error = $batch->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't insert batch record: $error"; + } + #primary key via dbdef? (so the column names don't have to match) + my $batch_value = $batch->get( $param->{'batch_keycol'} ); + + $params->{ $batch_col } = $batch_value; + } my $line; my $imported = 0; @@ -1743,6 +1767,8 @@ sub batch_import { last unless scalar(@buffer); $line = shift(@buffer); + next if $line =~ /^\s*$/; #skip empty lines + $parser->parse($line) or do { $dbh->rollback if $oldAutoCommit; return "can't parse: ". $parser->error_input(); @@ -2114,7 +2140,7 @@ sub ut_alpha { ''; } -=item ut_alpha COLUMN +=item ut_alphan COLUMN Check/untaint alphanumeric strings (no spaces). May be null. If there is an error, returns the error, otherwise returns false. @@ -2129,6 +2155,22 @@ sub ut_alphan { ''; } +=item ut_alphasn COLUMN + +Check/untaint alphanumeric strings, spaces allowed. May be null. If there is +an error, returns the error, otherwise returns false. + +=cut + +sub ut_alphasn { + my($self,$field)=@_; + $self->getfield($field) =~ /^([\w ]*)$/ + or return "Illegal (alphanumeric) $field: ". $self->getfield($field); + $self->setfield($field,$1); + ''; +} + + =item ut_alpha_lower COLUMN Check/untaint lowercase alphanumeric strings (no spaces). May not be null. If @@ -2204,12 +2246,14 @@ sub ut_hexn { } =item ut_ip COLUMN -Check/untaint ip addresses. IPv4 only for now. +Check/untaint ip addresses. IPv4 only for now, though ::1 is auto-translated +to 127.0.0.1. =cut 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; } @@ -2219,7 +2263,8 @@ sub ut_ip { =item ut_ipn COLUMN -Check/untaint ip addresses. IPv4 only for now. May be null. +Check/untaint ip addresses. IPv4 only for now, though ::1 is auto-translated +to 127.0.0.1. May be null. =cut @@ -2677,7 +2722,7 @@ sub loadRSA { #Initialize the Module $rsa_module = 'Crypt::OpenSSL::RSA'; # The Default - if ($conf->exists('encryptionmodule') && $conf->config_binary('encryptionmodule') ne '') { + if ($conf->exists('encryptionmodule') && $conf->config('encryptionmodule') ne '') { $rsa_module = $conf->config('encryptionmodule'); } @@ -2686,13 +2731,13 @@ sub loadRSA { $rsa_loaded++; } # Initialize Encryption - if ($conf->exists('encryptionpublickey') && $conf->config_binary('encryptionpublickey') ne '') { + 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); } # Intitalize Decryption - if ($conf->exists('encryptionprivatekey') && $conf->config_binary('encryptionprivatekey') ne '') { + 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); } @@ -2735,6 +2780,25 @@ sub h_date { $h ? $h->history_date : ''; } +=item scalar_sql SQL + +A class method with a propensity for becoming an instance method. This +method executes the sql statement represented by SQL and returns a scalar +representing the result. Don't ask for rows -- you get the first column +of the first row. Don't give me bogus SQL or I'll die on you. + +Returns an empty string in the event of no rows. + +=cut + +sub scalar_sql { + my($self, $sql ) = ( shift, shift ); + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute + or die "Unexpected error executing statement $sql: ". $sth->errstr; + $sth->fetchrow_arrayref->[0] || ''; +} + =back =head1 SUBROUTINES @@ -2878,6 +2942,48 @@ sub str2time_sql_closing { return ' ) '; } +=item regexp_sql [ DRIVER_NAME ] + +Returns the operator to do a regular expression comparison based on database +type, such as '~' for Pg or 'REGEXP' for mysql. + +You can pass an optional driver name such as "Pg", "mysql" or +$dbh->{Driver}->{Name} to return a function for that database instead of +the current database. + +=cut + +sub regexp_sql { + my $driver = shift || driver_name; + + return '~' if $driver =~ /^Pg/i; + return 'REGEXP' if $driver =~ /^mysql/i; + + die "don't know how to use regular expressions in ". driver_name." databases"; + +} + +=item not_regexp_sql [ DRIVER_NAME ] + +Returns the operator to do a regular expression negation based on database +type, such as '!~' for Pg or 'NOT REGEXP' for mysql. + +You can pass an optional driver name such as "Pg", "mysql" or +$dbh->{Driver}->{Name} to return a function for that database instead of +the current database. + +=cut + +sub not_regexp_sql { + my $driver = shift || driver_name; + + return '!~' if $driver =~ /^Pg/i; + return 'NOT REGEXP' if $driver =~ /^mysql/i; + + die "don't know how to use regular expressions in ". driver_name." databases"; + +} + =back =head1 BUGS