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