t/helper/csv.t

   1 use Test::More tests => 91;
   2
   3 use lib 't';
   4 use utf8;
   5
   6 use Data::Dumper;
   7 use Support::TestSetup;
   8
   9 use_ok 'SL::Helper::Csv';
  10
  11 Support::TestSetup::login();
  12
  13 my $csv = SL::Helper::Csv->new(
  14   file    => \"Kaffee\n",       # " # make emacs happy
  15   header  => [ 'description' ],
  16   profile => [{ class  => 'SL::DB::Part', }],
  17 );
  18
  19 isa_ok $csv->_csv, 'Text::CSV_XS';
  20 isa_ok $csv->_io, 'IO::File';
  21 isa_ok $csv->parse, 'SL::Helper::Csv', 'parsing returns self';
  22 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'simple case works';
  23
  24 is $csv->get_objects->[0]->description, 'Kaffee', 'get_object works';
  25 ####
  26
  27 $::myconfig{numberformat} = '1.000,00';
  28 $::myconfig{dateformat} = 'dd.mm.yyyy';
  29
  30 $csv = SL::Helper::Csv->new(
  31   file    => \"Kaffee;0.12;12,2;1,5234\n",            # " # make emacs happy
  32   header  => [ 'description', 'sellprice', 'lastcost_as_number', 'listprice' ],
  33   profile => [{profile => { listprice => 'listprice_as_number' },
  34                class   => 'SL::DB::Part',}],
  35 );
  36 $csv->parse;
  37
  38 is $csv->get_objects->[0]->sellprice, 0.12, 'numeric attr works';
  39 is $csv->get_objects->[0]->lastcost, 12.2, 'attr helper works';
  40 is $csv->get_objects->[0]->listprice, 1.5234, 'dispatch works';
  41
  42 #####
  43
  44
  45 $csv = SL::Helper::Csv->new(
  46   file   => \<<EOL,
  47 description,sellprice,lastcost_as_number,listprice,
  48 Kaffee,0.12,'12,2','1,5234'
  49 EOL
  50   sep_char => ',',
  51   quote_char => "'",
  52   profile => [{profile => { listprice => 'listprice_as_number' },
  53                class   => 'SL::DB::Part',}]
  54 );
  55 $csv->parse;
  56 is scalar @{ $csv->get_objects }, 1, 'auto header works';
  57 is $csv->get_objects->[0]->description, 'Kaffee', 'get_object works on auto header';
  58
  59 #####
  60
  61
  62 $csv = SL::Helper::Csv->new(
  63   file   => \<<EOL,
  64 ;;description;sellprice;lastcost_as_number;
  65 #####;Puppy;Kaffee;0.12;12,2;1,5234
  66 EOL
  67   profile => [{class  => 'SL::DB::Part'}],
  68 );
  69 $csv->parse;
  70 is scalar @{ $csv->get_objects }, 1, 'bozo header doesn\'t blow things up';
  71
  72 #####
  73
  74 $csv = SL::Helper::Csv->new(
  75   file   => \<<EOL,
  76 description;partnumber;sellprice;lastcost_as_number;
  77 Kaffee;;0.12;12,2;1,5234
  78 Beer;1123245;0.12;12,2;1,5234
  79 EOL
  80   profile => [{class  => 'SL::DB::Part'}],
  81 );
  82 $csv->parse;
  83 is scalar @{ $csv->get_objects }, 2, 'multiple objects work';
  84 is $csv->get_objects->[0]->description, 'Kaffee', 'first object';
  85 is $csv->get_objects->[1]->partnumber, '1123245', 'second object';
  86
  87 ####
  88
  89 $csv = SL::Helper::Csv->new(
  90   file   => \<<EOL,
  91 description;partnumber;sellprice;lastcost_as_number;
  92 Kaffee;;0.12;1,221.52
  93 Beer;1123245;0.12;1.5234
  94 EOL
  95   numberformat => '1,000.00',
  96   profile => [{class  => 'SL::DB::Part'}],
  97 );
  98 $csv->parse;
  99 is $csv->get_objects->[0]->lastcost, '1221.52', 'formatnumber';
 100
 101 ######
 102
 103 $csv = SL::Helper::Csv->new(
 104   file   => \<<EOL,
 105 "description;partnumber;sellprice;lastcost_as_number;
 106 Kaffee;;0.12;1,221.52
 107 Beer;1123245;0.12;1.5234
 108 EOL
 109 # " # make emacs happy
 110   numberformat => '1,000.00',
 111   profile => [{class  => 'SL::DB::Part'}],
 112 );
 113 is $csv->parse, undef, 'broken csv header won\'t get parsed';
 114
 115 ######
 116
 117 $csv = SL::Helper::Csv->new(
 118   file   => \<<EOL,
 119 description;partnumber;sellprice;lastcost_as_number;
 120 "Kaf"fee";;0.12;1,221.52
 121 Beer;1123245;0.12;1.5234
 122 EOL
 123 # " # make emacs happy
 124   numberformat => '1,000.00',
 125   profile => [{class  => 'SL::DB::Part'}],
 126 );
 127 is $csv->parse, undef, 'broken csv content won\'t get parsed';
 128 is_deeply $csv->errors, [ '"Kaf"fee";;0.12;1,221.52'."\n", 2023, 'EIQ - QUO character not allowed', 5, 2 ], 'error';
 129 isa_ok( ($csv->errors)[0], 'SL::Helper::Csv::Error', 'Errors get objectified');
 130
 131 ####
 132
 133 $csv = SL::Helper::Csv->new(
 134   file   => \<<EOL,
 135 description;partnumber;sellprice;lastcost_as_number;wiener;
 136 Kaffee;;0.12;1,221.52;ja wiener
 137 Beer;1123245;0.12;1.5234;nein kein wieder
 138 EOL
 139   numberformat => '1,000.00',
 140   ignore_unknown_columns => 1,
 141   profile => [{class  => 'SL::DB::Part'}],
 142 );
 143 $csv->parse;
 144 is $csv->get_objects->[0]->lastcost, '1221.52', 'ignore_unknown_columns works';
 145
 146 #####
 147
 148 $csv = SL::Helper::Csv->new(
 149   file   => \<<EOL,
 150 description;partnumber;sellprice;lastcost_as_number;buchungsgruppe;
 151 Kaffee;;0.12;1,221.52;Standard 7%
 152 Beer;1123245;0.12;1.5234;16 %
 153 EOL
 154   numberformat => '1,000.00',
 155   profile => [{
 156     profile => {buchungsgruppe => "buchungsgruppen.description"},
 157     class  => 'SL::DB::Part',
 158   }]
 159 );
 160 $csv->parse;
 161 isa_ok $csv->get_objects->[0]->buchungsgruppe, 'SL::DB::Buchungsgruppe', 'deep dispatch auto vivify works';
 162 is $csv->get_objects->[0]->buchungsgruppe->description, 'Standard 7%', '...and gets set correctly';
 163
 164
 165 #####
 166
 167 $csv = SL::Helper::Csv->new(
 168   file   => \<<EOL,
 169 description;partnumber;sellprice;lastcost_as_number;make_1;model_1;
 170   Kaffee;;0.12;1,221.52;213;Chair 0815
 171 Beer;1123245;0.12;1.5234;
 172 EOL
 173   numberformat => '1,000.00',
 174   profile => [{
 175     profile => {
 176       make_1 => "makemodels.0.make",
 177       model_1 => "makemodels.0.model",
 178     },
 179     class  => 'SL::DB::Part',
 180   }],
 181 );
 182 $csv->parse;
 183 my @mm = $csv->get_objects->[0]->makemodel;
 184 is scalar @mm,  1, 'one-to-many dispatch';
 185 is $csv->get_objects->[0]->makemodels->[0]->model, 'Chair 0815', '... and works';
 186
 187 #####
 188
 189
 190 $csv = SL::Helper::Csv->new(
 191   file   => \<<EOL,
 192 description;partnumber;sellprice;lastcost_as_number;make_1;model_1;make_2;model_2;
 193  Kaffee;;0.12;1,221.52;213;Chair 0815;523;Table 15
 194 EOL
 195   numberformat => '1,000.00',
 196   profile => [{
 197     profile => {
 198       make_1 => "makemodels.0.make",
 199       model_1 => "makemodels.0.model",
 200       make_2 => "makemodels.1.make",
 201       model_2 => "makemodels.1.model",
 202     },
 203     class  => 'SL::DB::Part',
 204   }]
 205 );
 206 $csv->parse;
 207
 208 print Dumper($csv->errors);
 209
 210 @mm = $csv->get_objects->[0]->makemodel;
 211 is scalar @mm,  1, 'multiple one-to-many dispatch';
 212 is $csv->get_objects->[0]->makemodels->[0]->model, 'Chair 0815', '...check 1';
 213 is $csv->get_objects->[0]->makemodels->[0]->make, '213', '...check 2';
 214 is $csv->get_objects->[0]->makemodels->[1]->model, 'Table 15', '...check 3';
 215 is $csv->get_objects->[0]->makemodels->[1]->make, '523', '...check 4';
 216
 217 ######
 218
 219 $csv = SL::Helper::Csv->new(
 220   file   => \<<EOL,
 221 description;partnumber;sellprice;lastcost_as_number;buchungsgruppe;
 222 EOL
 223   numberformat => '1,000.00',
 224   profile => [{
 225     profile => {buchungsgruppe => "buchungsgruppen.1.description"},
 226     class  => 'SL::DB::Part',
 227   }]
 228 );
 229 is $csv->parse, undef, 'wrong profile gets rejected';
 230 is_deeply $csv->errors, [ 'buchungsgruppen.1.description', undef, "Profile path error. Indexed relationship is not OneToMany around here: 'buchungsgruppen.1'", undef ,0 ], 'error indicates wrong header';
 231 isa_ok( ($csv->errors)[0], 'SL::Helper::Csv::Error', 'Errors get objectified');
 232
 233 ####
 234
 235 $csv = SL::Helper::Csv->new(
 236   file   => \<<EOL,
 237 description;partnumber;sellprice;lastcost;wiener;
 238 Kaffee;;0.12;1,221.52;ja wiener
 239 Beer;1123245;0.12;1.5234;nein kein wieder
 240 EOL
 241   numberformat => '1,000.00',
 242   ignore_unknown_columns => 1,
 243   strict_profile => 1,
 244   profile => [{
 245     profile => {lastcost => 'lastcost_as_number'},
 246     class  => 'SL::DB::Part',
 247   }]
 248 );
 249 $csv->parse;
 250 is $csv->get_objects->[0]->lastcost, '1221.52', 'strict_profile with ignore';
 251 is $csv->get_objects->[0]->sellprice, undef,  'strict profile with ignore 2';
 252
 253 ####
 254
 255 $csv = SL::Helper::Csv->new(
 256   file   => \<<EOL,
 257 description;partnumber;sellprice;lastcost;wiener;
 258 Kaffee;;0.12;1,221.52;ja wiener
 259 Beer;1123245;0.12;1.5234;nein kein wieder
 260 EOL
 261   numberformat => '1,000.00',
 262   strict_profile => 1,
 263   profile => [{
 264     profile => {lastcost => 'lastcost_as_number'},
 265     class  => 'SL::DB::Part',
 266   }]
 267 );
 268 $csv->parse;
 269
 270 is_deeply( ($csv->errors)[0], [ 'description', undef, 'header field \'description\' is not recognized', undef, 0 ], 'strict_profile without ignore_columns throws error');
 271
 272 #####
 273
 274 $csv = SL::Helper::Csv->new(
 275   file   => \"Kaffee",       # " # make emacs happy
 276   header =>  [ 'description' ],
 277   profile => [{class  => 'SL::DB::Part'}],
 278 );
 279 $csv->parse;
 280 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'eol bug at the end of files';
 281
 282 #####
 283
 284 $csv = SL::Helper::Csv->new(
 285   file   => \"Description\nKaffee",        # " # make emacs happy
 286   case_insensitive_header => 1,
 287   profile => [{
 288     profile => { description => 'description' },
 289     class  => 'SL::DB::Part'
 290   }],
 291 );
 292 $csv->parse;
 293 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'case insensitive header from csv works';
 294
 295 #####
 296
 297 $csv = SL::Helper::Csv->new(
 298   file   => \"Kaffee",          # " # make emacs happy
 299   header =>  [ 'Description' ],
 300   case_insensitive_header => 1,
 301   profile => [{
 302     profile => { description => 'description' },
 303     class  => 'SL::DB::Part'
 304   }],
 305 );
 306 $csv->parse;
 307 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'case insensitive header as param works';
 308
 309 #####
 310
 311 $csv = SL::Helper::Csv->new(
 312   file   => \"\x{EF}\x{BB}\x{BF}description\nKaffee",           # " # make emacs happy
 313   profile => [{class  => 'SL::DB::Part'}],
 314   encoding => 'utf8',
 315 );
 316 $csv->parse;
 317 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'utf8 BOM works (bug 1872)';
 318
 319 #####
 320
 321 $csv = SL::Helper::Csv->new(
 322   file   => \"Kaffee",            # " # make emacs happy
 323   header => [ 'Description' ],
 324   profile => [{class  => 'SL::DB::Part'}],
 325 );
 326 $csv->parse;
 327 is_deeply $csv->get_data, undef, 'case insensitive header without flag ignores';
 328
 329 #####
 330
 331 $csv = SL::Helper::Csv->new(
 332   file   => \"Kaffee",            # " # make emacs happy
 333   header => [ 'foo' ],
 334   profile => [{
 335     profile => { foo => '' },
 336     class  => 'SL::DB::Part',
 337   }],
 338 );
 339 $csv->parse;
 340
 341 is_deeply $csv->get_data, [ { foo => 'Kaffee' } ], 'empty path still gets parsed into data';
 342 ok $csv->get_objects->[0], 'empty path gets ignored in object creation';
 343
 344 #####
 345
 346 $csv = SL::Helper::Csv->new(
 347   file   => \"Kaffee",            # " # make emacs happy
 348   header => [ 'foo' ],
 349   strict_profile => 1,
 350   profile => [{
 351     profile => { foo => '' },
 352     class  => 'SL::DB::Part',
 353   }],
 354 );
 355 $csv->parse;
 356
 357 is_deeply $csv->get_data, [ { foo => 'Kaffee' } ], 'empty path still gets parsed into data (strict profile)';
 358 ok $csv->get_objects->[0], 'empty path gets ignored in object creation (strict profile)';
 359
 360 $csv = SL::Helper::Csv->new(
 361   file   => \"Phil",            # " # make emacs happy
 362   header => [ 'CVAR_grOUnDHog' ],
 363   strict_profile => 1,
 364   case_insensitive_header => 1,
 365   profile => [{
 366     profile => { cvar_Groundhog => '' },
 367     class  => 'SL::DB::Part',
 368   }],
 369
 370 );
 371 $csv->parse;
 372
 373 is_deeply $csv->get_data, [ { cvar_Groundhog => 'Phil' } ], 'using empty path to get cvars working';
 374 ok $csv->get_objects->[0], '...and not destorying the objects';
 375
 376 #####
 377
 378 $csv = SL::Helper::Csv->new(
 379   file   => \"description\nKaffee",            # " # make emacs happy
 380 );
 381 $csv->parse;
 382 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'without profile and class works';
 383
 384 #####
 385
 386 $csv = SL::Helper::Csv->new(
 387   file => \<<EOL,
 388 description;partnumber
 389 Kaffee;1
 390
 391 ;
 392  ;
 393 Tee;3
 394 EOL
 395 # Note: The second last line is not empty. The description is a space character.
 396 );
 397 ok $csv->parse;
 398 is_deeply $csv->get_data, [ {partnumber => 1, description => 'Kaffee'}, {partnumber => '', description => ' '}, {partnumber => 3, description => 'Tee'} ], 'ignoring empty lines works (header in csv file)';
 399
 400 #####
 401
 402 $csv = SL::Helper::Csv->new(
 403   file => \<<EOL,
 404 Kaffee;1
 405
 406 ;
 407  ;
 408 Tee;3
 409 EOL
 410 # Note: The second last line is not empty. The description is a space character.
 411   header => ['description', 'partnumber'],
 412 );
 413 ok $csv->parse;
 414 is_deeply $csv->get_data, [ {partnumber => 1, description => 'Kaffee'}, {partnumber => '', description => ' '}, {partnumber => 3, description => 'Tee'} ], 'ignoring empty lines works';
 415
 416 #####
 417
 418 $csv = SL::Helper::Csv->new(
 419   file    => \"Kaffee;1,50\nSchoke;0,89\n",
 420   header  => [
 421     [ 'datatype', 'description', 'sellprice' ],
 422   ],
 423   profile => [
 424     { profile   => { sellprice => 'sellprice_as_number' },
 425       class     => 'SL::DB::Part',}
 426   ],
 427 );
 428
 429 ok $csv->_check_multiplexed, 'multiplex check works on not-multiplexed data';
 430 ok !$csv->is_multiplexed, 'not-multiplexed data is recognized';
 431
 432 #####
 433 $csv = SL::Helper::Csv->new(
 434   file    => \"P;Kaffee;1,50\nC;Meier\n",
 435   header  => [
 436     [ 'datatype', 'description', 'listprice' ],
 437     [ 'datatype', 'name' ],
 438   ],
 439   profile => [
 440     { profile   => { listprice => 'listprice_as_number' },
 441       class     => 'SL::DB::Part',
 442       row_ident => 'P' },
 443     { class  => 'SL::DB::Customer',
 444       row_ident => 'C' }
 445   ],
 446 );
 447
 448 ok $csv->_check_multiplexed, 'multiplex check works on multiplexed data';
 449 ok $csv->is_multiplexed, 'multiplexed data is recognized';
 450
 451 #####
 452 $csv = SL::Helper::Csv->new(
 453   file    => \"P;Kaffee;1,50\nC;Meier\n",
 454   header  => [
 455     [ 'datatype', 'description', 'listprice' ],
 456     [ 'datatype', 'name' ],
 457   ],
 458   profile => [
 459     { profile   => { listprice => 'listprice_as_number' },
 460       class     => 'SL::DB::Part', },
 461     { class  => 'SL::DB::Customer',
 462       row_ident => 'C' }
 463   ],
 464 );
 465
 466 ok !$csv->_check_multiplexed, 'multiplex check works on multiplexed data and detects missing row_ident';
 467
 468 #####
 469 $csv = SL::Helper::Csv->new(
 470   file    => \"P;Kaffee;1,50\nC;Meier\n",
 471   header  => [
 472     [ 'datatype', 'description', 'listprice' ],
 473     [ 'datatype', 'name' ],
 474   ],
 475   profile => [
 476     { profile   => { listprice => 'listprice_as_number' },
 477       row_ident => 'P' },
 478     { class  => 'SL::DB::Customer',
 479       row_ident => 'C' }
 480   ],
 481 );
 482
 483 ok !$csv->_check_multiplexed, 'multiplex check works on multiplexed data and detects missing class';
 484
 485 #####
 486 $csv = SL::Helper::Csv->new(
 487   file    => \"P;Kaffee;1,50\nC;Meier\n",  # " # make emacs happy
 488   header  => [
 489     [ 'datatype', 'description', 'listprice' ],
 490   ],
 491   profile => [
 492     { profile   => { listprice => 'listprice_as_number' },
 493       class     => 'SL::DB::Part',
 494       row_ident => 'P' },
 495     { class  => 'SL::DB::Customer',
 496       row_ident => 'C' }
 497   ],
 498 );
 499
 500 ok !$csv->_check_multiplexed, 'multiplex check works on multiplexed data and detects missing header';
 501
 502 #####
 503
 504 $csv = SL::Helper::Csv->new(
 505   file    => \"P;Kaffee;1,50\nC;Meier\n",  # " # make emacs happy
 506   header  => [
 507     [ 'datatype', 'description', 'listprice' ],
 508     [ 'datatype', 'name' ],
 509   ],
 510   profile => [
 511     { profile   => { listprice => 'listprice_as_number' },
 512       class     => 'SL::DB::Part',
 513       row_ident => 'P' },
 514     { class  => 'SL::DB::Customer',
 515       row_ident => 'C' }
 516   ],
 517   ignore_unknown_columns => 1,
 518 );
 519
 520 $csv->parse;
 521 is_deeply $csv->get_data,
 522     [ { datatype => 'P', description => 'Kaffee', listprice => '1,50' }, { datatype => 'C', name => 'Meier' } ],
 523     'multiplex: simple case works';
 524 is scalar @{ $csv->get_objects }, 2, 'multiplex: multiple objects work';
 525 is $csv->get_objects->[0]->description, 'Kaffee', 'multiplex: first object';
 526 is $csv->get_objects->[1]->name,        'Meier',  'multiplex: second object';
 527
 528 #####
 529
 530 $csv = SL::Helper::Csv->new(
 531   file    => \"datatype;description;listprice\ndatatype;name\nP;Kaffee;1,50\nC;Meier\n",  # " # make emacs happy
 532   profile => [
 533     { profile   => { listprice => 'listprice_as_number' },
 534       class     => 'SL::DB::Part',
 535       row_ident => 'P' },
 536     { class  => 'SL::DB::Customer',
 537       row_ident => 'C' }
 538   ],
 539   ignore_unknown_columns => 1,
 540 );
 541
 542 $csv->parse;
 543 is scalar @{ $csv->get_objects }, 2, 'multiplex: auto header works';
 544 is $csv->get_objects->[0]->description, 'Kaffee', 'multiplex: auto header first object';
 545 is $csv->get_objects->[1]->name,        'Meier',  'multiplex: auto header second object';
 546
 547 ######
 548
 549 $csv = SL::Helper::Csv->new(
 550   file   => \<<EOL,
 551 datatype;description
 552 "datatype;name
 553 P;Kaffee
 554 C;Meier
 555 P;Beer
 556 EOL
 557 # " # make emacs happy
 558   profile => [
 559               {class  => 'SL::DB::Part',     row_ident => 'P'},
 560               {class  => 'SL::DB::Customer', row_ident => 'C'},
 561              ],
 562   ignore_unknown_columns => 1,
 563 );
 564 is $csv->parse, undef, 'multiplex: broken csv header won\'t get parsed';
 565
 566 ######
 567
 568 $csv = SL::Helper::Csv->new(
 569   file   => \<<EOL,
 570 datatype;description
 571 P;Kaffee
 572 C;Meier
 573 P;Beer
 574 EOL
 575 # " # make emacs happy
 576   profile => [
 577               {class  => 'SL::DB::Part',     row_ident => 'P'},
 578               {class  => 'SL::DB::Customer', row_ident => 'C'},
 579              ],
 580   header  => [ [], ['name'] ],
 581   ignore_unknown_columns => 1,
 582 );
 583 ok !$csv->_check_multiplexed, 'multiplex check detects empty header';
 584
 585 #####
 586
 587 $csv = SL::Helper::Csv->new(
 588   file   => \ Encode::encode('utf-8', <<EOL),
 589 description;longdescription;datatype
 590 name;customernumber;datatype
 591 Kaffee;"lecker Kaffee";P
 592 Meier;1;C
 593 Bier;"kühles Bier";P
 594 Mueller;2;C
 595 EOL
 596 # " # make emacs happy
 597   profile => [
 598               {class  => 'SL::DB::Part',     row_ident => 'P'},
 599               {class  => 'SL::DB::Customer', row_ident => 'C'},
 600              ],
 601   ignore_unknown_columns => 1,
 602 );
 603 $csv->parse;
 604 is $csv->_multiplex_datatype_position, 2, 'multiplex check detects datatype field position right';
 605
 606 is_deeply $csv->get_data, [ { datatype => 'P', description => 'Kaffee', longdescription => 'lecker Kaffee' },
 607                             { datatype => 'C', name => 'Meier', customernumber => 1},
 608                             { datatype => 'P', description => 'Bier', longdescription => 'kühles Bier' },
 609                             { datatype => 'C', name => 'Mueller', customernumber => 2}
 610                           ],
 611                           'multiplex: datatype not at first position works';
 612
 613 #####
 614
 615 $csv = SL::Helper::Csv->new(
 616   file   => \ Encode::encode('utf-8', <<EOL),
 617 datatype;description;longdescription
 618 name;datatype;customernumber
 619 P;Kaffee;"lecker Kaffee"
 620 Meier;C;1
 621 P;Bier;"kühles Bier"
 622 Mueller;C;2
 623 EOL
 624 # " # make emacs happy
 625   profile => [
 626               {class  => 'SL::DB::Part',     row_ident => 'P'},
 627               {class  => 'SL::DB::Customer', row_ident => 'C'},
 628              ],
 629   ignore_unknown_columns => 1,
 630 );
 631 ok !$csv->parse, 'multiplex check detects incosistent datatype field position';
 632 is_deeply( ($csv->errors)[0], [ undef, 0, 'datatype field must be at the same position for all datatypes for multiplexed data', 0, 0 ], 'multiplex data with inconsistent datatype field posiotion throws error');
 633
 634 #####
 635
 636 $csv = SL::Helper::Csv->new(
 637   file   => \"Datatype;Description\nDatatype;Name\nP;Kaffee\nC;Meier",        # " # make emacs happy
 638   case_insensitive_header => 1,
 639   ignore_unknown_columns => 1,
 640   profile => [
 641     {
 642       profile   => { datatype => 'datatype', description => 'description' },
 643       class     => 'SL::DB::Part',
 644       row_ident => 'P'
 645     },
 646     {
 647       profile   => { datatype => 'datatype', name => 'name' },
 648       class     => 'SL::DB::Customer',
 649       row_ident => 'C'
 650     }
 651   ],
 652 );
 653 $csv->parse;
 654 is_deeply $csv->get_data, [ { datatype => 'P', description => 'Kaffee' },
 655                             { datatype => 'C', name => 'Meier'} ],
 656                           'multiplex: case insensitive header from csv works';
 657
 658 #####
 659
 660 $csv = SL::Helper::Csv->new(
 661   file   => \"P;Kaffee\nC;Meier",          # " # make emacs happy
 662   header =>  [[ 'Datatype', 'Description' ], [ 'Datatype', 'Name']],
 663   case_insensitive_header => 1,
 664   ignore_unknown_columns => 1,
 665   profile => [
 666     {
 667       profile   => { datatype => 'datatype', description => 'description' },
 668       class     => 'SL::DB::Part',
 669       row_ident => 'P'
 670     },
 671     {
 672       profile => { datatype => 'datatype', name => 'name' },
 673       class  => 'SL::DB::Customer',
 674       row_ident => 'C'
 675     }
 676   ],
 677 );
 678 $csv->parse;
 679 is_deeply $csv->get_data, [ { datatype => 'P', description => 'Kaffee' },
 680                             { datatype => 'C', name => 'Meier' } ],
 681                           'multiplex: case insensitive header as param works';
 682
 683
 684 #####
 685
 686 $csv = SL::Helper::Csv->new(
 687   file   => \"P;Kaffee\nC;Meier",          # " # make emacs happy
 688   header =>  [[ 'Datatype', 'Description' ], [ 'Datatype', 'Name']],
 689   profile => [
 690     {
 691       profile   => { datatype => 'datatype', description => 'description' },
 692       class     => 'SL::DB::Part',
 693       row_ident => 'P'
 694     },
 695     {
 696       profile => { datatype => 'datatype', name => 'name' },
 697       class  => 'SL::DB::Customer',
 698       row_ident => 'C'
 699     }
 700   ],
 701 );
 702 $csv->parse;
 703 is_deeply $csv->get_data, undef, 'multiplex: case insensitive header without flag ignores';
 704
 705 #####
 706
 707 $csv = SL::Helper::Csv->new(
 708   file   => \<<EOL,
 709 P;Kaffee;lecker
 710 C;Meier;froh
 711 EOL
 712 # " # make emacs happy
 713   header => [[ 'datatype', 'Afoo', 'Abar' ], [ 'datatype', 'Bfoo', 'Bbar']],
 714   profile => [{
 715     profile   => { datatype => '', Afoo => '', Abar => '' },
 716     class     => 'SL::DB::Part',
 717     row_ident => 'P'
 718   },
 719   {
 720     profile   => { datatype => '', Bfoo => '', Bbar => '' },
 721     class     => 'SL::DB::Customer',
 722     row_ident => 'C'
 723   }],
 724 );
 725 $csv->parse;
 726
 727 is_deeply $csv->get_data,
 728     [ { datatype => 'P', Afoo => 'Kaffee', Abar => 'lecker' }, { datatype => 'C', Bfoo => 'Meier', Bbar => 'froh' } ],
 729     'multiplex: empty path still gets parsed into data';
 730 ok $csv->get_objects->[0], 'multiplex: empty path gets ignored in object creation';
 731
 732 #####
 733
 734 $csv = SL::Helper::Csv->new(
 735   file   => \<<EOL,
 736 P;Kaffee;lecker
 737 C;Meier;froh
 738 EOL
 739 # " # make emacs happy
 740   header => [[ 'datatype', 'Afoo', 'Abar' ], [ 'datatype', 'Bfoo', 'Bbar']],
 741   strict_profile => 1,
 742   profile => [{
 743     profile   => { datatype => '', Afoo => '', Abar => '' },
 744     class     => 'SL::DB::Part',
 745     row_ident => 'P'
 746   },
 747   {
 748     profile   => { datatype => '', Bfoo => '', Bbar => '' },
 749     class     => 'SL::DB::Customer',
 750     row_ident => 'C'
 751   }],
 752 );
 753 $csv->parse;
 754
 755 is_deeply $csv->get_data,
 756     [ { datatype => 'P', Afoo => 'Kaffee', Abar => 'lecker' }, { datatype => 'C', Bfoo => 'Meier', Bbar => 'froh' } ],
 757     'multiplex: empty path still gets parsed into data (strict profile)';
 758 ok $csv->get_objects->[0], 'multiplex: empty path gets ignored in object creation (strict profile)';
 759
 760 #####
 761
 762 $csv = SL::Helper::Csv->new(
 763   file => \<<EOL,
 764 datatype;customernumber;name
 765 datatype;description;partnumber
 766 C;1000;Meier
 767 P;Kaffee;1
 768
 769 ;;
 770 C
 771 P; ;
 772 C;2000;Meister
 773 P;Tee;3
 774 EOL
 775   ignore_unknown_columns => 1,
 776   profile => [ { class => 'SL::DB::Customer', row_ident => 'C' },
 777                { class => 'SL::DB::Part',     row_ident => 'P' },
 778   ],
 779 );
 780 $csv->parse;
 781 is_deeply $csv->get_data, [
 782   {datatype => 'C', customernumber => 1000, name => 'Meier'},
 783   {datatype => 'P', partnumber => 1, description => 'Kaffee'},
 784   {datatype => 'C', customernumber => undef, name => undef},
 785   {datatype => 'P', partnumber => '', description => ' '},
 786   {datatype => 'C', customernumber => 2000, name => 'Meister'},
 787   {datatype => 'P', partnumber => '3', description => 'Tee'},
 788 ], 'ignoring empty lines works (multiplex data)';
 789
 790 #####
 791
 792 # Mappings
 793 # simple case
 794 $csv = SL::Helper::Csv->new(
 795   file   => \<<EOL,
 796 description,sellprice,lastcost_as_number,purchaseprice,
 797 Kaffee,0.12,'12,2','1,5234'
 798 EOL
 799   sep_char => ',',
 800   quote_char => "'",
 801   profile => [
 802     {
 803       profile => { listprice => 'listprice_as_number' },
 804       mapping => { purchaseprice => 'listprice' },
 805       class   => 'SL::DB::Part',
 806     }
 807   ],
 808 );
 809 ok $csv->parse, 'simple mapping parses';
 810 is $csv->get_objects->[0]->listprice, 1.5234, 'simple mapping works';
 811
 812 $csv = SL::Helper::Csv->new(
 813   file   => \<<EOL,
 814 description;partnumber;sellprice;purchaseprice;wiener;
 815 Kaffee;;0.12;1,221.52;ja wiener
 816 Beer;1123245;0.12;1.5234;nein kein wieder
 817 EOL
 818   numberformat => '1,000.00',
 819   ignore_unknown_columns => 1,
 820   strict_profile => 1,
 821   profile => [{
 822     profile => { lastcost => 'lastcost_as_number' },
 823     mapping => { purchaseprice => 'lastcost' },
 824     class  => 'SL::DB::Part',
 825   }]
 826 );
 827 ok $csv->parse, 'strict mapping parses';
 828 is $csv->get_objects->[0]->lastcost, 1221.52, 'strict mapping works';
 829
 830 # swapping
 831 $csv = SL::Helper::Csv->new(
 832   file   => \<<EOL,
 833 description;partnumber;sellprice;lastcost;wiener;
 834 Kaffee;1;0.12;1,221.52;ja wiener
 835 Beer;1123245;0.12;1.5234;nein kein wieder
 836 EOL
 837   numberformat => '1,000.00',
 838   ignore_unknown_columns => 1,
 839   strict_profile => 1,
 840   profile => [{
 841     mapping => { partnumber => 'description', description => 'partnumber' },
 842     class  => 'SL::DB::Part',
 843   }]
 844 );
 845 ok $csv->parse, 'swapping parses';
 846 is $csv->get_objects->[0]->partnumber, 'Kaffee', 'strict mapping works 1';
 847 is $csv->get_objects->[0]->description, '1', 'strict mapping works 2';
 848
 849 # case insensitive shit
 850 $csv = SL::Helper::Csv->new(
 851   file   => \"Description\nKaffee",        # " # make emacs happy
 852   case_insensitive_header => 1,
 853   profile => [{
 854     mapping => { description => 'description' },
 855     class  => 'SL::DB::Part'
 856   }],
 857 );
 858 $csv->parse;
 859 is $csv->get_objects->[0]->description, 'Kaffee', 'case insensitive mapping without profile works';
 860
 861 # case insensitive shit
 862 $csv = SL::Helper::Csv->new(
 863   file   => \"Price\n4,99",        # " # make emacs happy
 864   case_insensitive_header => 1,
 865   profile => [{
 866     profile => { sellprice => 'sellprice_as_number' },
 867     mapping => { price => 'sellprice' },
 868     class  => 'SL::DB::Part',
 869   }],
 870 );
 871 $csv->parse;
 872 is $csv->get_objects->[0]->sellprice, 4.99, 'case insensitive mapping with profile works';
 873
 874
 875 # self-mapping with profile
 876 $csv = SL::Helper::Csv->new(
 877   file   => \"sellprice\n4,99",        # " # make emacs happy
 878   case_insensitive_header => 1,
 879   profile => [{
 880     profile => { sellprice => 'sellprice_as_number' },
 881     mapping => { sellprice => 'sellprice' },
 882     class  => 'SL::DB::Part',
 883   }],
 884 );
 885 $csv->parse;
 886 is $csv->get_objects->[0]->sellprice, 4.99, 'self-mapping with profile works';
 887
 888 # self-mapping without profile
 889 $csv = SL::Helper::Csv->new(
 890   file   => \"sellprice\n4.99",        # " # make emacs happy
 891   case_insensitive_header => 1,
 892   profile => [{
 893     mapping => { sellprice => 'sellprice' },
 894     class  => 'SL::DB::Part',
 895   }],
 896 );
 897 $csv->parse;
 898 is $csv->get_objects->[0]->sellprice, 4.99, 'self-mapping without profile works';
 899
 900 # vim: ft=perl
 901 # set emacs to perl mode
 902 # Local Variables:
 903 # mode: perl
 904 # End: