Csv Dispatcher implementiert.

diff --git a/SL/Helper/Csv.pm b/SL/Helper/Csv.pm
index d4383779f558f4b20b9cfd11de5f498df4fc047e..82e57011571e1a02fe0a7eec87f3dd98efdec14f 100644 (file)
--- a/SL/Helper/Csv.pm
+++ b/SL/Helper/Csv.pm
@@ -5,14 +5,15 @@ use warnings;
 
 use Carp;
 use IO::File;
 
 use Carp;
 use IO::File;

-use Text::CSV;

 use Params::Validate qw(:all);
 use Params::Validate qw(:all);

+use Text::CSV;

 use Rose::Object::MakeMethods::Generic scalar => [ qw(
   file encoding sep_char quote_char escape_char header profile class
   numberformat dateformat ignore_unknown_columns _io _csv _objects _parsed
   _data _errors
 ) ];
 
 use Rose::Object::MakeMethods::Generic scalar => [ qw(
   file encoding sep_char quote_char escape_char header profile class
   numberformat dateformat ignore_unknown_columns _io _csv _objects _parsed
   _data _errors
 ) ];
 

+use SL::Helper::Csv::Dispatcher;

 
 # public interface
 
 
 # public interface
 


@@ -53,7 +54,8 @@ sub parse {
 
   $self->_open_file;
   return if ! $self->_check_header;
 
   $self->_open_file;
   return if ! $self->_check_header;

-  return if $self->class && ! $self->_check_header_for_class;
+  return if ! $self->dispatcher->parse_profile;
+#  return if $self->class && ! $self->_check_header_for_class;

   return if ! $self->_parse_data;
 
   $self->_parsed(1);
   return if ! $self->_parse_data;
 
   $self->_parsed(1);


@@ -109,41 +111,6 @@ sub _check_header {
   $self->header($header);
 }
 
   $self->header($header);
 }
 

