t/controllers/csvimport/parts.t

   1 use Test::More tests => 43;
   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::Bin;
  25
  26 my ($translation, $bin1_1, $bin1_2, $bin2_1, $bin2_2, $wh1, $wh2, $bugru, $cvarconfig );
  27
  28 Support::TestSetup::login();
  29
  30 sub reset_state {
  31   # Create test data
  32
  33   clear_up();
  34
  35   $translation     = SL::DB::Language->new(
  36     description    => 'Englisch',
  37     article_code   => 'EN',
  38     template_code  => 'EN',
  39   )->save;
  40   $translation     = SL::DB::Language->new(
  41     description    => 'Italienisch',
  42     article_code   => 'IT',
  43     template_code  => 'IT',
  44   )->save;
  45   $wh1 = SL::DB::Warehouse->new(
  46     description    => 'Lager1',
  47     sortkey        => 1,
  48   )->save;
  49   $bin1_1 = SL::DB::Bin->new(
  50     description    => 'Ort1_von_Lager1',
  51     warehouse_id   => $wh1->id,
  52   )->save;
  53   $bin1_2 = SL::DB::Bin->new(
  54     description    => 'Ort2_von_Lager1',
  55     warehouse_id   => $wh1->id,
  56   )->save;
  57   $wh2 = SL::DB::Warehouse->new(
  58     description    => 'Lager2',
  59     sortkey        => 2,
  60   )->save;
  61   $bin2_1 = SL::DB::Bin->new(
  62     description    => 'Ort1_von_Lager2',
  63     warehouse_id   => $wh2->id,
  64   )->save;
  65   $bin2_2 = SL::DB::Bin->new(
  66     description    => 'Ort2_von_Lager2',
  67     warehouse_id   => $wh2->id,
  68   )->save;
  69
  70   $cvarconfig = SL::DB::CustomVariableConfig->new(
  71     module   => 'IC',
  72     name     => 'mycvar',
  73     type     => 'text',
  74     description => 'mein Schatz',
  75     searchable  => 1,
  76     sortkey => 1,
  77     includeable => 0,
  78     included_by_default => 0,
  79   )->save;
  80 }
  81
  82 $bugru = SL::DB::Manager::Buchungsgruppe->find_by(description => { like => 'Standard%19%' });
  83
  84 reset_state();
  85
  86 #####
  87 sub test_import {
  88   my ($file,$settings) = @_;
  89   my @profiles;
  90   my $controller = SL::Controller::CsvImport->new();
  91
  92   my $csv_part_import = SL::Controller::CsvImport::Part->new(
  93     settings   => $settings,
  94     controller => $controller,
  95     file       => $file,
  96   );
  97   #print "profile param type=".$csv_part_import->settings->{parts_type}."\n";
  98
  99   $csv_part_import->test_run(0);
 100   $csv_part_import->csv(SL::Helper::Csv->new(file                    => $csv_part_import->file,
 101                                              profile                 => [{ profile => $csv_part_import->profile,
 102                                                                            class   => $csv_part_import->class,
 103                                                                            mapping => $csv_part_import->controller->mappings_for_profile }],
 104                                              encoding                => 'utf-8',
 105                                              ignore_unknown_columns  => 1,
 106                                              strict_profile          => 1,
 107                                              case_insensitive_header => 1,
 108                                              sep_char                => ';',
 109                                              quote_char              => '"',
 110                                              ignore_unknown_columns  => 1,
 111                                             ));
 112
 113   $csv_part_import->csv->parse;
 114
 115   $csv_part_import->controller->errors([ $csv_part_import->csv->errors ]) if $csv_part_import->csv->errors;
 116
 117   return if ( !$csv_part_import->csv->header || $csv_part_import->csv->errors );
 118
 119   my $headers         = { headers => [ grep { $csv_part_import->csv->dispatcher->is_known($_, 0) } @{ $csv_part_import->csv->header } ] };
 120   $headers->{methods} = [ map { $_->{path} } @{ $csv_part_import->csv->specs->[0] } ];
 121   $headers->{used}    = { map { ($_ => 1) }  @{ $headers->{headers} } };
 122   $csv_part_import->controller->headers($headers);
 123   $csv_part_import->controller->raw_data_headers({ used => { }, headers => [ ] });
 124   $csv_part_import->controller->info_headers({ used => { }, headers => [ ] });
 125
 126   my $objects  = $csv_part_import->csv->get_objects;
 127   my @raw_data = @{ $csv_part_import->csv->get_data };
 128
 129   $csv_part_import->controller->data([ pairwise { no warnings 'once'; { object => $a, raw_data => $b, errors => [], information => [], info_data => {} } } @$objects, @raw_data ]);
 130
 131   $csv_part_import->check_objects;
 132
 133   # don't try and save objects that have errors
 134   $csv_part_import->save_objects unless scalar @{$csv_part_import->controller->data->[0]->{errors}};
 135
 136   return $csv_part_import->controller->data;
 137 }
 138
 139 $::myconfig{numberformat} = '1000.00';
 140 my $old_locale = $::locale;
 141 # set locale to en so we can match errors
 142 $::locale = Locale->new('en');
 143
 144
 145 my ($entries, $entry, $file);
 146
 147 # different settings for tests
 148 #
 149
 150 my $settings1 = {
 151                        sellprice_places          => 2,
 152                        sellprice_adjustment      => 0,
 153                        sellprice_adjustment_type => 'percent',
 154                        article_number_policy     => 'update_prices',
 155                        shoparticle_if_missing    => '0',
 156                        part_type                 => 'part',
 157                        parts_classification      => 3,
 158                        default_buchungsgruppe    => ($bugru ? $bugru->id : undef),
 159                        apply_buchungsgruppe      => 'all',
 160                 };
 161 my $settings2 = {
 162                        sellprice_places          => 2,
 163                        sellprice_adjustment      => 0,
 164                        sellprice_adjustment_type => 'percent',
 165                        article_number_policy     => 'update_parts',
 166                        shoparticle_if_missing    => '0',
 167                        part_type                 => 'mixed',
 168                        parts_classification      => 4,
 169                        default_buchungsgruppe    => ($bugru ? $bugru->id : undef),
 170                        apply_buchungsgruppe      => 'missing',
 171                        default_unit              => 'Stck',
 172                 };
 173
 174 #
 175 #
 176 # starting test of csv imports
 177 # to debug errors in certain tests, run after test_import:
 178 #   die Dumper($entry->{errors});
 179
 180
 181 ##### create part
 182 $file = \<<EOL;
 183 partnumber;sellprice;lastcost;listprice;unit
 184 P1000;100.10;90.20;95.30;kg
 185 EOL
 186 $entries = test_import($file,$settings1);
 187 $entry = $entries->[0];
 188 #foreach my $err ( @{ $entry->{errors} } ) {
 189 #  print $err;
 190 #}
 191 is $entry->{object}->partnumber,'P1000', 'partnumber';
 192 is $entry->{object}->sellprice, '100.1', 'sellprice';
 193 is $entry->{object}->lastcost,   '90.2', 'lastcost';
 194 is $entry->{object}->listprice,  '95.3', 'listprice';
 195
 196 ##### update prices of part
 197 $file = \<<EOL;
 198 partnumber;sellprice;lastcost;listprice;unit
 199 P1000;110.10;95.20;97.30;kg
 200 EOL
 201 $entries = test_import($file,$settings1);
 202 $entry = $entries->[0];
 203 is $entry->{object}->sellprice, '110.1', 'updated sellprice';
 204 is $entry->{object}->lastcost,   '95.2', 'updated lastcost';
 205 is $entry->{object}->listprice,  '97.3', 'updated listprice';
 206
 207 ##### insert parts with warehouse,bin name
 208
 209 $file = \<<EOL;
 210 partnumber;description;warehouse;bin;part_type
 211 P1000;Teil 1000;Lager1;Ort1_von_Lager1;part
 212 P1001;Teil 1001;Lager1;Ort2_von_Lager1;service
 213 P1002;Teil 1002;Lager2;Ort1_von_Lager2;service
 214 P1003;Teil 1003;Lager2;Ort2_von_Lager2;part
 215 EOL
 216 $entries = test_import($file,$settings2);
 217 $entry = $entries->[0];
 218 is $entry->{object}->description, 'Teil 1000', 'Teil 1000 set';
 219 is $entry->{object}->warehouse_id, $wh1->id, 'Lager1';
 220 is $entry->{object}->bin_id, $bin1_1->id, 'Lagerort1';
 221 is $entry->{object}->part_type, 'part', 'Typ ist part';
 222 $entry = $entries->[2];
 223 is $entry->{object}->description, 'Teil 1002', 'Teil 1002 set';
 224 is $entry->{object}->warehouse_id, $wh2->id, 'Lager2';
 225 is $entry->{object}->bin_id, $bin2_1->id, 'Lagerort1';
 226 is $entry->{object}->part_type, 'service', 'Typ ist service';
 227
 228 ##### update warehouse and bin
 229 $file = \<<EOL;
 230 partnumber;description;warehouse;bin;part_type
 231 P1000;Teil 1000;Lager2;Ort1_von_Lager2;part
 232 P1001;Teil 1001;Lager1;Ort1_von_Lager1;part
 233 P1002;Teil 1002;Lager2;Ort1_von_Lager1;part
 234 P1003;Teil 1003;Lager2;kein Lagerort;part
 235 EOL
 236 $entries = test_import($file,$settings2);
 237 $entry = $entries->[0];
 238 is $entry->{object}->description, 'Teil 1000', 'Teil 1000 set';
 239 is $entry->{object}->warehouse_id, $wh2->id, 'Lager2';
 240 is $entry->{object}->bin_id, $bin2_1->id, 'Lagerort1';
 241 $entry = $entries->[2];
 242 my $err1 = @{ $entry->{errors} }[0];
 243 #print "'".$err1."'\n";
 244 is $entry->{object}->description, 'Teil 1002', 'Teil 1002 set';
 245 is $entry->{object}->warehouse_id, $wh2->id, 'Lager2';
 246 is $err1, 'Error: Bin Ort1_von_Lager1 is not from warehouse Lager2','kein Lager von Lager2';
 247 $entry = $entries->[3];
 248 $err1 = @{ $entry->{errors} }[0];
 249 #print "'".$err1."'\n";
 250 is $entry->{object}->description, 'Teil 1003', 'Teil 1003 set';
 251 is $entry->{object}->warehouse_id, $wh2->id, 'Lager2';
 252 is $err1, 'Error: Invalid bin name kein Lagerort','kein Lagerort';
 253
 254 ##### add translations
 255 $file = \<<EOL;
 256 partnumber;description;description_EN;notes_EN;description_IT;notes_IT
 257 P1000;Teil 1000;descr EN 1000;notes EN;descr IT 1000;notes IT
 258 P1001;Teil 1001;descr EN 1001;notes EN;descr IT 1001;notes IT
 259 P1002;Teil 1002;descr EN 1002;notes EN;descr IT 1002;notes IT
 260 P1003;Teil 1003;descr EN 1003;notes EN;descr IT 1003;notes IT
 261 EOL
 262 $entries = test_import($file,$settings2);
 263 $entry = $entries->[0];
 264 is $entry->{object}->description, 'Teil 1000', 'Teil 1000 set';
 265 is $entry->{raw_data}->{description_EN},'descr EN 1000','EN set';
 266 is $entry->{raw_data}->{description_IT},'descr IT 1000','IT set';
 267 my $l = @{$entry->{object}->translations}[0];
 268 is $l->translation,'descr EN 1000','EN trans set';
 269 is $l->longdescription, 'notes EN','EN notes set';
 270 $l = @{$entry->{object}->translations}[1];
 271 is $l->translation,'descr IT 1000','IT trans set';
 272 is $l->longdescription, 'notes IT','IT notes set';
 273
 274 ##### add customvar
 275 $file = \<<EOL;
 276 partnumber;cvar_mycvar
 277 P1000;das ist der Ring
 278 P1001;nicht der Nibelungen
 279 P1002;sondern vom
 280 P1003;Herr der Ringe
 281 EOL
 282 $entries = test_import($file,$settings2);
 283 $entry = $entries->[0];
 284 is $entry->{object}->partnumber, 'P1000', 'P1000 set';
 285 is $entry->{raw_data}->{cvar_mycvar},'das ist der Ring','CVAR set';
 286 is @{$entry->{object}->custom_variables}[0]->text_value,'das ist der Ring','Cvar mit richtigem Wert';
 287
 288 # set locale to de so we can match abbreviations
 289 $::locale = $old_locale;
 290 ##### import part classification
 291 $file = \<<EOL;
 292 partnumber;pclass;description
 293 W1000;WE;Teil 1000
 294 W1001;WV;Teil 1001
 295 D1002;DV;Dienstleistung 1002
 296 D1003;DH;Dienstleistung 1003
 297 EOL
 298 $entries = test_import($file,$settings2);
 299 $entry = $entries->[0];
 300 is $entry->{object}->classification_id, '1', 'W1000 von Klasse Einkauf';
 301 is $entry->{object}->type, 'part', 'W1000 vom Type part';
 302 $entry = $entries->[1];
 303 is $entry->{object}->classification_id, '2', 'W1001 von Klasse Verkauf';
 304 is $entry->{object}->type, 'part', 'W1001 vom Type part';
 305 $entry = $entries->[2];
 306 is $entry->{object}->classification_id, '2', 'D1002 von Klasse Verkauf';
 307 is $entry->{object}->type, 'service', 'D1002 vom Type service';
 308 $entry = $entries->[3];
 309 is $entry->{object}->classification_id, '3', 'D1003 von Klasse Handelsware';
 310 is $entry->{object}->type, 'service', 'D1003 vom Type service';
 311
 312
 313 clear_up(); # remove all data at end of tests
 314
 315 # end of tests
 316
 317
 318 sub clear_up {
 319   SL::DB::Manager::Part       ->delete_all(all => 1);
 320   SL::DB::Manager::Translation->delete_all(all => 1);
 321   SL::DB::Manager::Language   ->delete_all(all => 1);
 322   SL::DB::Manager::Bin        ->delete_all(all => 1);
 323   SL::DB::Manager::Warehouse  ->delete_all(all => 1);
 324   SL::DB::Manager::CustomVariableConfig->delete_all(all => 1);
 325 }
 326
 327
 328 1;
 329
 330 #####
 331 # vim: ft=perl
 332 # set emacs to perl mode
 333 # Local Variables:
 334 # mode: perl
 335 # End: