Revision f74b0dac
Von Sven Schöling vor mehr als 8 Jahren hinzugefügt
| SL/Helper/Csv.pm | ||
|---|---|---|
|
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) {
|
||
| ... | ... | |
|
|
||
|
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.
|
||
| ... | ... | |
|
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',
|
||
| ... | ... | |
|
{
|
||
|
class => 'SL::DB::OrderItem',
|
||
|
row_ident => 'I',
|
||
|
profile => { sellprice => 'sellprice_as_number' }
|
||
|
profile => { sellprice => 'sellprice_as_number' },
|
||
|
mapping => { 'Verkaufspreis' => 'sellprice' }
|
||
|
},
|
||
|
]
|
||
|
|
||
| ... | ... | |
|
|
||
|
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
|
||
| SL/Helper/Csv/Dispatcher.pm | ||
|---|---|---|
|
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;
|
||
| ... | ... | |
|
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);
|
||
|
}
|
||
| t/helper/csv.t | ||
|---|---|---|
|
use Test::More tests => 75;
|
||
|
use Test::More tests => 84;
|
||
|
|
||
|
use lib 't';
|
||
|
use utf8;
|
||
| ... | ... | |
|
|
||
|
#####
|
||
|
|
||
|
# 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
|
||
Auch abrufbar als: Unified diff
Csv: mapping support