t/helper/csv.t

   1 use Test::More tests => 29;
   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
 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 my @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 # vim: ft=perl