#!/usr/bin/perl
use strict;
$^W = 1; # use warnings;
use Test::More;
BEGIN {
if ($] < 5.006) {
plan skip_all => "No lexical file handles in in this ancient perl version";
}
else {
plan tests => 105;
}
}
BEGIN {
$ENV{PERL_TEXT_CSV} = 0;
use_ok "Text::CSV";
plan skip_all => "Cannot load Text::CSV" if $@;
require "t/util.pl";
}
$| = 1;
$/ = "\n";
$\ = undef;
my $io;
my $csv = Text::CSV->new ();
my $UTF8 = ($ENV{LANG} || "C").($ENV{LC_ALL} || "C") =~ m/utf-?8/i ? 1 : 0;
ok (!$csv->print ($io, ["abc", "def\007", "ghi"]), "print bad character");
for ( [ 1, 1, 1, '""' ],
[ 2, 1, 1, '', '' ],
[ 3, 1, 0, '', 'I said, "Hi!"', '' ],
[ 4, 1, 0, '"', 'abc' ],
[ 5, 1, 0, 'abc', '"' ],
[ 6, 1, 1, 'abc', 'def', 'ghi' ],
[ 7, 1, 1, "abc\tdef", 'ghi' ],
[ 8, 1, 0, '"abc' ],
[ 9, 1, 0, 'ab"c' ],
[ 10, 1, 0, '"ab"c"' ],
[ 11, 0, 0, qq("abc\nc") ],
[ 12, 1, 1, q(","), ',' ],
[ 13, 1, 0, qq("","I said,\t""Hi!""",""), '', qq(I said,\t"Hi!"), '' ],
) {
my ($tst, $validp, $validg, @arg, $row) = @$_;
open $io, ">_21test.csv" or die "_21test.csv: $!";
is ($csv->print ($io, \@arg), $validp||"", "$tst - print ()");
close $io;
open $io, ">_21test.csv" or die "_21test.csv: $!";
print $io join ",", @arg;
close $io;
open $io, "<_21test.csv" or die "_21test.csv: $!";
$row = $csv->getline ($io);
unless ($validg) {
is ($row, undef, "$tst - false getline ()");
next;
}
ok ($row, "$tst - good getline ()");
$tst == 12 and @arg = (",", "", "");
foreach my $a (0 .. $#arg) {
(my $exp = $arg[$a]) =~ s/^"(.*)"$/$1/;
is ($row->[$a], $exp, "$tst - field $a");
}
}
unlink "_21test.csv";
# This test because of a problem with DBD::CSV
ok (1, "Tests for DBD::CSV");
open $io, ">_21test.csv" or die "_21test.csv: $!";
$csv->binary (1);
$csv->eol ("\r\n");
ok ($csv->print ($io, [ "id", "name" ]), "Bad character");
ok ($csv->print ($io, [ 1, "Alligator Descartes" ]), "Name 1");
ok ($csv->print ($io, [ "3", "Jochen Wiedmann" ]), "Name 2");
ok ($csv->print ($io, [ 2, "Tim Bunce" ]), "Name 3");
ok ($csv->print ($io, [ " 4", "Andreas König" ]), "Name 4");
ok ($csv->print ($io, [ 5 ]), "Name 5");
close $io;
my $expected = <<"CONTENTS";
id,name\015
1,"Alligator Descartes"\015
3,"Jochen Wiedmann"\015
2,"Tim Bunce"\015
" 4","Andreas König"\015
5\015
CONTENTS
open $io, "<_21test.csv" or die "_21test.csv: $!";
my $content = do { local $/; <$io> };
close $io;
is ($content, $expected, "Content");
open $io, ">_21test.csv" or die "_21test.csv: $!";
print $io $content;
close $io;
open $io, "<_21test.csv" or die "_21test.csv: $!";
my $fields;
print "# Retrieving data\n";
for (0 .. 5) {
ok ($fields = $csv->getline ($io), "Fetch field $_");
is ($csv->eof, "", "EOF");
print "# Row $_: $fields (@$fields)\n";
}
is ($csv->getline ($io), undef, "Fetch field 6");
is ($csv->eof, 1, "EOF");
# Edge cases
$csv = Text::CSV->new ({ escape_char => "+" });
for ([ 1, 1, 0, "\n" ],
[ 2, 1, 0, "+\n" ],
[ 3, 1, 0, "+" ],
[ 4, 0, 2021, qq{"+"\n} ],
[ 5, 0, 2025, qq{"+\n} ],
[ 6, 0, 2011, qq{""+\n} ],
[ 7, 0, 2027, qq{"+"} ],
[ 8, 0, 2024, qq{"+} ],
[ 9, 0, 2011, qq{""+} ],
[ 10, 0, 2037, "\r" ],
[ 11, 0, 2031, "\r\r" ],
[ 12, 0, 2032, "+\r\r" ],
[ 13, 0, 2032, "+\r\r+" ],
[ 14, 0, 2022, qq{"\r"} ],
[ 15, 0, 2022, qq{"\r\r" } ],
[ 16, 0, 2022, qq{"\r\r"\t} ],
[ 17, 0, 2025, qq{"+\r\r"} ],
[ 18, 0, 2025, qq{"+\r\r+"} ],
[ 19, 0, 2022, qq{"\r"\r} ],
[ 20, 0, 2022, qq{"\r\r"\r} ],
[ 21, 0, 2025, qq{"+\r\r"\r} ],
[ 22, 0, 2025, qq{"+\r\r+"\r} ],
) {
my ($tst, $valid, $err, $str) = @$_;
open my $io, ">_21test.csv" or die "_21test.csv: $!";
print $io $str;
close $io;
open $io, "<_21test.csv" or die "_21test.csv: $!";
my $row = $csv->getline ($io);
my @err = $csv->error_diag;
my $sstr = _readable ($str);
SKIP: {
$tst == 10 && $] >= 5.008 && $] < 5.008003 && $UTF8 and
skip "Be reasonable, this perl version does not do Unicode reliable", 2;
ok ($valid ? $row : !$row, "$tst - getline ESC +, '$sstr'");
# is ($err[0], $err, "Error expected $err");
ok ($err[0] >= 0, "Error $err[0] but in CSV_XS $err" . ($err[0] == $err ? " * same in PP and XS *" : "") );
}
}
unlink "_21test.csv";