Merge branch 'b-3.6.1' of ../kivitendo-erp_20220811

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

diff --git a/SL/Helper/Csv.pm b/SL/Helper/Csv.pm
index 145b7db..0d471eb 100644 (file)
--- a/SL/Helper/Csv.pm
+++ b/SL/Helper/Csv.pm
@@ -114,6 +114,7 @@ sub _check_multiplexed {
       # Each profile needs a class and a row_ident
       my $info_ok = all { defined $_->{class} && defined $_->{row_ident} } @profile;
       $self->_push_error([
+        undef,
         0,
         "missing class or row_ident in one of the profiles for multiplexed data",
         0,
@@ -125,6 +126,7 @@ sub _check_multiplexed {
         my @header = @{ $self->header };
         my $t_ok = scalar @profile == scalar @header;
         $self->_push_error([
+          undef,
           0,
           "number of headers and number of profiles must be the same for multiplexed data",
           0,
@@ -133,6 +135,7 @@ sub _check_multiplexed {
 
         $t_ok = all { scalar @$_ > 0} @header;
         $self->_push_error([
+          undef,
           0,
           "no empty headers are allowed for multiplexed data",
           0,
@@ -158,10 +161,11 @@ sub _check_header {
     foreach my $p_num (0..$n_header - 1) {
       my $h = $self->_csv->getline($self->_io);
 
+      my ($code, $string, $position, $record, $field) = $self->_csv->error_diag;
+
       $self->_push_error([
         $self->_csv->error_input,
-        $self->_csv->error_diag,
-        0,
+        $code, $string, $position, $record // 0,
       ]) unless $h;
 
       if ($self->is_multiplexed) {
@@ -202,13 +206,13 @@ sub _check_header {
       my $h_aref = ($self->is_multiplexed)? $header : [ $header ];
       my $p_num  = 0;
       foreach my $h (@{ $h_aref }) {
-        my @names = (
-          keys %{ $self->profile->[$p_num]->{profile} || {} },
-          keys %{ $self->profile->[$p_num]->{mapping} || {} },
+        my %names = (
+          (map { $_ => $_                                     } keys %{ $self->profile->[$p_num]->{profile} || {} }),
+          (map { $_ => $self->profile->[$p_num]{mapping}{$_}  } keys %{ $self->profile->[$p_num]->{mapping} || {} }),
         );
-        for my $name (@names) {
+        for my $name (keys %names) {
           for my $i (0..$#$h) {
-            $h->[$i] = $name if lc $h->[$i] eq lc $name;
+            $h->[$i] = $names{$name} if lc $h->[$i] eq lc $name;
           }
         }
         $p_num++;
@@ -230,7 +234,8 @@ sub _check_multiplex_datatype_position {
     $self->_multiplex_datatype_position($first_pos);
     return 1;
   } else {
-    $self->_push_error([0,
+    $self->_push_error([undef,
+                        0,
                         "datatype field must be at the same position for all datatypes for multiplexed data",
                         0,
                         0]);
@@ -238,6 +243,10 @@ sub _check_multiplex_datatype_position {
   }
 }
 
+sub _is_empty_row {
+  return !!all { !$_ } @{$_[0]};
+}
+
 sub _parse_data {
   my ($self, %params) = @_;
   my (@data, @errors);
@@ -245,9 +254,11 @@ sub _parse_data {
   while (1) {
     my $row = $self->_csv->getline($self->_io);
     if ($row) {
+      next if _is_empty_row($row);
       my $header = $self->_header_by_row($row);
       if (!$header) {
         push @errors, [
+          undef,
           0,
           "Cannot get header for row. Maybe row name and datatype field not matching.",
           0,
@@ -259,19 +270,15 @@ sub _parse_data {
       push @data, \%hr;
     } else {
       last if $self->_csv->eof;
+
       # Text::CSV_XS 0.89 added record number to error_diag
-      if (qv(Text::CSV_XS->VERSION) >= qv('0.89')) {
-        push @errors, [
-          $self->_csv->error_input,
-          $self->_csv->error_diag,
-        ];
-      } else {
-        push @errors, [
-          $self->_csv->error_input,
-          $self->_csv->error_diag,
-          $self->_io->input_line_number,
-        ];
-      }
+      my ($code, $string, $position, $record, $field) = $self->_csv->error_diag;
+
+      push @errors, [
+        $self->_csv->error_input,
+        $code, $string, $position,
+        $record // $self->_io->input_line_number,
+      ];
     }
     last if $self->_csv->eof;
   }
@@ -500,7 +507,7 @@ See section L</PROFILE> for information on this topic.
 
 =item C<ignore_unknown_columns>
 
-If set, the import will ignore unkown header columns. Useful for lazy imports,
+If set, the import will ignore unknown header columns. Useful for lazy imports,
 but deactivated by default.
 
 =item C<case_insensitive_header>
@@ -584,6 +591,9 @@ comply with the expected header identities.
 Without strict profiles, mappings can also directly map header fields that
 should end up in the same accessor.
 
+With case insensitive headings, mappings will also modify the headers, to fit
+the expected profile.
+
 Mappings can be identical to known fields and will be prefered during lookup,
 but will not replace the field, meaning that: