1#!/usr/bin/perl 2 3use strict; 4$^W = 1; 5 6#use Test::More "no_plan"; 7 use Test::More tests => 58; 8 9BEGIN { 10 $ENV{PERL_TEXT_CSV} = $ENV{TEST_PERL_TEXT_CSV} || 0; 11 use_ok "Text::CSV", ("csv"); 12 plan skip_all => "Cannot load Text::CSV" if $@; 13 require "./t/util.pl"; 14 } 15 16my $tfn = "_91test.csv"; END { -f $tfn and unlink $tfn } 17my $data = 18 "foo,bar,baz\n". 19 "1,2,3\n". 20 "2,a b,\n"; 21open my $fh, ">", $tfn or die "$tfn: $!"; 22print $fh $data; 23close $fh; 24 25my $aoa = [ 26 [qw( foo bar baz )], 27 [ 1, 2, 3 ], 28 [ 2, "a b", "" ], 29 ]; 30my $aoh = [ 31 { foo => 1, bar => 2, baz => 3 }, 32 { foo => 2, bar => "a b", baz => "" }, 33 ]; 34 35for (qw( after_in on_in before_out )) { 36 is_deeply (csv (in => $tfn, $_ => sub {}), $aoa, "callback $_ on AOA with empty sub"); 37 is_deeply (csv (in => $tfn, callbacks => { $_ => sub {} }), $aoa, "callback $_ on AOA with empty sub"); 38 } 39is_deeply (csv (in => $tfn, after_in => sub {}, 40 callbacks => { on_in => sub {} }), $aoa, "callback after_in and on_in on AOA"); 41 42for (qw( after_in on_in before_out )) { 43 is_deeply (csv (in => $tfn, headers => "auto", $_ => sub {}), $aoh, "callback $_ on AOH with empty sub"); 44 is_deeply (csv (in => $tfn, headers => "auto", callbacks => { $_ => sub {} }), $aoh, "callback $_ on AOH with empty sub"); 45 } 46is_deeply (csv (in => $tfn, headers => "auto", after_in => sub {}, 47 callbacks => { on_in => sub {} }), $aoh, "callback after_in and on_in on AOH"); 48 49is_deeply (csv (in => $tfn, after_in => sub { push @{$_[1]}, "A" }), [ 50 [qw( foo bar baz A )], 51 [ 1, 2, 3, "A" ], 52 [ 2, "a b", "", "A" ], 53 ], "AOA ith after_in callback"); 54 55is_deeply (csv (in => $tfn, headers => "auto", after_in => sub { $_[1]{baz} = "A" }), [ 56 { foo => 1, bar => 2, baz => "A" }, 57 { foo => 2, bar => "a b", baz => "A" }, 58 ], "AOH with after_in callback"); 59 60is_deeply (csv (in => $tfn, filter => { 2 => sub { /a/ }}), [ 61 [qw( foo bar baz )], 62 [ 2, "a b", "" ], 63 ], "AOA with filter on col 2"); 64is_deeply (csv (in => $tfn, filter => { 2 => sub { /a/ }, 65 1 => sub { length > 1 }}), [ 66 [qw( foo bar baz )], 67 ], "AOA with filter on col 1 and 2"); 68is_deeply (csv (in => $tfn, filter => { foo => sub { $_ > 1 }}), [ 69 { foo => 2, bar => "a b", baz => "" }, 70 ], "AOH with filter on column name"); 71 72is_deeply (csv (in => $tfn, headers => "lc"), 73 [ { foo => 1, bar => 2, baz => 3 }, 74 { foo => 2, bar => "a b", baz => "" }], 75 "AOH with lc headers"); 76is_deeply (csv (in => $tfn, headers => "uc"), 77 [ { FOO => 1, BAR => 2, BAZ => 3 }, 78 { FOO => 2, BAR => "a b", BAZ => "" }], 79 "AOH with lc headers"); 80is_deeply (csv (in => $tfn, headers => sub { lcfirst uc $_[0] }), 81 [ { fOO => 1, bAR => 2, bAZ => 3 }, 82 { fOO => 2, bAR => "a b", bAZ => "" }], 83 "AOH with mangled headers"); 84 85SKIP: { 86 $] < 5.008001 and skip "No BOM support in $]", 1; 87 is_deeply (csv (in => $tfn, munge => { bar => "boo" }), 88 [{ baz => 3, boo => 2, foo => 1 }, 89 { baz => "", boo => "a b", foo => 2 }], "Munge with hash"); 90 } 91 92open $fh, ">>", $tfn or die "$tfn: $!"; 93print $fh <<"EOD"; 943,3,3 954,5,6 965,7,9 976,9,12 987,11,15 998,13,18 100EOD 101close $fh; 102 103is_deeply (csv (in => $tfn, 104 filter => { foo => sub { $_ > 2 && $_[1][2] - $_[1][1] < 4 }}), [ 105 { foo => 3, bar => 3, baz => 3 }, 106 { foo => 4, bar => 5, baz => 6 }, 107 { foo => 5, bar => 7, baz => 9 }, 108 { foo => 6, bar => 9, baz => 12 }, 109 ], "AOH with filter on column name + on other numbered fields"); 110 111is_deeply (csv (in => $tfn, 112 filter => { foo => sub { $_ > 2 && $_{baz} - $_{bar} < 4 }}), [ 113 { foo => 3, bar => 3, baz => 3 }, 114 { foo => 4, bar => 5, baz => 6 }, 115 { foo => 5, bar => 7, baz => 9 }, 116 { foo => 6, bar => 9, baz => 12 }, 117 ], "AOH with filter on column name + on other named fields"); 118 119# Check content ref in on_in AOA 120{ my $aoa = csv ( 121 in => $tfn, 122 filter => { 1 => sub { m/^[3-9]/ }}, 123 on_in => sub { 124 is ($_[1][1], 2 * $_[1][0] - 3, "AOA $_[1][0]: b = 2a - 3 \$_[1][]"); 125 }); 126 } 127# Check content ref in on_in AOH 128{ my $aoa = csv ( 129 in => $tfn, 130 headers => "auto", 131 filter => { foo => sub { m/^[3-9]/ }}, 132 after_parse => sub { 133 is ($_[1]{bar}, 2 * $_[1]{foo} - 3, "AOH $_[1]{foo}: b = 2a - 3 \$_[1]{}"); 134 }); 135 } 136# Check content ref in on_in AOH with aliases %_ 137{ %_ = ( brt => 42 ); 138 my $aoa = csv ( 139 in => $tfn, 140 headers => "auto", 141 filter => { foo => sub { m/^[3-9]/ }}, 142 on_in => sub { 143 is ($_{bar}, 2 * $_{foo} - 3, "AOH $_{foo}: b = 2a - 3 \$_{}"); 144 }); 145 is_deeply (\%_, { brt => 42 }, "%_ restored"); 146 } 147 148SKIP: { 149 $] < 5.008001 and skip "Too complicated test for $]", 2; 150 # Add to %_ in callback 151 # And test bizarre (but allowed) attribute combinations 152 # Most of them can be either left out or done more efficiently in 153 # a different way 154 my $xcsv = Text::CSV->new; 155 is_deeply (csv (in => $tfn, 156 seps => [ ",", ";" ], 157 munge => "uc", 158 quo => '"', 159 esc => '"', 160 csv => $xcsv, 161 filter => { 1 => sub { $_ eq "4" }}, 162 on_in => sub { $_{BRT} = 42; }), 163 [{ FOO => 4, BAR => 5, BAZ => 6, BRT => 42 }], 164 "AOH with addition to %_ in on_in"); 165 is_deeply ($xcsv->csv ( 166 file => $tfn, 167 sep_set => [ ";", "," ], 168 munge_column_names => "uc", 169 quote_char => '"', 170 quote => '"', 171 escape_char => '"', 172 escape => '"', 173 filter => { 1 => sub { $_ eq "4" }}, 174 after_in => sub { $_{BRT} = 42; }), 175 [{ FOO => 4, BAR => 5, BAZ => 6, BRT => 42 }], 176 "AOH with addition to %_ in on_in"); 177 } 178 179 180{ ok (my $hr = csv (in => $tfn, key => "foo", on_in => sub { 181 $_[1]{quz} = "B"; $_{ziq} = 2; }), 182 "Get into hashref with key and on_in"); 183 is_deeply ($hr->{8}, {qw( bar 13 baz 18 foo 8 quz B ziq 2 )}, 184 "on_in with key works"); 185 } 186 187open $fh, ">", $tfn or die "$tfn: $!"; 188print $fh <<"EOD"; 1893,3,3 190 1915,7,9 192, 193"", 194,, , 195,"", 196,," ", 197"" 1988,13,18 199EOD 200close $fh; 201 202is_deeply (csv (in => $tfn, filter => "not_blank"), 203 [[3,3,3],[5,7,9],["",""],["",""],["",""," ",""], 204 ["","",""],["",""," ",""],[8,13,18]], 205 "filter => not_blank"); 206is_deeply (csv (in => $tfn, filter => "not_empty"), 207 [[3,3,3],[5,7,9],["",""," ",""],["",""," ",""],[8,13,18]], 208 "filter => not_empty"); 209is_deeply (csv (in => $tfn, filter => "filled"), 210 [[3,3,3],[5,7,9],[8,13,18]], 211 "filter => filled"); 212 213is_deeply (csv (in => $tfn, filter => sub { 214 grep { defined && m/\S/ } @{$_[1]} }), 215 [[3,3,3],[5,7,9],[8,13,18]], 216 "filter => filled"); 217 218# Count rows in different ways 219open $fh, ">", $tfn or die "$tfn: $!"; 220print $fh <<"EOD"; 221foo,bar,baz 2221,,3 2230,"d 224€",4 225999,999, 226EOD 227close $fh; 228 229{ my $n = 0; 230 open my $fh, "<", $tfn; 231 my $csv = Text::CSV->new ({ binary => 1 }); 232 while (my $row = $csv->getline ($fh)) { $n++; } 233 close $fh; 234 is ($n, 4, "Count rows with getline"); 235 } 236{ my $n = 0; 237 my $aoa = csv (in => $tfn, on_in => sub { $n++ }); 238 is ($n, 4, "Count rows with on_in"); 239 } 240{ my $n = 0; 241 my $aoa = csv (in => $tfn, filter => { 0 => sub { $n++; 0; }}); 242 is ($n, 4, "Count rows with filter hash"); 243 } 244{ my $n = 0; 245 my $aoa = csv (in => $tfn, filter => sub { $n++; 0; }); 246 is ($n, 4, "Count rows with filter sub"); 247 } 248{ my $n = 0; 249 csv (in => $tfn, on_in => sub { $n++; 0; }, out => \"skip"); 250 is ($n, 4, "Count rows with on_in and skipped out"); 251 } 252