| 7 |
7 |
use Carp;
|
| 8 |
8 |
use IO::File;
|
| 9 |
9 |
use Params::Validate qw(:all);
|
|
10 |
use List::MoreUtils qw(all);
|
| 10 |
11 |
use Text::CSV_XS;
|
| 11 |
12 |
use Rose::Object::MakeMethods::Generic scalar => [ qw(
|
| 12 |
13 |
file encoding sep_char quote_char escape_char header profile
|
| ... | ... | |
| 108 |
109 |
if ($self->profile) {
|
| 109 |
110 |
my @profile = @{ $self->profile };
|
| 110 |
111 |
if (scalar @profile > 1) {
|
| 111 |
|
my $info_ok = 1;
|
| 112 |
112 |
# Each profile needs a class and a row_ident
|
| 113 |
|
foreach my $p (@profile) {
|
| 114 |
|
if ( !defined $p->{class} || !defined $p->{row_ident} ) {
|
| 115 |
|
$info_ok = 0;
|
| 116 |
|
last;
|
| 117 |
|
}
|
| 118 |
|
}
|
|
113 |
my $info_ok = all { defined $_->{class} && defined $_->{row_ident} } @profile;
|
| 119 |
114 |
|
| 120 |
115 |
# If header is given, there need to be a header for each profile
|
|
116 |
# and no empty headers.
|
| 121 |
117 |
if ($info_ok && $self->header) {
|
| 122 |
118 |
my @header = @{ $self->header };
|
| 123 |
|
if (scalar @profile != scalar @header) {
|
| 124 |
|
$info_ok = 0;
|
| 125 |
|
}
|
|
119 |
$info_ok = $info_ok && scalar @profile == scalar @header;
|
|
120 |
$info_ok = $info_ok && all { scalar @$_ > 0} @header;
|
| 126 |
121 |
}
|
| 127 |
122 |
$self->is_multiplexed($info_ok);
|
| 128 |
123 |
return $info_ok;
|
| ... | ... | |
| 158 |
153 |
# data with a discouraged but valid byte order mark
|
| 159 |
154 |
# if not removed, the first header field will not be recognized
|
| 160 |
155 |
if ($header) {
|
| 161 |
|
foreach my $h (@{ $header }) {
|
| 162 |
|
if ($h && $h->[0] && $self->encoding =~ /utf-?8/i) {
|
| 163 |
|
$h->[0] =~ s/^\x{FEFF}//;
|
| 164 |
|
}
|
|
156 |
my $h = $header->[0];
|
|
157 |
if ($h && $h->[0] && $self->encoding =~ /utf-?8/i) {
|
|
158 |
$h->[0] =~ s/^\x{FEFF}//;
|
| 165 |
159 |
}
|
| 166 |
160 |
}
|
| 167 |
161 |
|
| 168 |
162 |
# check, if all header fields are parsed well
|
| 169 |
|
my $all_ok = 1;
|
| 170 |
|
if ($header) {
|
| 171 |
|
foreach my $h (@{ $header }) {
|
| 172 |
|
if (!$h) {
|
| 173 |
|
$all_ok = 0;
|
| 174 |
|
last;
|
| 175 |
|
}
|
| 176 |
|
}
|
| 177 |
|
} else {
|
| 178 |
|
$all_ok = 0;
|
| 179 |
|
}
|
| 180 |
|
return unless $all_ok;
|
|
163 |
return unless $header && all { $_ } @$header;
|
| 181 |
164 |
|
| 182 |
165 |
# Special case: human stupidity
|
| 183 |
166 |
# people insist that case sensitivity doesn't exist and try to enter all
|
| ... | ... | |
| 207 |
190 |
my $row = $self->_csv->getline($self->_io);
|
| 208 |
191 |
if ($row) {
|
| 209 |
192 |
my $header = $self->_header_by_row($row);
|
| 210 |
|
$self->_csv->column_names(@{ $header });
|
| 211 |
193 |
my %hr;
|
| 212 |
194 |
@hr{@{ $header }} = @$row;
|
| 213 |
195 |
push @data, \%hr;
|
| ... | ... | |
| 243 |
225 |
if ($self->is_multiplexed) {
|
| 244 |
226 |
my $i = 0;
|
| 245 |
227 |
foreach my $profile (@{ $self->profile }) {
|
| 246 |
|
if (@{ $row }[0] eq $profile->{row_ident}) {
|
|
228 |
if ($row->[0] eq $profile->{row_ident}) {
|
| 247 |
229 |
return $header[$i];
|
| 248 |
230 |
}
|
| 249 |
231 |
$i++;
|
Auf leere Header bei Multiplex-Daten testen und ...
Kosmetik und Code-Vereinfachung