]> wagnertech.de Git - mfinanz.git/commitdiff
SL::Helper::Csv -> ignore_unkown_columns flag
authorSven Schöling <s.schoeling@linet-services.de>
Wed, 23 Feb 2011 11:17:18 +0000 (12:17 +0100)
committerMoritz Bunkus <m.bunkus@linet-services.de>
Thu, 16 Jun 2011 06:44:00 +0000 (08:44 +0200)
SL/Helper/Csv.pm
t/helper/csv.t

index 72863431c55654faf8d697a843e231b9e79e329f..d4383779f558f4b20b9cfd11de5f498df4fc047e 100644 (file)
@@ -8,8 +8,9 @@ use IO::File;
 use Text::CSV;
 use Params::Validate qw(:all);
 use Rose::Object::MakeMethods::Generic scalar => [ qw(
 use Text::CSV;
 use Params::Validate qw(:all);
 use Rose::Object::MakeMethods::Generic scalar => [ qw(
-   file encoding sep_char quote_char escape_char header profile class
-   numberformat dateformat _io _csv _objects _parsed _data _errors
+  file encoding sep_char quote_char escape_char header profile class
+  numberformat dateformat ignore_unknown_columns _io _csv _objects _parsed
+  _data _errors
 ) ];
 
 
 ) ];
 
 
@@ -18,16 +19,17 @@ use Rose::Object::MakeMethods::Generic scalar => [ qw(
 sub new {
   my $class  = shift;
   my %params = validate(@_, {
 sub new {
   my $class  = shift;
   my %params = validate(@_, {
-    sep_char      => { default => ';' },
-    quote_char    => { default => '"' },
-    escape_char   => { default => '"' },
-    header        => { type    => ARRAYREF, optional => 1 },
-    profile       => { type    => HASHREF,  optional => 1 },
-    file          => 1,
-    encoding      => 0,
-    class         => 0,
-    numberformat  => 0,
-    dateformat    => 0,
+    sep_char               => { default => ';' },
+    quote_char             => { default => '"' },
+    escape_char            => { default => '"' },
+    header                 => { type    => ARRAYREF, optional => 1 },
+    profile                => { type    => HASHREF,  optional => 1 },
+    file                   => 1,
+    encoding               => 0,
+    class                  => 0,
+    numberformat           => 0,
+    dateformat             => 0,
+    ignore_unknown_columns => 0,
   });
   my $self = bless {}, $class;
 
   });
   my $self = bless {}, $class;
 
@@ -50,8 +52,9 @@ sub parse {
   my ($self, %params) = @_;
 
   $self->_open_file;
   my ($self, %params) = @_;
 
   $self->_open_file;
-  return unless $self->_check_header;
-  return unless $self->_parse_data;
+  return if ! $self->_check_header;
+  return if $self->class && ! $self->_check_header_for_class;
+  return if ! $self->_parse_data;
 
   $self->_parsed(1);
   return $self;
 
   $self->_parsed(1);
   return $self;
@@ -110,24 +113,35 @@ sub _check_header_for_class {
   my ($self, %params) = @_;
   my @errors;
 
   my ($self, %params) = @_;
   my @errors;
 
-  return unless $self->class;
-  return $self->header;
+  carp 'this should never be called without' unless $self->class;
 
 
-  for my $method (@{ $self->header }) {
-    next if $self->class->can($self->_real_method($method));
+  if ($self->ignore_unknown_columns) {
+    my @new_header;
+    for my $method (@{ $self->header }) {
+      push @new_header, $self->class->can($self->_real_method($method))
+         ? $method : undef;
+    }
 
 
-    push @errors, [
-      $method,
-      undef,
-      "header field $method is not recognized",
-      undef,
-      0,
-    ];
-  }
+    $self->header(\@new_header);
 
 
-  $self->_push_error(@errors);
+    return 1;
+  } else {
+    for my $method (@{ $self->header }) {
+      next if ! $method;
+      next if $self->class->can($self->_real_method($method));
 
 
-  return ! @errors;
+      push @errors, [
+        $method,
+        undef,
+        "header field $method is not recognized",
+        undef,
+        0,
+      ];
+    }
+
+    $self->_push_error(@errors);
+    return ! @errors;
+  }
 }
 
 sub _parse_data {
 }
 
 sub _parse_data {
@@ -308,6 +322,11 @@ C<listprice> column.
 If present, the line will be handed to the new sub of this class,
 and the return value used instead of the line itself.
 
 If present, the line will be handed to the new sub of this class,
 and the return value used instead of the line itself.
 
+=item C<ignore_unknown_columns>
+
+If set, the import will ignore unkown header columns. Useful for lazy imports,
+but deactivated by default.
+
 =back
 
 =head1 ERROR HANDLING
 =back
 
 =head1 ERROR HANDLING
index 25932221f2022dab12e28146f3b9ba244fe6c637..2a58cabee5b9a1318783d94b207654d621c54208 100644 (file)
@@ -125,5 +125,21 @@ EOL
 is $csv->parse, undef, 'broken csv content won\'t get parsed';
 is_deeply $csv->errors, [ '"Kaf"fee";;0.12;1,221.52'."\n", 2023, 'EIQ - QUO character not allowed', 5, 2 ], 'error';
 
 is $csv->parse, undef, 'broken csv content won\'t get parsed';
 is_deeply $csv->errors, [ '"Kaf"fee";;0.12;1,221.52'."\n", 2023, 'EIQ - QUO character not allowed', 5, 2 ], 'error';
 
+####
+
+$csv = SL::Helper::Csv->new(
+  file   => \<<EOL,
+description;partnumber;sellprice;lastcost_as_number;wiener;
+Kaffee;;0.12;1,221.52;ja wiener
+Beer;1123245;0.12;1.5234;nein kein wieder
+EOL
+  numberformat => '1,000.00',
+  ignore_unknown_columns => 1,
+  class  => 'SL::DB::Part',
+);
+$csv->parse;
+is $csv->get_objects->[0]->lastcost, '1221.52', 'ignore_unkown_columns works';
+
+
 done_testing();
 # vim: ft=perl
 done_testing();
 # vim: ft=perl