Revision af205393
Von Bernd Blessmann vor etwa 11 Jahren hinzugefügt
SL/Controller/CsvImport/Base.pm | ||
---|---|---|
31 | 31 |
my $profile = $self->profile; |
32 | 32 |
$self->csv(SL::Helper::Csv->new(file => $self->file->file_name, |
33 | 33 |
encoding => $self->controller->profile->get('charset'), |
34 |
profile => { profile => $profile, class => $self->class },
|
|
34 |
profile => [{ profile => $profile, class => $self->class }],
|
|
35 | 35 |
ignore_unknown_columns => 1, |
36 | 36 |
strict_profile => 1, |
37 | 37 |
case_insensitive_header => 1, |
... | ... | |
47 | 47 |
|
48 | 48 |
$self->controller->track_progress(progress => 50); |
49 | 49 |
|
50 |
if ($self->csv->is_multiplexed) { |
|
51 |
die "controller for multiplex data is not implemented yet"; |
|
52 |
} |
|
53 |
|
|
50 | 54 |
$self->controller->errors([ $self->csv->errors ]) if $self->csv->errors; |
51 | 55 |
|
52 | 56 |
return if ( !$self->csv->header || $self->csv->errors ); |
53 | 57 |
|
54 |
my $headers = { headers => [ grep { $profile->{$_} } @{ $self->csv->header } ] }; |
|
58 |
my $headers = { headers => [ grep { $profile->{$_} } @{ $self->csv->header->[0] } ] };
|
|
55 | 59 |
$headers->{methods} = [ map { $profile->{$_} } @{ $headers->{headers} } ]; |
56 | 60 |
$headers->{used} = { map { ($_ => 1) } @{ $headers->{headers} } }; |
57 | 61 |
$self->controller->headers($headers); |
SL/Helper/Csv.pm | ||
---|---|---|
10 | 10 |
use Text::CSV_XS; |
11 | 11 |
use Rose::Object::MakeMethods::Generic scalar => [ qw( |
12 | 12 |
file encoding sep_char quote_char escape_char header profile |
13 |
numberformat dateformat ignore_unknown_columns strict_profile _io _csv
|
|
14 |
_objects _parsed _data _errors all_cvar_configs case_insensitive_header |
|
13 |
numberformat dateformat ignore_unknown_columns strict_profile is_multiplexed
|
|
14 |
_io _csv _objects _parsed _data _errors all_cvar_configs case_insensitive_header
|
|
15 | 15 |
) ]; |
16 | 16 |
|
17 | 17 |
use SL::Helper::Csv::Dispatcher; |
... | ... | |
26 | 26 |
quote_char => { default => '"' }, |
27 | 27 |
escape_char => { default => '"' }, |
28 | 28 |
header => { type => ARRAYREF, optional => 1 }, |
29 |
profile => { type => HASHREF, optional => 1 },
|
|
29 |
profile => { type => ARRAYREF, optional => 1 },
|
|
30 | 30 |
file => 1, |
31 | 31 |
encoding => 0, |
32 | 32 |
numberformat => 0, |
... | ... | |
56 | 56 |
my ($self, %params) = @_; |
57 | 57 |
|
58 | 58 |
$self->_open_file; |
59 |
return if ! $self->_check_multiplexed; |
|
59 | 60 |
return if ! $self->_check_header; |
60 | 61 |
return if ! $self->dispatcher->parse_profile; |
61 | 62 |
return if ! $self->_parse_data; |
... | ... | |
97 | 98 |
return $self->_io; |
98 | 99 |
} |
99 | 100 |
|
101 |
# check, if data is multiplexed and if all nessesary infos are given |
|
102 |
sub _check_multiplexed { |
|
103 |
my ($self, %params) = @_; |
|
104 |
|
|
105 |
$self->is_multiplexed(0); |
|
106 |
|
|
107 |
# If more than one profile is given, it is multiplexed. |
|
108 |
if ($self->profile) { |
|
109 |
my @profile = @{ $self->profile }; |
|
110 |
if (scalar @profile > 1) { |
|
111 |
my $info_ok = 1; |
|
112 |
# Each profile needs a class and a row_ident |
|
113 |
foreach my $p (@profile) { |
|
114 |
if ( !defined $p->{class} || !defined $p->{row_ident} ) { |
|
115 |
$info_ok = 0; |
|
116 |
last; |
|
117 |
} |
|
118 |
} |
|
119 |
|
|
120 |
# If header is given, there need to be a header for each profile |
|
121 |
if ($info_ok && $self->header) { |
|
122 |
my @header = @{ $self->header }; |
|
123 |
if (scalar @profile != scalar @header) { |
|
124 |
$info_ok = 0; |
|
125 |
} |
|
126 |
} |
|
127 |
$self->is_multiplexed($info_ok); |
|
128 |
return $info_ok; |
|
129 |
} |
|
130 |
} |
|
131 |
|
|
132 |
# ok, if not multiplexed |
|
133 |
return 1; |
|
134 |
} |
|
135 |
|
|
100 | 136 |
sub _check_header { |
101 | 137 |
my ($self, %params) = @_; |
102 |
my $header = $self->header;
|
|
138 |
my $header; |
|
103 | 139 |
|
104 |
if (! $header) { |
|
105 |
$header = $self->_csv->getline($self->_io); |
|
140 |
$header = $self->header; |
|
141 |
if (!$header) { |
|
142 |
my $n_header = ($self->is_multiplexed)? scalar @{ $self->profile } : 1; |
|
143 |
foreach my $p_num (0..$n_header - 1) { |
|
144 |
my $h = $self->_csv->getline($self->_io); |
|
106 | 145 |
|
107 |
$self->_push_error([ |
|
108 |
$self->_csv->error_input, |
|
109 |
$self->_csv->error_diag, |
|
110 |
0, |
|
111 |
]) unless $header; |
|
146 |
$self->_push_error([ |
|
147 |
$self->_csv->error_input, |
|
148 |
$self->_csv->error_diag, |
|
149 |
0, |
|
150 |
]) unless $h; |
|
151 |
|
|
152 |
push @{ $header }, $h; |
|
153 |
} |
|
112 | 154 |
} |
113 | 155 |
|
114 | 156 |
# Special case: utf8 BOM. |
115 | 157 |
# certain software (namely MS Office and notepad.exe insist on prefixing |
116 | 158 |
# data with a discouraged but valid byte order mark |
117 | 159 |
# if not removed, the first header field will not be recognized |
118 |
if ($header && $header->[0] && $self->encoding =~ /utf-?8/i) { |
|
119 |
$header->[0] =~ s/^\x{FEFF}//; |
|
160 |
if ($header) { |
|
161 |
foreach my $h (@{ $header }) { |
|
162 |
if ($h && $h->[0] && $self->encoding =~ /utf-?8/i) { |
|
163 |
$h->[0] =~ s/^\x{FEFF}//; |
|
164 |
} |
|
165 |
} |
|
120 | 166 |
} |
121 | 167 |
|
122 |
return unless $header; |
|
168 |
# check, if all header fields are parsed well |
|
169 |
my $all_ok = 1; |
|
170 |
if ($header) { |
|
171 |
foreach my $h (@{ $header }) { |
|
172 |
if (!$h) { |
|
173 |
$all_ok = 0; |
|
174 |
last; |
|
175 |
} |
|
176 |
} |
|
177 |
} else { |
|
178 |
$all_ok = 0; |
|
179 |
} |
|
180 |
return unless $all_ok; |
|
123 | 181 |
|
124 | 182 |
# Special case: human stupidity |
125 | 183 |
# people insist that case sensitivity doesn't exist and try to enter all |
... | ... | |
145 | 203 |
my ($self, %params) = @_; |
146 | 204 |
my (@data, @errors); |
147 | 205 |
|
148 |
$self->_csv->column_names(@{ $self->header }); |
|
149 |
|
|
150 | 206 |
while (1) { |
151 | 207 |
my $row = $self->_csv->getline($self->_io); |
152 | 208 |
if ($row) { |
209 |
my $header = $self->_header_by_row($row); |
|
210 |
$self->_csv->column_names(@{ $header }); |
|
153 | 211 |
my %hr; |
154 |
@hr{@{ $self->header }} = @$row;
|
|
212 |
@hr{@{ $header }} = @$row; |
|
155 | 213 |
push @data, \%hr; |
156 | 214 |
} else { |
157 | 215 |
last if $self->_csv->eof; |
... | ... | |
178 | 236 |
return ! @errors; |
179 | 237 |
} |
180 | 238 |
|
239 |
sub _header_by_row { |
|
240 |
my ($self, $row) = @_; |
|
241 |
|
|
242 |
my @header = @{ $self->header }; |
|
243 |
if ($self->is_multiplexed) { |
|
244 |
my $i = 0; |
|
245 |
foreach my $profile (@{ $self->profile }) { |
|
246 |
if (@{ $row }[0] eq $profile->{row_ident}) { |
|
247 |
return $header[$i]; |
|
248 |
} |
|
249 |
$i++; |
|
250 |
} |
|
251 |
} else { |
|
252 |
return $header[0]; |
|
253 |
} |
|
254 |
} |
|
255 |
|
|
181 | 256 |
sub _encode_layer { |
182 | 257 |
':encoding(' . $_[0]->encoding . ')'; |
183 | 258 |
} |
... | ... | |
243 | 318 |
sep_char => ',', # default ';' |
244 | 319 |
quote_char => '\'', # default '"' |
245 | 320 |
escape_char => '"', # default '"' |
246 |
header => [qw(id text sellprice word)], # see later |
|
247 |
profile => { profile => { sellprice => 'sellprice_as_number'}, class => SL::DB::Part }, |
|
321 |
header => [ [qw(id text sellprice word)] ], # see later |
|
322 |
profile => [ { profile => { sellprice => 'sellprice_as_number'}, |
|
323 |
class => 'SL::DB::Part' } ], |
|
248 | 324 |
); |
249 | 325 |
|
250 | 326 |
my $status = $csv->parse; |
... | ... | |
285 | 361 |
happen here. You will receive a plain mapping of the data into the class tree, |
286 | 362 |
nothing more. |
287 | 363 |
|
364 |
=item Multiplex data |
|
365 |
|
|
366 |
This module can handle multiplexed data of different class types. In that case |
|
367 |
multiple profiles with classes and row identifiers must be given. Multiple |
|
368 |
headers may also be given or read from csv data. Data must contain the row |
|
369 |
identifier in the first column and it's field name must be 'datatype'. |
|
370 |
|
|
288 | 371 |
=back |
289 | 372 |
|
290 | 373 |
=head1 METHODS |
... | ... | |
338 | 421 |
|
339 | 422 |
Same as in L<Text::CSV> |
340 | 423 |
|
341 |
=item C<header> \@FIELDS |
|
424 |
=item C<header> \@HEADERS |
|
425 |
|
|
426 |
If given, it contains an ARRAYREF for each different class type (i.e. one |
|
427 |
ARRAYREF if the data is only of one class type). These ARRAYREFS are the header |
|
428 |
fields which are an array of columns. In this case the first lines are not used |
|
429 |
as a header. Empty header fields will be ignored in objects. |
|
430 |
|
|
431 |
If not given, headers are taken from the first n lines of data, where n is the |
|
432 |
number of different class types. |
|
342 | 433 |
|
343 |
Can be an array of columns, in this case the first line is not used as a |
|
344 |
header. Empty header fields will be ignored in objects. |
|
434 |
Examples: |
|
345 | 435 |
|
346 |
=item C<profile> {profile => \%ACCESSORS, class => class} |
|
436 |
classic data of one type: |
|
437 |
[ [ 'name', 'street', 'zipcode', 'city' ] ] |
|
347 | 438 |
|
348 |
This is a HASHREF to hash which may contain the keys C<profile> and C<class>. |
|
439 |
multiplexed data with two different types |
|
440 |
[ [ 'ordernumber', 'customer', 'transdate' ], [ 'partnumber', 'qty', 'sellprice' ] ] |
|
441 |
|
|
442 |
=item C<profile> [{profile => \%ACCESSORS, class => class, row_ident => ri},] |
|
443 |
|
|
444 |
This is an ARRAYREF to HASHREFs which may contain the keys C<profile>, C<class> |
|
445 |
and C<row_ident>. |
|
349 | 446 |
|
350 | 447 |
The C<profile> is a HASHREF which may be used to map header fields to custom |
351 | 448 |
accessors. Example: |
352 | 449 |
|
353 |
{profile => { listprice => listprice_as_number }}
|
|
450 |
[ {profile => { listprice => listprice_as_number }} ]
|
|
354 | 451 |
|
355 | 452 |
In this case C<listprice_as_number> will be used to read in values from the |
356 | 453 |
C<listprice> column. |
... | ... | |
358 | 455 |
In case of a One-To-One relationsship these can also be set over |
359 | 456 |
relationsships by sparating the steps with a dot (C<.>). This will work: |
360 | 457 |
|
361 |
{profile => { customer => 'customer.name' }}
|
|
458 |
[ {profile => { customer => 'customer.name' }} ]
|
|
362 | 459 |
|
363 | 460 |
And will result in something like this: |
364 | 461 |
|
... | ... | |
374 | 471 |
If C<class> is present, the line will be handed to the new sub of this class, |
375 | 472 |
and the return value used instead of the line itself. |
376 | 473 |
|
474 |
C<row_ident> is a string to recognize the right profile and class for each data |
|
475 |
line in multiplexed data. |
|
476 |
|
|
477 |
In case of multiplexed data, C<class> and C<row_ident> must be given. |
|
478 |
Example: |
|
479 |
[ { |
|
480 |
class => 'SL::DB::Order', |
|
481 |
row_ident => 'O' |
|
482 |
}, |
|
483 |
{ |
|
484 |
class => 'SL::DB::OrderItem', |
|
485 |
row_ident => 'I', |
|
486 |
profile => {sellprice => sellprice_as_number} |
|
487 |
} ] |
|
488 |
|
|
377 | 489 |
=item C<ignore_unknown_columns> |
378 | 490 |
|
379 | 491 |
If set, the import will ignore unkown header columns. Useful for lazy imports, |
... | ... | |
433 | 545 |
|
434 | 546 |
$csv = SL::Helper::Csv->new( |
435 | 547 |
file => ... |
436 |
profile => { |
|
548 |
profile => [ {
|
|
437 | 549 |
profile => [ |
438 | 550 |
makemodel => { |
439 | 551 |
make_1 => make, |
... | ... | |
445 | 557 |
}, |
446 | 558 |
], |
447 | 559 |
class => SL::DB::Part, |
448 |
} |
|
560 |
} ]
|
|
449 | 561 |
); |
450 | 562 |
|
451 | 563 |
=head1 AUTHOR |
SL/Helper/Csv/Dispatcher.pm | ||
---|---|---|
24 | 24 |
sub dispatch { |
25 | 25 |
my ($self, $line) = @_; |
26 | 26 |
|
27 |
eval "require " . $self->_csv->profile->{class};
|
|
28 |
my $obj = $self->_csv->profile->{class}->new;
|
|
27 |
my $class = $self->_class_by_line($line);
|
|
28 |
croak 'no class given' unless $class;
|
|
29 | 29 |
|
30 |
for my $spec (@{ $self->_specs }) { |
|
30 |
eval "require " . $class; |
|
31 |
my $obj = $class->new; |
|
32 |
|
|
33 |
my $specs = $self->_specs_by_line($line); |
|
34 |
for my $spec (@{ $specs }) { |
|
31 | 35 |
$self->apply($obj, $spec, $line->{$spec->{key}}); |
32 | 36 |
} |
33 | 37 |
|
34 | 38 |
return $obj; |
35 | 39 |
} |
36 | 40 |
|
41 |
# return class for given line |
|
42 |
# if only one profile is given, return this profiles class |
|
43 |
# if more than one profile is given, identify class by first |
|
44 |
# column??? |
|
45 |
sub _class_by_line { |
|
46 |
my ($self, $line) = @_; |
|
47 |
|
|
48 |
my $class; |
|
49 |
if ($self->_csv->is_multiplexed) { |
|
50 |
foreach my $p (@{ $self->_csv->profile }) { |
|
51 |
my $row_ident = $p->{row_ident}; |
|
52 |
if ($line->{datatype} eq $row_ident) { |
|
53 |
$class = $p->{class}; |
|
54 |
last; |
|
55 |
} |
|
56 |
} |
|
57 |
} else { |
|
58 |
$class = @{ $self->_csv->profile }[0]->{class}; |
|
59 |
} |
|
60 |
|
|
61 |
return $class; |
|
62 |
} |
|
63 |
|
|
64 |
sub _specs_by_line { |
|
65 |
my ($self, $line) = @_; |
|
66 |
|
|
67 |
my $spec; |
|
68 |
my $i = 0; |
|
69 |
if ($self->_csv->is_multiplexed) { |
|
70 |
foreach my $p (@{ $self->_csv->profile }) { |
|
71 |
my $row_ident = $p->{row_ident}; |
|
72 |
if ($line->{datatype} eq $row_ident) { |
|
73 |
$spec = @{ $self->_specs }[$i]; |
|
74 |
last; |
|
75 |
} |
|
76 |
$i++; |
|
77 |
} |
|
78 |
} else { |
|
79 |
$spec = @{ $self->_specs }[0]; |
|
80 |
} |
|
81 |
|
|
82 |
return $spec; |
|
83 |
} |
|
84 |
|
|
85 |
|
|
37 | 86 |
sub apply { |
38 | 87 |
my ($self, $obj, $spec, $value) = @_; |
39 | 88 |
return unless $value; |
... | ... | |
70 | 119 |
sub parse_profile { |
71 | 120 |
my ($self, %params) = @_; |
72 | 121 |
|
73 |
my $header = $self->_csv->header; |
|
74 |
my $profile = $self->_csv->profile->{profile}; |
|
122 |
my $profile; |
|
123 |
my $class; |
|
124 |
my $header; |
|
125 |
my @specs; |
|
126 |
|
|
127 |
my $i = 0; |
|
128 |
foreach my $h (@{ $self->_csv->header }) { |
|
129 |
$header = $h; |
|
130 |
if ($self->_csv->profile) { |
|
131 |
$profile = @{ $self->_csv->profile }[$i]->{profile}; |
|
132 |
$class = @{ $self->_csv->profile }[$i]->{class}; |
|
133 |
} |
|
134 |
|
|
135 |
my $spec = $self->_parse_profile(profile => $profile, |
|
136 |
class => $class, |
|
137 |
header => $header); |
|
138 |
push @specs, $spec; |
|
139 |
$i++; |
|
140 |
} |
|
141 |
|
|
142 |
$self->_specs(\@specs); |
|
143 |
|
|
144 |
return ! $self->errors; |
|
145 |
} |
|
146 |
|
|
147 |
sub _parse_profile { |
|
148 |
my ($self, %params) = @_; |
|
149 |
|
|
150 |
my $profile = $params{profile}; |
|
151 |
my $class = $params{class}; |
|
152 |
my $header = $params{header}; |
|
153 |
|
|
75 | 154 |
my @specs; |
76 | 155 |
|
77 | 156 |
for my $col (@$header) { |
78 | 157 |
next unless $col; |
79 | 158 |
if ($self->_csv->strict_profile) { |
80 | 159 |
if (exists $profile->{$col}) { |
81 |
push @specs, $self->make_spec($col, $profile->{$col}); |
|
160 |
push @specs, $self->make_spec($col, $profile->{$col}, $class);
|
|
82 | 161 |
} else { |
83 | 162 |
$self->unknown_column($col, undef); |
84 | 163 |
} |
85 | 164 |
} else { |
86 | 165 |
if (exists $profile->{$col}) { |
87 |
push @specs, $self->make_spec($col, $profile->{$col}); |
|
166 |
push @specs, $self->make_spec($col, $profile->{$col}, $class);
|
|
88 | 167 |
} else { |
89 |
push @specs, $self->make_spec($col, $col); |
|
168 |
push @specs, $self->make_spec($col, $col, $class);
|
|
90 | 169 |
} |
91 | 170 |
} |
92 | 171 |
} |
93 | 172 |
|
94 |
$self->_specs(\@specs); |
|
95 | 173 |
$self->_csv->_push_error($self->errors); |
96 |
return ! $self->errors; |
|
174 |
|
|
175 |
return \@specs; |
|
97 | 176 |
} |
98 | 177 |
|
99 | 178 |
sub make_spec { |
100 |
my ($self, $col, $path) = @_; |
|
179 |
my ($self, $col, $path, $cur_class) = @_;
|
|
101 | 180 |
|
102 | 181 |
my $spec = { key => $col, steps => [] }; |
103 | 182 |
|
104 | 183 |
return unless $path; |
105 | 184 |
|
106 |
my $cur_class = $self->_csv->profile->{class}; |
|
107 |
|
|
108 | 185 |
return unless $cur_class; |
109 | 186 |
|
110 | 187 |
for my $step_index ( split /\.(?!\d)/, $path ) { |
t/helper/csv.t | ||
---|---|---|
1 |
use Test::More tests => 47;
|
|
1 |
use Test::More tests => 56;
|
|
2 | 2 |
|
3 | 3 |
use lib 't'; |
4 | 4 |
use utf8; |
... | ... | |
11 | 11 |
Support::TestSetup::login(); |
12 | 12 |
|
13 | 13 |
my $csv = SL::Helper::Csv->new( |
14 |
file => \"Kaffee\n", |
|
15 |
header => [ 'description' ],
|
|
16 |
profile => { class => 'SL::DB::Part', },
|
|
14 |
file => \"Kaffee\n", # " # make emacs happy
|
|
15 |
header => [[ 'description' ]],
|
|
16 |
profile => [{ class => 'SL::DB::Part', }],
|
|
17 | 17 |
); |
18 | 18 |
|
19 | 19 |
isa_ok $csv->_csv, 'Text::CSV_XS'; |
... | ... | |
29 | 29 |
|
30 | 30 |
$csv = SL::Helper::Csv->new( |
31 | 31 |
file => \"Kaffee;0.12;12,2;1,5234\n", |
32 |
header => [ 'description', 'sellprice', 'lastcost_as_number', 'listprice' ],
|
|
33 |
profile => {profile => { listprice => 'listprice_as_number' }, |
|
34 |
class => 'SL::DB::Part',},
|
|
32 |
header => [[ 'description', 'sellprice', 'lastcost_as_number', 'listprice' ]],
|
|
33 |
profile => [{profile => { listprice => 'listprice_as_number' },
|
|
34 |
class => 'SL::DB::Part',}],
|
|
35 | 35 |
); |
36 | 36 |
$csv->parse; |
37 | 37 |
|
... | ... | |
49 | 49 |
EOL |
50 | 50 |
sep_char => ',', |
51 | 51 |
quote_char => "'", |
52 |
profile => {profile => { listprice => 'listprice_as_number' }, |
|
53 |
class => 'SL::DB::Part',}
|
|
52 |
profile => [{profile => { listprice => 'listprice_as_number' },
|
|
53 |
class => 'SL::DB::Part',}]
|
|
54 | 54 |
); |
55 | 55 |
$csv->parse; |
56 | 56 |
is scalar @{ $csv->get_objects }, 1, 'auto header works'; |
... | ... | |
64 | 64 |
;;description;sellprice;lastcost_as_number; |
65 | 65 |
#####;Puppy;Kaffee;0.12;12,2;1,5234 |
66 | 66 |
EOL |
67 |
profile => {class => 'SL::DB::Part'},
|
|
67 |
profile => [{class => 'SL::DB::Part'}],
|
|
68 | 68 |
); |
69 | 69 |
$csv->parse; |
70 | 70 |
is scalar @{ $csv->get_objects }, 1, 'bozo header doesn\'t blow things up'; |
... | ... | |
77 | 77 |
Kaffee;;0.12;12,2;1,5234 |
78 | 78 |
Beer;1123245;0.12;12,2;1,5234 |
79 | 79 |
EOL |
80 |
profile => {class => 'SL::DB::Part'},
|
|
80 |
profile => [{class => 'SL::DB::Part'}],
|
|
81 | 81 |
); |
82 | 82 |
$csv->parse; |
83 | 83 |
is scalar @{ $csv->get_objects }, 2, 'multiple objects work'; |
... | ... | |
93 | 93 |
Beer;1123245;0.12;1.5234 |
94 | 94 |
EOL |
95 | 95 |
numberformat => '1,000.00', |
96 |
profile => {class => 'SL::DB::Part'},
|
|
96 |
profile => [{class => 'SL::DB::Part'}],
|
|
97 | 97 |
); |
98 | 98 |
$csv->parse; |
99 | 99 |
is $csv->get_objects->[0]->lastcost, '1221.52', 'formatnumber'; |
... | ... | |
107 | 107 |
Beer;1123245;0.12;1.5234 |
108 | 108 |
EOL |
109 | 109 |
numberformat => '1,000.00', |
110 |
profile => {class => 'SL::DB::Part'},
|
|
110 |
profile => [{class => 'SL::DB::Part'}],
|
|
111 | 111 |
); |
112 | 112 |
is $csv->parse, undef, 'broken csv header won\'t get parsed'; |
113 | 113 |
|
... | ... | |
120 | 120 |
Beer;1123245;0.12;1.5234 |
121 | 121 |
EOL |
122 | 122 |
numberformat => '1,000.00', |
123 |
profile => {class => 'SL::DB::Part'},
|
|
123 |
profile => [{class => 'SL::DB::Part'}],
|
|
124 | 124 |
); |
125 | 125 |
is $csv->parse, undef, 'broken csv content won\'t get parsed'; |
126 | 126 |
is_deeply $csv->errors, [ '"Kaf"fee";;0.12;1,221.52'."\n", 2023, 'EIQ - QUO character not allowed', 5, 2 ], 'error'; |
... | ... | |
136 | 136 |
EOL |
137 | 137 |
numberformat => '1,000.00', |
138 | 138 |
ignore_unknown_columns => 1, |
139 |
profile => {class => 'SL::DB::Part'},
|
|
139 |
profile => [{class => 'SL::DB::Part'}],
|
|
140 | 140 |
); |
141 | 141 |
$csv->parse; |
142 | 142 |
is $csv->get_objects->[0]->lastcost, '1221.52', 'ignore_unkown_columns works'; |
... | ... | |
150 | 150 |
Beer;1123245;0.12;1.5234;16 % |
151 | 151 |
EOL |
152 | 152 |
numberformat => '1,000.00', |
153 |
profile => { |
|
153 |
profile => [{
|
|
154 | 154 |
profile => {buchungsgruppe => "buchungsgruppen.description"}, |
155 | 155 |
class => 'SL::DB::Part', |
156 |
} |
|
156 |
}]
|
|
157 | 157 |
); |
158 | 158 |
$csv->parse; |
159 | 159 |
isa_ok $csv->get_objects->[0]->buchungsgruppe, 'SL::DB::Buchungsgruppe', 'deep dispatch auto vivify works'; |
... | ... | |
169 | 169 |
Beer;1123245;0.12;1.5234; |
170 | 170 |
EOL |
171 | 171 |
numberformat => '1,000.00', |
172 |
profile => { |
|
172 |
profile => [{
|
|
173 | 173 |
profile => { |
174 | 174 |
make_1 => "makemodels.0.make", |
175 | 175 |
model_1 => "makemodels.0.model", |
176 | 176 |
}, |
177 | 177 |
class => 'SL::DB::Part', |
178 |
}, |
|
178 |
}],
|
|
179 | 179 |
); |
180 | 180 |
$csv->parse; |
181 | 181 |
my @mm = $csv->get_objects->[0]->makemodel; |
... | ... | |
191 | 191 |
Kaffee;;0.12;1,221.52;213;Chair 0815;523;Table 15 |
192 | 192 |
EOL |
193 | 193 |
numberformat => '1,000.00', |
194 |
profile => { |
|
194 |
profile => [{
|
|
195 | 195 |
profile => { |
196 | 196 |
make_1 => "makemodels.0.make", |
197 | 197 |
model_1 => "makemodels.0.model", |
... | ... | |
199 | 199 |
model_2 => "makemodels.1.model", |
200 | 200 |
}, |
201 | 201 |
class => 'SL::DB::Part', |
202 |
} |
|
202 |
}]
|
|
203 | 203 |
); |
204 | 204 |
$csv->parse; |
205 | 205 |
|
... | ... | |
219 | 219 |
description;partnumber;sellprice;lastcost_as_number;buchungsgruppe; |
220 | 220 |
EOL |
221 | 221 |
numberformat => '1,000.00', |
222 |
profile => { |
|
222 |
profile => [{
|
|
223 | 223 |
profile => {buchungsgruppe => "buchungsgruppen.1.description"}, |
224 | 224 |
class => 'SL::DB::Part', |
225 |
} |
|
225 |
}]
|
|
226 | 226 |
); |
227 | 227 |
is $csv->parse, undef, 'wrong profile gets rejected'; |
228 | 228 |
is_deeply $csv->errors, [ 'buchungsgruppen.1.description', undef, "Profile path error. Indexed relationship is not OneToMany around here: 'buchungsgruppen.1'", undef ,0 ], 'error indicates wrong header'; |
... | ... | |
239 | 239 |
numberformat => '1,000.00', |
240 | 240 |
ignore_unknown_columns => 1, |
241 | 241 |
strict_profile => 1, |
242 |
profile => { |
|
242 |
profile => [{
|
|
243 | 243 |
profile => {lastcost => 'lastcost_as_number'}, |
244 | 244 |
class => 'SL::DB::Part', |
245 |
} |
|
245 |
}]
|
|
246 | 246 |
); |
247 | 247 |
$csv->parse; |
248 | 248 |
is $csv->get_objects->[0]->lastcost, '1221.52', 'strict_profile with ignore'; |
... | ... | |
258 | 258 |
EOL |
259 | 259 |
numberformat => '1,000.00', |
260 | 260 |
strict_profile => 1, |
261 |
profile => { |
|
261 |
profile => [{
|
|
262 | 262 |
profile => {lastcost => 'lastcost_as_number'}, |
263 | 263 |
class => 'SL::DB::Part', |
264 |
} |
|
264 |
}]
|
|
265 | 265 |
); |
266 | 266 |
$csv->parse; |
267 | 267 |
|
... | ... | |
271 | 271 |
|
272 | 272 |
$csv = SL::Helper::Csv->new( |
273 | 273 |
file => \"Kaffee", |
274 |
header => [ 'description' ],
|
|
275 |
profile => {class => 'SL::DB::Part'},
|
|
274 |
header => [[ 'description' ]],
|
|
275 |
profile => [{class => 'SL::DB::Part'}],
|
|
276 | 276 |
); |
277 | 277 |
$csv->parse; |
278 | 278 |
is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'eol bug at the end of files'; |
... | ... | |
302 | 302 |
|
303 | 303 |
$csv = SL::Helper::Csv->new( |
304 | 304 |
file => \"\x{EF}\x{BB}\x{BF}description\nKaffee", |
305 |
profile => {class => 'SL::DB::Part'},
|
|
305 |
profile => [{class => 'SL::DB::Part'}],
|
|
306 | 306 |
encoding => 'utf8', |
307 | 307 |
); |
308 | 308 |
$csv->parse; |
... | ... | |
313 | 313 |
$csv = SL::Helper::Csv->new( |
314 | 314 |
file => \"Kaffee", |
315 | 315 |
header => [ 'Description' ], |
316 |
class => 'SL::DB::Part',
|
|
316 |
profile => [{class => 'SL::DB::Part'}],
|
|
317 | 317 |
); |
318 | 318 |
$csv->parse; |
319 | 319 |
is_deeply $csv->get_data, undef, 'case insensitive header without flag ignores'; |
... | ... | |
365 | 365 |
is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'without profile and class works'; |
366 | 366 |
|
367 | 367 |
# vim: ft=perl |
368 |
# set emacs to perl mode |
|
369 |
# Local Variables: |
|
370 |
# mode: perl |
|
371 |
# End: |
Auch abrufbar als: Unified diff
SL::Helper::Csv kann mit Multiplex-Daten (mehreren Profilen) umgehen.