X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=758e0f96c42e1266200b33506fc26996e27275ea;hp=201e7b23cdf3e8378fe6089a57a8b5789ebdd8bf;hb=b1d445f94514a29e5d4753839798b0291d89aee3;hpb=7e0aae7956b9f07d88295a350e560978032847fd diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 201e7b23c..758e0f96c 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -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]'; @@ -795,6 +795,17 @@ sub setfield { $self->set(@_); } +=item exists COLUMN + +Returns true if the column/field/key COLUMN exists. + +=cut + +sub exists { + my($self,$field) = @_; + exists($self->{Hash}->{$field}); +} + =item AUTLOADED METHODS $record->column is a synonym for $record->get('column'); @@ -1569,6 +1580,7 @@ sub process_batch_import { format_headers => $opt->{format_headers}, format_sep_chars => $opt->{format_sep_chars}, format_fixedlength_formats => $opt->{format_fixedlength_formats}, + format_row_callbacks => $opt->{format_row_callbacks}, #per-import job => $job, file => $file, @@ -1599,6 +1611,8 @@ Class method for batch imports. Available params: =item table +=item format - usual way to specify import, with this format string selecting data from the formats and format_* info hashes + =item formats =item format_types @@ -1609,6 +1623,12 @@ Class method for batch imports. Available params: =item format_fixedlength_formats +=item format_row_callbacks + +=item fields - Alternate way to specify import, specifying import fields directly as a listref + +=item postinsert_callback + =item params =item job @@ -1621,8 +1641,6 @@ FS::queue object, will be updated with progress csv, xls or fixedlength -=item format - =item empty_ok =back @@ -1636,18 +1654,61 @@ sub batch_import { if $DEBUG; my $table = $param->{table}; - my $formats = $param->{formats}; my $job = $param->{job}; my $file = $param->{file}; - my $format = $param->{'format'}; my $params = $param->{params} || {}; - die "unknown format $format" unless exists $formats->{ $format }; + my( $type, $header, $sep_char, $fixedlength_format, $row_callback, @fields ); + my $postinsert_callback = ''; + if ( $param->{'format'} ) { + + my $format = $param->{'format'}; + my $formats = $param->{formats}; + die "unknown format $format" unless exists $formats->{ $format }; + + $type = $param->{'format_types'} + ? $param->{'format_types'}{ $format } + : $param->{type} || 'csv'; + + + $header = $param->{'format_headers'} + ? $param->{'format_headers'}{ $param->{'format'} } + : 0; + + $sep_char = $param->{'format_sep_chars'} + ? $param->{'format_sep_chars'}{ $param->{'format'} } + : ','; + + $fixedlength_format = + $param->{'format_fixedlength_formats'} + ? $param->{'format_fixedlength_formats'}{ $param->{'format'} } + : ''; + + $row_callback = + $param->{'format_row_callbacks'} + ? $param->{'format_row_callbacks'}{ $param->{'format'} } + : ''; + + @fields = @{ $formats->{ $format } }; - my $type = $param->{'format_types'} - ? $param->{'format_types'}{ $format } - : $param->{type} || 'csv'; + } elsif ( $param->{'fields'} ) { + + $type = ''; #infer from filename + $header = 0; + $sep_char = ','; + $fixedlength_format = ''; + $row_callback = ''; + @fields = @{ $param->{'fields'} }; + + $postinsert_callback = $param->{'postinsert_callback'} + if $param->{'postinsert_callback'} + + } else { + die "neither format nor fields specified"; + } + + #my $file = $param->{file}; unless ( $type ) { if ( $file =~ /\.(\w+)$/i ) { @@ -1661,20 +1722,6 @@ sub batch_import { if $param->{'default_csv'} && $type ne 'xls'; } - my $header = $param->{'format_headers'} - ? $param->{'format_headers'}{ $param->{'format'} } - : 0; - - my $sep_char = $param->{'format_sep_chars'} - ? $param->{'format_sep_chars'}{ $param->{'format'} } - : ','; - - my $fixedlength_format = - $param->{'format_fixedlength_formats'} - ? $param->{'format_fixedlength_formats'}{ $param->{'format'} } - : ''; - - my @fields = @{ $formats->{ $format } }; my $row = 0; my $count; @@ -1738,6 +1785,7 @@ sub batch_import { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + #my $params = $param->{params} || {}; if ( $param->{'batch_namecol'} && $param->{'batch_namevalue'} ) { my $batch_col = $param->{'batch_keycol'}; @@ -1755,7 +1803,8 @@ sub batch_import { $params->{ $batch_col } = $batch_value; } - + + #my $job = $param->{job}; my $line; my $imported = 0; my( $last, $min_sec ) = ( time, 5 ); #progressbar foo @@ -1769,6 +1818,8 @@ sub batch_import { next if $line =~ /^\s*$/; #skip empty lines + $line = &{$row_callback}($line) if $row_callback; + $parser->parse($line) or do { $dbh->rollback if $oldAutoCommit; return "can't parse: ". $parser->error_input(); @@ -1811,6 +1862,7 @@ sub batch_import { } + #my $table = $param->{table}; my $class = "FS::$table"; my $record = $class->new( \%hash ); @@ -1834,6 +1886,15 @@ sub batch_import { $row++; $imported++; + if ( $postinsert_callback ) { + my $error = &{$postinsert_callback}($record, $param); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "postinsert_callback error". ( $line ? " for $line" : '' ). + ": $error"; + } + } + if ( $job && time - $min_sec > $last ) { #progress bar $job->update_statustext( int(100 * $imported / $count) ); $last = time; @@ -2140,7 +2201,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. @@ -2155,6 +2216,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 @@ -2764,23 +2841,25 @@ sub h_date { $h ? $h->history_date : ''; } -=item scalar_sql SQL +=item scalar_sql SQL [ PLACEHOLDER, ... ] -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. +A class or object method. Executes the sql statement represented by SQL and +returns a scalar representing the result: the first column of the first row. -Returns an empty string in the event of no rows. +Dies on bogus SQL. Returns an empty string if no row is returned. + +Typically used for statments which return a single value such as "SELECT +COUNT(*) FROM table WHERE something" OR "SELECT column FROM table WHERE key = ?" =cut sub scalar_sql { - my($self, $sql ) = ( shift, shift ); + my($self, $sql) = (shift, shift); my $sth = dbh->prepare($sql) or die dbh->errstr; - $sth->execute + $sth->execute(@_) or die "Unexpected error executing statement $sql: ". $sth->errstr; - $sth->fetchrow_arrayref->[0] || ''; + my $scalar = $sth->fetchrow_arrayref->[0]; + defined($scalar) ? $scalar : ''; } =back @@ -2926,6 +3005,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