1 use Test::More tests => 47;
9 use Support::TestSetup;
12 use List::MoreUtils qw(pairwise);
13 use SL::Controller::CsvImport;
17 use_ok 'SL::Controller::CsvImport::Part';
19 use SL::DB::Buchungsgruppe;
23 use SL::DB::Warehouse;
24 use SL::DB::Pricegroup;
28 my ($translation, $bin1_1, $bin1_2, $bin2_1, $bin2_2, $wh1, $wh2, $bugru, $cvarconfig );
29 my ($pg1_id, $pg2_id, $pg3_id);
31 Support::TestSetup::login();
38 $translation = SL::DB::Language->new(
39 description => 'Englisch',
41 template_code => 'EN',
43 $translation = SL::DB::Language->new(
44 description => 'Italienisch',
46 template_code => 'IT',
48 $wh1 = SL::DB::Warehouse->new(
49 description => 'Lager1',
52 $bin1_1 = SL::DB::Bin->new(
53 description => 'Ort1_von_Lager1',
54 warehouse_id => $wh1->id,
56 $bin1_2 = SL::DB::Bin->new(
57 description => 'Ort2_von_Lager1',
58 warehouse_id => $wh1->id,
60 $wh2 = SL::DB::Warehouse->new(
61 description => 'Lager2',
64 $bin2_1 = SL::DB::Bin->new(
65 description => 'Ort1_von_Lager2',
66 warehouse_id => $wh2->id,
68 $bin2_2 = SL::DB::Bin->new(
69 description => 'Ort2_von_Lager2',
70 warehouse_id => $wh2->id,
73 $cvarconfig = SL::DB::CustomVariableConfig->new(
77 description => 'mein Schatz',
81 included_by_default => 0,
84 foreach ( { id => 1, pricegroup => 'A', sortkey => 1 },
85 { id => 2, pricegroup => 'B', sortkey => 2 },
86 { id => 3, pricegroup => 'C', sortkey => 3 },
87 { id => 4, pricegroup => 'D', sortkey => 4 } ) {
88 SL::DB::Pricegroup->new(%{$_})->save;
92 $bugru = SL::DB::Manager::Buchungsgruppe->find_by(description => { like => 'Standard%19%' });
98 my ($file,$settings) = @_;
100 my $controller = SL::Controller::CsvImport->new();
102 my $csv_part_import = SL::Controller::CsvImport::Part->new(
103 settings => $settings,
104 controller => $controller,
107 #print "profile param type=".$csv_part_import->settings->{parts_type}."\n";
109 $csv_part_import->test_run(0);
110 $csv_part_import->csv(SL::Helper::Csv->new(file => $csv_part_import->file,
111 profile => [{ profile => $csv_part_import->profile,
112 class => $csv_part_import->class,
113 mapping => $csv_part_import->controller->mappings_for_profile }],
115 ignore_unknown_columns => 1,
117 case_insensitive_header => 1,
120 ignore_unknown_columns => 1,
123 $csv_part_import->csv->parse;
125 $csv_part_import->controller->errors([ $csv_part_import->csv->errors ]) if $csv_part_import->csv->errors;
127 return if ( !$csv_part_import->csv->header || $csv_part_import->csv->errors );
129 my $headers = { headers => [ grep { $csv_part_import->csv->dispatcher->is_known($_, 0) } @{ $csv_part_import->csv->header } ] };
130 $headers->{methods} = [ map { $_->{path} } @{ $csv_part_import->csv->specs->[0] } ];
131 $headers->{used} = { map { ($_ => 1) } @{ $headers->{headers} } };
132 $csv_part_import->controller->headers($headers);
133 $csv_part_import->controller->raw_data_headers({ used => { }, headers => [ ] });
134 $csv_part_import->controller->info_headers({ used => { }, headers => [ ] });
136 my $objects = $csv_part_import->csv->get_objects;
137 my @raw_data = @{ $csv_part_import->csv->get_data };
139 $csv_part_import->controller->data([ pairwise { no warnings 'once'; { object => $a, raw_data => $b, errors => [], information => [], info_data => {} } } @$objects, @raw_data ]);
141 $csv_part_import->check_objects;
143 # don't try and save objects that have errors
144 $csv_part_import->save_objects unless scalar @{$csv_part_import->controller->data->[0]->{errors}};
146 return $csv_part_import->controller->data;
149 $::myconfig{numberformat} = '1000.00';
150 my $old_locale = $::locale;
151 # set locale to en so we can match errors
152 $::locale = Locale->new('en');
155 my ($entries, $entry, $file);
157 # different settings for tests
161 sellprice_places => 2,
162 sellprice_adjustment => 0,
163 sellprice_adjustment_type => 'percent',
164 article_number_policy => 'update_prices',
165 shoparticle_if_missing => '0',
167 part_classification => 3,
168 default_buchungsgruppe => ($bugru ? $bugru->id : undef),
169 apply_buchungsgruppe => 'all',
172 sellprice_places => 2,
173 sellprice_adjustment => 0,
174 sellprice_adjustment_type => 'percent',
175 article_number_policy => 'update_parts',
176 shoparticle_if_missing => '0',
177 part_type => 'mixed',
178 part_classification => 4,
179 default_buchungsgruppe => ($bugru ? $bugru->id : undef),
180 apply_buchungsgruppe => 'missing',
181 default_unit => 'Stck',
186 # starting test of csv imports
187 # to debug errors in certain tests, run after test_import:
188 # die Dumper($entry->{errors});
191 ##### create part with prices and 3 pricegroup prices
193 partnumber;sellprice;lastcost;listprice;unit;pricegroup_1;pricegroup_2;pricegroup_3
194 P1000;100.10;90.20;95.30;kg;111.11;122.22;133.33
196 $entries = test_import($file,$settings1);
197 $entry = $entries->[0];
198 #foreach my $err ( @{ $entry->{errors} } ) {
201 is $entry->{object}->partnumber,'P1000', 'partnumber';
202 is $entry->{object}->sellprice, '100.1', 'sellprice';
203 is $entry->{object}->lastcost, '90.2', 'lastcost';
204 is $entry->{object}->listprice, '95.3', 'listprice';
205 is $entry->{object}->find_prices( { pricegroup_id => 2 } )->[0]->price, '122.22000', 'pricegroup_2 price';
207 ##### update prices of part, and price of pricegroup_2, keeping pricegroup_1 and pricegroup_3
209 partnumber;sellprice;lastcost;listprice;unit;pricegroup_2;pricegroup_4
210 P1000;110.10;95.20;97.30;kg;123.45;144.44
212 $entries = test_import($file,$settings1);
213 $entry = $entries->[0];
214 is $entry->{object}->sellprice, '110.1', 'updated sellprice';
215 is $entry->{object}->lastcost, '95.2', 'updated lastcost';
216 is $entry->{object}->listprice, '97.3', 'updated listprice';
217 # $entry->{object}->prices currently only contains prices pricegroup_2 and pricegroup_4, reload object from db
218 # printf("%s %s: %s\n", $_->pricegroup_id, $_->pricegroup->pricegroup, $_->price) foreach @{$entry->{object}->prices};
219 $entry->{object}->load;
220 is $entry->{object}->find_prices( { pricegroup_id => 1 } )->[0]->price, '111.11000', 'pricegroup_1 price didn\'t change';
221 is $entry->{object}->find_prices( { pricegroup_id => 2 } )->[0]->price, '123.45000', 'pricegroup_2 price was updated';
222 is $entry->{object}->find_prices( { pricegroup_id => 4 } )->[0]->price, '144.44000', 'pricegroup_4 price was added';
224 ##### insert parts with warehouse,bin name
227 partnumber;description;warehouse;bin;part_type
228 P1000;Teil 1000;Lager1;Ort1_von_Lager1;part
229 P1001;Teil 1001;Lager1;Ort2_von_Lager1;service
230 P1002;Teil 1002;Lager2;Ort1_von_Lager2;service
231 P1003;Teil 1003;Lager2;Ort2_von_Lager2;part
233 $entries = test_import($file,$settings2);
234 $entry = $entries->[0];
235 is $entry->{object}->description, 'Teil 1000', 'Teil 1000 set';
236 is $entry->{object}->warehouse_id, $wh1->id, 'Lager1';
237 is $entry->{object}->bin_id, $bin1_1->id, 'Lagerort1';
238 is $entry->{object}->part_type, 'part', 'Typ ist part';
239 $entry = $entries->[2];
240 is $entry->{object}->description, 'Teil 1002', 'Teil 1002 set';
241 is $entry->{object}->warehouse_id, $wh2->id, 'Lager2';
242 is $entry->{object}->bin_id, $bin2_1->id, 'Lagerort1';
243 is $entry->{object}->part_type, 'service', 'Typ ist service';
245 ##### update warehouse and bin
247 partnumber;description;warehouse;bin;part_type
248 P1000;Teil 1000;Lager2;Ort1_von_Lager2;part
249 P1001;Teil 1001;Lager1;Ort1_von_Lager1;part
250 P1002;Teil 1002;Lager2;Ort1_von_Lager1;part
251 P1003;Teil 1003;Lager2;kein Lagerort;part
253 $entries = test_import($file,$settings2);
254 $entry = $entries->[0];
255 is $entry->{object}->description, 'Teil 1000', 'Teil 1000 set';
256 is $entry->{object}->warehouse_id, $wh2->id, 'Lager2';
257 is $entry->{object}->bin_id, $bin2_1->id, 'Lagerort1';
258 $entry = $entries->[2];
259 my $err1 = @{ $entry->{errors} }[0];
260 #print "'".$err1."'\n";
261 is $entry->{object}->description, 'Teil 1002', 'Teil 1002 set';
262 is $entry->{object}->warehouse_id, $wh2->id, 'Lager2';
263 is $err1, 'Error: Bin Ort1_von_Lager1 is not from warehouse Lager2','kein Lager von Lager2';
264 $entry = $entries->[3];
265 $err1 = @{ $entry->{errors} }[0];
266 #print "'".$err1."'\n";
267 is $entry->{object}->description, 'Teil 1003', 'Teil 1003 set';
268 is $entry->{object}->warehouse_id, $wh2->id, 'Lager2';
269 is $err1, 'Error: Invalid bin name kein Lagerort','kein Lagerort';
271 ##### add translations
273 partnumber;description;description_EN;notes_EN;description_IT;notes_IT
274 P1000;Teil 1000;descr EN 1000;notes EN;descr IT 1000;notes IT
275 P1001;Teil 1001;descr EN 1001;notes EN;descr IT 1001;notes IT
276 P1002;Teil 1002;descr EN 1002;notes EN;descr IT 1002;notes IT
277 P1003;Teil 1003;descr EN 1003;notes EN;descr IT 1003;notes IT
279 $entries = test_import($file,$settings2);
280 $entry = $entries->[0];
281 is $entry->{object}->description, 'Teil 1000', 'Teil 1000 set';
282 is $entry->{raw_data}->{description_EN},'descr EN 1000','EN set';
283 is $entry->{raw_data}->{description_IT},'descr IT 1000','IT set';
284 my $l = @{$entry->{object}->translations}[0];
285 is $l->translation,'descr EN 1000','EN trans set';
286 is $l->longdescription, 'notes EN','EN notes set';
287 $l = @{$entry->{object}->translations}[1];
288 is $l->translation,'descr IT 1000','IT trans set';
289 is $l->longdescription, 'notes IT','IT notes set';
293 partnumber;cvar_mycvar
294 P1000;das ist der Ring
295 P1001;nicht der Nibelungen
299 $entries = test_import($file,$settings2);
300 $entry = $entries->[0];
301 is $entry->{object}->partnumber, 'P1000', 'P1000 set';
302 is $entry->{raw_data}->{cvar_mycvar},'das ist der Ring','CVAR set';
303 is @{$entry->{object}->custom_variables}[0]->text_value,'das ist der Ring','Cvar mit richtigem Wert';
305 # set locale to de so we can match abbreviations
306 $::locale = $old_locale;
307 ##### import part classification
309 partnumber;pclass;description
312 D1002;DV;Dienstleistung 1002
313 D1003;DH;Dienstleistung 1003
315 $entries = test_import($file,$settings2);
316 $entry = $entries->[0];
317 is $entry->{object}->classification_id, '1', 'W1000 von Klasse Einkauf';
318 is $entry->{object}->type, 'part', 'W1000 vom Type part';
319 $entry = $entries->[1];
320 is $entry->{object}->classification_id, '2', 'W1001 von Klasse Verkauf';
321 is $entry->{object}->type, 'part', 'W1001 vom Type part';
322 $entry = $entries->[2];
323 is $entry->{object}->classification_id, '2', 'D1002 von Klasse Verkauf';
324 is $entry->{object}->type, 'service', 'D1002 vom Type service';
325 $entry = $entries->[3];
326 is $entry->{object}->classification_id, '3', 'D1003 von Klasse Handelsware';
327 is $entry->{object}->type, 'service', 'D1003 vom Type service';
330 clear_up(); # remove all data at end of tests
336 SL::DB::Manager::Part ->delete_all(all => 1);
337 SL::DB::Manager::Pricegroup ->delete_all(all => 1);
338 SL::DB::Manager::Price ->delete_all(all => 1);
339 SL::DB::Manager::Translation->delete_all(all => 1);
340 SL::DB::Manager::Language ->delete_all(all => 1);
341 SL::DB::Manager::Bin ->delete_all(all => 1);
342 SL::DB::Manager::Warehouse ->delete_all(all => 1);
343 SL::DB::Manager::CustomVariableConfig->delete_all(all => 1);
351 # set emacs to perl mode