Helper::Csv: Support für leere profile.path Angaben und case_insensitive_header

diff --git a/SL/Helper/Csv.pm b/SL/Helper/Csv.pm
index 5b629ee..e481614 100644 (file)
--- a/SL/Helper/Csv.pm
+++ b/SL/Helper/Csv.pm
@@ -10,7 +10,7 @@ use Text::CSV_XS;
 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;
@@ -33,6 +33,7 @@ sub new {
     dateformat             => 0,
     ignore_unknown_columns => 0,
     strict_profile         => 0,
+    case_insensitive_header => 0,
   });
   my $self = bless {}, $class;
 
@@ -120,7 +121,25 @@ sub _check_header {
   }
 
   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 {
@@ -345,6 +364,12 @@ these information are unique, and should be connected to preexisting data, you
 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,
@@ -355,11 +380,24 @@ and the return value used instead of the line itself.
 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

diff --git a/SL/Helper/Csv/Dispatcher.pm b/SL/Helper/Csv/Dispatcher.pm
index be3fadd..add444b 100644 (file)
--- a/SL/Helper/Csv/Dispatcher.pm
+++ b/SL/Helper/Csv/Dispatcher.pm
@@ -78,7 +78,11 @@ sub parse_profile {
         $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);
+      }
     }
   }
 
@@ -91,6 +95,9 @@ sub make_spec {
   my ($self, $col, $path) = @_;
 
   my $spec = { key => $col, steps => [] };
+
+  return unless $path;
+
   my $cur_class = $self->_csv->class;
 
   return unless $cur_class;

diff --git a/t/helper/csv.t b/t/helper/csv.t
index 63fc858..3023833 100644 (file)
--- a/t/helper/csv.t
+++ b/t/helper/csv.t
@@ -1,11 +1,11 @@
-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();
@@ -278,6 +278,8 @@ is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'eol bug at the end o
 $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';
@@ -285,9 +287,11 @@ is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'case insensitive hea
 #####
 
 $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';
@@ -302,4 +306,54 @@ $csv = SL::Helper::Csv->new(
 $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