r66552 - in /branches/upstream/libtext-csv-perl/current: Changes MANIFEST META.yml README files/macosx.csv lib/Text/CSV.pm lib/Text/CSV_PP.pm t/45_eol.t t/51_utf8.t t/70_rt.t t/77_getall.t t/80_diag.t
carnil at users.alioth.debian.org
carnil at users.alioth.debian.org
Tue Dec 28 13:44:47 UTC 2010
Author: carnil
Date: Tue Dec 28 13:44:18 2010
New Revision: 66552
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=66552
Log:
[svn-upgrade] new version libtext-csv-perl (1.21)
Added:
branches/upstream/libtext-csv-perl/current/files/macosx.csv
branches/upstream/libtext-csv-perl/current/t/51_utf8.t
branches/upstream/libtext-csv-perl/current/t/77_getall.t
Modified:
branches/upstream/libtext-csv-perl/current/Changes
branches/upstream/libtext-csv-perl/current/MANIFEST
branches/upstream/libtext-csv-perl/current/META.yml
branches/upstream/libtext-csv-perl/current/README
branches/upstream/libtext-csv-perl/current/lib/Text/CSV.pm
branches/upstream/libtext-csv-perl/current/lib/Text/CSV_PP.pm
branches/upstream/libtext-csv-perl/current/t/45_eol.t
branches/upstream/libtext-csv-perl/current/t/70_rt.t
branches/upstream/libtext-csv-perl/current/t/80_diag.t
Modified: branches/upstream/libtext-csv-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-perl/current/Changes?rev=66552&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/Changes (original)
+++ branches/upstream/libtext-csv-perl/current/Changes Tue Dec 28 13:44:18 2010
@@ -1,4 +1,9 @@
Revision history for Perl extension Text::CSV.
+
+1.21 Mon Dec 27 12:35:35 2010
+ - updated the compatibility for Text::CSV_XS version 0.80
+ * added getline_all() and getaline_hr_all()
+ * added missing test file
1.20 Wed Oct 20 13:53:59 2010
- couldn't parse the csv containing the column starting with '0'. (hiratara)
Modified: branches/upstream/libtext-csv-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-perl/current/MANIFEST?rev=66552&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/MANIFEST (original)
+++ branches/upstream/libtext-csv-perl/current/MANIFEST Tue Dec 28 13:44:18 2010
@@ -20,6 +20,7 @@
t/45_eol.t Embedded EOL
t/46_eol_si.t Embedded EOL using scalar io (perlio)
t/50_utf8.t Unicode stress tests
+t/51_utf8.t Unicode IO encoding tests
t/55_combi.t Different CSV character combinations
t/60_samples.t Miscellaneous problems from the modules history.
t/65_allow.t Allow bad formats
@@ -27,9 +28,11 @@
t/71_pp.t Tests for bug report fixes or patches (for Text::CSV_PP)
t/75_hashref.t getline_hr related tests
t/76_magic.t array_ref from magig (useless for Text::CSV_PP)
+t/77_getall.t gat all rows at once
t/80_diag.t Error diagnostics
t/81_subclass.t Subclassed
+files/macosx.csv A CSV files exported on MacOSX
files/utf8.csv A UTF-8 encode test file
t/util.pl Extra test utilities
Modified: branches/upstream/libtext-csv-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-perl/current/META.yml?rev=66552&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/META.yml (original)
+++ branches/upstream/libtext-csv-perl/current/META.yml Tue Dec 28 13:44:18 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Text-CSV
-version: 1.20
+version: 1.21
abstract: comma-separated values manipulator (using XS or PurePerl)
author:
- Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
Modified: branches/upstream/libtext-csv-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-perl/current/README?rev=66552&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/README (original)
+++ branches/upstream/libtext-csv-perl/current/README Tue Dec 28 13:44:18 2010
@@ -1,4 +1,4 @@
-Text::CSV version 1.20
+Text::CSV version 1.21
========================
comma-separated values manipulator
Added: branches/upstream/libtext-csv-perl/current/files/macosx.csv
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-perl/current/files/macosx.csv?rev=66552&op=file
==============================================================================
--- branches/upstream/libtext-csv-perl/current/files/macosx.csv (added)
+++ branches/upstream/libtext-csv-perl/current/files/macosx.csv Tue Dec 28 13:44:18 2010
@@ -1,0 +1,1 @@
+"'\'\\'\\\'""\""\\""\\\""",,,,,,,,,,,,,,
Exported 12/16/2008 10:30 AM,,,,,,Category,Category name,,,,,Category name 2,,
Username,Last Name,First Name M.,Section/Group,Status,Notes,Assignment,Category name 1,Category name 2,Category name 3,woot!,dqwdqwd,Category name 2 1,Total Score,Class Grade
,,,,,,Grading scale,Points,Points,Points,Points,Points,Points,,
,,,,,,Points possible,11,11,11,11,11,11,,
dcwalker,,,,Dropped,<b>,,1,34,1,,,,109,
jdr99,,,devs,Active,"qwd
qwd
qwd",,12,0,1,,,,39,
jlaney,,,devs,Active,,,,2,23,,,,114,
mcrawfor,,,devs,Active,"line 1
line 2
line 3 XX <b>fwe</b>
and
so
on
yea!",,,,,,,,,
,,,,,,,,,,,,,,
,,,,,,Mean,6.5,12.0,8.33,#DIV/0!,#DIV/0!,#DIV/0!,87.33,
,,,,,,Median,6.5,2.0,1.0,#NUM!,#NUM!,#NUM!,109.0,
,,,,,,Mode,#N/A,#N/A,1.0,#N/A,#N/A,#N/A,#N/A,
,,,,,,Min,1.0,0.0,1.0,0.0,0.0,0.0,39.0,
,,,,,,Max,12.0,34.0,23.0,0.0,0.0,0.0,114.0,
,,,,,,Std. Dev.,7.78,19.08,12.7,#DIV/0!,#DIV/0!,#DIV/0!,41.93,
Modified: branches/upstream/libtext-csv-perl/current/lib/Text/CSV.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-perl/current/lib/Text/CSV.pm?rev=66552&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/lib/Text/CSV.pm (original)
+++ branches/upstream/libtext-csv-perl/current/lib/Text/CSV.pm Tue Dec 28 13:44:18 2010
@@ -6,14 +6,14 @@
use vars qw( $VERSION $DEBUG );
BEGIN {
- $VERSION = '1.20';
+ $VERSION = '1.21';
$DEBUG = 0;
}
# if use CSV_XS, requires version
my $Module_XS = 'Text::CSV_XS';
my $Module_PP = 'Text::CSV_PP';
-my $XS_Version = '0.74';
+my $XS_Version = '0.80';
my $Is_Dynamic = 0;
@@ -26,7 +26,7 @@
version types quote_char escape_char sep_char eol always_quote binary allow_whitespace
keep_meta_info allow_loose_quotes allow_loose_escapes verbatim meta_info is_quoted is_binary eof
getline print parse combine fields string error_diag error_input status blank_is_undef empty_is_undef
- getline_hr column_names bind_columns auto_diag quote_space quote_null
+ getline_hr column_names bind_columns auto_diag quote_space quote_null getline_all getline_hr_all
PV IV NV
/;
#
@@ -287,9 +287,9 @@
=head1 VERSION
- 1.20
-
-This module is compatible with Text::CSV_XS B<0.74> and later.
+ 1.21
+
+This module is compatible with Text::CSV_XS B<0.80> and later.
=head2 Embedded newlines
@@ -727,6 +727,30 @@
The I<$csv-E<gt>string ()>, I<$csv-E<gt>fields ()> and I<$csv-E<gt>status ()>
methods are meaningless, again.
+=head2 getline_all
+
+ $arrayref = $csv->getline_all ($io);
+ $arrayref = $csv->getline_all ($io, $offset);
+ $arrayref = $csv->getline_all ($io, $offset, $length);
+
+This will return a reference to a list of C<getline ($io)> results.
+In this call, C<keep_meta_info> is disabled. If C<$offset> is negative,
+as with C<splice ()>, only the last C<abs ($offset)> records of C<$io>
+are taken into consideration.
+
+Given a CSV file with 10 lines:
+
+ lines call
+ ----- ---------------------------------------------------------
+ 0..9 $csv->getline_all ($io) # all
+ 0..9 $csv->getline_all ($io, 0) # all
+ 8..9 $csv->getline_all ($io, 8) # start at 8
+ - $csv->getline_all ($io, 0, 0) # start at 0 first 0 rows
+ 0..4 $csv->getline_all ($io, 0, 5) # start at 0 first 5 rows
+ 4..5 $csv->getline_all ($io, 4, 2) # start at 4 first 2 rows
+ 8..9 $csv->getline_all ($io, -2) # last 2 rows
+ 6..7 $csv->getline_all ($io, -4, 2) # first 2 of last 4 rows
+
=head2 parse
$status = $csv->parse ($line);
@@ -753,6 +777,15 @@
C<getline_hr ()> will croak if called before C<column_names ()>.
+=head2 getline_hr_all
+
+ $arrayref = $csv->getline_hr_all ($io);
+ $arrayref = $csv->getline_hr_all ($io, $offset);
+ $arrayref = $csv->getline_hr_all ($io, $offset, $length);
+
+This will return a reference to a list of C<getline_hr ($io)> results.
+In this call, C<keep_meta_info> is disabled.
+
=head2 column_names
Set the keys that will be used in the C<getline_hr ()> calls. If no keys
Modified: branches/upstream/libtext-csv-perl/current/lib/Text/CSV_PP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-perl/current/lib/Text/CSV_PP.pm?rev=66552&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/lib/Text/CSV_PP.pm (original)
+++ branches/upstream/libtext-csv-perl/current/lib/Text/CSV_PP.pm Tue Dec 28 13:44:18 2010
@@ -11,7 +11,7 @@
use vars qw($VERSION);
use Carp ();
-$VERSION = '1.28';
+$VERSION = '1.29';
sub PV { 0 }
sub IV { 1 }
@@ -705,7 +705,38 @@
return [];
}
-
+################################################################################
+# getline_all
+################################################################################
+sub getline_all {
+ my ( $self, $io, $offset, $len ) = @_;
+ my @list;
+ my $tail;
+ my $n = 0;
+
+ $offset ||= 0;
+
+ if ( $offset < 0 ) {
+ $tail = -$offset;
+ $offset = 0;
+ }
+
+ while ( my $row = $self->getline($io) ) {
+ next if $offset && $offset-- > 0; # skip
+ last if defined $len && !$tail && $n >= $len; # exceedes limit size
+ push @list, $row;
+ ++$n;
+ if ( $tail && $n > $tail ) {
+ shift @list;
+ }
+ }
+
+ if ( $tail && defined $len && $n > $len ) {
+ @list = splice( @list, 0, $len);
+ }
+
+ return \@list;
+}
################################################################################
# getline_hr
################################################################################
@@ -722,6 +753,21 @@
@hr{ @{ $self->{_COLUMN_NAMES} } } = @$fr;
\%hr;
+}
+################################################################################
+# getline_hr_all
+################################################################################
+sub getline_hr_all {
+ my ( $self, $io, @args ) = @_;
+ my %hr;
+
+ unless ( $self->{_COLUMN_NAMES} ) {
+ $self->SetDiag( 3002 );
+ }
+
+ my @cn = @{$self->{_COLUMN_NAMES}};
+
+ return [ map { my %h; @h{ @cn } = @$_; \%h } @{ $self->getline_all( $io, @args ) } ];
}
################################################################################
# column_names
@@ -996,9 +1042,9 @@
=head1 VERSION
- 1.28
-
-This module is compatible with Text::CSV_XS B<0.74> and later.
+ 1.29
+
+This module is compatible with Text::CSV_XS B<0.80> and later.
=head2 Unicode (UTF8)
@@ -1377,6 +1423,30 @@
The I<$csv-E<gt>string ()>, I<$csv-E<gt>fields ()> and I<$csv-E<gt>status ()>
methods are meaningless, again.
+=head2 getline_all
+
+ $arrayref = $csv->getline_all ($io);
+ $arrayref = $csv->getline_all ($io, $offset);
+ $arrayref = $csv->getline_all ($io, $offset, $length);
+
+This will return a reference to a list of C<getline ($io)> results.
+In this call, C<keep_meta_info> is disabled. If C<$offset> is negative,
+as with C<splice ()>, only the last C<abs ($offset)> records of C<$io>
+are taken into consideration.
+
+Given a CSV file with 10 lines:
+
+ lines call
+ ----- ---------------------------------------------------------
+ 0..9 $csv->getline_all ($io) # all
+ 0..9 $csv->getline_all ($io, 0) # all
+ 8..9 $csv->getline_all ($io, 8) # start at 8
+ - $csv->getline_all ($io, 0, 0) # start at 0 first 0 rows
+ 0..4 $csv->getline_all ($io, 0, 5) # start at 0 first 5 rows
+ 4..5 $csv->getline_all ($io, 4, 2) # start at 4 first 2 rows
+ 8..9 $csv->getline_all ($io, -2) # last 2 rows
+ 6..7 $csv->getline_all ($io, -4, 2) # first 2 of last 4 rows
+
=head2 parse
$status = $csv->parse ($line);
@@ -1403,6 +1473,13 @@
C<getline_hr ()> will croak if called before C<column_names ()>.
+=head2 getline_hr_all
+
+ $arrayref = $csv->getline_hr_all ($io);
+
+This will return a reference to a list of C<getline_hr ($io)> results.
+In this call, C<keep_meta_info> is disabled.
+
=head2 column_names
Set the keys that will be used in the C<getline_hr ()> calls. If no keys
Modified: branches/upstream/libtext-csv-perl/current/t/45_eol.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-perl/current/t/45_eol.t?rev=66552&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/t/45_eol.t (original)
+++ branches/upstream/libtext-csv-perl/current/t/45_eol.t Tue Dec 28 13:44:18 2010
@@ -3,7 +3,7 @@
use strict;
$^W = 1;
-use Test::More tests => 546;
+use Test::More tests => 1065;
BEGIN {
$ENV{PERL_TEXT_CSV} = 0;
@@ -43,7 +43,7 @@
"\"$eol\"", " \" $eol \"\n ", "EOL");
if ($pass == 0) {
- ok ($csv->combine (@f), "combine |$s_eol|");
+ 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|");
@@ -112,7 +112,6 @@
}
$/ = $def_rs;
-
ok (1, "Auto-detecting \\r");
{ my @row = qw( a b c ); local $" = ",";
for (["\n", "\\n"], ["\r\n", "\\r\\n"], ["\r", "\\r"]) {
@@ -121,7 +120,6 @@
print FH qq{@row$eol at row$eol at row$eol\x91};
close FH;
open FH, "<_eol.csv";
-
my $c = Text::CSV->new ({ binary => 1, auto_diag => 1 });
is ($c->eol (), "", "default EOL");
is_deeply ($c->getline (*FH), [ @row ], "EOL 1 $s_eol");
@@ -156,7 +154,7 @@
ok (1, "EOL undef");
{ $/ = "\r";
- ok (my $csv = Text::CSV->new ({eol => undef }), "new csv with eol => undef");
+ ok (my $csv = Text::CSV->new ({ eol => undef }), "new csv with eol => undef");
open FH, ">_eol.csv";
ok ($csv->print (*FH, [1, 2, 3]), "print");
ok ($csv->print (*FH, [4, 5, 6]), "print");
@@ -171,8 +169,12 @@
}
$/ = $def_rs;
-foreach my $eol ("!", "!!", "!\n", "!\n!") {
+foreach my $eol ("!", "!!", "!\n", "!\n!", "!!!!!!!!", "!!!!!!!!!!",
+ "\n!!!!!\n!!!!!", "!!!!!\n!!!!!\n", "%^+_\n\0!X**",
+ "\r\n", "\r") {
(my $s_eol = $eol) =~ s/\n/\\n/g;
+ $s_eol =~ s/\r/\\r/g;
+ $s_eol =~ s/\0/\\0/g;
ok (1, "EOL $s_eol");
ok (my $csv = Text::CSV->new ({ eol => $eol }), "new csv with eol => $s_eol");
open FH, ">_eol.csv";
@@ -186,10 +188,10 @@
ok (1, "with RS $s_rs");
open FH, "<_eol.csv";
ok (my $row = $csv->getline (*FH), "getline 1");
- is (scalar @$row, 3, "# fields");
+ is (scalar @$row, 3, "field count");
is_deeply ($row, [ 1, 2, 3], "fields 1");
ok ( $row = $csv->getline (*FH), "getline 2");
- is (scalar @$row, 3, "# fields");
+ is (scalar @$row, 3, "field count");
is_deeply ($row, [ 4, 5, 6], "fields 2");
close FH;
}
@@ -197,4 +199,58 @@
}
$/ = $def_rs;
+{ open FH, "<files/macosx.csv" or die "Ouch $!";
+ ok (1, "MacOSX exported file");
+ ok (my $csv = Text::CSV->new ({ auto_diag => 1, binary => 1 }), "new csv");
+ diag ();
+ ok (my $row = $csv->getline (*FH), "getline 1");
+ is (scalar @$row, 15, "field count");
+ is ($row->[7], "", "field 8");
+ ok ( $row = $csv->getline (*FH), "getline 2");
+ is (scalar @$row, 15, "field count");
+ is ($row->[6], "Category", "field 7");
+ ok ( $row = $csv->getline (*FH), "getline 3");
+ is (scalar @$row, 15, "field count");
+ is ($row->[5], "Notes", "field 6");
+ ok ( $row = $csv->getline (*FH), "getline 4");
+ is (scalar @$row, 15, "field count");
+ is ($row->[7], "Points", "field 8");
+ ok ( $row = $csv->getline (*FH), "getline 5");
+ is (scalar @$row, 15, "field count");
+ is ($row->[7], 11, "field 8");
+ ok ( $row = $csv->getline (*FH), "getline 6");
+ is (scalar @$row, 15, "field count");
+ is ($row->[8], 34, "field 9");
+ ok ( $row = $csv->getline (*FH), "getline 7");
+ is (scalar @$row, 15, "field count");
+ is ($row->[7], 12, "field 8");
+ ok ( $row = $csv->getline (*FH), "getline 8");
+ is (scalar @$row, 15, "field count");
+ is ($row->[8], 2, "field 9");
+ ok ( $row = $csv->getline (*FH), "getline 9");
+ is (scalar @$row, 15, "field count");
+ is ($row->[3], "devs", "field 4");
+ ok ( $row = $csv->getline (*FH), "getline 10");
+ is (scalar @$row, 15, "field count");
+ is ($row->[3], "", "field 4");
+ ok ( $row = $csv->getline (*FH), "getline 11");
+ is (scalar @$row, 15, "field count");
+ is ($row->[6], "Mean", "field 7");
+ ok ( $row = $csv->getline (*FH), "getline 12");
+ is (scalar @$row, 15, "field count");
+ is ($row->[6], "Median", "field 7");
+ ok ( $row = $csv->getline (*FH), "getline 13");
+ is (scalar @$row, 15, "field count");
+ is ($row->[6], "Mode", "field 7");
+ ok ( $row = $csv->getline (*FH), "getline 14");
+ is (scalar @$row, 15, "field count");
+ is ($row->[6], "Min", "field 7");
+ ok ( $row = $csv->getline (*FH), "getline 15");
+ is (scalar @$row, 15, "field count");
+ is ($row->[6], "Max", "field 7");
+ ok ( $row = $csv->getline (*FH), "getline 16");
+ is (scalar @$row, 15, "field count");
+ is ($row->[0], "", "field 1");
+ }
+
1;
Added: branches/upstream/libtext-csv-perl/current/t/51_utf8.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-perl/current/t/51_utf8.t?rev=66552&op=file
==============================================================================
--- branches/upstream/libtext-csv-perl/current/t/51_utf8.t (added)
+++ branches/upstream/libtext-csv-perl/current/t/51_utf8.t Tue Dec 28 13:44:18 2010
@@ -1,0 +1,96 @@
+#!/usr/bin/perl
+
+use strict;
+$^W = 1;
+
+use Test::More;
+
+BEGIN {
+ $ENV{PERL_TEXT_CSV} = 0;
+ $] < 5.008 and
+ plan skip_all => "UTF8 tests useless in this ancient perl version";
+ }
+
+my @tests;
+
+BEGIN {
+ delete $ENV{PERLIO};
+
+ my $euro_ch = "\x{20ac}";
+
+ utf8::encode (my $bytes = $euro_ch);
+ utf8::downgrade (my $bytes_dn = $bytes);
+ utf8::upgrade (my $bytes_up = $bytes);
+
+ @tests = (
+ # $test $perlio $data, $encoding $expect_w
+ # ---------------------------- ------------------- ----------- --------- ----------
+ [ "Unicode default", "", $euro_ch, "utf8", "warn", ],
+ [ "Unicode binmode", "[binmode]", $euro_ch, "utf8", "warn", ],
+ [ "Unicode :utf8", ":utf8", $euro_ch, "utf8", "no warn", ],
+ [ "Unicode :encoding(utf8)", ":encoding(utf8)", $euro_ch, "utf8", "no warn", ],
+ [ "Unicode :encoding(UTF-8)", ":encoding(UTF-8)", $euro_ch, "utf8", "no warn", ],
+
+ [ "bytes dn default", "", $bytes_dn, "[none]", "no warn", ],
+ [ "bytes dn binmode", "[binmode]", $bytes_dn, "[none]", "no warn", ],
+ [ "bytes dn :utf8", ":utf8", $bytes_dn, "utf8", "no warn", ],
+ [ "bytes dn :encoding(utf8)", ":encoding(utf8)", $bytes_dn, "utf8", "no warn", ],
+ [ "bytes dn :encoding(UTF-8)", ":encoding(UTF-8)", $bytes_dn, "utf8", "no warn", ],
+
+ [ "bytes up default", "", $bytes_up, "[none]", "no warn", ],
+ [ "bytes up binmode", "[binmode]", $bytes_up, "[none]", "no warn", ],
+ [ "bytes up :utf8", ":utf8", $bytes_up, "utf8", "no warn", ],
+ [ "bytes up :encoding(utf8)", ":encoding(utf8)", $bytes_up, "utf8", "no warn", ],
+ [ "bytes up :encoding(UTF-8)", ":encoding(UTF-8)", $bytes_up, "utf8", "no warn", ],
+ );
+
+ plan tests => 1 + 6 * @tests;
+ }
+
+BEGIN {
+ require_ok "Text::CSV";
+ plan skip_all => "Cannot load Text::CSV" if $@;
+ require "t/util.pl";
+ }
+
+sub hexify { join " ", map { sprintf "%02x", $_ } unpack "C*", @_ }
+sub warned { length ($_[0]) ? "warn" : "no warn" }
+
+my $csv = Text::CSV->new ({ auto_diag => 1, binary => 1 });
+
+for (@tests) {
+ my ($test, $perlio, $data, $enc, $expect_w) = @$_;
+
+ my $expect = qq{"$data"};
+ $enc eq "utf8" and utf8::encode ($expect);
+
+ my ($p_out, $p_fh) = ("");
+ my ($c_out, $c_fh) = ("");
+
+ if ($perlio eq "[binmode]") {
+ open $p_fh, ">", \$p_out; binmode $p_fh;
+ open $c_fh, ">", \$c_out; binmode $c_fh;
+ }
+ else {
+ open $p_fh, ">$perlio", \$p_out;
+ open $c_fh, ">$perlio", \$c_out;
+ }
+
+ my $p_warn = "";
+ { local $SIG{__WARN__} = sub { $p_warn .= join "", @_ };
+ ok ((print $p_fh qq{"$data"}), "$test perl print");
+ close $p_fh;
+ }
+
+ my $c_warn = "";
+ { local $SIG{__WARN__} = sub { $c_warn .= join "", @_ };
+ ok ($csv->print ($c_fh, [ $data ]), "$test csv print");
+ close $c_fh;
+ }
+
+ is (hexify ($c_out), hexify ($p_out), "$test against Perl");
+ is (hexify ($c_out), hexify ($expect), "$test against expected");
+
+ is (warned ($c_warn), warned ($p_warn), "$test against Perl warning");
+ is (warned ($c_warn), $expect_w, "$test against expected warning");
+ }
Modified: branches/upstream/libtext-csv-perl/current/t/70_rt.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-perl/current/t/70_rt.t?rev=66552&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/t/70_rt.t (original)
+++ branches/upstream/libtext-csv-perl/current/t/70_rt.t Tue Dec 28 13:44:18 2010
@@ -4,12 +4,13 @@
$^W = 1;
#use Test::More "no_plan";
- use Test::More tests => 397;
+ use Test::More tests => 438;
BEGIN {
$ENV{PERL_TEXT_CSV} = 0;
use_ok "Text::CSV", ();
plan skip_all => "Cannot load Text::CSV" if $@;
+ require "t/util.pl";
}
my $csv_file = "_70test.csv";
@@ -280,6 +281,24 @@
unlink $csv_file;
}
+{ # Ruslan reported a case where only Text::CSV_PP misbehaved (regression test)
+ $rt = "x1001";
+ open FH, ">$csv_file";
+ print FH @{$input{$rt}};
+ close FH;
+ my ($c1, $c2);
+ ok (my $csv = Text::CSV->new (), "RT-$rt: $desc{$rt}");
+ open FH, "<$csv_file";
+ for (1 .. 4) {
+ ok (my $row = $csv->getline (*FH), "getline ($_)");
+ is (scalar @$row, 2, "Line $_: 2 columns");
+ my @exp = $_ <= 2 ? ("0", "A") : ("A", "0");
+ is_deeply ($row, \@exp, "@exp");
+ }
+ close FH;
+ unlink $csv_file;
+ }
+
{ # http://rt.cpan.org/Ticket/Display.html?id=58356
# 58356 - Incorrect CSV generated if "quote_space => 0"
$rt = "58356";
@@ -293,7 +312,10 @@
{ # http://rt.cpan.org/Ticket/Display.html?id=61525
$rt = "61525";
- foreach my $eol ("\n", "!") {
+ # First try with eol in constructor
+ foreach my $eol ("\n", "\r", "!") {
+ $/ = "\n";
+ my $s_eol = _readable ($eol);
ok (my $csv = Text::CSV->new ({
binary => 1,
sep_char => ":",
@@ -301,12 +323,39 @@
escape_char => '"',
eol => $eol,
auto_diag => 1,
- }), "RT-$rt: $desc{$rt}");
+ }), "RT-$rt: $desc{$rt} - eol = $s_eol (1)");
open FH, ">$csv_file";
print FH join $eol => qw( "a":"b" "c":"d" "e":"x!y" "!!":"z" );
close FH;
+ open FH, "<$csv_file";
+ is_deeply ($csv->getline (*FH), [ "a", "b" ], "Pair 1");
+ is_deeply ($csv->getline (*FH), [ "c", "d" ], "Pair 2");
+ is_deeply ($csv->getline (*FH), [ "e", "x!y" ], "Pair 3");
+ is_deeply ($csv->getline (*FH), [ "!!", "z" ], "Pair 4");
+ is ($csv->getline (*FH), undef, "no more pairs");
+ ok ($csv->eof, "EOF");
+ close FH;
+ unlink $csv_file;
+ }
+
+ # And secondly with eol as method only if not one of the defaults
+ foreach my $eol ("\n", "\r", "!") {
+ $/ = "\n";
+ my $s_eol = _readable ($eol);
+ ok (my $csv = Text::CSV->new ({
+ binary => 1,
+ sep_char => ":",
+ quote_char => '"',
+ escape_char => '"',
+ auto_diag => 1,
+ }), "RT-$rt: $desc{$rt} - eol = $s_eol (2)");
+ $eol eq "!" and $csv->eol ($eol);
+
+ open FH, ">$csv_file";
+ print FH join $eol => qw( "a":"b" "c":"d" "e":"x!y" "!!":"z" );
+ close FH;
open FH, "<$csv_file";
is_deeply ($csv->getline (*FH), [ "a", "b" ], "Pair 1");
is_deeply ($csv->getline (*FH), [ "c", "d" ], "Pair 2");
@@ -363,3 +412,8 @@
--------------090302050909040309030109--
«58356» - Incorrect CSV generated if "quote_space => 0"
«61525» - eol not working for values other than "\n"?
+«x1001» - Lines starting with "0" (Ruslan Dautkhanov)
+"0","A"
+"0","A"
+"A","0"
+"A","0"
Added: branches/upstream/libtext-csv-perl/current/t/77_getall.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-perl/current/t/77_getall.t?rev=66552&op=file
==============================================================================
--- branches/upstream/libtext-csv-perl/current/t/77_getall.t (added)
+++ branches/upstream/libtext-csv-perl/current/t/77_getall.t Tue Dec 28 13:44:18 2010
@@ -1,0 +1,70 @@
+#!/usr/bin/perl
+
+use strict;
+$^W = 1;
+
+use Test::More tests => 29;
+
+BEGIN {
+ $ENV{PERL_TEXT_CSV} = 0;
+ require_ok "Text::CSV";
+ plan skip_all => "Cannot load Text::CSV" if $@;
+ require "t/util.pl";
+ }
+
+$| = 1;
+
+my @list = (
+ [ 1, "a", "\x01", "A" ],
+ [ 2, "b", "\x02", "B" ],
+ [ 3, "c", "\x03", "C" ],
+ [ 4, "d", "\x04", "D" ],
+ );
+
+{ ok (my $csv = Text::CSV->new ({ binary => 1, eol => "\n" }), "csv out");
+ open FH, ">_77test.csv" or die "_77test.csv: $!";
+ ok ($csv->print (*FH, $_), "write $_->[0]") for @list;
+ close FH;
+ }
+
+sub do_tests
+{
+ my $sub = shift;
+
+ $sub->(\@list);
+ $sub->(\@list, 0);
+ $sub->([@list[2,3]], 2);
+ $sub->([], 0, 0);
+ $sub->(\@list, 0, 10);
+ $sub->([@list[0,1]], 0, 2);
+ $sub->([@list[1,2]], 1, 2);
+ $sub->([@list[1..3]], -3);
+ $sub->([@list[1,2]], -3, 2);
+ $sub->([@list[1..3]], -3, 3);
+ } # do_tests
+
+{ ok (my $csv = Text::CSV->new ({ binary => 1 }), "csv in");
+
+ do_tests (sub {
+ my ($expect, @args) = @_;
+ open FH, "<_77test.csv" or die "_77test.csv: $!";
+ my $s_args = join ", " => @args;
+ is_deeply ($csv->getline_all (*FH, @args), $expect, "getline_all ($s_args)");
+ close FH;
+ });
+ }
+
+{ ok (my $csv = Text::CSV->new ({ binary => 1 }), "csv in");
+ ok ($csv->column_names (my @cn = qw( foo bar bin baz )));
+ @list = map { my %h; @h{@cn} = @$_; \%h } @list;
+
+ do_tests (sub {
+ my ($expect, @args) = @_;
+ open FH, "<_77test.csv" or die "_77test.csv: $!";
+ my $s_args = join ", " => @args;
+ is_deeply ($csv->getline_hr_all (*FH, @args), $expect, "getline_hr_all ($s_args)");
+ close FH;
+ });
+ }
+
+unlink "_77test.csv";
Modified: branches/upstream/libtext-csv-perl/current/t/80_diag.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-perl/current/t/80_diag.t?rev=66552&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/t/80_diag.t (original)
+++ branches/upstream/libtext-csv-perl/current/t/80_diag.t Tue Dec 28 13:44:18 2010
@@ -3,7 +3,7 @@
use strict;
$^W = 1;
- use Test::More tests => 99;
+ use Test::More tests => 124;
#use Test::More "no_plan";
my %err;
@@ -119,4 +119,29 @@
like ($@, qr '^# CSV_PP ERROR: 2027 -', "2 - error message");
}
+SKIP: {
+ skip "incompatible between PP and XS", 25;
+{ my @warn;
+ local $SIG{__WARN__} = sub { push @warn, @_ };
+ Text::CSV->new ()->_cache_diag ();
+ ok (@warn == 1, "Got warn");
+ is ($warn[0], "CACHE: invalid\n", "Uninitialized cache");
+ }
+
+my $diag_file = "_$$.out";
+open EH, ">&STDERR";
+open STDERR, ">$diag_file";
+ok ($csv->_cache_diag, "Cache debugging output");
+close STDERR;
+open STDERR, ">&EH";
+open EH, "<$diag_file";
+is (scalar <EH>, "CACHE:\n", "Title");
+while (<EH>) {
+ like ($_, qr{^ \w+\s+[0-9a-f]+:(?:".*"|\s*[0-9]+)$}, "Content");
+ }
+close EH;
+unlink $diag_file;
+
+}
+
1;
More information about the Pkg-perl-cvs-commits
mailing list