1 use Test::More tests => 75;
 
   7 use Support::TestSetup;
 
   9 use_ok 'SL::Helper::Csv';
 
  11 Support::TestSetup::login();
 
  13 my $csv = SL::Helper::Csv->new(
 
  14   file    => \"Kaffee\n",       # " # make emacs happy
 
  15   header  => [ 'description' ],
 
  16   profile => [{ class  => 'SL::DB::Part', }],
 
  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';
 
  24 is $csv->get_objects->[0]->description, 'Kaffee', 'get_object works';
 
  27 $::myconfig{numberformat} = '1.000,00';
 
  28 $::myconfig{dateformat} = 'dd.mm.yyyy';
 
  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',}],
 
  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';
 
  45 $csv = SL::Helper::Csv->new(
 
  47 description,sellprice,lastcost_as_number,listprice,
 
  48 Kaffee,0.12,'12,2','1,5234'
 
  52   profile => [{profile => { listprice => 'listprice_as_number' },
 
  53                class   => 'SL::DB::Part',}]
 
  56 is scalar @{ $csv->get_objects }, 1, 'auto header works';
 
  57 is $csv->get_objects->[0]->description, 'Kaffee', 'get_object works on auto header';
 
  62 $csv = SL::Helper::Csv->new(
 
  64 ;;description;sellprice;lastcost_as_number;
 
  65 #####;Puppy;Kaffee;0.12;12,2;1,5234
 
  67   profile => [{class  => 'SL::DB::Part'}],
 
  70 is scalar @{ $csv->get_objects }, 1, 'bozo header doesn\'t blow things up';
 
  74 $csv = SL::Helper::Csv->new(
 
  76 description;partnumber;sellprice;lastcost_as_number;
 
  77 Kaffee;;0.12;12,2;1,5234
 
  78 Beer;1123245;0.12;12,2;1,5234
 
  80   profile => [{class  => 'SL::DB::Part'}],
 
  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';
 
  89 $csv = SL::Helper::Csv->new(
 
  91 description;partnumber;sellprice;lastcost_as_number;
 
  93 Beer;1123245;0.12;1.5234
 
  95   numberformat => '1,000.00',
 
  96   profile => [{class  => 'SL::DB::Part'}],
 
  99 is $csv->get_objects->[0]->lastcost, '1221.52', 'formatnumber';
 
 103 $csv = SL::Helper::Csv->new(
 
 105 "description;partnumber;sellprice;lastcost_as_number;
 
 106 Kaffee;;0.12;1,221.52
 
 107 Beer;1123245;0.12;1.5234
 
 109 # " # make emacs happy
 
 110   numberformat => '1,000.00',
 
 111   profile => [{class  => 'SL::DB::Part'}],
 
 113 is $csv->parse, undef, 'broken csv header won\'t get parsed';
 
 117 $csv = SL::Helper::Csv->new(
 
 119 description;partnumber;sellprice;lastcost_as_number;
 
 120 "Kaf"fee";;0.12;1,221.52
 
 121 Beer;1123245;0.12;1.5234
 
 123 # " # make emacs happy
 
 124   numberformat => '1,000.00',
 
 125   profile => [{class  => 'SL::DB::Part'}],
 
 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');
 
 133 $csv = SL::Helper::Csv->new(
 
 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
 
 139   numberformat => '1,000.00',
 
 140   ignore_unknown_columns => 1,
 
 141   profile => [{class  => 'SL::DB::Part'}],
 
 144 is $csv->get_objects->[0]->lastcost, '1221.52', 'ignore_unkown_columns works';
 
 148 $csv = SL::Helper::Csv->new(
 
 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 %
 
 154   numberformat => '1,000.00',
 
 156     profile => {buchungsgruppe => "buchungsgruppen.description"},
 
 157     class  => 'SL::DB::Part',
 
 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';
 
 167 $csv = SL::Helper::Csv->new(
 
 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;
 
 173   numberformat => '1,000.00',
 
 176       make_1 => "makemodels.0.make",
 
 177       model_1 => "makemodels.0.model",
 
 179     class  => 'SL::DB::Part',
 
 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';
 
 190 $csv = SL::Helper::Csv->new(
 
 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
 
 195   numberformat => '1,000.00',
 
 198       make_1 => "makemodels.0.make",
 
 199       model_1 => "makemodels.0.model",
 
 200       make_2 => "makemodels.1.make",
 
 201       model_2 => "makemodels.1.model",
 
 203     class  => 'SL::DB::Part',
 
 208 print Dumper($csv->errors);
 
 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';
 
 219 $csv = SL::Helper::Csv->new(
 
 221 description;partnumber;sellprice;lastcost_as_number;buchungsgruppe;
 
 223   numberformat => '1,000.00',
 
 225     profile => {buchungsgruppe => "buchungsgruppen.1.description"},
 
 226     class  => 'SL::DB::Part',
 
 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');
 
 235 $csv = SL::Helper::Csv->new(
 
 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
 
 241   numberformat => '1,000.00',
 
 242   ignore_unknown_columns => 1,
 
 245     profile => {lastcost => 'lastcost_as_number'},
 
 246     class  => 'SL::DB::Part',
 
 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';
 
 255 $csv = SL::Helper::Csv->new(
 
 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
 
 261   numberformat => '1,000.00',
 
 264     profile => {lastcost => 'lastcost_as_number'},
 
 265     class  => 'SL::DB::Part',
 
 270 is_deeply( ($csv->errors)[0], [ 'description', undef, 'header field \'description\' is not recognized', undef, 0 ], 'strict_profile without ignore_columns throws error');
 
 274 $csv = SL::Helper::Csv->new(
 
 275   file   => \"Kaffee",       # " # make emacs happy
 
 276   header =>  [ 'description' ],
 
 277   profile => [{class  => 'SL::DB::Part'}],
 
 280 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'eol bug at the end of files';
 
 284 $csv = SL::Helper::Csv->new(
 
 285   file   => \"Description\nKaffee",        # " # make emacs happy
 
 286   case_insensitive_header => 1,
 
 288     profile => { description => 'description' },
 
 289     class  => 'SL::DB::Part'
 
 293 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'case insensitive header from csv works';
 
 297 $csv = SL::Helper::Csv->new(
 
 298   file   => \"Kaffee",          # " # make emacs happy
 
 299   header =>  [ 'Description' ],
 
 300   case_insensitive_header => 1,
 
 302     profile => { description => 'description' },
 
 303     class  => 'SL::DB::Part'
 
 307 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'case insensitive header as param works';
 
 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'}],
 
 317 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'utf8 BOM works (bug 1872)';
 
 321 $csv = SL::Helper::Csv->new(
 
 322   file   => \"Kaffee",            # " # make emacs happy
 
 323   header => [ 'Description' ],
 
 324   profile => [{class  => 'SL::DB::Part'}],
 
 327 is_deeply $csv->get_data, undef, 'case insensitive header without flag ignores';
 
 331 $csv = SL::Helper::Csv->new(
 
 332   file   => \"Kaffee",            # " # make emacs happy
 
 335     profile => { foo => '' },
 
 336     class  => 'SL::DB::Part',
 
 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';
 
 346 $csv = SL::Helper::Csv->new(
 
 347   file   => \"Kaffee",            # " # make emacs happy
 
 351     profile => { foo => '' },
 
 352     class  => 'SL::DB::Part',
 
 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)';
 
 360 $csv = SL::Helper::Csv->new(
 
 361   file   => \"Phil",            # " # make emacs happy
 
 362   header => [ 'CVAR_grOUnDHog' ],
 
 364   case_insensitive_header => 1,
 
 366     profile => { cvar_Groundhog => '' },
 
 367     class  => 'SL::DB::Part',
 
 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';
 
 378 $csv = SL::Helper::Csv->new(
 
 379   file   => \"description\nKaffee",            # " # make emacs happy
 
 382 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'without profile and class works';
 
 385 $csv = SL::Helper::Csv->new(
 
 386   file    => \"Kaffee;1,50\nSchoke;0,89\n",
 
 388     [ 'datatype', 'description', 'sellprice' ],
 
 391     { profile   => { sellprice => 'sellprice_as_number' },
 
 392       class     => 'SL::DB::Part',}
 
 396 ok $csv->_check_multiplexed, 'multiplex check works on not-multiplexed data';
 
 397 ok !$csv->is_multiplexed, 'not-multiplexed data is recognized';
 
 400 $csv = SL::Helper::Csv->new(
 
 401   file    => \"P;Kaffee;1,50\nC;Meier\n",
 
 403     [ 'datatype', 'description', 'listprice' ],
 
 404     [ 'datatype', 'name' ],
 
 407     { profile   => { listprice => 'listprice_as_number' },
 
 408       class     => 'SL::DB::Part',
 
 410     { class  => 'SL::DB::Customer',
 
 415 ok $csv->_check_multiplexed, 'multiplex check works on multiplexed data';
 
 416 ok $csv->is_multiplexed, 'multiplexed data is recognized';
 
 419 $csv = SL::Helper::Csv->new(
 
 420   file    => \"P;Kaffee;1,50\nC;Meier\n",
 
 422     [ 'datatype', 'description', 'listprice' ],
 
 423     [ 'datatype', 'name' ],
 
 426     { profile   => { listprice => 'listprice_as_number' },
 
 427       class     => 'SL::DB::Part', },
 
 428     { class  => 'SL::DB::Customer',
 
 433 ok !$csv->_check_multiplexed, 'multiplex check works on multiplexed data and detects missing row_ident';
 
 436 $csv = SL::Helper::Csv->new(
 
 437   file    => \"P;Kaffee;1,50\nC;Meier\n",
 
 439     [ 'datatype', 'description', 'listprice' ],
 
 440     [ 'datatype', 'name' ],
 
 443     { profile   => { listprice => 'listprice_as_number' },
 
 445     { class  => 'SL::DB::Customer',
 
 450 ok !$csv->_check_multiplexed, 'multiplex check works on multiplexed data and detects missing class';
 
 453 $csv = SL::Helper::Csv->new(
 
 454   file    => \"P;Kaffee;1,50\nC;Meier\n",  # " # make emacs happy
 
 456     [ 'datatype', 'description', 'listprice' ],
 
 459     { profile   => { listprice => 'listprice_as_number' },
 
 460       class     => 'SL::DB::Part',
 
 462     { class  => 'SL::DB::Customer',
 
 467 ok !$csv->_check_multiplexed, 'multiplex check works on multiplexed data and detects missing header';
 
 471 $csv = SL::Helper::Csv->new(
 
 472   file    => \"P;Kaffee;1,50\nC;Meier\n",  # " # make emacs happy
 
 474     [ 'datatype', 'description', 'listprice' ],
 
 475     [ 'datatype', 'name' ],
 
 478     { profile   => { listprice => 'listprice_as_number' },
 
 479       class     => 'SL::DB::Part',
 
 481     { class  => 'SL::DB::Customer',
 
 484   ignore_unknown_columns => 1,
 
 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';
 
 497 $csv = SL::Helper::Csv->new(
 
 498   file    => \"datatype;description;listprice\ndatatype;name\nP;Kaffee;1,50\nC;Meier\n",  # " # make emacs happy
 
 500     { profile   => { listprice => 'listprice_as_number' },
 
 501       class     => 'SL::DB::Part',
 
 503     { class  => 'SL::DB::Customer',
 
 506   ignore_unknown_columns => 1,
 
 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';
 
 516 $csv = SL::Helper::Csv->new(
 
 524 # " # make emacs happy
 
 526               {class  => 'SL::DB::Part',     row_ident => 'P'},
 
 527               {class  => 'SL::DB::Customer', row_ident => 'C'},
 
 529   ignore_unknown_columns => 1,
 
 531 is $csv->parse, undef, 'multiplex: broken csv header won\'t get parsed';
 
 535 $csv = SL::Helper::Csv->new(
 
 542 # " # make emacs happy
 
 544               {class  => 'SL::DB::Part',     row_ident => 'P'},
 
 545               {class  => 'SL::DB::Customer', row_ident => 'C'},
 
 547   header  => [ [], ['name'] ],
 
 548   ignore_unknown_columns => 1,
 
 550 ok !$csv->_check_multiplexed, 'multiplex check detects empty header';
 
 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
 
 563 # " # make emacs happy
 
 565               {class  => 'SL::DB::Part',     row_ident => 'P'},
 
 566               {class  => 'SL::DB::Customer', row_ident => 'C'},
 
 568   ignore_unknown_columns => 1,
 
 571 is $csv->_multiplex_datatype_position, 2, 'multiplex check detects datatype field position right';
 
 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}
 
 578                           'multiplex: datatype not at first position works';
 
 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"
 
 591 # " # make emacs happy
 
 593               {class  => 'SL::DB::Part',     row_ident => 'P'},
 
 594               {class  => 'SL::DB::Customer', row_ident => 'C'},
 
 596   ignore_unknown_columns => 1,
 
 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');
 
 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,
 
 609       profile   => { datatype => 'datatype', description => 'description' },
 
 610       class     => 'SL::DB::Part',
 
 614       profile   => { datatype => 'datatype', name => 'name' },
 
 615       class     => 'SL::DB::Customer',
 
 621 is_deeply $csv->get_data, [ { datatype => 'P', description => 'Kaffee' },
 
 622                             { datatype => 'C', name => 'Meier'} ],
 
 623                           'multiplex: case insensitive header from csv works';
 
 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,
 
 634       profile   => { datatype => 'datatype', description => 'description' },
 
 635       class     => 'SL::DB::Part',
 
 639       profile => { datatype => 'datatype', name => 'name' },
 
 640       class  => 'SL::DB::Customer',
 
 646 is_deeply $csv->get_data, [ { datatype => 'P', description => 'Kaffee' },
 
 647                             { datatype => 'C', name => 'Meier' } ],
 
 648                           'multiplex: case insensitive header as param works';
 
 653 $csv = SL::Helper::Csv->new(
 
 654   file   => \"P;Kaffee\nC;Meier",          # " # make emacs happy
 
 655   header =>  [[ 'Datatype', 'Description' ], [ 'Datatype', 'Name']],
 
 658       profile   => { datatype => 'datatype', description => 'description' },
 
 659       class     => 'SL::DB::Part',
 
 663       profile => { datatype => 'datatype', name => 'name' },
 
 664       class  => 'SL::DB::Customer',
 
 670 is_deeply $csv->get_data, undef, 'multiplex: case insensitive header without flag ignores';
 
 674 $csv = SL::Helper::Csv->new(
 
 679 # " # make emacs happy
 
 680   header => [[ 'datatype', 'Afoo', 'Abar' ], [ 'datatype', 'Bfoo', 'Bbar']],
 
 682     profile   => { datatype => '', Afoo => '', Abar => '' },
 
 683     class     => 'SL::DB::Part',
 
 687     profile   => { datatype => '', Bfoo => '', Bbar => '' },
 
 688     class     => 'SL::DB::Customer',
 
 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';
 
 701 $csv = SL::Helper::Csv->new(
 
 706 # " # make emacs happy
 
 707   header => [[ 'datatype', 'Afoo', 'Abar' ], [ 'datatype', 'Bfoo', 'Bbar']],
 
 710     profile   => { datatype => '', Afoo => '', Abar => '' },
 
 711     class     => 'SL::DB::Part',
 
 715     profile   => { datatype => '', Bfoo => '', Bbar => '' },
 
 716     class     => 'SL::DB::Customer',
 
 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)';
 
 731 # set emacs to perl mode