t/helper/csv.t

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