use Rose::Object::MakeMethods::Generic scalar => [ qw(
file encoding sep_char quote_char escape_char header profile class
numberformat dateformat ignore_unknown_columns strict_profile _io _csv
- _objects _parsed _data _errors
+ _objects _parsed _data _errors all_cvar_configs case_insensitive_header
) ];
use SL::Helper::Csv::Dispatcher;
dateformat => 0,
ignore_unknown_columns => 0,
strict_profile => 0,
+ case_insensitive_header => 0,
});
my $self = bless {}, $class;
}
return unless $header;
- return $self->header([ map { lc } @$header ]);
+
+ # Special case: human stupidity
+ # people insist that case sensitivity doesn't exist and try to enter all
+ # sorts of stuff. at this point we've got a profile (with keys that represent
+ # valid methods), and a header full of strings. if two of them match, the user
+ # mopst likely meant that field, so rewrite the header
+ if ($self->case_insensitive_header) {
+ die 'case_insensitive_header is only possible with profile' unless $self->profile;
+ my @names = (
+ keys %{ $self->profile || {} },
+ );
+ for my $name (@names) {
+ for my $i (0..$#$header) {
+ $header->[$i] = $name if lc $header->[$i] eq lc $name;
+ }
+ }
+ }
+
+ return $self->header($header);
}
sub _parse_data {
will have to do that for yourself. Since you provided the profile, it is
assumed you know what to do in this case.
+If no profile is given, any header field found will be taken as is.
+
+If the path in a profile entry is empty, the field will be subjected to
+C<strict_profile> and C<case_insensitive_header> checking, will be parsed into
+C<get_data>, but will not be attempted to be dispatched into objects.
+
=item C<class>
If present, the line will be handed to the new sub of this class,
If set, the import will ignore unkown header columns. Useful for lazy imports,
but deactivated by default.
+=item C<case_insensitive_header>
+
+If set, header columns will be matched against profile entries case
+insensitive, and on match the profile name will be taken.
+
+Only works if a profile is given, will die otherwise.
+
+If both C<case_insensitive_header> and C<strict_profile> is set, matched header
+columns will be accepted.
+
=item C<strict_profile>
If set, all columns to be parsed must be specified in C<profile>. Every header
field not listed there will be treated like an unknown column.
+If both C<case_insensitive_header> and C<strict_profile> is set, matched header
+columns will be accepted.
+
=back
=head1 ERROR HANDLING
$self->unknown_column($col, undef);
}
} else {
- push @specs, $self->make_spec($col, $profile->{$col} || $col);
+ if (exists $profile->{$col}) {
+ push @specs, $self->make_spec($col, $profile->{$col});
+ } else {
+ push @specs, $self->make_spec($col, $col);
+ }
}
}
my ($self, $col, $path) = @_;
my $spec = { key => $col, steps => [] };
+
+ return unless $path;
+
my $cur_class = $self->_csv->class;
return unless $cur_class;
-use Test::More tests => 41;
+use Test::More tests => 47;
use lib 't';
+use utf8;
use Data::Dumper;
-use utf8;
+use Support::TestSetup;
-use_ok 'Support::TestSetup';
use_ok 'SL::Helper::Csv';
Support::TestSetup::login();
$csv = SL::Helper::Csv->new(
file => \"Description\nKaffee",
class => 'SL::DB::Part',
+ case_insensitive_header => 1,
+ profile => { description => 'description' },
);
$csv->parse;
is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'case insensitive header from csv works';
#####
$csv = SL::Helper::Csv->new(
-file => \"Kaffee",
-header => [ 'Description' ],
-class => 'SL::DB::Part',
+ file => \"Kaffee",
+ header => [ 'Description' ],
+ class => 'SL::DB::Part',
+ case_insensitive_header => 1,
+ profile => { description => 'description' },
);
$csv->parse;
is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'case insensitive header as param works';
$csv->parse;
is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'utf8 BOM works (bug 1872)';
+#####
+
+$csv = SL::Helper::Csv->new(
+ file => \"Kaffee",
+ header => [ 'Description' ],
+ class => 'SL::DB::Part',
+);
+$csv->parse;
+is_deeply $csv->get_data, undef, 'case insensitive header without flag ignores';
+
+#####
+
+$csv = SL::Helper::Csv->new(
+ file => \"Kaffee",
+ header => [ 'foo' ],
+ class => 'SL::DB::Part',
+ profile => { foo => '' },
+);
+$csv->parse;
+
+is_deeply $csv->get_data, [ { foo => 'Kaffee' } ], 'empty path still gets parsed into data';
+ok $csv->get_objects->[0], 'empty path gets ignored in object creation';
+
+#####
+
+$csv = SL::Helper::Csv->new(
+ file => \"Kaffee",
+ header => [ 'foo' ],
+ class => 'SL::DB::Part',
+ strict_profile => 1,
+ profile => { foo => '' },
+);
+$csv->parse;
+
+is_deeply $csv->get_data, [ { foo => 'Kaffee' } ], 'empty path still gets parsed into data (strict profile)';
+ok $csv->get_objects->[0], 'empty path gets ignored in object creation (strict profile)';
+
+$csv = SL::Helper::Csv->new(
+ file => \"Phil",
+ header => [ 'CVAR_grOUnDHog' ],
+ class => 'SL::DB::Part',
+ strict_profile => 1,
+ case_insensitive_header => 1,
+ profile => { cvar_Groundhog => '' },
+);
+$csv->parse;
+
+is_deeply $csv->get_data, [ { cvar_Groundhog => 'Phil' } ], 'using empty path to get cvars working';
+ok $csv->get_objects->[0], '...and not destorying the objects';
+
# vim: ft=perl