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