Csv Dispatcher implementiert.
[kivitendo-erp.git] / 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;