t/helper/csv.t

   1 use Test::More tests => 58;
   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",
  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   numberformat => '1,000.00',
 110   profile => [{class  => 'SL::DB::Part'}],
 111 );
 112 is $csv->parse, undef, 'broken csv header won\'t get parsed';
 113
 114 ######
 115
 116 $csv = SL::Helper::Csv->new(
 117   file   => \<<EOL,
 118 description;partnumber;sellprice;lastcost_as_number;
 119 "Kaf"fee";;0.12;1,221.52
 120 Beer;1123245;0.12;1.5234
 121 EOL
 122   numberformat => '1,000.00',
 123   profile => [{class  => 'SL::DB::Part'}],
 124 );
 125 is $csv->parse, undef, 'broken csv content won\'t get parsed';
 126 is_deeply $csv->errors, [ '"Kaf"fee";;0.12;1,221.52'."\n", 2023, 'EIQ - QUO character not allowed', 5, 2 ], 'error';
 127 isa_ok( ($csv->errors)[0], 'SL::Helper::Csv::Error', 'Errors get objectified');
 128
 129 ####
 130
 131 $csv = SL::Helper::Csv->new(
 132   file   => \<<EOL,
 133 description;partnumber;sellprice;lastcost_as_number;wiener;
 134 Kaffee;;0.12;1,221.52;ja wiener
 135 Beer;1123245;0.12;1.5234;nein kein wieder
 136 EOL
 137   numberformat => '1,000.00',
 138   ignore_unknown_columns => 1,
 139   profile => [{class  => 'SL::DB::Part'}],
 140 );
 141 $csv->parse;
 142 is $csv->get_objects->[0]->lastcost, '1221.52', 'ignore_unkown_columns works';
 143
 144 #####
 145
 146 $csv = SL::Helper::Csv->new(
 147   file   => \<<EOL,
 148 description;partnumber;sellprice;lastcost_as_number;buchungsgruppe;
 149 Kaffee;;0.12;1,221.52;Standard 7%
 150 Beer;1123245;0.12;1.5234;16 %
 151 EOL
 152   numberformat => '1,000.00',
 153   profile => [{
 154     profile => {buchungsgruppe => "buchungsgruppen.description"},
 155     class  => 'SL::DB::Part',
 156   }]
 157 );
 158 $csv->parse;
 159 isa_ok $csv->get_objects->[0]->buchungsgruppe, 'SL::DB::Buchungsgruppe', 'deep dispatch auto vivify works';
 160 is $csv->get_objects->[0]->buchungsgruppe->description, 'Standard 7%', '...and gets set correctly';
 161
 162
 163 #####
 164
 165 $csv = SL::Helper::Csv->new(
 166   file   => \<<EOL,
 167 description;partnumber;sellprice;lastcost_as_number;make_1;model_1;
 168   Kaffee;;0.12;1,221.52;213;Chair 0815
 169 Beer;1123245;0.12;1.5234;
 170 EOL
 171   numberformat => '1,000.00',
 172   profile => [{
 173     profile => {
 174       make_1 => "makemodels.0.make",
 175       model_1 => "makemodels.0.model",
 176     },
 177     class  => 'SL::DB::Part',
 178   }],
 179 );
 180 $csv->parse;
 181 my @mm = $csv->get_objects->[0]->makemodel;
 182 is scalar @mm,  1, 'one-to-many dispatch';
 183 is $csv->get_objects->[0]->makemodels->[0]->model, 'Chair 0815', '... and works';
 184
 185 #####
 186
 187
 188 $csv = SL::Helper::Csv->new(
 189   file   => \<<EOL,
 190 description;partnumber;sellprice;lastcost_as_number;make_1;model_1;make_2;model_2;
 191  Kaffee;;0.12;1,221.52;213;Chair 0815;523;Table 15
 192 EOL
 193   numberformat => '1,000.00',
 194   profile => [{
 195     profile => {
 196       make_1 => "makemodels.0.make",
 197       model_1 => "makemodels.0.model",
 198       make_2 => "makemodels.1.make",
 199       model_2 => "makemodels.1.model",
 200     },
 201     class  => 'SL::DB::Part',
 202   }]
 203 );
 204 $csv->parse;
 205
 206 print Dumper($csv->errors);
 207
 208 @mm = $csv->get_objects->[0]->makemodel;
 209 is scalar @mm,  1, 'multiple one-to-many dispatch';
 210 is $csv->get_objects->[0]->makemodels->[0]->model, 'Chair 0815', '...check 1';
 211 is $csv->get_objects->[0]->makemodels->[0]->make, '213', '...check 2';
 212 is $csv->get_objects->[0]->makemodels->[1]->model, 'Table 15', '...check 3';
 213 is $csv->get_objects->[0]->makemodels->[1]->make, '523', '...check 4';
 214
 215 ######
 216
 217 $csv = SL::Helper::Csv->new(
 218   file   => \<<EOL,
 219 description;partnumber;sellprice;lastcost_as_number;buchungsgruppe;
 220 EOL
 221   numberformat => '1,000.00',
 222   profile => [{
 223     profile => {buchungsgruppe => "buchungsgruppen.1.description"},
 224     class  => 'SL::DB::Part',
 225   }]
 226 );
 227 is $csv->parse, undef, 'wrong profile gets rejected';
 228 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';
 229 isa_ok( ($csv->errors)[0], 'SL::Helper::Csv::Error', 'Errors get objectified');
 230
 231 ####
 232
 233 $csv = SL::Helper::Csv->new(
 234   file   => \<<EOL,
 235 description;partnumber;sellprice;lastcost;wiener;
 236 Kaffee;;0.12;1,221.52;ja wiener
 237 Beer;1123245;0.12;1.5234;nein kein wieder
 238 EOL
 239   numberformat => '1,000.00',
 240   ignore_unknown_columns => 1,
 241   strict_profile => 1,
 242   profile => [{
 243     profile => {lastcost => 'lastcost_as_number'},
 244     class  => 'SL::DB::Part',
 245   }]
 246 );
 247 $csv->parse;
 248 is $csv->get_objects->[0]->lastcost, '1221.52', 'strict_profile with ignore';
 249 is $csv->get_objects->[0]->sellprice, undef,  'strict profile with ignore 2';
 250
 251 ####
 252
 253 $csv = SL::Helper::Csv->new(
 254   file   => \<<EOL,
 255 description;partnumber;sellprice;lastcost;wiener;
 256 Kaffee;;0.12;1,221.52;ja wiener
 257 Beer;1123245;0.12;1.5234;nein kein wieder
 258 EOL
 259   numberformat => '1,000.00',
 260   strict_profile => 1,
 261   profile => [{
 262     profile => {lastcost => 'lastcost_as_number'},
 263     class  => 'SL::DB::Part',
 264   }]
 265 );
 266 $csv->parse;
 267
 268 is_deeply( ($csv->errors)[0], [ 'description', undef, 'header field \'description\' is not recognized', undef, 0 ], 'strict_profile without ignore_columns throws error');
 269
 270 #####
 271
 272 $csv = SL::Helper::Csv->new(
 273   file   => \"Kaffee",
 274   header =>  [[ 'description' ]],
 275   profile => [{class  => 'SL::DB::Part'}],
 276 );
 277 $csv->parse;
 278 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'eol bug at the end of files';
 279
 280 #####
 281
 282 $csv = SL::Helper::Csv->new(
 283   file   => \"Description\nKaffee",
 284   case_insensitive_header => 1,
 285   profile => [ {profile => { description => 'description' }, class  => 'SL::DB::Part'} ],
 286 );
 287 $csv->parse;
 288 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'case insensitive header from csv works';
 289
 290 #####
 291
 292 $csv = SL::Helper::Csv->new(
 293   file   => \"Kaffee",
 294   header =>  [[ 'Description' ]],
 295   profile => [{profile => { description => 'description' }, {class  => 'SL::DB::Part'}],
 296 );
 297 $csv->parse;
 298 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'case insensitive header as param works';
 299
 300 #####
 301
 302 $csv = SL::Helper::Csv->new(
 303   file   => \"\x{EF}\x{BB}\x{BF}description\nKaffee",
 304   profile => [{class  => 'SL::DB::Part'}],
 305   encoding => 'utf8',
 306 );
 307 $csv->parse;
 308 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'utf8 BOM works (bug 1872)';
 309
 310 #####
 311
 312 $csv = SL::Helper::Csv->new(
 313   file   => \"Kaffee",
 314   header => [[ 'Description' ]],
 315   profile => [{class  => 'SL::DB::Part'}],
 316 );
 317 $csv->parse;
 318 is_deeply $csv->get_data, undef, 'case insensitive header without flag ignores';
 319
 320 #####
 321 $csv = SL::Helper::Csv->new(
 322   file    => \"Kaffee;1,50\nSchoke;0,89\n",
 323   header  => [
 324     [ 'datatype', 'description', 'sellprice' ],
 325   ],
 326   profile => [
 327     { profile   => { sellprice => 'sellprice_as_number' },
 328       class     => 'SL::DB::Part',}
 329   ],
 330 );
 331
 332 ok $csv->_check_multiplexed, 'multiplex check works on not-multiplexed data';
 333 ok !$csv->is_multiplexed, 'not-multiplexed data is recognized';
 334
 335 #####
 336 $csv = SL::Helper::Csv->new(
 337   file    => \"P;Kaffee;1,50\nC;Meier\n",
 338   header  => [
 339     [ 'datatype', 'description', 'listprice' ],
 340     [ 'datatype', 'name' ],
 341   ],
 342   profile => [
 343     { profile   => { listprice => 'listprice_as_number' },
 344       class     => 'SL::DB::Part',
 345       row_ident => 'P' },
 346     { class  => 'SL::DB::Customer',
 347       row_ident => 'C' }
 348   ],
 349 );
 350 $csv->parse;
 351
 352 ok $csv->_check_multiplexed, 'multiplex check works on multiplexed data';
 353 ok $csv->is_multiplexed, 'multiplexed data is recognized';
 354
 355 #####
 356 $csv = SL::Helper::Csv->new(
 357   file    => \"P;Kaffee;1,50\nC;Meier\n",
 358   header  => [
 359     [ 'datatype', 'description', 'listprice' ],
 360     [ 'datatype', 'name' ],
 361   ],
 362   profile => [
 363     { profile   => { listprice => 'listprice_as_number' },
 364       class     => 'SL::DB::Part', },
 365     { class  => 'SL::DB::Customer',
 366       row_ident => 'C' }
 367   ],
 368 );
 369
 370 ok !$csv->_check_multiplexed, 'multiplex check works on multiplexed data an detects missing row_ident';
 371
 372 #####
 373 $csv = SL::Helper::Csv->new(
 374   file    => \"P;Kaffee;1,50\nC;Meier\n",
 375   header  => [
 376     [ 'datatype', 'description', 'listprice' ],
 377     [ 'datatype', 'name' ],
 378   ],
 379   profile => [
 380     { profile   => { listprice => 'listprice_as_number' },
 381       row_ident => 'P' },
 382     { class  => 'SL::DB::Customer',
 383       row_ident => 'C' }
 384   ],
 385 );
 386 $csv->parse;
 387
 388 ok !$csv->_check_multiplexed, 'multiplex check works on multiplexed data an detects missing class';
 389
 390 #####
 391 $csv = SL::Helper::Csv->new(
 392   file    => \"P;Kaffee;1,50\nC;Meier\n",  # " # make emacs happy
 393   header  => [
 394     [ 'datatype', 'description', 'listprice' ],
 395   ],
 396   profile => [
 397     { profile   => { listprice => 'listprice_as_number' },
 398       class     => 'SL::DB::Part',
 399       row_ident => 'P' },
 400     { class  => 'SL::DB::Customer',
 401       row_ident => 'C' }
 402   ],
 403 );
 404
 405 ok !$csv->_check_multiplexed, 'multiplex check works on multiplexed data an detects missing header';
 406
 407 #####
 408
 409 $csv = SL::Helper::Csv->new(
 410   file    => \"P;Kaffee;1,50\nC;Meier\n",  # " # make emacs happy
 411   header  => [
 412     [ 'datatype', 'description', 'listprice' ],
 413     [ 'datatype', 'name' ],
 414   ],
 415   profile => [
 416     { profile   => { listprice => 'listprice_as_number' },
 417       class     => 'SL::DB::Part',
 418       row_ident => 'P' },
 419     { class  => 'SL::DB::Customer',
 420       row_ident => 'C' }
 421   ],
 422   ignore_unknown_columns => 1,
 423 );
 424 $csv->parse;
 425 is_deeply $csv->get_data,
 426     [ { datatype => 'P', description => 'Kaffee', listprice => '1,50' }, { datatype => 'C', name => 'Meier' } ],
 427     'multiplex: simple case works';
 428 is scalar @{ $csv->get_objects }, 2, 'multiplex: multiple objects work';
 429 is $csv->get_objects->[0]->description, 'Kaffee', 'multiplex: first object';
 430 is $csv->get_objects->[1]->name,        'Meier',  'multiplex: second object';
 431
 432 #####
 433
 434 $csv = SL::Helper::Csv->new(
 435   file    => \"datatype;description;listprice\ndatatype;name\nP;Kaffee;1,50\nC;Meier\n",  # " # make emacs happy
 436   profile => [
 437     { profile   => { listprice => 'listprice_as_number' },
 438       class     => 'SL::DB::Part',
 439       row_ident => 'P' },
 440     { class  => 'SL::DB::Customer',
 441       row_ident => 'C' }
 442   ],
 443   ignore_unknown_columns => 1,
 444 );
 445
 446 $csv->parse;
 447 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'without profile and class works';
 448
 449 ######
 450
 451 $csv = SL::Helper::Csv->new(
 452   file   => \<<EOL,
 453 datatype;description
 454 "datatype;name
 455 P;Kaffee
 456 C;Meier
 457 P;Beer
 458 EOL
 459 # " # make emacs happy
 460   profile => [
 461               {class  => 'SL::DB::Part',     row_ident => 'P'},
 462               {class  => 'SL::DB::Customer', row_ident => 'C'},
 463              ],
 464   ignore_unknown_columns => 1,
 465 );
 466 is $csv->parse, undef, 'multiplex: broken csv header won\'t get parsed';
 467
 468 ######
 469
 470 $csv = SL::Helper::Csv->new(
 471   file   => \<<EOL,
 472 datatype;description
 473 P;Kaffee
 474 C;Meier
 475 P;Beer
 476 EOL
 477 # " # make emacs happy
 478   profile => [
 479               {class  => 'SL::DB::Part',     row_ident => 'P'},
 480               {class  => 'SL::DB::Customer', row_ident => 'C'},
 481              ],
 482   header  => [ [], ['name'] ],
 483   ignore_unknown_columns => 1,
 484 );
 485 ok !$csv->_check_multiplexed, 'multiplex check detects empty header';
 486
 487
 488 # vim: ft=perl
 489 # set emacs to perl mode
 490 # Local Variables:
 491 # mode: perl
 492 # End:
 493