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 use SL::Helper::Csv::Error;
  13
  14 sub new {
  15   my ($class, $parent) = @_;
  16   my $self = bless { }, $class;
  17
  18   weaken($self->{_csv} = $parent);
  19   $self->_errors([]);
  20
  21   return $self;
  22 }
  23
  24 sub dispatch {
  25   my ($self, $obj, $line) = @_;
  26
  27   for my $spec (@{ $self->_specs }) {
  28     $self->apply($obj, $spec, $line->{$spec->{key}});
  29   }
  30 }
  31
  32 sub apply {
  33   my ($self, $obj, $spec, $value) = @_;
  34   return unless $value;
  35
  36   for my $step (@{ $spec->{steps} }) {
  37     my ($acc, $class, $index) = @$step;
  38     if ($class) {
  39
  40       # autovifify
  41       if (defined $index) {
  42         if (! $obj->$acc || !$obj->$acc->[$index]) {
  43           my @objects = $obj->$acc;
  44           $obj->$acc(@objects, map { $class->new } 0 .. $index - @objects);
  45         }
  46         $obj = $obj->$acc->[$index];
  47       } else {
  48         if (! $obj->$acc) {
  49           $obj->$acc($class->new);
  50         }
  51         $obj = $obj->$acc;
  52       }
  53
  54     } else {
  55       $obj->$acc($value);
  56     }
  57   }
  58 }
  59
  60 sub is_known {
  61   my ($self, $col) = @_;
  62   return grep { $col eq $_->{key} } $self->_specs;
  63 }
  64
  65 sub parse_profile {
  66   my ($self, %params) = @_;
  67
  68   my $header  = $self->_csv->header;
  69   my $profile = $self->_csv->profile;
  70   my @specs;
  71
  72   for my $col (@$header) {
  73     next unless $col;
  74     if ($self->_csv->strict_profile) {
  75       if (exists $profile->{$col}) {
  76         push @specs, $self->make_spec($col, $profile->{$col});
  77       } else {
  78         $self->unknown_column($col, undef);
  79       }
  80     } else {
  81       if (exists $profile->{$col}) {
  82         push @specs, $self->make_spec($col, $profile->{$col});
  83       } else {
  84         push @specs, $self->make_spec($col, $col);
  85       }
  86     }
  87   }
  88
  89   $self->_specs(\@specs);
  90   $self->_csv->_push_error($self->errors);
  91   return ! $self->errors;
  92 }
  93
  94 sub make_spec {
  95   my ($self, $col, $path) = @_;
  96
  97   my $spec = { key => $col, steps => [] };
  98
  99   return unless $path;
 100
 101   my $cur_class = $self->_csv->class;
 102
 103   return unless $cur_class;
 104
 105   for my $step_index ( split /\.(?!\d)/, $path ) {
 106     my ($step, $index) = split /\./, $step_index;
 107     if ($cur_class->can($step)) {
 108       if (my $rel = $cur_class->meta->relationship($step)) { #a
 109         if ($index && ! $rel->isa('Rose::DB::Object::Metadata::Relationship::OneToMany')) {
 110           $self->_push_error([
 111             $path,
 112             undef,
 113             "Profile path error. Indexed relationship is not OneToMany around here: '$step_index'",
 114             undef,
 115             0,
 116           ]);
 117           return;
 118         } else {
 119           my $next_class = $cur_class->meta->relationship($step)->class;
 120           push @{ $spec->{steps} }, [ $step, $next_class, $index ];
 121           $cur_class = $next_class;
 122           eval "require $cur_class; 1" or die "could not load class '$cur_class'";
 123         }
 124       } else { # simple dispatch
 125         push @{ $spec->{steps} }, [ $step ];
 126         last;
 127       }
 128     } else {
 129       $self->unknown_column($col, $path);
 130     }
 131   }
 132
 133   return $spec;
 134 }
 135
 136 sub unknown_column {
 137   my ($self, $col, $path) = @_;
 138   return if $self->_csv->ignore_unknown_columns;
 139
 140   $self->_push_error([
 141     $col,
 142     undef,
 143     "header field '$col' is not recognized",
 144     undef,
 145     0,
 146   ]);
 147 }
 148
 149 sub _csv {
 150   $_[0]->{_csv};
 151 }
 152
 153 sub errors {
 154   @{ $_[0]->_errors }
 155 }
 156
 157 sub _push_error {
 158   my ($self, @errors) = @_;
 159   my @new_errors = ($self->errors, map { SL::Helper::Csv::Error->new(@$_) } @errors);
 160   $self->_errors(\@new_errors);
 161 }
 162
 163 1;