Revision 7ec8b55e
Von Bernd Blessmann vor mehr als 11 Jahren hinzugefügt
| SL/Helper/Csv.pm | ||
|---|---|---|
|
use Carp;
|
||
|
use IO::File;
|
||
|
use Params::Validate qw(:all);
|
||
|
use List::MoreUtils qw(all);
|
||
|
use List::MoreUtils qw(all pairwise);
|
||
|
use Text::CSV_XS;
|
||
|
use Rose::Object::MakeMethods::Generic scalar => [ qw(
|
||
|
file encoding sep_char quote_char escape_char header profile
|
||
|
numberformat dateformat ignore_unknown_columns strict_profile is_multiplexed
|
||
|
_io _csv _objects _parsed _data _errors all_cvar_configs case_insensitive_header
|
||
|
_row_header _io _csv _objects _parsed _data _errors all_cvar_configs case_insensitive_header
|
||
|
) ];
|
||
|
|
||
|
use SL::Helper::Csv::Dispatcher;
|
||
| ... | ... | |
|
sub _header_by_row {
|
||
|
my ($self, $row) = @_;
|
||
|
|
||
|
my @header = @{ $self->header };
|
||
|
# initialize lookup hash if not already done
|
||
|
if ($self->is_multiplexed && ! defined $self->_row_header ) {
|
||
|
$self->_row_header({ pairwise { $a->{row_ident} => $b } @{ $self->profile }, @{ $self->header } });
|
||
|
}
|
||
|
|
||
|
if ($self->is_multiplexed) {
|
||
|
my $i = 0;
|
||
|
foreach my $profile (@{ $self->profile }) {
|
||
|
if ($row->[0] eq $profile->{row_ident}) {
|
||
|
return $header[$i];
|
||
|
}
|
||
|
$i++;
|
||
|
}
|
||
|
return $self->_row_header->{$row->[0]}
|
||
|
} else {
|
||
|
return $header[0];
|
||
|
return $self->header->[0];
|
||
|
}
|
||
|
}
|
||
|
|
||
| SL/Helper/Csv/Dispatcher.pm | ||
|---|---|---|
|
use Data::Dumper;
|
||
|
use Carp;
|
||
|
use Scalar::Util qw(weaken);
|
||
|
use List::MoreUtils qw(all pairwise);
|
||
|
use Rose::Object::MakeMethods::Generic scalar => [ qw(
|
||
|
_specs _errors
|
||
|
_specs _row_class _row_spec _errors
|
||
|
) ];
|
||
|
|
||
|
use SL::Helper::Csv::Error;
|
||
| ... | ... | |
|
return $obj;
|
||
|
}
|
||
|
|
||
|
# return class for given line
|
||
|
# if only one profile is given, return this profiles class
|
||
|
# if more than one profile is given, identify class by first
|
||
|
# column???
|
||
|
sub _class_by_line {
|
||
|
my ($self, $line) = @_;
|
||
|
|
||
|
my $class;
|
||
|
# initialize lookup hash if not already done
|
||
|
if ($self->_csv->is_multiplexed && ! defined $self->_row_class ) {
|
||
|
$self->_row_class({ map { $_->{row_ident} => $_->{class} } @{ $self->_csv->profile } });
|
||
|
}
|
||
|
|
||
|
if ($self->_csv->is_multiplexed) {
|
||
|
foreach my $p (@{ $self->_csv->profile }) {
|
||
|
my $row_ident = $p->{row_ident};
|
||
|
if ($line->{datatype} eq $row_ident) {
|
||
|
$class = $p->{class};
|
||
|
last;
|
||
|
}
|
||
|
}
|
||
|
return $self->_row_class->{$line->{datatype}};
|
||
|
} else {
|
||
|
$class = $self->_csv->profile->[0]->{class};
|
||
|
return $self->_csv->profile->[0]->{class};
|
||
|
}
|
||
|
|
||
|
return $class;
|
||
|
}
|
||
|
|
||
|
sub _specs_by_line {
|
||
|
my ($self, $line) = @_;
|
||
|
|
||
|
my $spec;
|
||
|
my $i = 0;
|
||
|
# initialize lookup hash if not already done
|
||
|
if ($self->_csv->is_multiplexed && ! defined $self->_row_spec ) {
|
||
|
$self->_row_spec({ pairwise { $a->{row_ident} => $b } @{ $self->_csv->profile }, @{ $self->_specs } });
|
||
|
}
|
||
|
|
||
|
if ($self->_csv->is_multiplexed) {
|
||
|
foreach my $p (@{ $self->_csv->profile }) {
|
||
|
my $row_ident = $p->{row_ident};
|
||
|
if ($line->{datatype} eq $row_ident) {
|
||
|
$spec = $self->_specs->[$i];
|
||
|
last;
|
||
|
}
|
||
|
$i++;
|
||
|
}
|
||
|
return $self->_row_spec->{$line->{datatype}};
|
||
|
} else {
|
||
|
$spec = $self->_specs->[0];
|
||
|
return $self->_specs->[0];
|
||
|
}
|
||
|
|
||
|
return $spec;
|
||
|
}
|
||
|
|
||
|
|
||
Auch abrufbar als: Unified diff
Lookup-Hashes für Header, Klassen und Specs bei Multiplex-Daten benutzen.