From f74b0dac7a8e55cc7a67c4a03a3ee229415b3fbd Mon Sep 17 00:00:00 2001 From: =?utf8?q?Sven=20Sch=C3=B6ling?= Date: Mon, 13 Jun 2016 17:12:13 +0200 Subject: [PATCH] Csv: mapping support --- SL/Helper/Csv.pm | 52 +++++++++++++++++------ SL/Helper/Csv/Dispatcher.pm | 18 ++++---- t/helper/csv.t | 84 ++++++++++++++++++++++++++++++++++++- 3 files changed, 133 insertions(+), 21 deletions(-) diff --git a/SL/Helper/Csv.pm b/SL/Helper/Csv.pm index 50a95faad..fc9ff2002 100644 --- 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 is a HASHREF which may be used to map header fields to custom +The C 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 will be used to store the values from the C column. @@ -575,7 +574,32 @@ dispatching into it. C 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 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 3a725b5a0..a063103ba 100644 --- 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 bab3825df..99da3d38d 100644 --- 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 => \< ',', + 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 => \< '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 => \< '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 -- 2.20.1