SL/Helper/Csv/Dispatcher.pm

   1 package SL::Helper::Csv::Dispatcher;
   2
   3 use strict;
   4
   5 use Data::Dumper;
   6 use Carp;
   7 use Scalar::Util qw(weaken);
   8 use Rose::Object::MakeMethods::Generic scalar => [ qw(
   9   _specs _errors
  10 ) ];
  11
  12 sub new {
  13   my ($class, $parent) = @_;
  14   my $self = bless { }, $class;
  15
  16   weaken($self->{_csv} = $parent);
  17   $self->_errors([]);
  18
  19   return $self;
  20 }
  21
  22 sub dispatch {
  23   my ($self, $obj, $line) = @_;
  24
  25   for my $spec (@{ $self->_specs }) {
  26     $self->apply($obj, $spec, $line->{$spec->{key}});
  27   }
  28 }
  29
  30 sub apply {
  31   my ($self, $obj, $spec, $value) = @_;
  32   return unless $value;
  33
  34   for my $step (@{ $spec->{steps} }) {
  35     my ($acc, $class) = @$step;
  36     if ($class) {
  37       eval "require $class; 1" or die "could not load class '$class'";
  38       $obj->$acc($class->new) if ! $$obj->$acc;
  39       $obj = $obj->$acc;
  40     } else {
  41       $obj->$acc($value);
  42     }
  43   }
  44 }
  45
  46 sub is_known {
  47   my ($self, $col) = @_;
  48   return grep { $col eq $_->{key} } $self->_specs;
  49 }
  50
  51 sub parse_profile {
  52   my ($self, %params) = @_;
  53
  54   my $header  = $self->_csv->header;
  55   my $profile = $self->_csv->profile;
  56   my @specs;
  57
  58   for my $col (@$header) {
  59     next unless $col;
  60     push @specs, $self->make_spec($col, $profile->{$col} || $col);
  61   }
  62
  63   $self->_specs(\@specs);
  64   $self->_csv->_push_error($self->errors);
  65   return ! $self->errors;
  66 }
  67
  68 sub make_spec {
  69   my ($self, $col, $path) = @_;
  70
  71   my $spec = { key => $col, steps => [] };
  72   my $cur_class = $self->_csv->class;
  73
  74   for my $step ( split /\./, $path ) {
  75     if ($cur_class->can($step)) {
  76       if ($cur_class->meta->relationship($step)) { #a
  77         my $next_class = $cur_class->meta->relationsship($step)->class;
  78         push @{ $spec->{steps} }, [ $step, $next_class ];
  79         $cur_class = $next_class;
  80       } else { # simple dispatch
  81         push @{ $spec->{steps} }, [ $step ];
  82         last;
  83       }
  84     } else {
  85       $self->unknown_column($col, $path);
  86     }
  87   }
  88
  89   return $spec;
  90 }
  91
  92 sub unknown_column {
  93   my ($self, $col, $path) = @_;
  94   return if $self->_csv->ignore_unknown_columns;
  95
  96   $self->_push_error([
  97     $col,
  98     undef,
  99     "header field '$col' is not recognized",
 100     undef,
 101     0,
 102   ]);
 103 }
 104
 105 sub _csv {
 106   $_[0]->{_csv};
 107 }
 108
 109 sub errors {
 110   @{ $_[0]->_errors }
 111 }
 112
 113 sub _push_error {
 114   my ($self, @errors) = @_;
 115   my @new_errors = ($self->errors, @errors);
 116   $self->_errors(\@new_errors);
 117 }
 118
 119 1;