Merge branch 'master' of vc.linet-services.de:public/lx-office-erp

[kivitendo-erp.git] / SL / Helper / Csv.pm

diff --git a/SL/Helper/Csv.pm b/SL/Helper/Csv.pm
index 945758f..3132b28 100644 (file)
--- a/SL/Helper/Csv.pm
+++ b/SL/Helper/Csv.pm
@@ -6,11 +6,11 @@ use warnings;
 use Carp;
 use IO::File;
 use Params::Validate qw(:all);
 use Carp;
 use IO::File;
 use Params::Validate qw(:all);

-use Text::CSV;
+use Text::CSV_XS;

 use Rose::Object::MakeMethods::Generic scalar => [ qw(
   file encoding sep_char quote_char escape_char header profile class
 use Rose::Object::MakeMethods::Generic scalar => [ qw(
   file encoding sep_char quote_char escape_char header profile class

-  numberformat dateformat ignore_unknown_columns _io _csv _objects _parsed
-  _data _errors
+  numberformat dateformat ignore_unknown_columns strict_profile _io _csv
+  _objects _parsed _data _errors

 ) ];
 
 use SL::Helper::Csv::Dispatcher;
 ) ];
 
 use SL::Helper::Csv::Dispatcher;


@@ -32,13 +32,14 @@ sub new {
     numberformat           => 0,
     dateformat             => 0,
     ignore_unknown_columns => 0,
     numberformat           => 0,
     dateformat             => 0,
     ignore_unknown_columns => 0,

+    strict_profile         => 0,

   });
   my $self = bless {}, $class;
 
   $self->$_($params{$_}) for keys %params;
 
   $self->_io(IO::File->new);
   });
   my $self = bless {}, $class;
 
   $self->$_($params{$_}) for keys %params;
 
   $self->_io(IO::File->new);

-  $self->_csv(Text::CSV->new({
+  $self->_csv(Text::CSV_XS->new({

     binary => 1,
     sep_char    => $self->sep_char,
     quote_char  => $self->quote_char,
     binary => 1,
     sep_char    => $self->sep_char,
     quote_char  => $self->quote_char,


@@ -98,17 +99,20 @@ sub _open_file {
 
 sub _check_header {
   my ($self, %params) = @_;
 
 sub _check_header {
   my ($self, %params) = @_;

-  return $self->header if $self->header;
+  my $header = $self->header;

 
 

-  my $header = $self->_csv->getline($self->_io);
+  if (! $header) {
+    $header = $self->_csv->getline($self->_io);

 
 

-  $self->_push_error([
-    $self->_csv->error_input,
-    $self->_csv->error_diag,
-    0,
-  ]) unless $header;
+    $self->_push_error([
+      $self->_csv->error_input,
+      $self->_csv->error_diag,
+      0,
+    ]) unless $header;
+  }

 
 

-  $self->header($header);
+  return unless $header;
+  return $self->header([ map { lc } @$header ]);

 }
 
 sub _parse_data {
 }
 
 sub _parse_data {


@@ -119,18 +123,19 @@ sub _parse_data {
 
   while (1) {
     my $row = $self->_csv->getline($self->_io);
 
   while (1) {
     my $row = $self->_csv->getline($self->_io);

-    last if $self->_csv->eof;

     if ($row) {
       my %hr;
       @hr{@{ $self->header }} = @$row;
       push @data, \%hr;
     } else {
     if ($row) {
       my %hr;
       @hr{@{ $self->header }} = @$row;
       push @data, \%hr;
     } else {

+      last if $self->_csv->eof;

       push @errors, [
         $self->_csv->error_input,
         $self->_csv->error_diag,
         $self->_io->input_line_number,
       ];
     }
       push @errors, [
         $self->_csv->error_input,
         $self->_csv->error_diag,
         $self->_io->input_line_number,
       ];
     }

+    last if $self->_csv->eof;

   }
 
   $self->_data(\@data);
   }
 
   $self->_data(\@data);


@@ -342,6 +347,11 @@ and the return value used instead of the line itself.
 If set, the import will ignore unkown header columns. Useful for lazy imports,
 but deactivated by default.
 
 If set, the import will ignore unkown header columns. Useful for lazy imports,
 but deactivated by default.
 

+=item C<strict_profile>
+
+If set, all columns to be parsed must be specified in C<profile>. Every header
+field not listed there will be treated like an unknown column.
+

 =back
 
 =head1 ERROR HANDLING
 =back
 
 =head1 ERROR HANDLING