Revision 202844a1
Von Bernd Blessmann vor fast 11 Jahren hinzugefügt
| SL/Helper/Csv.pm | ||
|---|---|---|
| 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++; |
Auch abrufbar als: Unified diff
Auf leere Header bei Multiplex-Daten testen und ...
Kosmetik und Code-Vereinfachung