t/helper/csv.t

   1 use Test::More tests => 84;
   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_unkown_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 $csv = SL::Helper::Csv->new(
 386   file    => \"Kaffee;1,50\nSchoke;0,89\n",
 387   header  => [
 388     [ 'datatype', 'description', 'sellprice' ],
 389   ],
 390   profile => [
 391     { profile   => { sellprice => 'sellprice_as_number' },
 392       class     => 'SL::DB::Part',}
 393   ],
 394 );
 395
 396 ok $csv->_check_multiplexed, 'multiplex check works on not-multiplexed data';
 397 ok !$csv->is_multiplexed, 'not-multiplexed data is recognized';
 398
 399 #####
 400 $csv = SL::Helper::Csv->new(
 401   file    => \"P;Kaffee;1,50\nC;Meier\n",
 402   header  => [
 403     [ 'datatype', 'description', 'listprice' ],
 404     [ 'datatype', 'name' ],
 405   ],
 406   profile => [
 407     { profile   => { listprice => 'listprice_as_number' },
 408       class     => 'SL::DB::Part',
 409       row_ident => 'P' },
 410     { class  => 'SL::DB::Customer',
 411       row_ident => 'C' }
 412   ],
 413 );
 414
 415 ok $csv->_check_multiplexed, 'multiplex check works on multiplexed data';
 416 ok $csv->is_multiplexed, 'multiplexed data is recognized';
 417
 418 #####
 419 $csv = SL::Helper::Csv->new(
 420   file    => \"P;Kaffee;1,50\nC;Meier\n",
 421   header  => [
 422     [ 'datatype', 'description', 'listprice' ],
 423     [ 'datatype', 'name' ],
 424   ],
 425   profile => [
 426     { profile   => { listprice => 'listprice_as_number' },
 427       class     => 'SL::DB::Part', },
 428     { class  => 'SL::DB::Customer',
 429       row_ident => 'C' }
 430   ],
 431 );
 432
 433 ok !$csv->_check_multiplexed, 'multiplex check works on multiplexed data and detects missing row_ident';
 434
 435 #####
 436 $csv = SL::Helper::Csv->new(
 437   file    => \"P;Kaffee;1,50\nC;Meier\n",
 438   header  => [
 439     [ 'datatype', 'description', 'listprice' ],
 440     [ 'datatype', 'name' ],
 441   ],
 442   profile => [
 443     { profile   => { listprice => 'listprice_as_number' },
 444       row_ident => 'P' },
 445     { class  => 'SL::DB::Customer',
 446       row_ident => 'C' }
 447   ],
 448 );
 449
 450 ok !$csv->_check_multiplexed, 'multiplex check works on multiplexed data and detects missing class';
 451
 452 #####
 453 $csv = SL::Helper::Csv->new(
 454   file    => \"P;Kaffee;1,50\nC;Meier\n",  # " # make emacs happy
 455   header  => [
 456     [ 'datatype', 'description', 'listprice' ],
 457   ],
 458   profile => [
 459     { profile   => { listprice => 'listprice_as_number' },
 460       class     => 'SL::DB::Part',
 461       row_ident => 'P' },
 462     { class  => 'SL::DB::Customer',
 463       row_ident => 'C' }
 464   ],
 465 );
 466
 467 ok !$csv->_check_multiplexed, 'multiplex check works on multiplexed data and detects missing header';
 468
 469 #####
 470
 471 $csv = SL::Helper::Csv->new(
 472   file    => \"P;Kaffee;1,50\nC;Meier\n",  # " # make emacs happy
 473   header  => [
 474     [ 'datatype', 'description', 'listprice' ],
 475     [ 'datatype', 'name' ],
 476   ],
 477   profile => [
 478     { profile   => { listprice => 'listprice_as_number' },
 479       class     => 'SL::DB::Part',
 480       row_ident => 'P' },
 481     { class  => 'SL::DB::Customer',
 482       row_ident => 'C' }
 483   ],
 484   ignore_unknown_columns => 1,
 485 );
 486
 487 $csv->parse;
 488 is_deeply $csv->get_data,
 489     [ { datatype => 'P', description => 'Kaffee', listprice => '1,50' }, { datatype => 'C', name => 'Meier' } ],
 490     'multiplex: simple case works';
 491 is scalar @{ $csv->get_objects }, 2, 'multiplex: multiple objects work';
 492 is $csv->get_objects->[0]->description, 'Kaffee', 'multiplex: first object';
 493 is $csv->get_objects->[1]->name,        'Meier',  'multiplex: second object';
 494
 495 #####
 496
 497 $csv = SL::Helper::Csv->new(
 498   file    => \"datatype;description;listprice\ndatatype;name\nP;Kaffee;1,50\nC;Meier\n",  # " # make emacs happy
 499   profile => [
 500     { profile   => { listprice => 'listprice_as_number' },
 501       class     => 'SL::DB::Part',
 502       row_ident => 'P' },
 503     { class  => 'SL::DB::Customer',
 504       row_ident => 'C' }
 505   ],
 506   ignore_unknown_columns => 1,
 507 );
 508
 509 $csv->parse;
 510 is scalar @{ $csv->get_objects }, 2, 'multiplex: auto header works';
 511 is $csv->get_objects->[0]->description, 'Kaffee', 'multiplex: auto header first object';
 512 is $csv->get_objects->[1]->name,        'Meier',  'multiplex: auto header second object';
 513
 514 ######
 515
 516 $csv = SL::Helper::Csv->new(
 517   file   => \<<EOL,
 518 datatype;description
 519 "datatype;name
 520 P;Kaffee
 521 C;Meier
 522 P;Beer
 523 EOL
 524 # " # make emacs happy
 525   profile => [
 526               {class  => 'SL::DB::Part',     row_ident => 'P'},
 527               {class  => 'SL::DB::Customer', row_ident => 'C'},
 528              ],
 529   ignore_unknown_columns => 1,
 530 );
 531 is $csv->parse, undef, 'multiplex: broken csv header won\'t get parsed';
 532
 533 ######
 534
 535 $csv = SL::Helper::Csv->new(
 536   file   => \<<EOL,
 537 datatype;description
 538 P;Kaffee
 539 C;Meier
 540 P;Beer
 541 EOL
 542 # " # make emacs happy
 543   profile => [
 544               {class  => 'SL::DB::Part',     row_ident => 'P'},
 545               {class  => 'SL::DB::Customer', row_ident => 'C'},
 546              ],
 547   header  => [ [], ['name'] ],
 548   ignore_unknown_columns => 1,
 549 );
 550 ok !$csv->_check_multiplexed, 'multiplex check detects empty header';
 551
 552 #####
 553
 554 $csv = SL::Helper::Csv->new(
 555   file   => \ Encode::encode('utf-8', <<EOL),
 556 description;longdescription;datatype
 557 name;customernumber;datatype
 558 Kaffee;"lecker Kaffee";P
 559 Meier;1;C
 560 Bier;"kühles Bier";P
 561 Mueller;2;C
 562 EOL
 563 # " # make emacs happy
 564   profile => [
 565               {class  => 'SL::DB::Part',     row_ident => 'P'},
 566               {class  => 'SL::DB::Customer', row_ident => 'C'},
 567              ],
 568   ignore_unknown_columns => 1,
 569 );
 570 $csv->parse;
 571 is $csv->_multiplex_datatype_position, 2, 'multiplex check detects datatype field position right';
 572
 573 is_deeply $csv->get_data, [ { datatype => 'P', description => 'Kaffee', longdescription => 'lecker Kaffee' },
 574                             { datatype => 'C', name => 'Meier', customernumber => 1},
 575                             { datatype => 'P', description => 'Bier', longdescription => 'kühles Bier' },
 576                             { datatype => 'C', name => 'Mueller', customernumber => 2}
 577                           ],
 578                           'multiplex: datatype not at first position works';
 579
 580 #####
 581
 582 $csv = SL::Helper::Csv->new(
 583   file   => \ Encode::encode('utf-8', <<EOL),
 584 datatype;description;longdescription
 585 name;datatype;customernumber
 586 P;Kaffee;"lecker Kaffee"
 587 Meier;C;1
 588 P;Bier;"kühles Bier"
 589 Mueller;C;2
 590 EOL
 591 # " # make emacs happy
 592   profile => [
 593               {class  => 'SL::DB::Part',     row_ident => 'P'},
 594               {class  => 'SL::DB::Customer', row_ident => 'C'},
 595              ],
 596   ignore_unknown_columns => 1,
 597 );
 598 ok !$csv->parse, 'multiplex check detects incosistent datatype field position';
 599 is_deeply( ($csv->errors)[0], [ 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');
 600
 601 #####
 602
 603 $csv = SL::Helper::Csv->new(
 604   file   => \"Datatype;Description\nDatatype;Name\nP;Kaffee\nC;Meier",        # " # make emacs happy
 605   case_insensitive_header => 1,
 606   ignore_unknown_columns => 1,
 607   profile => [
 608     {
 609       profile   => { datatype => 'datatype', description => 'description' },
 610       class     => 'SL::DB::Part',
 611       row_ident => 'P'
 612     },
 613     {
 614       profile   => { datatype => 'datatype', name => 'name' },
 615       class     => 'SL::DB::Customer',
 616       row_ident => 'C'
 617     }
 618   ],
 619 );
 620 $csv->parse;
 621 is_deeply $csv->get_data, [ { datatype => 'P', description => 'Kaffee' },
 622                             { datatype => 'C', name => 'Meier'} ],
 623                           'multiplex: case insensitive header from csv works';
 624
 625 #####
 626
 627 $csv = SL::Helper::Csv->new(
 628   file   => \"P;Kaffee\nC;Meier",          # " # make emacs happy
 629   header =>  [[ 'Datatype', 'Description' ], [ 'Datatype', 'Name']],
 630   case_insensitive_header => 1,
 631   ignore_unknown_columns => 1,
 632   profile => [
 633     {
 634       profile   => { datatype => 'datatype', description => 'description' },
 635       class     => 'SL::DB::Part',
 636       row_ident => 'P'
 637     },
 638     {
 639       profile => { datatype => 'datatype', name => 'name' },
 640       class  => 'SL::DB::Customer',
 641       row_ident => 'C'
 642     }
 643   ],
 644 );
 645 $csv->parse;
 646 is_deeply $csv->get_data, [ { datatype => 'P', description => 'Kaffee' },
 647                             { datatype => 'C', name => 'Meier' } ],
 648                           'multiplex: case insensitive header as param works';
 649
 650
 651 #####
 652
 653 $csv = SL::Helper::Csv->new(
 654   file   => \"P;Kaffee\nC;Meier",          # " # make emacs happy
 655   header =>  [[ 'Datatype', 'Description' ], [ 'Datatype', 'Name']],
 656   profile => [
 657     {
 658       profile   => { datatype => 'datatype', description => 'description' },
 659       class     => 'SL::DB::Part',
 660       row_ident => 'P'
 661     },
 662     {
 663       profile => { datatype => 'datatype', name => 'name' },
 664       class  => 'SL::DB::Customer',
 665       row_ident => 'C'
 666     }
 667   ],
 668 );
 669 $csv->parse;
 670 is_deeply $csv->get_data, undef, 'multiplex: case insensitive header without flag ignores';
 671
 672 #####
 673
 674 $csv = SL::Helper::Csv->new(
 675   file   => \<<EOL,
 676 P;Kaffee;lecker
 677 C;Meier;froh
 678 EOL
 679 # " # make emacs happy
 680   header => [[ 'datatype', 'Afoo', 'Abar' ], [ 'datatype', 'Bfoo', 'Bbar']],
 681   profile => [{
 682     profile   => { datatype => '', Afoo => '', Abar => '' },
 683     class     => 'SL::DB::Part',
 684     row_ident => 'P'
 685   },
 686   {
 687     profile   => { datatype => '', Bfoo => '', Bbar => '' },
 688     class     => 'SL::DB::Customer',
 689     row_ident => 'C'
 690   }],
 691 );
 692 $csv->parse;
 693
 694 is_deeply $csv->get_data,
 695     [ { datatype => 'P', Afoo => 'Kaffee', Abar => 'lecker' }, { datatype => 'C', Bfoo => 'Meier', Bbar => 'froh' } ],
 696     'multiplex: empty path still gets parsed into data';
 697 ok $csv->get_objects->[0], 'multiplex: empty path gets ignored in object creation';
 698
 699 #####
 700
 701 $csv = SL::Helper::Csv->new(
 702   file   => \<<EOL,
 703 P;Kaffee;lecker
 704 C;Meier;froh
 705 EOL
 706 # " # make emacs happy
 707   header => [[ 'datatype', 'Afoo', 'Abar' ], [ 'datatype', 'Bfoo', 'Bbar']],
 708   strict_profile => 1,
 709   profile => [{
 710     profile   => { datatype => '', Afoo => '', Abar => '' },
 711     class     => 'SL::DB::Part',
 712     row_ident => 'P'
 713   },
 714   {
 715     profile   => { datatype => '', Bfoo => '', Bbar => '' },
 716     class     => 'SL::DB::Customer',
 717     row_ident => 'C'
 718   }],
 719 );
 720 $csv->parse;
 721
 722 is_deeply $csv->get_data,
 723     [ { datatype => 'P', Afoo => 'Kaffee', Abar => 'lecker' }, { datatype => 'C', Bfoo => 'Meier', Bbar => 'froh' } ],
 724     'multiplex: empty path still gets parsed into data (strict profile)';
 725 ok $csv->get_objects->[0], 'multiplex: empty path gets ignored in object creation (strict profile)';
 726
 727 #####
 728
 729 # Mappings
 730 # simple case
 731 $csv = SL::Helper::Csv->new(
 732   file   => \<<EOL,
 733 description,sellprice,lastcost_as_number,purchaseprice,
 734 Kaffee,0.12,'12,2','1,5234'
 735 EOL
 736   sep_char => ',',
 737   quote_char => "'",
 738   profile => [
 739     {
 740       profile => { listprice => 'listprice_as_number' },
 741       mapping => { purchaseprice => 'listprice' },
 742       class   => 'SL::DB::Part',
 743     }
 744   ],
 745 );
 746 ok $csv->parse, 'simple mapping parses';
 747 is $csv->get_objects->[0]->listprice, 1.5234, 'simple mapping works';
 748
 749 $csv = SL::Helper::Csv->new(
 750   file   => \<<EOL,
 751 description;partnumber;sellprice;purchaseprice;wiener;
 752 Kaffee;;0.12;1,221.52;ja wiener
 753 Beer;1123245;0.12;1.5234;nein kein wieder
 754 EOL
 755   numberformat => '1,000.00',
 756   ignore_unknown_columns => 1,
 757   strict_profile => 1,
 758   profile => [{
 759     profile => { lastcost => 'lastcost_as_number' },
 760     mapping => { purchaseprice => 'lastcost' },
 761     class  => 'SL::DB::Part',
 762   }]
 763 );
 764 ok $csv->parse, 'strict mapping parses';
 765 is $csv->get_objects->[0]->lastcost, 1221.52, 'strict mapping works';
 766
 767 # swapping
 768 $csv = SL::Helper::Csv->new(
 769   file   => \<<EOL,
 770 description;partnumber;sellprice;lastcost;wiener;
 771 Kaffee;1;0.12;1,221.52;ja wiener
 772 Beer;1123245;0.12;1.5234;nein kein wieder
 773 EOL
 774   numberformat => '1,000.00',
 775   ignore_unknown_columns => 1,
 776   strict_profile => 1,
 777   profile => [{
 778     mapping => { partnumber => 'description', description => 'partnumber' },
 779     class  => 'SL::DB::Part',
 780   }]
 781 );
 782 ok $csv->parse, 'swapping parses';
 783 is $csv->get_objects->[0]->partnumber, 'Kaffee', 'strict mapping works 1';
 784 is $csv->get_objects->[0]->description, '1', 'strict mapping works 2';
 785
 786 # case insensitive shit
 787 $csv = SL::Helper::Csv->new(
 788   file   => \"Description\nKaffee",        # " # make emacs happy
 789   case_insensitive_header => 1,
 790   profile => [{
 791     mapping => { description => 'description' },
 792     class  => 'SL::DB::Part'
 793   }],
 794 );
 795 $csv->parse;
 796 is $csv->get_objects->[0]->description, 'Kaffee', 'case insensitive mapping without profile works';
 797
 798 # case insensitive shit
 799 $csv = SL::Helper::Csv->new(
 800   file   => \"Price\n4,99",        # " # make emacs happy
 801   case_insensitive_header => 1,
 802   profile => [{
 803     profile => { sellprice => 'sellprice_as_number' },
 804     mapping => { price => 'sellprice' },
 805     class  => 'SL::DB::Part',
 806   }],
 807 );
 808 $csv->parse;
 809 is $csv->get_objects->[0]->sellprice, 4.99, 'case insensitive mapping with profile works';
 810
 811
 812 # vim: ft=perl
 813 # set emacs to perl mode
 814 # Local Variables:
 815 # mode: perl
 816 # End:
 817