Text-CSV_XS
view release on metacpan or search on metacpan
) \s* $}xi or croak ($self->SetDiag (2013));
my ($type, $range) = (lc $1, $2);
my @h = $self->column_names ();
my @c;
if ($type eq "cell") {
my @spec;
my $min_row;
my $max_row = 0;
for (split m/\s*;\s*/ => $range) {
my ($tlr, $tlc, $brr, $brc) = (m{
^ \s* ([0-9]+ ) \s* , \s* ([0-9]+ ) \s*
(?: - \s* ([0-9]+ | \*) \s* , \s* ([0-9]+ | \*) \s* )?
$}x) or croak ($self->SetDiag (2013));
defined $brr or ($brr, $brc) = ($tlr, $tlc);
$tlr == 0 || $tlc == 0 ||
($brr ne "*" && ($brr == 0 || $brr < $tlr)) ||
($brc ne "*" && ($brc == 0 || $brc < $tlc))
and croak ($self->SetDiag (2013));
$tlc--;
$c[-1] = \%h;
}
$max_row ne "*" && $r == $max_row and last;
}
return \@c;
}
# row or col
my @r;
my $eod = 0;
for (split m/\s*;\s*/ => $range) {
my ($from, $to) = m/^\s* ([0-9]+) (?: \s* - \s* ([0-9]+ | \* ))? \s* $/x
or croak ($self->SetDiag (2013));
$to ||= $from;
$to eq "*" and ($to, $eod) = ($from, 1);
# $to cannot be <= 0 due to regex and ||=
$from <= 0 || $to < $from and croak ($self->SetDiag (2013));
$r[$_] = 1 for $from .. $to;
}
my $r = 0;
examples/csv-check view on Meta::CPAN
$diag[0] = 0;
}
elsif ($diag[2]) {
say "$ARGV record $diag[3] at line $line/$diag[2] - $diag[0] - $diag[1]";
my $ep = $diag[2] - 1; # diag[2] is 1-based
my $ei = $csv->error_input;
if (defined $ei) {
my $l = 0;
my $s = "";
eval { my $u = decode ("utf-8", $ei); $ei = $u };
for (split m/([^ -~])/ => $ei) {
if (m/^[ -~]+$/) {
$s .= $_;
$l += length;
next;
}
if ($_ eq "\t") {
$s .= "\\t";
$ep > $l and $ep++;
$l += 2;
next;
examples/csv2xlsx view on Meta::CPAN
my $m = $ENV{NO_COLOR} ? "Pod::Text" : "Pod::Text::Color";
my $p = $m->new ();
open my $fh, ">", \my $out or die "Cannot generate manual: $!\n";
$p->parse_from_file ($0, $fh);
close $fh;
print $out;
exit 0;
} # pod_text
sub pod_nroff {
first { -x "$_/nroff" } grep { -d } split m/:+/ => $ENV{PATH} or pod_text ();
require Pod::Man;
my $p = Pod::Man->new ();
open my $fh, "|-", "nroff", "-man" or die "Cannot generate manual: $!\n";
$p->parse_from_file ($0, $fh);
close $fh;
exit 0;
} # pod_nroff
if ($mrg) {
t/47_comment.t view on Meta::CPAN
print $fh qq{e,$cstr,$rest\n};
print $fh qq{$cstr\n};
print $fh qq{g,i$cstr\n};
print $fh qq{j,"k\n${cstr}k"\n};
print $fh qq{$cstr\n};
close $fh;
open $fh, "<", $tfn or die "$tfn: $!\n";
my $cuni = Encode::decode ("utf-8", $cstr);
my @rest = split m/,/ => $rest, -1; @rest or push @rest => "";
is_deeply ($csv->getline ($fh), [ "c", $cuni ], "$cstr , $rest");
is_deeply ($csv->getline ($fh), [ " $cuni" ], "leading space");
is_deeply ($csv->getline ($fh), [ "e", $cuni, @rest ], "not start of line");
is_deeply ($csv->getline ($fh), [ "g", "i$cuni" ], "not start of field");
is_deeply ($csv->getline ($fh), [ "j", "k\n${cuni}k" ], "in quoted field after NL");
close $fh;
unlink $tfn;
t/66_formula.t view on Meta::CPAN
ok (my $p = Text::CSV_XS->new ({ formula => $f }), "new with $f");
is ($p->formula, $f{$f}, "Set to $f{$f}");
}
eval { Text::CSV_XS->new ({ formula => "xxx" }); };
like ($@, qr/\bformula-handling 'xxx' is not supported/, "xxx is invalid");
# TODO : $csv->formula (sub { 42; });
# Parser
my @data = split m/\n/ => <<"EOC";
a,b,c
1,2,3
=1+2,3,4
1,=2+3,4
1,2,=3+4
EOC
sub parse {
my $f = shift;
my @d;
t/71_strict.t view on Meta::CPAN
"a,b,c\n" . "d,e,f\n". "g,h,f\n" , 2, 5 ],
[ "a,b,c\n" . "g,h\n". "i,j,k\n",
"a,b,c\n" . "g,h,c\n". "i,j,k\n", 1, 5 ],
[ "a,b\n" . "d,e,f\n". "g,h\n". "i,j,k\n",
"a,b,*\n" . "d,e,f\n". "g,h,f\n". "i,j,k\n", 1, 5 ],
) {
my ($dta, $dta0, $err_line, $pos) = @$test;
open $fh, ">", $tfn or die "$tfn: $!\n";
print $fh $dta;
close $fh;
my $expect = [ map {[ split m/,/ => $_ ]} grep m/\S/ => split "\n" => $dta0 ];
foreach my $strict (0, 1) {
open $fh, "<", $tfn or die "$tfn: $!\n";
my $csv = Text::CSV_XS->new ({ strict => $strict });
my ($r1, $r2, $r3) = ("-", "+", "*");
$csv->bind_columns (\($r1, $r2, $r3));
my @out;
eval {
while ($csv->getline ($fh)) {
push @out => [ $r1, $r2, $r3 ];
}
t/80_diag.t view on Meta::CPAN
is ($csv->parse ('"","'), 0, "1 - bad parse");
ok (@warn == 1, "1 - One error");
like ($warn[0], qr '^# CSV_XS ERROR: 2027 -', "1 - error message");
is ($csv->{_RECNO}, 1, "One record read");
}
{ my @warn;
local $SIG{__WARN__} = sub { push @warn => @_ };
is ($csv->diag_verbose (3), 3, "Set diag_verbose");
is ($csv->parse ('"","'), 0, "1 - bad parse");
ok (@warn == 1, "1 - One error");
@warn = split m/\n/ => $warn[0];
ok (@warn == 3, "1 - error plus two lines");
like ($warn[0], qr '^# CSV_XS ERROR: 2027 -', "1 - error message");
like ($warn[1], qr '^"","', "1 - input line");
like ($warn[2], qr '^ \^', "1 - position indicator");
is ($csv->{_RECNO}, 2, "Another record read");
}
{ ok ($csv->{auto_diag} = 2, "auto_diag = 2 to die");
eval { $csv->parse ('"","') };
like ($@, qr '^# CSV_XS ERROR: 2027 -', "2 - error message");
}
0xdc, 0xd9, 0xda, 0x9f );
sub _readable {
defined $_[0] or return "--undef--";
join "", map {
my $cp = ord $_;
$ebcdic and $cp = $ebcdic[$cp];
$cp >= 0x20 && $cp <= 0x7e
? $_
: $special{$cp} || sprintf "\\x{%02x}", $cp
} split m//, $_[0];
} # _readable
sub is_binary {
my ($str, $exp, $tst) = @_;
if ($str eq $exp) {
ok (1, $tst);
}
else {
my ($hs, $he) = map { _readable $_ } $str, $exp;
is ($hs, $he, $tst);
( run in 0.925 second using v1.01-cache-2.11-cpan-5511b514fd6 )