t/controllers/csvimport/parts.t

   1 use Test::More tests => 33;
   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 schattz',
  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
  98   $csv_part_import->init_bg_by;
  99   $csv_part_import->init_price_factors_by;
 100   $csv_part_import->init_partsgroups_by;
 101   $csv_part_import->init_units_by;
 102   $csv_part_import->init_bins_by;
 103   $csv_part_import->init_warehouses_by;
 104   $csv_part_import->init_parts_by;
 105   $csv_part_import->test_run(0);
 106   $csv_part_import->csv(SL::Helper::Csv->new(file                    => $csv_part_import->file,
 107                                              profile                 => [{ profile => $csv_part_import->profile,
 108                                                                            class   => $csv_part_import->class,
 109                                                                            mapping => $csv_part_import->controller->mappings_for_profile }],
 110                                              encoding                => 'utf-8',
 111                                              ignore_unknown_columns  => 1,
 112                                              strict_profile          => 1,
 113                                              case_insensitive_header => 1,
 114                                              sep_char                => ';',
 115                                              quote_char              => '"',
 116                                              ignore_unknown_columns  => 1,
 117                                             ));
 118
 119   $csv_part_import->csv->parse;
 120
 121   $csv_part_import->controller->errors([ $csv_part_import->csv->errors ]) if $csv_part_import->csv->errors;
 122
 123   return if ( !$csv_part_import->csv->header || $csv_part_import->csv->errors );
 124
 125   my $headers         = { headers => [ grep { $csv_part_import->csv->dispatcher->is_known($_, 0) } @{ $csv_part_import->csv->header } ] };
 126   $headers->{methods} = [ map { $_->{path} } @{ $csv_part_import->csv->specs->[0] } ];
 127   $headers->{used}    = { map { ($_ => 1) }  @{ $headers->{headers} } };
 128   $csv_part_import->controller->headers($headers);
 129   $csv_part_import->controller->raw_data_headers({ used => { }, headers => [ ] });
 130   $csv_part_import->controller->info_headers({ used => { }, headers => [ ] });
 131
 132   my $objects  = $csv_part_import->csv->get_objects;
 133   my @raw_data = @{ $csv_part_import->csv->get_data };
 134
 135   $csv_part_import->controller->data([ pairwise { no warnings 'once'; { object => $a, raw_data => $b, errors => [], information => [], info_data => {} } } @$objects, @raw_data ]);
 136
 137   $csv_part_import->check_objects;
 138
 139   # don't try and save objects that have errors
 140   $csv_part_import->save_objects unless scalar @{$csv_part_import->controller->data->[0]->{errors}};
 141
 142   return $csv_part_import->controller->data;
 143 }
 144
 145 $::myconfig{numberformat} = '1000.00';
 146 my $old_locale = $::locale;
 147 # set locale to en so we can match errors
 148 $::locale = Locale->new('en');
 149
 150
 151 my ($entries, $entry, $file);
 152
 153 # different settings for tests
 154 #
 155
 156 my $settings1 = {
 157                        sellprice_places          => 2,
 158                        sellprice_adjustment      => 0,
 159                        sellprice_adjustment_type => 'percent',
 160                        article_number_policy     => 'update_prices',
 161                        shoparticle_if_missing    => '0',
 162                        parts_type                => 'part',
 163                        default_buchungsgruppe    => ($bugru ? $bugru->id : undef),
 164                        apply_buchungsgruppe      => 'all',
 165                 };
 166 my $settings2 = {
 167                        sellprice_places          => 2,
 168                        sellprice_adjustment      => 0,
 169                        sellprice_adjustment_type => 'percent',
 170                        article_number_policy     => 'update_parts',
 171                        shoparticle_if_missing    => '0',
 172                        parts_type                => 'part',
 173                        default_buchungsgruppe    => ($bugru ? $bugru->id : undef),
 174                        apply_buchungsgruppe      => 'missing',
 175                        default_unit              => 'Stck',
 176                 };
 177
 178 #
 179 #
 180 # starting test of csv imports
 181 # to debug errors in certain tests, run after test_import:
 182 #   die Dumper($entry->{errors});
 183
 184
 185 ##### create part
 186 $file = \<<EOL;
 187 partnumber;sellprice;lastcost;listprice;unit
 188 P1000;100.10;90.20;95.30;kg
 189 EOL
 190 $entries = test_import($file,$settings1);
 191 $entry = $entries->[0];
 192 #foreach my $err ( @{ $entry->{errors} } ) {
 193 #  print $err;
 194 #}
 195 is $entry->{object}->partnumber,'P1000', 'partnumber';
 196 is $entry->{object}->sellprice, '100.1', 'sellprice';
 197 is $entry->{object}->lastcost,   '90.2', 'lastcost';
 198 is $entry->{object}->listprice,  '95.3', 'listprice';
 199
 200 ##### update prices of part
 201 $file = \<<EOL;
 202 partnumber;sellprice;lastcost;listprice;unit
 203 P1000;110.10;95.20;97.30;kg
 204 EOL
 205 $entries = test_import($file,$settings1);
 206 $entry = $entries->[0];
 207 is $entry->{object}->sellprice, '110.1', 'updated sellprice';
 208 is $entry->{object}->lastcost,   '95.2', 'updated lastcost';
 209 is $entry->{object}->listprice,  '97.3', 'updated listprice';
 210
 211 ##### insert parts with warehouse,bin name
 212
 213 $file = \<<EOL;
 214 partnumber;description;warehouse;bin
 215 P1000;Teil 1000;Lager1;Ort1_von_Lager1
 216 P1001;Teil 1001;Lager1;Ort2_von_Lager1
 217 P1002;Teil 1002;Lager2;Ort1_von_Lager2
 218 P1003;Teil 1003;Lager2;Ort2_von_Lager2
 219 EOL
 220 $entries = test_import($file,$settings2);
 221 $entry = $entries->[0];
 222 is $entry->{object}->description, 'Teil 1000', 'Teil 1000 set';
 223 is $entry->{object}->warehouse_id, $wh1->id, 'Lager1';
 224 is $entry->{object}->bin_id, $bin1_1->id, 'Lagerort1';
 225 $entry = $entries->[2];
 226 is $entry->{object}->description, 'Teil 1002', 'Teil 1002 set';
 227 is $entry->{object}->warehouse_id, $wh2->id, 'Lager2';
 228 is $entry->{object}->bin_id, $bin2_1->id, 'Lagerort1';
 229
 230 ##### update warehouse and bin
 231 $file = \<<EOL;
 232 partnumber;description;warehouse;bin
 233 P1000;Teil 1000;Lager2;Ort1_von_Lager2
 234 P1001;Teil 1001;Lager1;Ort1_von_Lager1
 235 P1002;Teil 1002;Lager2;Ort1_von_Lager1
 236 P1003;Teil 1003;Lager2;kein Lagerort
 237 EOL
 238 $entries = test_import($file,$settings2);
 239 $entry = $entries->[0];
 240 is $entry->{object}->description, 'Teil 1000', 'Teil 1000 set';
 241 is $entry->{object}->warehouse_id, $wh2->id, 'Lager2';
 242 is $entry->{object}->bin_id, $bin2_1->id, 'Lagerort1';
 243 $entry = $entries->[2];
 244 my $err1 = @{ $entry->{errors} }[0];
 245 #print "'".$err1."'\n";
 246 is $entry->{object}->description, 'Teil 1002', 'Teil 1002 set';
 247 is $entry->{object}->warehouse_id, $wh2->id, 'Lager2';
 248 is $err1, 'Error: Bin Ort1_von_Lager1 is not from warehouse Lager2','kein Lager von Lager2';
 249 $entry = $entries->[3];
 250 $err1 = @{ $entry->{errors} }[0];
 251 #print "'".$err1."'\n";
 252 is $entry->{object}->description, 'Teil 1003', 'Teil 1003 set';
 253 is $entry->{object}->warehouse_id, $wh2->id, 'Lager2';
 254 is $err1, 'Error: Invalid bin name kein Lagerort','kein Lagerort';
 255
 256 ##### add translations
 257 $file = \<<EOL;
 258 partnumber;description;description_EN;notes_EN;description_IT;notes_IT
 259 P1000;Teil 1000;descr EN 1000;notes EN;descr IT 1000;notes IT
 260 P1001;Teil 1001;descr EN 1001;notes EN;descr IT 1001;notes IT
 261 P1002;Teil 1002;descr EN 1002;notes EN;descr IT 1002;notes IT
 262 P1003;Teil 1003;descr EN 1003;notes EN;descr IT 1003;notes IT
 263 EOL
 264 $entries = test_import($file,$settings2);
 265 $entry = $entries->[0];
 266 is $entry->{object}->description, 'Teil 1000', 'Teil 1000 set';
 267 is $entry->{raw_data}->{description_EN},'descr EN 1000','EN set';
 268 is $entry->{raw_data}->{description_IT},'descr IT 1000','IT set';
 269 my $l = @{$entry->{object}->translations}[0];
 270 is $l->translation,'descr EN 1000','EN trans set';
 271 is $l->longdescription, 'notes EN','EN notes set';
 272 $l = @{$entry->{object}->translations}[1];
 273 is $l->translation,'descr IT 1000','IT trans set';
 274 is $l->longdescription, 'notes IT','IT notes set';
 275
 276 ##### add customvar
 277 $file = \<<EOL;
 278 partnumber;cvar_mycvar
 279 P1000;das ist der ring
 280 P1001;nicht der nibelungen
 281 P1002;sondern vom
 282 P1003;Herr der Ringe
 283 EOL
 284 $entries = test_import($file,$settings2);
 285 $entry = $entries->[0];
 286 is $entry->{object}->partnumber, 'P1000', 'P1000 set';
 287 is $entry->{raw_data}->{cvar_mycvar},'das ist der ring','CVAR set';
 288 is @{$entry->{object}->custom_variables}[0]->text_value,'das ist der ring','Cvar mit richtigem Weert';
 289
 290 clear_up(); # remove all data at end of tests
 291
 292 # end of tests
 293
 294
 295 sub clear_up {
 296   SL::DB::Manager::Part       ->delete_all(all => 1);
 297   SL::DB::Manager::Translation->delete_all(all => 1);
 298   SL::DB::Manager::Language   ->delete_all(all => 1);
 299   SL::DB::Manager::Bin        ->delete_all(all => 1);
 300   SL::DB::Manager::Warehouse  ->delete_all(all => 1);
 301   SL::DB::Manager::CustomVariableConfig->delete_all(all => 1);
 302 }
 303
 304
 305 1;
 306
 307 #####
 308 # vim: ft=perl
 309 # set emacs to perl mode
 310 # Local Variables:
 311 # mode: perl
 312 # End: