X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=fb83faa3fec411e1cd1a647e6a338ed35f6701ee;hb=f9a181e4c2e505df84de16190ee3b75011326f3f;hp=758e0f96c42e1266200b33506fc26996e27275ea;hpb=b1d445f94514a29e5d4753839798b0291d89aee3;p=freeside.git diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 758e0f96c..fb83faa3f 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -30,8 +30,10 @@ use Tie::IxHash; @ISA = qw(Exporter); #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 regexp_sql not_regexp_sql ); +@EXPORT_OK = qw( + dbh fields hfields qsearch qsearchs dbdef jsearch + str2time_sql str2time_sql_closing regexp_sql not_regexp_sql concat_sql +); $DEBUG = 0; $me = '[FS::Record]'; @@ -350,7 +352,8 @@ sub qsearch { 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; @@ -1580,6 +1583,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_xml_formats => $opt->{format_xml_formats}, format_row_callbacks => $opt->{format_row_callbacks}, #per-import job => $job, @@ -1589,6 +1593,7 @@ sub process_batch_import { params => { map { $_ => $param->{$_} } @pass_params }, #? default_csv => $opt->{default_csv}, + postinsert_callback => $opt->{postinsert_callback}, ); if ( $opt->{'batch_namecol'} ) { @@ -1639,7 +1644,7 @@ FS::queue object, will be updated with progress =item type -csv, xls or fixedlength +csv, xls, fixedlength, xml =item empty_ok @@ -1659,8 +1664,11 @@ sub batch_import { 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 = ''; + $postinsert_callback = $param->{'postinsert_callback'} + if $param->{'postinsert_callback'}; if ( $param->{'format'} ) { my $format = $param->{'format'}; @@ -1685,6 +1693,11 @@ sub batch_import { ? $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'} } @@ -1701,9 +1714,6 @@ sub batch_import { $row_callback = ''; @fields = @{ $param->{'fields'} }; - $postinsert_callback = $param->{'postinsert_callback'} - if $param->{'postinsert_callback'} - } else { die "neither format nor fields specified"; } @@ -1740,8 +1750,9 @@ sub batch_import { eval "use Parse::FixedLength;"; die $@ if $@; $parser = new Parse::FixedLength $fixedlength_format; - - } else { + + } + else { die "Unknown file type $type\n"; } @@ -1767,7 +1778,22 @@ sub batch_import { $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"; } @@ -1841,6 +1867,11 @@ sub batch_import { #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"; } @@ -1871,7 +1902,13 @@ sub batch_import { while ( scalar(@later) ) { my $sub = shift @later; my $data = shift @later; - &{$sub}($record, $data, $conf, $param); # $record->&{$sub}($data, $conf); + 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} ); } next if exists( $param->{skiprow} ); @@ -1902,9 +1939,12 @@ sub batch_import { } - $dbh->commit or die $dbh->errstr if $oldAutoCommit;; + unless ( $imported || $param->{empty_ok} ) { + $dbh->rollback if $oldAutoCommit; + return "Empty file!"; + } - return "Empty file!" unless $imported || $param->{empty_ok}; + $dbh->commit or die $dbh->errstr if $oldAutoCommit;; ''; #no error @@ -2161,7 +2201,7 @@ sub ut_text { #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); @@ -2178,11 +2218,8 @@ May be null. If there is an error, returns the error, otherwise returns false. sub ut_textn { my($self,$field)=@_; - $self->getfield($field) - =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]*)$/ - or return gettext('illegal_text'). " $field: ". $self->getfield($field); - $self->setfield($field,$1); - ''; + return $self->setfield($field, '') if $self->getfield($field) =~ /^$/; + $self->ut_text($field); } =item ut_alpha COLUMN @@ -2451,7 +2488,9 @@ May not be null. 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); ''; @@ -2552,6 +2591,20 @@ sub ut_enum { return "Illegal (enum) field $field: ". $self->getfield($field); } +=item ut_enumn COLUMN CHOICES_ARRAYREF + +Like ut_enum, except the null value is also allowed. + +=cut + +sub ut_enumn { + my( $self, $field, $choices ) = @_; + $self->getfield($field) + ? $self->ut_enum($field, $choices) + : ''; +} + + =item ut_foreign_key COLUMN FOREIGN_TABLE FOREIGN_COLUMN Check/untaint a foreign column key. Call a regular ut_ method (like ut_number) @@ -2858,7 +2911,8 @@ sub scalar_sql { 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]; + my $row = $sth->fetchrow_arrayref or return ''; + my $scalar = $row->[0]; defined($scalar) ? $scalar : ''; } @@ -3047,6 +3101,29 @@ sub not_regexp_sql { } +=item concat_sql [ DRIVER_NAME ] ITEMS_ARRAYREF + +Returns the items concatendated based on database type, using "CONCAT()" for +mysql and " || " for Pg and other databases. + +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 concat_sql { + my $driver = ref($_[0]) ? driver_name : shift; + my $items = shift; + + if ( $driver =~ /^mysql/i ) { + 'CONCAT('. join(',', @$items). ')'; + } else { + join('||', @$items); + } + +} + =back =head1 BUGS