-sub _check_header_for_class {
-  my ($self, %params) = @_;
-  my @errors;
-
-  carp 'this should never be called without' unless $self->class;
-
-  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;
-    }
-
-    $self->header(\@new_header);
-
-    return 1;
-  } else {
-    for my $method (@{ $self->header }) {
-      next if ! $method;
-      next if $self->class->can($self->_real_method($method));
-
-      push @errors, [
-        $method,
-        undef,
-        "header field $method is not recognized",
-        undef,
-        0,
-      ];
-    }
-
-    $self->_push_error(@errors);
-    return ! @errors;
-  }
-}
-

 sub _parse_data {
   my ($self, %params) = @_;
   my (@data, @errors);
 sub _parse_data {
   my ($self, %params) = @_;
   my (@data, @errors);


@@ -153,7 +120,6 @@ sub _parse_data {
   while (1) {
     my $row = $self->_csv->getline($self->_io);
     last if $self->_csv->eof;
   while (1) {
     my $row = $self->_csv->getline($self->_io);
     last if $self->_csv->eof;

-

     if ($row) {
       my %hr;
       @hr{@{ $self->header }} = @$row;
     if ($row) {
       my %hr;
       @hr{@{ $self->header }} = @$row;


@@ -186,19 +152,26 @@ sub _make_objects {
   local $::myconfig{dateformat}   = $self->dateformat   if $self->dateformat;
 
   for my $line (@{ $self->_data }) {
   local $::myconfig{dateformat}   = $self->dateformat   if $self->dateformat;
 
   for my $line (@{ $self->_data }) {

-    push @objs, $self->class->new(
-      map {
-        $self->_real_method($_) => $line->{$_}
-      } grep { $_ } keys %$line
-    );
+    my $tmp_obj = $self->class->new;
+    $self->dispatcher->dispatch($tmp_obj, $line);
+    push @objs, $tmp_obj;

   }
 
   $self->_objects(\@objs);
 }
 
   }
 
   $self->_objects(\@objs);
 }
 

-sub _real_method {
-  my ($self, $arg) = @_;
-  ($self->profile && $self->profile->{$arg}) || $arg;
+sub dispatcher {
+  my ($self, %params) = @_;
+
+  $self->{_dispatcher} ||= $self->_make_dispatcher;
+}
+
+sub _make_dispatcher {
+  my ($self, %params) = @_;
+
+  die 'need a header to make a dispatcher' unless $self->header;
+
+  return SL::Helper::Csv::Dispatcher->new($self);

 }
 
 sub _guess_encoding {
 }
 
 sub _guess_encoding {

diff --git a/SL/Helper/Csv/Dispatcher.pm b/SL/Helper/Csv/Dispatcher.pm
new file mode 100644 (file)
index 0000000..e060f82
--- /dev/null
+++ b/SL/Helper/Csv/Dispatcher.pm
@@ -0,0 +1,119 @@
+package SL::Helper::Csv::Dispatcher;
+
+use strict;
+
+use Data::Dumper;
+use Carp;
+use Scalar::Util qw(weaken);
+use Rose::Object::MakeMethods::Generic scalar => [ qw(
+  _specs _errors
+) ];
+
+sub new {
+  my ($class, $parent) = @_;
+  my $self = bless { }, $class;
+
+  weaken($self->{_csv} = $parent);
+  $self->_errors([]);
+
+  return $self;
+}
+
+sub dispatch {
+  my ($self, $obj, $line) = @_;
+
+  for my $spec (@{ $self->_specs }) {
+    $self->apply($obj, $spec, $line->{$spec->{key}});
+  }
+}
+
+sub apply {
+  my ($self, $obj, $spec, $value) = @_;
+  return unless $value;
+
+  for my $step (@{ $spec->{steps} }) {
+    my ($acc, $class) = @$step;
+    if ($class) {
+      eval "require $class; 1" or die "could not load class '$class'";
+      $obj->$acc($class->new) if ! $$obj->$acc;
+      $obj = $obj->$acc;
+    } else {
+      $obj->$acc($value);
+    }
+  }
+}
+
+sub is_known {
+  my ($self, $col) = @_;
+  return grep { $col eq $_->{key} } $self->_specs;
+}
+
+sub parse_profile {
+  my ($self, %params) = @_;
+
+  my $header  = $self->_csv->header;
+  my $profile = $self->_csv->profile;
+  my @specs;
+
+  for my $col (@$header) {
+    next unless $col;
+    push @specs, $self->make_spec($col, $profile->{$col} || $col);
+  }
+
+  $self->_specs(\@specs);
+  $self->_csv->_push_error($self->errors);
+  return ! $self->errors;
+}
+
+sub make_spec {
+  my ($self, $col, $path) = @_;
+
+  my $spec = { key => $col, steps => [] };
+  my $cur_class = $self->_csv->class;
+
+  for my $step ( split /\./, $path ) {
+    if ($cur_class->can($step)) {
+      if ($cur_class->meta->relationship($step)) { #a
+        my $next_class = $cur_class->meta->relationsship($step)->class;
+        push @{ $spec->{steps} }, [ $step, $next_class ];
+        $cur_class = $next_class;
+      } else { # simple dispatch
+        push @{ $spec->{steps} }, [ $step ];
+        last;
+      }
+    } else {
+      $self->unknown_column($col, $path);
+    }
+  }
+
+  return $spec;
+}
+
+sub unknown_column {
+  my ($self, $col, $path) = @_;
+  return if $self->_csv->ignore_unknown_columns;
+
+  $self->_push_error([
+    $col,
+    undef,
+    "header field '$col' is not recognized",
+    undef,
+    0,
+  ]);
+}
+
+sub _csv {
+  $_[0]->{_csv};
+}
+
+sub errors {
+  @{ $_[0]->_errors }
+}
+
+sub _push_error {
+  my ($self, @errors) = @_;
+  my @new_errors = ($self->errors, @errors);
+  $self->_errors(\@new_errors);
+}
+
+1;