Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision 202844a1

Von Bernd Blessmann vor fast 11 Jahren hinzugefügt

  • ID 202844a12433fe5234126e4f8c4b542c43559107
  • Vorgänger e87f225c
  • Nachfolger 7ec8b55e

Auf leere Header bei Multiplex-Daten testen und ...

Kosmetik und Code-Vereinfachung

Unterschiede anzeigen:

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++;
SL/Helper/Csv/Dispatcher.pm
55 55
      }
56 56
    }
57 57
  } else {
58
    $class = @{ $self->_csv->profile }[0]->{class};
58
    $class = $self->_csv->profile->[0]->{class};
59 59
  }
60 60

  
61 61
  return $class;
......
70 70
    foreach my $p (@{ $self->_csv->profile }) {
71 71
      my $row_ident = $p->{row_ident};
72 72
      if ($line->{datatype} eq $row_ident) {
73
        $spec = @{ $self->_specs }[$i];
73
        $spec = $self->_specs->[$i];
74 74
        last;
75 75
      }
76 76
      $i++;
77 77
    }
78 78
  } else {
79
    $spec = @{ $self->_specs }[0];
79
    $spec = $self->_specs->[0];
80 80
  }
81 81

  
82 82
  return $spec;
......
128 128
  foreach my $h (@{ $self->_csv->header }) {
129 129
    $header = $h;
130 130
    if ($self->_csv->profile) {
131
      $profile = @{ $self->_csv->profile }[$i]->{profile};
132
      $class   = @{ $self->_csv->profile }[$i]->{class};
131
      $profile = $self->_csv->profile->[$i]->{profile};
132
      $class   = $self->_csv->profile->[$i]->{class};
133 133
    }
134 134

  
135 135
    my $spec = $self->_parse_profile(profile => $profile,

Auch abrufbar als: Unified diff