#!/pro/bin/perl
$^W = 1;
$| = 1;
BEGIN {
unless
(
exists
$Config
{useperlio} &&
defined
$Config
{useperlio} &&
$] >= 5.008 &&
$Config
{useperlio} eq
"define"
) {
plan
skip_all
=>
"No reliable perlIO available"
;
}
else
{
plan
tests
=> 38;
}
}
BEGIN {
$ENV
{PERL_TEXT_CSV} =
$ENV
{TEST_PERL_TEXT_CSV} || 0; }
my
$csv
= Text::CSV->new ();
my
@test
= (
"row=1"
=> [[ 11,12,13,14,15,16,17,18,19 ]],
"row=2-3"
=> [[ 21,22,23,24,25,26,27,28,29 ],
[ 31,32,33,34,35,36,37,38,39 ]],
"row=2;4;6"
=> [[ 21,22,23,24,25,26,27,28,29 ],
[ 41,42,43,44,45,46,47,48,49 ],
[ 61,62,63,64,65,66,67,68,69 ]],
"row=1-2;4;6-*"
=> [[ 11,12,13,14,15,16,17,18,19 ],
[ 21,22,23,24,25,26,27,28,29 ],
[ 41,42,43,44,45,46,47,48,49 ],
[ 61,62,63,64,65,66,67,68,69 ],
[ 71,72,73,74,75,76,77,78,79 ],
[ 81,82,83,84,85,86,87,88,89 ],
[ 91,92,93,94,95,96,97,98,99 ]],
"col=1"
=> [[11],[21],[31],[41],[51],[61],[71],[81],[91]],
"col=2-3"
=> [[12,13],[22,23],[32,33],[42,43],[52,53],
[62,63],[72,73],[82,83],[92,93]],
"col=2;4;6"
=> [[12,14,16],[22,24,26],[32,34,36],[42,44,46],[52,54,56],
[62,64,66],[72,74,76],[82,84,86],[92,94,96]],
"col=1-2;4;6-*"
=> [[11,12,14,16,17,18,19], [21,22,24,26,27,28,29],
[31,32,34,36,37,38,39], [41,42,44,46,47,48,49],
[51,52,54,56,57,58,59], [61,62,64,66,67,68,69],
[71,72,74,76,77,78,79], [81,82,84,86,87,88,89],
[91,92,94,96,97,98,99]],
"cell=7,7"
=> [[ 77 ]],
"cell=7,7-8,8"
=> [[ 77,78 ], [ 87,88 ]],
"cell=7,7-*,8"
=> [[ 77,78 ], [ 87,88 ], [ 97,98 ]],
"cell=7,7-8,*"
=> [[ 77,78,79 ], [ 87,88,89 ]],
"cell=7,7-*,*"
=> [[ 77,78,79 ], [ 87,88,89 ], [ 97,98,99 ]],
"cell=7,7;7,8;8,7;8,8"
=> [[ 77,78 ], [ 87,88 ]],
"cell=8,8;8,7;7,8;7,7"
=> [[ 77,78 ], [ 87,88 ]],
"cell=1,1-2,2;3,3-4,4"
=> [
[11,12],
[21,22],
[33,34],
[43,44]],
"cell=1,1-3,3;2,3-4,4"
=> [
[11,12,13],
[21,22,23,24],
[31,32,33,34],
[43,44]],
"cell=1,1-3,3;2,2-4,4;2,3;4,2"
=> [
[11,12,13],
[21,22,23,24],
[31,32,33,34],
[42,43,44]],
"cell=1,1-2,2;3,3-4,4;1,4;4,1"
=> [
[11,12, 14],
[21,22],
[33,34],
[41, 43,44]],
);
my
$todo
=
""
;
my
$data
=
join
""
=> <DATA>;
while
(
my
(
$spec
,
$expect
) =
splice
@test
, 0, 2) {
open
my
$io
,
"<"
, \
$data
or
die
"IO: $!\n"
;
my
$aoa
=
$csv
->fragment (
$io
,
$spec
);
is_deeply (
$aoa
,
$expect
,
"${todo}Fragment $spec"
);
}
{
$csv
->column_names (
"c3"
,
"c4"
);
open
my
$io
,
"<"
, \
$data
or
die
"IO: $!\n"
;
is_deeply (
$csv
->fragment (
$io
,
"cell=3,2-4,3"
),
[ {
c3
=> 32,
c4
=> 33 }, {
c3
=> 42,
c4
=> 43 }],
"Fragment to AoH"
);
}
{
$csv
->column_names (
"C1"
,
"C2"
);
open
my
$io
,
"<"
, \
$data
or
die
"IO: $!\n"
;
is_deeply (
$csv
->fragment (
$io
,
"row=3"
),
[ {
C1
=> 31,
C2
=> 32 }],
"Fragment row with headers to AoH"
);
}
{
$csv
->column_names (
"C1"
);
open
my
$io
,
"<"
, \
$data
or
die
"IO: $!\n"
;
is_deeply (
$csv
->fragment (
$io
,
"col=2"
),
[
map
+{
C1
=>
$_
.2 } => 1 .. 9 ],
"Fragment col with headers to AoH"
);
}
$csv
->column_names (
undef
);
foreach
my
$spec
(
"col=1;3=2"
,
"col=1,3-2"
,
"col=-3"
,
"col=0"
,
"col=2--5"
,
"col=0-2"
,
"col=2-0"
,
"col=2;;3"
) {
open
my
$io
,
"<"
, \
$data
or
die
"IO: $!\n"
;
my
$ref
=
eval
{
$csv
->fragment (
$io
,
"col=2;3=2"
); };
is (
$ref
,
undef
,
"Bad fragment spec"
);
is (0 +
$csv
->error_diag, 2013,
"Error in spec"
);
}