Csv: mapping support

diff --git a/SL/Helper/Csv.pm b/SL/Helper/Csv.pm
index 50a95fa..fc9ff20 100644 (file)
--- a/SL/Helper/Csv.pm
+++ b/SL/Helper/Csv.pm
@@ -204,6 +204,7 @@ sub _check_header {
       foreach my $h (@{ $h_aref }) {
         my @names = (
           keys %{ $self->profile->[$p_num]->{profile} || {} },
+          keys %{ $self->profile->[$p_num]->{mapping} || {} },
         );
         for my $name (@names) {
           for my $i (0..$#$h) {
@@ -527,22 +528,20 @@ The basic structure is:
 
   PROFILE       := [ CLASS_PROFILE, CLASS_PROFILE* ]
   CLASS_PROFILE := {
-                      profile   => { ACCESSORS },
+                      profile   => { ACCESSORS+ },
                       class     => $classname,
                       row_ident => $row_ident,
+                      mapping   => { MAPPINGS* },
                    }
-  ACCESSORS     := $field => $accessor, ACCESSORS*
+  ACCESSORS     := $field => $accessor
+  MAPPINGS      := $alias => $field
 
-The C<profile> is a HASHREF which may be used to map header fields to custom
+The C<ACCESSORS> may be used to map header fields to custom
 accessors. Example:
 
-  [
-    {
-      profile => {
-        listprice => 'listprice_as_number',
-      }
-    }
-  ]
+  profile => {
+    listprice => 'listprice_as_number',
+  }
 
 In this case C<listprice_as_number> will be used to store the values from the
 C<listprice> column.
@@ -575,7 +574,32 @@ dispatching into it.
 C<row_ident> is used to determine the correct profile in multiplexed data and
 must be given there. It's not used in non-multiplexed data.
 
-Example:
+If C<mappings> is present, it must contain a hashref that maps strings to known
+fields. This can be used to add custom profiles for known sources, that don't
+comply with the expected header identities.
+
+Without strict profiles, mappings can also directly map header fields that
+should end up in the same accessor.
+
+Mappings can be identical to known fields and will be prefered during lookup,
+but will not replace the field, meaning that:
+
+  profile => {
+    name        => 'name',
+    description => 'description',
+  }
+  mapping => {
+    name        => 'description',
+    shortname   => 'name',
+  }
+
+will work as expected, and shortname will not end up in description. This also
+works with the case insensitive option. Note however that the case insensitive
+option will not enable true unicode collating.
+
+
+Here's a full example:
+
   [
     {
       class     => 'SL::DB::Order',
@@ -584,7 +608,8 @@ Example:
     {
       class     => 'SL::DB::OrderItem',
       row_ident => 'I',
-      profile   => { sellprice => 'sellprice_as_number' }
+      profile   => { sellprice => 'sellprice_as_number' },
+      mapping   => { 'Verkaufspreis' => 'sellprice' }
     },
   ]
 
@@ -601,6 +626,9 @@ Each entry is an object with the following attributes:
 
 Note that the last entry can be off, but will give an estimate.
 
+Error handling is also known to break on new Perl versions and need to be
+adjusted from time to time due to changes in Text::CSV_XS.
+
 =head1 CAVEATS
 
 =over 4

diff --git a/SL/Helper/Csv/Dispatcher.pm b/SL/Helper/Csv/Dispatcher.pm
index 3a725b5..a063103 100644 (file)
--- a/SL/Helper/Csv/Dispatcher.pm
+++ b/SL/Helper/Csv/Dispatcher.pm
@@ -113,6 +113,7 @@ sub parse_profile {
   my $i = 0;
   foreach my $header (@{ $h_aref }) {
     my $spec = $self->_parse_profile(profile => $csv_profile->[$i]->{profile},
+                                     mapping => $csv_profile->[$i]->{mapping},
                                      class   => $csv_profile->[$i]->{class},
                                      header  => $header);
     push @specs, $spec;
@@ -132,20 +133,21 @@ sub _parse_profile {
   my $profile = $params{profile};
   my $class   = $params{class};
   my $header  = $params{header};
+  my $mapping = $params{mapping};
 
   my @specs;
 
   for my $col (@$header) {
     next unless $col;
-    if ($self->_csv->strict_profile) {
-      if (exists $profile->{$col}) {
-        push @specs, $self->make_spec($col, $profile->{$col}, $class);
-      } else {
-        $self->unknown_column($col, undef);
-      }
+    if (exists $mapping->{$col} && $profile->{$mapping->{$col}}) {
+      push @specs, $self->make_spec($col, $profile->{$mapping->{$col}}, $class);
+    } elsif (exists $mapping->{$col}) {
+      push @specs, $self->make_spec($col, $mapping->{$col}, $class);
+    } elsif (exists $profile->{$col}) {
+      push @specs, $self->make_spec($col, $profile->{$col}, $class);
     } else {
-      if (exists $profile->{$col}) {
-        push @specs, $self->make_spec($col, $profile->{$col}, $class);
+      if ($self->_csv->strict_profile) {
+        $self->unknown_column($col, undef);
       } else {
         push @specs, $self->make_spec($col, $col, $class);
       }

diff --git a/t/helper/csv.t b/t/helper/csv.t
index bab3825..99da3d3 100644 (file)
--- a/t/helper/csv.t
+++ b/t/helper/csv.t
@@ -1,4 +1,4 @@
-use Test::More tests => 75;
+use Test::More tests => 84;
 
 use lib 't';
 use utf8;
@@ -726,6 +726,88 @@ ok $csv->get_objects->[0], 'multiplex: empty path gets ignored in object creatio
 
 #####
 
+# Mappings
+# simple case
+$csv = SL::Helper::Csv->new(
+  file   => \<<EOL,
+description,sellprice,lastcost_as_number,purchaseprice,
+Kaffee,0.12,'12,2','1,5234'
+EOL
+  sep_char => ',',
+  quote_char => "'",
+  profile => [
+    {
+      profile => { listprice => 'listprice_as_number' },
+      mapping => { purchaseprice => 'listprice' },
+      class   => 'SL::DB::Part',
+    }
+  ],
+);
+ok $csv->parse, 'simple mapping parses';
+is $csv->get_objects->[0]->listprice, 1.5234, 'simple mapping works';
+
+$csv = SL::Helper::Csv->new(
+  file   => \<<EOL,
+description;partnumber;sellprice;purchaseprice;wiener;
+Kaffee;;0.12;1,221.52;ja wiener
+Beer;1123245;0.12;1.5234;nein kein wieder
+EOL
+  numberformat => '1,000.00',
+  ignore_unknown_columns => 1,
+  strict_profile => 1,
+  profile => [{
+    profile => { lastcost => 'lastcost_as_number' },
+    mapping => { purchaseprice => 'lastcost' },
+    class  => 'SL::DB::Part',
+  }]
+);
+ok $csv->parse, 'strict mapping parses';
+is $csv->get_objects->[0]->lastcost, 1221.52, 'strict mapping works';
+
+# swapping
+$csv = SL::Helper::Csv->new(
+  file   => \<<EOL,
+description;partnumber;sellprice;lastcost;wiener;
+Kaffee;1;0.12;1,221.52;ja wiener
+Beer;1123245;0.12;1.5234;nein kein wieder
+EOL
+  numberformat => '1,000.00',
+  ignore_unknown_columns => 1,
+  strict_profile => 1,
+  profile => [{
+    mapping => { partnumber => 'description', description => 'partnumber' },
+    class  => 'SL::DB::Part',
+  }]
+);
+ok $csv->parse, 'swapping parses';
+is $csv->get_objects->[0]->partnumber, 'Kaffee', 'strict mapping works 1';
+is $csv->get_objects->[0]->description, '1', 'strict mapping works 2';
+
+# case insensitive shit
+$csv = SL::Helper::Csv->new(
+  file   => \"Description\nKaffee",        # " # make emacs happy
+  case_insensitive_header => 1,
+  profile => [{
+    mapping => { description => 'description' },
+    class  => 'SL::DB::Part'
+  }],
+);
+$csv->parse;
+is $csv->get_objects->[0]->description, 'Kaffee', 'case insensitive mapping without profile works';
+
+# case insensitive shit
+$csv = SL::Helper::Csv->new(
+  file   => \"Price\n4,99",        # " # make emacs happy
+  case_insensitive_header => 1,
+  profile => [{
+    profile => { sellprice => 'sellprice_as_number' },
+    mapping => { price => 'sellprice' },
+    class  => 'SL::DB::Part',
+  }],
+);
+$csv->parse;
+is $csv->get_objects->[0]->sellprice, 4.99, 'case insensitive mapping with profile works';
+
 
 # vim: ft=perl
 # set emacs to perl mode