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