my @bind_type = ();
my $dbh = dbh;
foreach my $stable ( @stable ) {
- my $record = shift @record;
+ #stop altering the caller's hashref
+ my $record = { %{ shift(@record) || {} } };#and be liberal in receipt
my $select = shift @select;
my $extra_sql = shift @extra_sql;
my $extra_param = shift @extra_param;
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_row_callbacks => $opt->{format_row_callbacks},
#per-import
job => $job,
=item type
-csv, xls or fixedlength
+csv, xls, fixedlength, xml
=item empty_ok
my $file = $param->{file};
my $params = $param->{params} || {};
- my( $type, $header, $sep_char, $fixedlength_format, $row_callback, @fields );
+ my( $type, $header, $sep_char, $fixedlength_format,
+ $xml_format, $row_callback, @fields );
my $postinsert_callback = '';
if ( $param->{'format'} ) {
? $param->{'format_fixedlength_formats'}{ $param->{'format'} }
: '';
+ $xml_format =
+ $param->{'format_xml_formats'}
+ ? $param->{'format_xml_formats'}{ $param->{'format'} }
+ : '';
+
$row_callback =
$param->{'format_row_callbacks'}
? $param->{'format_row_callbacks'}{ $param->{'format'} }
eval "use Parse::FixedLength;";
die $@ if $@;
$parser = new Parse::FixedLength $fixedlength_format;
-
- } else {
+
+ }
+ else {
die "Unknown file type $type\n";
}
$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;
} else {
die "Unknown file type $type\n";
}
#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 };
} else {
die "Unknown file type $type\n";
}
#warn "notexist ". \¬exist. "\n";
#warn "AUTOLOAD ". \&AUTOLOAD. "\n";
$self->getfield($field)
- =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>]+)$/
+ =~ /^([µ_0123456789aAáÁàÀâÂåÅäÄãêæÆbBcCçÇdDðÐeEéÉèÈêÊëËfFgGhHiIíÍìÌîÎïÏjJkKlLmMnNñÑoOóÓòÒôÔöÖõÕøغpPqQrRsSßtTuUúÚùÙûÛüÜvVwWxXyYýÝÿzZþÞ \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>]+)$/
or return gettext('illegal_or_empty_text'). " $field: ".
$self->getfield($field);
$self->setfield($field,$1);
sub ut_name {
my( $self, $field ) = @_;
- $self->getfield($field) =~ /^([\w \,\.\-\']+)$/
+# warn "ut_name allowed alphanumerics: +(sort grep /\w/, map { chr() } 0..255), "\n";
+ #$self->getfield($field) =~ /^([\w \,\.\-\']+)$/
+ $self->getfield($field) =~ /^([µ_0123456789aAáÁàÀâÂåÅäÄãêæÆbBcCçÇdDðÐeEéÉèÈêÊëËfFgGhHiIíÍìÌîÎïÏjJkKlLmMnNñÑoOóÓòÒôÔöÖõÕøغpPqQrRsSßtTuUúÚùÙûÛüÜvVwWxXyYýÝÿzZþÞ \,\.\-\']+)$/
or return gettext('illegal_name'). " $field: ". $self->getfield($field);
$self->setfield($field,$1);
'';