#!/usr/bin/perl
use strict;
use warnings;
use Config;
use Test::More;
BEGIN {
unless (exists $Config{useperlio} &&
defined $Config{useperlio} &&
$] >= 5.008 && # perlio was experimental in 5.6.2, but not reliable
$Config{useperlio} eq "define") {
plan skip_all => "No reliable perlIO available";
}
else {
plan tests => 553;
}
}
BEGIN {
require_ok "Text::CSV_XS";
plan skip_all => "Cannot load Text::CSV_XS" if $@;
require "t/util.pl";
}
$| = 1;
# Embedded newline tests
my $file = "";
my $def_rs = $/;
foreach my $rs ("\n", "\r\n", "\r") {
for $\ (undef, $rs) {
my $csv = Text::CSV_XS->new ({ binary => 1 });
$csv->eol ($/ = $rs) unless defined $\;
my $fh;
foreach my $pass (0, 1) {
if ($pass == 0) {
$file = "";
open $fh, ">", \$file or die "IO: $!\n";
}
else {
open $fh, "<", \$file or die "IO: $!\n";
}
foreach my $eol ("", "\r", "\n", "\r\n", "\n\r") {
my $s_eol = join " - ", map { defined $_ ? $_ : "<undef>" } $\, $rs, $eol;
$s_eol =~ s/\r/\\r/g;
$s_eol =~ s/\n/\\n/g;
my @p;
my @f = ("", 1,
$eol, " $eol", "$eol ", " $eol ", "'$eol'",
"\"$eol\"", " \" $eol \"\n ", "EOL");
if ($pass == 0) {
ok ($csv->combine (@f), "combine |$s_eol|");
ok (my $str = $csv->string, "string |$s_eol|");
my $state = $csv->parse ($str);
ok ($state, "parse |$s_eol|");
if ($state) {
ok (@p = $csv->fields, "fields |$s_eol|");
}
else{
is ($csv->error_input, $str, "error |$s_eol|");
}
print $fh $str;
}
else {
ok (my $row = $csv->getline ($fh), "getline |$s_eol|");
is (ref $row, "ARRAY", "row |$s_eol|");
@p = @$row;
}
local $, = "|";
is_binary ("@p", "@f", "result |$s_eol|");
}
close $fh;
}
}
}
$/ = $def_rs;
{ my $csv = Text::CSV_XS->new ({ escape_char => undef });
ok ($csv->parse (qq{"x"\r\n}), "Trailing \\r\\n with no escape char");
is ($csv->eol ("\r"), "\r", "eol set to \\r");
ok ($csv->parse (qq{"x"\r}), "Trailing \\r with no escape char");
ok ($csv->allow_whitespace (1), "Allow whitespace");
ok ($csv->parse (qq{"x" \r}), "Trailing \\r with no escape char");
}
SKIP: {
$] < 5.008 and skip "\$\\ tests don't work in perl 5.6.x and older", 2;
{ local $\ = "#\r\n";
my $csv = Text::CSV_XS->new ();
$file = "";
open my $fh, ">", \$file or die "IO: $!\n";
$csv->print ($fh, [ "a", 1 ]);
close $fh;
open $fh, "<", \$file or die "IO: $!\n";
local $/;
is (<$fh>, "a,1#\r\n", "Strange \$\\");
close $fh;
}
{ local $\ = "#\r\n";
my $csv = Text::CSV_XS->new ({ eol => $\ });
$file = "";
open my $fh, ">", \$file or die "IO: $!\n";
$csv->print ($fh, [ "a", 1 ]);
close $fh;
open $fh, "<", \$file or die "IO: $!\n";
local $/;
is (<$fh>, "a,1#\r\n", "Strange \$\\ + eol");
close $fh;
}
}
$/ = $def_rs;
ok (1, "Auto-detecting \\r");
{ my @row = qw( a b c ); local $" = ",";
for (["\n", "\\n"], ["\r\n", "\\r\\n"], ["\r", "\\r"]) {
my ($eol, $s_eol) = @$_;
$file = "";
open my $fh, ">", \$file or die "IO: $!\n";
print $fh qq{@row$eol@row$eol@row$eol\x91};
close $fh;
open $fh, "<", \$file or die "IO: $!\n";
my $c = Text::CSV_XS->new ({ binary => 1, auto_diag => 1 });
is ($c->eol (), "", "default EOL");
is_deeply ($c->getline ($fh), [ @row ], "EOL 1 $s_eol");
is ($c->eol (), $eol eq "\r" ? "\r" : "", "EOL");
is_deeply ($c->getline ($fh), [ @row ], "EOL 2 $s_eol");
is_deeply ($c->getline ($fh), [ @row ], "EOL 3 $s_eol");
close $fh;
}
}
ok (1, "Specific \\r test from tfrayner");
{ $/ = "\r";
$file = "";
open my $fh, ">", \$file or die "IO: $!\n";
print $fh qq{a,b,c$/}, qq{"d","e","f"$/};
close $fh;
open $fh, "<", \$file or die "IO: $!\n";
my $c = Text::CSV_XS->new ({ eol => $/ });
my $row;
local $" = " ";
ok ($row = $c->getline ($fh), "getline 1");
is (scalar @$row, 3, "# fields");
is ("@$row", "a b c", "fields 1");
ok ($row = $c->getline ($fh), "getline 2");
is (scalar @$row, 3, "# fields");
is ("@$row", "d e f", "fields 2");
close $fh;
}
$/ = $def_rs;
ok (1, "EOL undef");
{ $/ = "\r";
ok (my $csv = Text::CSV_XS->new ({ eol => undef }), "new csv with eol => undef");
$file = "";
open my $fh, ">", \$file or die "IO: $!\n";
ok ($csv->print ($fh, [1, 2, 3]), "print");
ok ($csv->print ($fh, [4, 5, 6]), "print");
close $fh;
open $fh, "<", \$file or die "IO: $!\n";
ok (my $row = $csv->getline ($fh), "getline 1");
is (scalar @$row, 5, "# fields");
is_deeply ($row, [ 1, 2, 34, 5, 6], "fields 1");
close $fh;
}
$/ = $def_rs;
foreach my $eol ("!", "!!", "!\n", "!\n!") {
(my $s_eol = $eol) =~ s/\n/\\n/g;
ok (1, "EOL $s_eol");
ok (my $csv = Text::CSV_XS->new ({ eol => $eol }), "new csv with eol => $s_eol");
$file = "";
open my $fh, ">", \$file or die "IO: $!\n";
ok ($csv->print ($fh, [1, 2, 3]), "print");
ok ($csv->print ($fh, [4, 5, 6]), "print");
close $fh;
foreach my $rs (undef, "", "\n", $eol, "!", "!\n", "\n!", "!\n!", "\n!\n") {
local $/ = $rs;
(my $s_rs = defined $rs ? $rs : "-- undef --") =~ s/\n/\\n/g;
ok (1, "with RS $s_rs");
open $fh, "<", \$file or die "IO: $!\n";
ok (my $row = $csv->getline ($fh), "getline 1");
is (scalar @$row, 3, "# fields");
is_deeply ($row, [ 1, 2, 3], "fields 1");
ok ( $row = $csv->getline ($fh), "getline 2");
is (scalar @$row, 3, "# fields");
is_deeply ($row, [ 4, 5, 6], "fields 2");
close $fh;
}
}
$/ = $def_rs;
{ ok (my $csv = Text::CSV_XS->new, "new for say");
my $foo;
open my $fh, ">", \$foo or die "IO: $!\n";
ok ($csv->say ($fh, [ 1, 2 ]), "say");
close $fh;
is ($foo, "1,2$/");
$foo = "";
$csv->eol ("#");
open $fh, ">", \$foo or die "IO: $!\n";
ok ($csv->say ($fh, [ 1, 2 ]), "say");
close $fh;
is ($foo, "1,2#");
$foo = "";
$csv->eol ("0");
open $fh, ">", \$foo or die "IO: $!\n";
ok ($csv->say ($fh, [ 1, 2 ]), "say");
close $fh;
is ($foo, "1,20");
}
1;