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   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   case_insensitive_header => 1,
 296   profile => {profile => { description => 'description' }, class  => 'SL::DB::Part'},
 297 );
 298 $csv->parse;
 299 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'case insensitive header as param works';
 300
 301 #####
 302
 303 $csv = SL::Helper::Csv->new(
 304   file   => \"\x{EF}\x{BB}\x{BF}description\nKaffee",
 305   profile => {class  => 'SL::DB::Part'},
 306   encoding => 'utf8',
 307 );
 308 $csv->parse;
 309 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'utf8 BOM works (bug 1872)';
 310
 311 #####
 312
 313 $csv = SL::Helper::Csv->new(
 314   file   => \"Kaffee",
 315   header => [ 'Description' ],
 316   class  => 'SL::DB::Part',
 317 );
 318 $csv->parse;
 319 is_deeply $csv->get_data, undef, 'case insensitive header without flag ignores';
 320
 321 #####
 322
 323 $csv = SL::Helper::Csv->new(
 324   file   => \"Kaffee",
 325   header => [ 'foo' ],
 326   class  => 'SL::DB::Part',
 327   profile => { foo => '' },
 328 );
 329 $csv->parse;
 330
 331 is_deeply $csv->get_data, [ { foo => 'Kaffee' } ], 'empty path still gets parsed into data';
 332 ok $csv->get_objects->[0], 'empty path gets ignored in object creation';
 333
 334 #####
 335
 336 $csv = SL::Helper::Csv->new(
 337   file   => \"Kaffee",
 338   header => [ 'foo' ],
 339   class  => 'SL::DB::Part',
 340   strict_profile => 1,
 341   profile => { foo => '' },
 342 );
 343 $csv->parse;
 344
 345 is_deeply $csv->get_data, [ { foo => 'Kaffee' } ], 'empty path still gets parsed into data (strict profile)';
 346 ok $csv->get_objects->[0], 'empty path gets ignored in object creation (strict profile)';
 347
 348 $csv = SL::Helper::Csv->new(
 349   file   => \"Phil",
 350   header => [ 'CVAR_grOUnDHog' ],
 351   class  => 'SL::DB::Part',
 352   strict_profile => 1,
 353   case_insensitive_header => 1,
 354   profile => { cvar_Groundhog => '' },
 355 );
 356 $csv->parse;
 357
 358 is_deeply $csv->get_data, [ { cvar_Groundhog => 'Phil' } ], 'using empty path to get cvars working';
 359 ok $csv->get_objects->[0], '...and not destorying the objects';
 360
 361 $csv = SL::Helper::Csv->new(
 362   file   => \"description\nKaffee",
 363 );
 364 $csv->parse;
 365 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'without profile and class works';
 366
 367 # vim: ft=perl