+=item format_headers
+
+Optional format hashref of header lines. Keys are field names, values are 0
+for no header, 1 to ignore the first line, or to higher numbers to ignore that
+number of lines.
+
+=item format_sep_chars
+
+Optional format hashref of CSV sep_chars. Keys are field names, values are the
+CSV separation character.
+
+=item format_fixedlenth_formats
+
+Optional format hashref of fixed length format defintiions. Keys are field
+names, values Parse::FixedLength listrefs of field definitions.
+
+=item default_csv
+
+Set true to default to CSV file type if the filename does not contain a
+recognizable ".csv" or ".xls" extension (and type is not pre-specified by
+format_types).
+
+=back
+
+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
+
+use Data::Dumper;
+sub process_batch_import {
+ my($job, $opt, $param) = @_;
+
+ my $table = $opt->{table};
+ my @pass_params = $opt->{params} ? @{ $opt->{params} } : ();
+ my %formats = %{ $opt->{formats} };
+
+ warn Dumper($param) if $DEBUG;
+
+ my $files = $param->{'uploaded_files'}
+ or die "No files provided.\n";
+
+ my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
+
+ my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
+ my $file = $dir. $files{'file'};
+
+ 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_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,
+ #type => $type,
+ format => $param->{format},
+ 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'} ) {
+ $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;
+
+ die "$error\n" if $error;
+}
+
+=item batch_import PARAM_HASHREF
+
+Class method for batch imports. Available params:
+
+=over 4
+
+=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_headers
+
+=item format_sep_chars
+
+=item format_fixedlength_formats
+
+=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
+
+=item postinsert_callback
+
+=item params
+
+=item job
+
+FS::queue object, will be updated with progress
+
+=item file
+
+=item type
+
+csv, xls, fixedlength, xml
+
+=item empty_ok
+
+=back
+
+=cut
+
+use Data::Dumper;
+sub batch_import {
+ my $param = shift;
+
+ warn "$me batch_import call with params: \n". Dumper($param)
+ if $DEBUG;
+
+ my $table = $param->{table};
+
+ my $job = $param->{job};
+ my $file = $param->{file};
+ my $params = $param->{params} || {};
+
+ my $custnum_prefix = $conf->config('cust_main-custnum-display_prefix');
+ my $custnum_length = $conf->config('cust_main-custnum-display_length') || 8;
+
+ my( $type, $header, $sep_char,
+ $fixedlength_format, $xml_format, $asn_format,
+ $parser_opt, $row_callback, $hash_callback, @fields );
+
+ my $postinsert_callback = '';
+ $postinsert_callback = $param->{'postinsert_callback'}
+ if $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'} ) {
+
+ 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'} }
+ : '';
+
+ $parser_opt =
+ $param->{'format_parser_opts'}
+ ? $param->{'format_parser_opts'}{ $param->{'format'} }
+ : {};
+
+ $xml_format =
+ $param->{'format_xml_formats'}
+ ? $param->{'format_xml_formats'}{ $param->{'format'} }
+ : '';
+
+ $asn_format =
+ $param->{'format_asn_formats'}
+ ? $param->{'format_asn_formats'}{ $param->{'format'} }
+ : '';
+
+ $row_callback =
+ $param->{'format_row_callbacks'}
+ ? $param->{'format_row_callbacks'}{ $param->{'format'} }
+ : '';
+
+ $hash_callback =
+ $param->{'format_hash_callbacks'}
+ ? $param->{'format_hash_callbacks'}{ $param->{'format'} }
+ : '';
+
+ @fields = @{ $formats->{ $format } };
+
+ } elsif ( $param->{'fields'} ) {
+
+ $type = ''; #infer from filename
+ $header = 0;
+ $sep_char = ',';
+ $fixedlength_format = '';
+ $row_callback = '';
+ $hash_callback = '';
+ @fields = @{ $param->{'fields'} };
+
+ } else {
+ die "neither format nor fields specified";
+ }
+
+ #my $file = $param->{file};
+
+ unless ( $type ) {
+ if ( $file =~ /\.(\w+)$/i ) {
+ $type = lc($1);
+ } else {
+ #or error out???
+ warn "can't parse file type from filename $file; defaulting to CSV";
+ $type = 'csv';
+ }
+ $type = 'csv'
+ if $param->{'default_csv'} && $type ne 'xls';
+ }
+
+
+ my $row = 0;
+ my $count;
+ my $parser;
+ my @buffer = ();
+ my $asn_header_buffer;
+ if ( $type eq 'csv' || $type eq 'fixedlength' ) {
+
+ if ( $type eq 'csv' ) {
+
+ $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_opt);
+
+ } else {
+ die "Unknown file type $type\n";
+ }
+
+ @buffer = split(/\r?\n/, slurp($file) );
+ splice(@buffer, 0, ($header || 0) );
+ $count = scalar(@buffer);
+
+ } elsif ( $type eq 'xls' ) {
+
+ eval "use Spreadsheet::ParseExcel;";
+ die $@ if $@;
+
+ eval "use DateTime::Format::Excel;";
+ #for now, just let the error be thrown if it is used, since only CDR
+ # formats bill_west and troop use it, not other excel-parsing things
+ #die $@ if $@;
+
+ my $excel = Spreadsheet::ParseExcel::Workbook->new->Parse($file);
+
+ $parser = $excel->{Worksheet}[0]; #first sheet
+
+ $count = $parser->{MaxRow} || $parser->{MinRow};
+ $count++;
+
+ $row = $header || 0;
+
+ } elsif ( $type eq 'xml' ) {
+
+ # FS::pay_batch
+ eval "use XML::Simple;";
+ die $@ if $@;
+ my $xmlrow = $xml_format->{'xmlrow'};
+ $parser = $xml_format->{'xmlkeys'};
+ die 'no xmlkeys specified' unless ref $parser eq 'ARRAY';
+ my $data = XML::Simple::XMLin(
+ $file,
+ 'SuppressEmpty' => '', #sets empty values to ''
+ 'KeepRoot' => 1,
+ );
+ my $rows = $data;
+ $rows = $rows->{$_} foreach @$xmlrow;
+ $rows = [ $rows ] if ref($rows) ne 'ARRAY';
+ $count = @buffer = @$rows;
+
+ } elsif ( $type eq 'asn.1' ) {
+
+ eval "use Convert::ASN1";
+ die $@ if $@;
+
+ my $asn = Convert::ASN1->new;
+ $asn->prepare( $asn_format->{'spec'} ) or die $asn->error;
+
+ $parser = $asn->find( $asn_format->{'macro'} ) or die $asn->error;
+
+ my $data = slurp($file);
+ my $asn_output = $parser->decode( $data )
+ or return "No ". $asn_format->{'macro'}. " found\n";
+
+ $asn_header_buffer = &{ $asn_format->{'header_buffer'} }( $asn_output );
+
+ my $rows = &{ $asn_format->{'arrayref'} }( $asn_output );
+ $count = @buffer = @$rows;
+
+ } else {
+ die "Unknown file type $type\n";
+ }
+
+ #my $columns;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ 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 $unique_skip = 0; #lines skipped because they're already in the system
+ my( $last, $min_sec ) = ( time, 5 ); #progressbar foo
+ while (1) {
+
+ my @columns = ();
+ my %hash = %$params;
+ if ( $type eq 'csv' ) {
+
+ last unless scalar(@buffer);
+ $line = shift(@buffer);
+
+ next if $line =~ /^\s*$/; #skip empty lines
+
+ $line = &{$row_callback}($line) if $row_callback;
+
+ next if $line =~ /^\s*$/; #skip empty lines
+
+ $parser->parse($line) or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't parse: ". $parser->error_input() . " " . $parser->error_diag;
+ };
+ @columns = $parser->fields();
+
+ } elsif ( $type eq 'fixedlength' ) {
+
+ last unless scalar(@buffer);
+ $line = shift(@buffer);
+
+ @columns = $parser->parse($line);
+
+ } elsif ( $type eq 'xls' ) {
+
+ last if $row > ($parser->{MaxRow} || $parser->{MinRow})
+ || ! $parser->{Cells}[$row];
+
+ my @row = @{ $parser->{Cells}[$row] };
+ @columns = map $_->{Val}, @row;
+
+ #my $z = 'A';
+ #warn $z++. ": $_\n" for @columns;
+
+ } elsif ( $type eq 'xml' ) {
+
+ # $parser = [ 'Column0Key', 'Column1Key' ... ]
+ last unless scalar(@buffer);
+ my $row = shift @buffer;
+ @columns = @{ $row }{ @$parser };
+
+ } elsif ( $type eq 'asn.1' ) {
+
+ last unless scalar(@buffer);
+ my $row = shift @buffer;
+ &{ $asn_format->{row_callback} }( $row, $asn_header_buffer )
+ if $asn_format->{row_callback};
+ foreach my $key ( keys %{ $asn_format->{map} } ) {
+ $hash{$key} = &{ $asn_format->{map}{$key} }( $row, $asn_header_buffer );
+ }
+
+ } else {
+ die "Unknown file type $type\n";
+ }
+
+ my @later = ();
+
+ foreach my $field ( @fields ) {
+
+ my $value = shift @columns;
+
+ if ( ref($field) eq 'CODE' ) {
+ #&{$field}(\%hash, $value);
+ push @later, $field, $value;
+ } else {
+ #??? $hash{$field} = $value if length($value);
+ $hash{$field} = $value if defined($value) && length($value);
+ }
+
+ }
+
+ if ( $custnum_prefix && $hash{custnum} =~ /^$custnum_prefix(0*([1-9]\d*))$/
+ && length($1) == $custnum_length ) {
+ $hash{custnum} = $2;
+ }
+
+ %hash = &{$hash_callback}(%hash) if $hash_callback;
+
+ #my $table = $param->{table};
+ my $class = "FS::$table";
+
+ my $record = $class->new( \%hash );
+
+ my $param = {};
+ while ( scalar(@later) ) {
+ my $sub = shift @later;
+ my $data = shift @later;
+ eval {
+ &{$sub}($record, $data, $conf, $param); # $record->&{$sub}($data, $conf)
+ };
+ if ( $@ ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't insert record". ( $line ? " for $line" : '' ). ": $@";
+ }
+ last if exists( $param->{skiprow} );
+ }
+ $unique_skip++ if $param->{unique_skip}; #line is already in the system
+ next if exists( $param->{skiprow} );
+
+ if ( $preinsert_callback ) {
+ my $error = &{$preinsert_callback}($record, $param);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "preinsert_callback error". ( $line ? " for $line" : '' ).
+ ": $error";
+ }
+ next if exists $param->{skiprow} && $param->{skiprow};
+ }
+
+ 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;
+ return "can't insert record". ( $line ? " for $line" : '' ). ": $error";
+ }
+
+ $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;
+ }
+
+ }
+
+ unless ( $imported || $param->{empty_ok} ) {
+ $dbh->rollback if $oldAutoCommit;
+ # freeside-cdr-conexiant-import is sensitive to the text of this message
+ return $unique_skip ? "All records in file were previously imported" : "Empty file!";
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ ''; #no error
+
+}
+
+sub _h_statement {
+ my( $self, $action, $time ) = @_;
+
+ $time ||= time;
+
+ my %nohistory = map { $_=>1 } $self->nohistory_fields;
+
+ my @fields =
+ grep { defined($self->get($_)) && $self->get($_) ne "" && ! $nohistory{$_} }
+ real_fields($self->table);
+ ;
+
+ # If we're encrypting then don't store the payinfo in the history
+ if ( $conf_encryption && $self->table ne 'banned_pay' ) {
+ @fields = grep { $_ ne 'payinfo' } @fields;
+ }
+
+ my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields;
+
+ "INSERT INTO h_". $self->table. " ( ".
+ join(', ', qw(history_date history_usernum history_action), @fields ).
+ ") VALUES (".
+ join(', ', $time,
+ $FS::CurrentUser::CurrentUser->usernum,
+ dbh->quote($action),
+ @values
+ ).
+ ")"
+ ;
+}
+
+=item unique COLUMN
+
+B<Warning>: External use is B<deprecated>.
+
+Replaces COLUMN in record with a unique number, using counters in the
+filesystem. Used by the B<insert> method on single-field unique columns
+(see L<DBIx::DBSchema::Table>) and also as a fallback for primary keys
+that aren't SERIAL (Pg) or AUTO_INCREMENT (mysql).
+
+Returns the new value.
+
+=cut
+
+sub unique {
+ my($self,$field) = @_;
+ my($table)=$self->table;
+
+ croak "Unique called on field $field, but it is ",
+ $self->getfield($field),
+ ", not null!"
+ if $self->getfield($field);
+
+ #warn "table $table is tainted" if is_tainted($table);
+ #warn "field $field is tainted" if is_tainted($field);
+
+ my($counter) = new File::CounterFile "$table.$field",0;
+
+ my $index = $counter->inc;
+ $index = $counter->inc while qsearchs($table, { $field=>$index } );
+
+ $index =~ /^(\d*)$/;
+ $index=$1;
+
+ $self->setfield($field,$index);
+
+}
+
+=item ut_float COLUMN
projects / freeside.git / blobdiff