t/helper/csv.t

   1 use Test::More tests => 47;
   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",
  15   header => [ 'description' ],
  16   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 => { 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 => { 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   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   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   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   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   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   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   class  => 'SL::DB::Part',
 154   profile => {
 155     buchungsgruppe => "buchungsgruppen.description",
 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   class  => 'SL::DB::Part',
 173   profile => {
 174     make_1 => "makemodels.0.make",
 175     model_1 => "makemodels.0.model",
 176   }
 177 );
 178 $csv->parse;
 179 my @mm = $csv->get_objects->[0]->makemodel;
 180 is scalar @mm,  1, 'one-to-many dispatch';
 181 is $csv->get_objects->[0]->makemodels->[0]->model, 'Chair 0815', '... and works';
 182
 183 #####
 184
 185
 186 $csv = SL::Helper::Csv->new(
 187   file   => \<<EOL,
 188 description;partnumber;sellprice;lastcost_as_number;make_1;model_1;make_2;model_2;
 189  Kaffee;;0.12;1,221.52;213;Chair 0815;523;Table 15
 190 EOL
 191   numberformat => '1,000.00',
 192   class  => 'SL::DB::Part',
 193   profile => {
 194     make_1 => "makemodels.0.make",
 195     model_1 => "makemodels.0.model",
 196     make_2 => "makemodels.1.make",
 197     model_2 => "makemodels.1.model",
 198   }
 199 );
 200 $csv->parse;
 201
 202 print Dumper($csv->errors);
 203
 204 @mm = $csv->get_objects->[0]->makemodel;
 205 is scalar @mm,  1, 'multiple one-to-many dispatch';
 206 is $csv->get_objects->[0]->makemodels->[0]->model, 'Chair 0815', '...check 1';
 207 is $csv->get_objects->[0]->makemodels->[0]->make, '213', '...check 2';
 208 is $csv->get_objects->[0]->makemodels->[1]->model, 'Table 15', '...check 3';
 209 is $csv->get_objects->[0]->makemodels->[1]->make, '523', '...check 4';
 210
 211 ######
 212
 213 $csv = SL::Helper::Csv->new(
 214   file   => \<<EOL,
 215 description;partnumber;sellprice;lastcost_as_number;buchungsgruppe;
 216 EOL
 217   numberformat => '1,000.00',
 218   class  => 'SL::DB::Part',
 219   profile => {
 220     buchungsgruppe => "buchungsgruppen.1.description",
 221   }
 222 );
 223 is $csv->parse, undef, 'wrong profile gets rejected';
 224 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';
 225 isa_ok( ($csv->errors)[0], 'SL::Helper::Csv::Error', 'Errors get objectified');
 226
 227 ####
 228
 229 $csv = SL::Helper::Csv->new(
 230   file   => \<<EOL,
 231 description;partnumber;sellprice;lastcost;wiener;
 232 Kaffee;;0.12;1,221.52;ja wiener
 233 Beer;1123245;0.12;1.5234;nein kein wieder
 234 EOL
 235   numberformat => '1,000.00',
 236   ignore_unknown_columns => 1,
 237   strict_profile => 1,
 238   class  => 'SL::DB::Part',
 239   profile => {
 240     lastcost => 'lastcost_as_number',
 241   }
 242 );
 243 $csv->parse;
 244 is $csv->get_objects->[0]->lastcost, '1221.52', 'strict_profile with ignore';
 245 is $csv->get_objects->[0]->sellprice, undef,  'strict profile with ignore 2';
 246
 247 ####
 248
 249 $csv = SL::Helper::Csv->new(
 250   file   => \<<EOL,
 251 description;partnumber;sellprice;lastcost;wiener;
 252 Kaffee;;0.12;1,221.52;ja wiener
 253 Beer;1123245;0.12;1.5234;nein kein wieder
 254 EOL
 255   numberformat => '1,000.00',
 256   strict_profile => 1,
 257   class  => 'SL::DB::Part',
 258   profile => {
 259     lastcost => 'lastcost_as_number',
 260   }
 261 );
 262 $csv->parse;
 263
 264 is_deeply( ($csv->errors)[0], [ 'description', undef, 'header field \'description\' is not recognized', undef, 0 ], 'strict_profile without ignore_columns throws error');
 265
 266 #####
 267
 268 $csv = SL::Helper::Csv->new(
 269   file   => \"Kaffee",
 270   header => [ 'description' ],
 271   class  => 'SL::DB::Part',
 272 );
 273 $csv->parse;
 274 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'eol bug at the end of files';
 275
 276 #####
 277
 278 $csv = SL::Helper::Csv->new(
 279   file   => \"Description\nKaffee",
 280   class  => 'SL::DB::Part',
 281   case_insensitive_header => 1,
 282   profile => { description => 'description' },
 283 );
 284 $csv->parse;
 285 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'case insensitive header from csv works';
 286
 287 #####
 288
 289 $csv = SL::Helper::Csv->new(
 290   file   => \"Kaffee",
 291   header => [ 'Description' ],
 292   class  => 'SL::DB::Part',
 293   case_insensitive_header => 1,
 294   profile => { description => 'description' },
 295 );
 296 $csv->parse;
 297 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'case insensitive header as param works';
 298
 299 #####
 300
 301 $csv = SL::Helper::Csv->new(
 302   file   => \"\x{EF}\x{BB}\x{BF}description\nKaffee",
 303   class  => 'SL::DB::Part',
 304   encoding => 'utf8',
 305 );
 306 $csv->parse;
 307 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'utf8 BOM works (bug 1872)';
 308
 309 #####
 310
 311 $csv = SL::Helper::Csv->new(
 312   file   => \"Kaffee",
 313   header => [ 'Description' ],
 314   class  => 'SL::DB::Part',
 315 );
 316 $csv->parse;
 317 is_deeply $csv->get_data, undef, 'case insensitive header without flag ignores';
 318
 319 #####
 320
 321 $csv = SL::Helper::Csv->new(
 322   file   => \"Kaffee",
 323   header => [ 'foo' ],
 324   class  => 'SL::DB::Part',
 325   profile => { foo => '' },
 326 );
 327 $csv->parse;
 328
 329 is_deeply $csv->get_data, [ { foo => 'Kaffee' } ], 'empty path still gets parsed into data';
 330 ok $csv->get_objects->[0], 'empty path gets ignored in object creation';
 331
 332 #####
 333
 334 $csv = SL::Helper::Csv->new(
 335   file   => \"Kaffee",
 336   header => [ 'foo' ],
 337   class  => 'SL::DB::Part',
 338   strict_profile => 1,
 339   profile => { foo => '' },
 340 );
 341 $csv->parse;
 342
 343 is_deeply $csv->get_data, [ { foo => 'Kaffee' } ], 'empty path still gets parsed into data (strict profile)';
 344 ok $csv->get_objects->[0], 'empty path gets ignored in object creation (strict profile)';
 345
 346 $csv = SL::Helper::Csv->new(
 347   file   => \"Phil",
 348   header => [ 'CVAR_grOUnDHog' ],
 349   class  => 'SL::DB::Part',
 350   strict_profile => 1,
 351   case_insensitive_header => 1,
 352   profile => { cvar_Groundhog => '' },
 353 );
 354 $csv->parse;
 355
 356 is_deeply $csv->get_data, [ { cvar_Groundhog => 'Phil' } ], 'using empty path to get cvars working';
 357 ok $csv->get_objects->[0], '...and not destorying the objects';
 358
 359 # vim: ft=perl