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);
#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]';
$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');
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)
#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".
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));
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},
+ format_row_callbacks => $opt->{format_row_callbacks},
+ #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;
=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
=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
csv, xls or fixedlength
-=item format
-
=item empty_ok
=back
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'} }
+ : '';
- my $type = $param->{'format_types'}
- ? $param->{'format_types'}{ $format }
- : $param->{type} || 'csv';
+ @fields = @{ $formats->{ $format } };
+
+ } 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 ) {
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;
my $oldAutoCommit = $FS::UID::AutoCommit;
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'};
+
+ 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 $job = $param->{job};
my $line;
my $imported = 0;
my( $last, $min_sec ) = ( time, 5 ); #progressbar foo
last unless scalar(@buffer);
$line = shift(@buffer);
+ 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();
}
+ #my $table = $param->{table};
my $class = "FS::$table";
my $record = $class->new( \%hash );
$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;
'';
}
-=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.
'';
}
+=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
$h ? $h->history_date : '';
}
+=item scalar_sql SQL [ PLACEHOLDER, ... ]
+
+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.
+
+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 $sth = dbh->prepare($sql) or die dbh->errstr;
+ $sth->execute(@_)
+ or die "Unexpected error executing statement $sql: ". $sth->errstr;
+ my $scalar = $sth->fetchrow_arrayref->[0];
+ defined($scalar) ? $scalar : '';
+}
+
=back
=head1 SUBROUTINES
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
projects / freeside.git / blobdiff