t/helper/csv.t

   1 use Test::More tests => 39;
   2 use SL::Dispatcher;
   3 use Data::Dumper;
   4 use utf8;
   5
   6 use_ok 'SL::Helper::Csv';
   7 my $csv;
   8
   9 $csv = SL::Helper::Csv->new(
  10   file   => \"Kaffee\n",
  11   header => [ 'description' ],
  12   class  => 'SL::DB::Part',
  13 );
  14
  15 isa_ok $csv->_csv, 'Text::CSV_XS';
  16 isa_ok $csv->_io, 'IO::File';
  17 isa_ok $csv->parse, 'SL::Helper::Csv', 'parsing returns self';
  18 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'simple case works';
  19
  20
  21 is $csv->get_objects->[0]->description, 'Kaffee', 'get_object works';
  22 ####
  23
  24 {
  25 no warnings 'once';
  26 $::dispatcher = SL::Dispatcher->new;
  27 $::dispatcher->pre_startup_setup();
  28 }
  29
  30 $::form = Form->new;
  31 $::myconfig{numberformat} = '1.000,00';
  32 $::myconfig{dateformat} = 'dd.mm.yyyy';
  33 $::locale = Locale->new('de');
  34
  35 $csv = SL::Helper::Csv->new(
  36   file   => \"Kaffee;0.12;12,2;1,5234\n",
  37   header => [ 'description', 'sellprice', 'lastcost_as_number', 'listprice' ],
  38   profile => { listprice => 'listprice_as_number' },
  39   class  => 'SL::DB::Part',
  40 );
  41 $csv->parse;
  42
  43 is $csv->get_objects->[0]->sellprice, 0.12, 'numeric attr works';
  44 is $csv->get_objects->[0]->lastcost, 12.2, 'attr helper works';
  45 is $csv->get_objects->[0]->listprice, 1.5234, 'dispatch works';
  46
  47 #####
  48
  49
  50 $csv = SL::Helper::Csv->new(
  51   file   => \<<EOL,
  52 description,sellprice,lastcost_as_number,listprice,
  53 Kaffee,0.12,'12,2','1,5234'
  54 EOL
  55   sep_char => ',',
  56   quote_char => "'",
  57   profile => { listprice => 'listprice_as_number' },
  58   class  => 'SL::DB::Part',
  59 );
  60 $csv->parse;
  61 is scalar @{ $csv->get_objects }, 1, 'auto header works';
  62 is $csv->get_objects->[0]->description, 'Kaffee', 'get_object works on auto header';
  63
  64 #####
  65
  66
  67 $csv = SL::Helper::Csv->new(
  68   file   => \<<EOL,
  69 ;;description;sellprice;lastcost_as_number;
  70 #####;Puppy;Kaffee;0.12;12,2;1,5234
  71 EOL
  72   class  => 'SL::DB::Part',
  73 );
  74 $csv->parse;
  75 is scalar @{ $csv->get_objects }, 1, 'bozo header doesn\'t blow things up';
  76
  77 #####
  78
  79 $csv = SL::Helper::Csv->new(
  80   file   => \<<EOL,
  81 description;partnumber;sellprice;lastcost_as_number;
  82 Kaffee;;0.12;12,2;1,5234
  83 Beer;1123245;0.12;12,2;1,5234
  84 EOL
  85   class  => 'SL::DB::Part',
  86 );
  87 $csv->parse;
  88 is scalar @{ $csv->get_objects }, 2, 'multiple objects work';
  89 is $csv->get_objects->[0]->description, 'Kaffee', 'first object';
  90 is $csv->get_objects->[1]->partnumber, '1123245', 'second object';
  91
  92 ####
  93
  94 $csv = SL::Helper::Csv->new(
  95   file   => \<<EOL,
  96 description;partnumber;sellprice;lastcost_as_number;
  97 Kaffee;;0.12;1,221.52
  98 Beer;1123245;0.12;1.5234
  99 EOL
 100   numberformat => '1,000.00',
 101   class  => 'SL::DB::Part',
 102 );
 103 $csv->parse;
 104 is $csv->get_objects->[0]->lastcost, '1221.52', 'formatnumber';
 105
 106 ######
 107
 108 $csv = SL::Helper::Csv->new(
 109   file   => \<<EOL,
 110 "description;partnumber;sellprice;lastcost_as_number;
 111 Kaffee;;0.12;1,221.52
 112 Beer;1123245;0.12;1.5234
 113 EOL
 114   numberformat => '1,000.00',
 115   class  => 'SL::DB::Part',
 116 );
 117 is $csv->parse, undef, 'broken csv header won\'t get parsed';
 118
 119 ######
 120
 121 $csv = SL::Helper::Csv->new(
 122   file   => \<<EOL,
 123 description;partnumber;sellprice;lastcost_as_number;
 124 "Kaf"fee";;0.12;1,221.52
 125 Beer;1123245;0.12;1.5234
 126 EOL
 127   numberformat => '1,000.00',
 128   class  => 'SL::DB::Part',
 129 );
 130 is $csv->parse, undef, 'broken csv content won\'t get parsed';
 131 is_deeply $csv->errors, [ '"Kaf"fee";;0.12;1,221.52'."\n", 2023, 'EIQ - QUO character not allowed', 5, 2 ], 'error';
 132 isa_ok( ($csv->errors)[0], 'SL::Helper::Csv::Error', 'Errors get objectified');
 133
 134 ####
 135
 136 $csv = SL::Helper::Csv->new(
 137   file   => \<<EOL,
 138 description;partnumber;sellprice;lastcost_as_number;wiener;
 139 Kaffee;;0.12;1,221.52;ja wiener
 140 Beer;1123245;0.12;1.5234;nein kein wieder
 141 EOL
 142   numberformat => '1,000.00',
 143   ignore_unknown_columns => 1,
 144   class  => 'SL::DB::Part',
 145 );
 146 $csv->parse;
 147 is $csv->get_objects->[0]->lastcost, '1221.52', 'ignore_unkown_columns works';
 148
 149 #####
 150
 151 $csv = SL::Helper::Csv->new(
 152   file   => \<<EOL,
 153 description;partnumber;sellprice;lastcost_as_number;buchungsgruppe;
 154 Kaffee;;0.12;1,221.52;Standard 7%
 155 Beer;1123245;0.12;1.5234;16 %
 156 EOL
 157   numberformat => '1,000.00',
 158   class  => 'SL::DB::Part',
 159   profile => {
 160     buchungsgruppe => "buchungsgruppen.description",
 161   }
 162 );
 163 $csv->parse;
 164 isa_ok $csv->get_objects->[0]->buchungsgruppe, 'SL::DB::Buchungsgruppe', 'deep dispatch auto vivify works';
 165 is $csv->get_objects->[0]->buchungsgruppe->description, 'Standard 7%', '...and gets set correctly';
 166
 167
 168 #####
 169
 170 $csv = SL::Helper::Csv->new(
 171   file   => \<<EOL,
 172 description;partnumber;sellprice;lastcost_as_number;make_1;model_1;
 173   Kaffee;;0.12;1,221.52;213;Chair 0815
 174 Beer;1123245;0.12;1.5234;
 175 EOL
 176   numberformat => '1,000.00',
 177   class  => 'SL::DB::Part',
 178   profile => {
 179     make_1 => "makemodels.0.make",
 180     model_1 => "makemodels.0.model",
 181   }
 182 );
 183 $csv->parse;
 184 my @mm = $csv->get_objects->[0]->makemodel;
 185 is scalar @mm,  1, 'one-to-many dispatch';
 186 is $csv->get_objects->[0]->makemodels->[0]->model, 'Chair 0815', '... and works';
 187
 188 #####
 189
 190
 191 $csv = SL::Helper::Csv->new(
 192   file   => \<<EOL,
 193 description;partnumber;sellprice;lastcost_as_number;make_1;model_1;make_2;model_2;
 194  Kaffee;;0.12;1,221.52;213;Chair 0815;523;Table 15
 195 EOL
 196   numberformat => '1,000.00',
 197   class  => 'SL::DB::Part',
 198   profile => {
 199     make_1 => "makemodels.0.make",
 200     model_1 => "makemodels.0.model",
 201     make_2 => "makemodels.1.make",
 202     model_2 => "makemodels.1.model",
 203   }
 204 );
 205 $csv->parse;
 206
 207 print Dumper($csv->errors);
 208
 209 @mm = $csv->get_objects->[0]->makemodel;
 210 is scalar @mm,  1, 'multiple one-to-many dispatch';
 211 is $csv->get_objects->[0]->makemodels->[0]->model, 'Chair 0815', '...check 1';
 212 is $csv->get_objects->[0]->makemodels->[0]->make, '213', '...check 2';
 213 is $csv->get_objects->[0]->makemodels->[1]->model, 'Table 15', '...check 3';
 214 is $csv->get_objects->[0]->makemodels->[1]->make, '523', '...check 4';
 215
 216 ######
 217
 218 $csv = SL::Helper::Csv->new(
 219   file   => \<<EOL,
 220 description;partnumber;sellprice;lastcost_as_number;buchungsgruppe;
 221 EOL
 222   numberformat => '1,000.00',
 223   class  => 'SL::DB::Part',
 224   profile => {
 225     buchungsgruppe => "buchungsgruppen.1.description",
 226   }
 227 );
 228 is $csv->parse, undef, 'wrong profile gets rejected';
 229 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';
 230 isa_ok( ($csv->errors)[0], 'SL::Helper::Csv::Error', 'Errors get objectified');
 231
 232 ####
 233
 234 $csv = SL::Helper::Csv->new(
 235   file   => \<<EOL,
 236 description;partnumber;sellprice;lastcost;wiener;
 237 Kaffee;;0.12;1,221.52;ja wiener
 238 Beer;1123245;0.12;1.5234;nein kein wieder
 239 EOL
 240   numberformat => '1,000.00',
 241   ignore_unknown_columns => 1,
 242   strict_profile => 1,
 243   class  => 'SL::DB::Part',
 244   profile => {
 245     lastcost => 'lastcost_as_number',
 246   }
 247 );
 248 $csv->parse;
 249 is $csv->get_objects->[0]->lastcost, '1221.52', 'strict_profile with ignore';
 250 is $csv->get_objects->[0]->sellprice, undef,  'strict profile with ignore 2';
 251
 252 ####
 253
 254 $csv = SL::Helper::Csv->new(
 255   file   => \<<EOL,
 256 description;partnumber;sellprice;lastcost;wiener;
 257 Kaffee;;0.12;1,221.52;ja wiener
 258 Beer;1123245;0.12;1.5234;nein kein wieder
 259 EOL
 260   numberformat => '1,000.00',
 261   strict_profile => 1,
 262   class  => 'SL::DB::Part',
 263   profile => {
 264     lastcost => 'lastcost_as_number',
 265   }
 266 );
 267 $csv->parse;
 268
 269 is_deeply( ($csv->errors)[0], [ 'description', undef, 'header field \'description\' is not recognized', undef, 0 ], 'strict_profile without ignore_columns throws error');
 270
 271 #####
 272
 273 $csv = SL::Helper::Csv->new(
 274   file   => \"Kaffee",
 275   header => [ 'description' ],
 276   class  => 'SL::DB::Part',
 277 );
 278 $csv->parse;
 279 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'eol bug at the end of files';
 280
 281 #####
 282
 283 $csv = SL::Helper::Csv->new(
 284   file   => \"Description\nKaffee",
 285   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   class  => 'SL::DB::Part',
 296 );
 297 $csv->parse;
 298 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'case insensitive header as param works';
 299
 300 # vim: ft=perl