Massenerstellen von RG aus LS: geschlossene LS nicht (erneut) verarbeiten
[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 List::MoreUtils qw(all pairwise);
9 use Rose::Object::MakeMethods::Generic scalar => [ qw(
10   _specs _row_class _row_spec _errors
11 ) ];
12
13 use SL::Helper::Csv::Error;
14
15 sub new {
16   my ($class, $parent) = @_;
17   my $self = bless { }, $class;
18
19   weaken($self->{_csv} = $parent);
20   $self->_errors([]);
21
22   return $self;
23 }
24
25 sub dispatch {
26   my ($self, $line) = @_;
27
28   my $class = $self->_class_by_line($line);
29   croak 'no class given' unless $class;
30
31   eval "require " . $class;
32   my $obj = $class->new;
33
34   my $specs = $self->_specs_by_line($line);
35   for my $spec (@{ $specs }) {
36     $self->apply($obj, $spec, $line->{$spec->{key}});
37   }
38
39   return $obj;
40 }
41
42 sub _class_by_line {
43   my ($self, $line) = @_;
44
45   # initialize lookup hash if not already done
46   if ($self->_csv->is_multiplexed && ! defined $self->_row_class ) {
47     $self->_row_class({ map { $_->{row_ident} => $_->{class} } @{ $self->_csv->profile } });
48   }
49
50   if ($self->_csv->is_multiplexed) {
51     return $self->_row_class->{$line->{datatype}};
52   } else {
53     return $self->_csv->profile->[0]->{class};
54   }
55 }
56
57 sub _specs_by_line {
58   my ($self, $line) = @_;
59
60   # initialize lookup hash if not already done
61   if ($self->_csv->is_multiplexed && ! defined $self->_row_spec ) {
62     $self->_row_spec({ pairwise { no warnings 'once'; $a->{row_ident} => $b } @{ $self->_csv->profile }, @{ $self->_specs } });
63   }
64
65   if ($self->_csv->is_multiplexed) {
66     return $self->_row_spec->{$line->{datatype}};
67   } else {
68     return $self->_specs->[0];
69   }
70 }
71
72
73 sub apply {
74   my ($self, $obj, $spec, $value) = @_;
75   return unless $value;
76
77   for my $step (@{ $spec->{steps} }) {
78     my ($acc, $class, $index) = @$step;
79     if ($class) {
80
81       # autovifify
82       if (defined $index) {
83         if (! $obj->$acc || !$obj->$acc->[$index]) {
84           my @objects = $obj->$acc;
85           $obj->$acc(@objects, map { $class->new } 0 .. $index - @objects);
86         }
87         $obj = $obj->$acc->[$index];
88       } else {
89         if (! $obj->$acc) {
90           $obj->$acc($class->new);
91         }
92         $obj = $obj->$acc;
93       }
94
95     } else {
96       $obj->$acc($value);
97     }
98   }
99 }
100
101 sub is_known {
102   my ($self, $col, $row) = @_;
103   return grep { $col eq $_->{key} } @{ $self->_specs->[$row // 0] };
104 }
105
106 sub parse_profile {
107   my ($self, %params) = @_;
108
109   my @specs;
110
111   my $csv_profile = $self->_csv->profile;
112   my $h_aref = ($self->_csv->is_multiplexed)? $self->_csv->header : [ $self->_csv->header ];
113   my $i = 0;
114   foreach my $header (@{ $h_aref }) {
115     my $spec = $self->_parse_profile(profile => $csv_profile->[$i]->{profile},
116                                      mapping => $csv_profile->[$i]->{mapping},
117                                      class   => $csv_profile->[$i]->{class},
118                                      header  => $header);
119     push @specs, $spec;
120     $i++;
121   }
122
123   $self->_specs(\@specs);
124
125   $self->_csv->_push_error($self->errors);
126
127   return ! $self->errors;
128 }
129
130 sub _parse_profile {
131   my ($self, %params) = @_;
132
133   my $profile = $params{profile} // {};
134   my $class   = $params{class};
135   my $header  = $params{header};
136   my $mapping = $params{mapping};
137
138   my @specs;
139
140   for my $col (@$header) {
141     next unless $col;
142     if (exists $mapping->{$col} && $profile->{$mapping->{$col}}) {
143       push @specs, $self->make_spec($col, $profile->{$mapping->{$col}}, $class);
144     } elsif (exists $mapping->{$col} && !%{ $profile }) {
145       push @specs, $self->make_spec($col, $mapping->{$col}, $class);
146     } elsif (exists $profile->{$col}) {
147       push @specs, $self->make_spec($col, $profile->{$col}, $class);
148     } else {
149       if ($self->_csv->strict_profile) {
150         $self->unknown_column($col, undef);
151       } else {
152         push @specs, $self->make_spec($col, $col, $class);
153       }
154     }
155   }
156
157   return \@specs;
158 }
159
160 sub make_spec {
161   my ($self, $col, $path, $cur_class) = @_;
162
163   my $spec = { key => $col, path => $path, steps => [] };
164
165   return unless $path;
166
167   return unless $cur_class;
168
169   for my $step_index ( split /\.(?!\d)/, $path ) {
170     my ($step, $index) = split /\./, $step_index;
171     if ($cur_class->can($step)) {
172       if (my $rel = $cur_class->meta->relationship($step)) { #a
173         if ($index && ! $rel->isa('Rose::DB::Object::Metadata::Relationship::OneToMany')) {
174           $self->_push_error([
175             $path,
176             undef,
177             "Profile path error. Indexed relationship is not OneToMany around here: '$step_index'",
178             undef,
179             0,
180           ]);
181           return;
182         } else {
183           my $next_class = $cur_class->meta->relationship($step)->class;
184           push @{ $spec->{steps} }, [ $step, $next_class, $index ];
185           $cur_class = $next_class;
186           eval "require $cur_class; 1" or die "could not load class '$cur_class'";
187         }
188       } else { # simple dispatch
189         push @{ $spec->{steps} }, [ $step ];
190         last;
191       }
192     } else {
193       $self->unknown_column($col, $path);
194     }
195   }
196
197   return $spec;
198 }
199
200 sub unknown_column {
201   my ($self, $col, $path) = @_;
202   return if $self->_csv->ignore_unknown_columns;
203
204   $self->_push_error([
205     $col,
206     undef,
207     "header field '$col' is not recognized",
208     undef,
209     0,
210   ]);
211 }
212
213 sub _csv {
214   $_[0]->{_csv};
215 }
216
217 sub errors {
218   @{ $_[0]->_errors }
219 }
220
221 sub _push_error {
222   my ($self, @errors) = @_;
223   my @new_errors = ($self->errors, map { SL::Helper::Csv::Error->new(@$_) } @errors);
224   $self->_errors(\@new_errors);
225 }
226
227 1;