t/controllers/csvimport/parts.t

   1 use Test::More tests => 47;
   2
   3 use strict;
   4
   5 use lib 't';
   6
   7 use Carp;
   8 use Data::Dumper;
   9 use Support::TestSetup;
  10 use Test::Exception;
  11
  12 use List::MoreUtils qw(pairwise);
  13 use SL::Controller::CsvImport;
  14
  15 my $DEBUG = 0;
  16
  17 use_ok 'SL::Controller::CsvImport::Part';
  18
  19 use SL::DB::Buchungsgruppe;
  20 use SL::DB::Currency;
  21 use SL::DB::Customer;
  22 use SL::DB::Language;
  23 use SL::DB::Warehouse;
  24 use SL::DB::Pricegroup;
  25 use SL::DB::Price;
  26 use SL::DB::Bin;
  27
  28 my ($translation, $bin1_1, $bin1_2, $bin2_1, $bin2_2, $wh1, $wh2, $bugru, $cvarconfig );
  29 my ($pg1_id, $pg2_id, $pg3_id);
  30
  31 Support::TestSetup::login();
  32
  33 sub reset_state {
  34   # Create test data
  35
  36   clear_up();
  37
  38   $translation     = SL::DB::Language->new(
  39     description    => 'Englisch',
  40     article_code   => 'EN',
  41     template_code  => 'EN',
  42   )->save;
  43   $translation     = SL::DB::Language->new(
  44     description    => 'Italienisch',
  45     article_code   => 'IT',
  46     template_code  => 'IT',
  47   )->save;
  48   $wh1 = SL::DB::Warehouse->new(
  49     description    => 'Lager1',
  50     sortkey        => 1,
  51   )->save;
  52   $bin1_1 = SL::DB::Bin->new(
  53     description    => 'Ort1_von_Lager1',
  54     warehouse_id   => $wh1->id,
  55   )->save;
  56   $bin1_2 = SL::DB::Bin->new(
  57     description    => 'Ort2_von_Lager1',
  58     warehouse_id   => $wh1->id,
  59   )->save;
  60   $wh2 = SL::DB::Warehouse->new(
  61     description    => 'Lager2',
  62     sortkey        => 2,
  63   )->save;
  64   $bin2_1 = SL::DB::Bin->new(
  65     description    => 'Ort1_von_Lager2',
  66     warehouse_id   => $wh2->id,
  67   )->save;
  68   $bin2_2 = SL::DB::Bin->new(
  69     description    => 'Ort2_von_Lager2',
  70     warehouse_id   => $wh2->id,
  71   )->save;
  72
  73   $cvarconfig = SL::DB::CustomVariableConfig->new(
  74     module   => 'IC',
  75     name     => 'mycvar',
  76     type     => 'text',
  77     description => 'mein Schatz',
  78     searchable  => 1,
  79     sortkey => 1,
  80     includeable => 0,
  81     included_by_default => 0,
  82   )->save;
  83
  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;
  89   }
  90 }
  91
  92 $bugru = SL::DB::Manager::Buchungsgruppe->find_by(description => { like => 'Standard%19%' });
  93
  94 reset_state();
  95
  96 #####
  97 sub test_import {
  98   my ($file,$settings) = @_;
  99   my @profiles;
 100   my $controller = SL::Controller::CsvImport->new();
 101
 102   my $csv_part_import = SL::Controller::CsvImport::Part->new(
 103     settings   => $settings,
 104     controller => $controller,
 105     file       => $file,
 106   );
 107   #print "profile param type=".$csv_part_import->settings->{parts_type}."\n";
 108
 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 }],
 114                                              encoding                => 'utf-8',
 115                                              ignore_unknown_columns  => 1,
 116                                              strict_profile          => 1,
 117                                              case_insensitive_header => 1,
 118                                              sep_char                => ';',
 119                                              quote_char              => '"',
 120                                              ignore_unknown_columns  => 1,
 121                                             ));
 122
 123   $csv_part_import->csv->parse;
 124
 125   $csv_part_import->controller->errors([ $csv_part_import->csv->errors ]) if $csv_part_import->csv->errors;
 126
 127   return if ( !$csv_part_import->csv->header || $csv_part_import->csv->errors );
 128
 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 => [ ] });
 135
 136   my $objects  = $csv_part_import->csv->get_objects;
 137   my @raw_data = @{ $csv_part_import->csv->get_data };
 138
 139   $csv_part_import->controller->data([ pairwise { no warnings 'once'; { object => $a, raw_data => $b, errors => [], information => [], info_data => {} } } @$objects, @raw_data ]);
 140
 141   $csv_part_import->check_objects;
 142
 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}};
 145
 146   return $csv_part_import->controller->data;
 147 }
 148
 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');
 153
 154
 155 my ($entries, $entry, $file);
 156
 157 # different settings for tests
 158 #
 159
 160 my $settings1 = {
 161                        sellprice_places          => 2,
 162                        sellprice_adjustment      => 0,
 163                        sellprice_adjustment_type => 'percent',
 164                        article_number_policy     => 'update_prices',
 165                        shoparticle_if_missing    => '0',
 166                        part_type                 => 'part',
 167                        part_classification       => 3,
 168                        default_buchungsgruppe    => ($bugru ? $bugru->id : undef),
 169                        apply_buchungsgruppe      => 'all',
 170                 };
 171 my $settings2 = {
 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',
 182                 };
 183
 184 #
 185 #
 186 # starting test of csv imports
 187 # to debug errors in certain tests, run after test_import:
 188 #   die Dumper($entry->{errors});
 189
 190
 191 ##### create part with prices and 3 pricegroup prices
 192 $file = \<<EOL;
 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
 195 EOL
 196 $entries = test_import($file,$settings1);
 197 $entry = $entries->[0];
 198 #foreach my $err ( @{ $entry->{errors} } ) {
 199 #  print $err;
 200 #}
 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';
 206
 207 ##### update prices of part, and price of pricegroup_2, keeping pricegroup_1 and pricegroup_3
 208 $file = \<<EOL;
 209 partnumber;sellprice;lastcost;listprice;unit;pricegroup_2;pricegroup_4
 210 P1000;110.10;95.20;97.30;kg;123.45;144.44
 211 EOL
 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';
 223
 224 ##### insert parts with warehouse,bin name
 225
 226 $file = \<<EOL;
 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
 232 EOL
 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';
 244
 245 ##### update warehouse and bin
 246 $file = \<<EOL;
 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
 252 EOL
 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';
 270
 271 ##### add translations
 272 $file = \<<EOL;
 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
 278 EOL
 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';
 290
 291 ##### add customvar
 292 $file = \<<EOL;
 293 partnumber;cvar_mycvar
 294 P1000;das ist der Ring
 295 P1001;nicht der Nibelungen
 296 P1002;sondern vom
 297 P1003;Herr der Ringe
 298 EOL
 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';
 304
 305 # set locale to de so we can match abbreviations
 306 $::locale = $old_locale;
 307 ##### import part classification
 308 $file = \<<EOL;
 309 partnumber;pclass;description
 310 W1000;WE;Teil 1000
 311 W1001;WV;Teil 1001
 312 D1002;DV;Dienstleistung 1002
 313 D1003;DH;Dienstleistung 1003
 314 EOL
 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';
 328
 329
 330 clear_up(); # remove all data at end of tests
 331
 332 # end of tests
 333
 334
 335 sub clear_up {
 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);
 344 }
 345
 346
 347 1;
 348
 349 #####
 350 # vim: ft=perl
 351 # set emacs to perl mode
 352 # Local Variables:
 353 # mode: perl
 354 # End: