X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=f3dead164d1e610553b449a7882c2c253171b399;hb=f9a89c91cab9e85a7ca8dd67782919f8a85c2ebb;hp=201e7b23cdf3e8378fe6089a57a8b5789ebdd8bf;hpb=7e0aae7956b9f07d88295a350e560978032847fd;p=freeside.git diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 201e7b23c..f3dead164 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]'; @@ -1569,6 +1569,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, @@ -1609,6 +1610,8 @@ Class method for batch imports. Available params: =item format_fixedlength_formats +=item format_row_callbacks + =item params =item job @@ -1633,7 +1636,7 @@ sub batch_import { my $param = shift; warn "$me batch_import call with params: \n". Dumper($param) - if $DEBUG; + ;# if $DEBUG; my $table = $param->{table}; my $formats = $param->{formats}; @@ -1674,6 +1677,11 @@ sub batch_import { ? $param->{'format_fixedlength_formats'}{ $param->{'format'} } : ''; + my $row_callback = + $param->{'format_row_callbacks'} + ? $param->{'format_row_callbacks'}{ $param->{'format'} } + : ''; + my @fields = @{ $formats->{ $format } }; my $row = 0; @@ -1769,6 +1777,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(); @@ -2140,7 +2150,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 +2165,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 @@ -2926,6 +2952,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