r41075 - in /branches/upstream/libtext-csv-perl/current: Changes META.yml README lib/Text/CSV.pm lib/Text/CSV_PP.pm t/71_pp.t

ansgar-guest at users.alioth.debian.org ansgar-guest at users.alioth.debian.org
Sat Aug 1 12:16:48 UTC 2009


Author: ansgar-guest
Date: Sat Aug  1 12:16:26 2009
New Revision: 41075

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=41075
Log:
[svn-upgrade] Integrating new upstream version, libtext-csv-perl (1.13)

Modified:
    branches/upstream/libtext-csv-perl/current/Changes
    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/71_pp.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=41075&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/Changes (original)
+++ branches/upstream/libtext-csv-perl/current/Changes Sat Aug  1 12:16:26 2009
@@ -1,4 +1,8 @@
 Revision history for Perl extension Text::CSV.
+
+1.13  Fri Jul 31 12:02:53 2009
+	- getline() didn't handle '0' starting multi line data
+	                                 (pointed by Diego Santa Cruz).
 
 1.12  Sat May 16 10:46:38 2009
 	- updated the compatibility for Text::CSV_XS version 0.65

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=41075&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/META.yml (original)
+++ branches/upstream/libtext-csv-perl/current/META.yml Sat Aug  1 12:16:26 2009
@@ -1,16 +1,22 @@
 --- #YAML:1.0
-name:                Text-CSV
-version:             1.12
-abstract:            comma-separated values manipulator (using XS or PurePerl)
-license:             perl
-author:              
+name:               Text-CSV
+version:            1.13
+abstract:           comma-separated values manipulator (using XS or PurePerl)
+author:
     - Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
-generated_by:        ExtUtils::MakeMaker version 6.42
-distribution_type:   module
-requires:     
-    IO::Handle:                    0
-    Test::Harness:                 0
-    Test::More:                    0
+license:            perl
+distribution_type:  module
+configure_requires:
+    ExtUtils::MakeMaker:  0
+requires:
+    IO::Handle:     0
+    Test::Harness:  0
+    Test::More:     0
+no_index:
+    directory:
+        - t
+        - inc
+generated_by:       ExtUtils::MakeMaker version 6.48
 meta-spec:
-    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
-    version: 1.3
+    url:      http://module-build.sourceforge.net/META-spec-v1.4.html
+    version:  1.4

Modified: branches/upstream/libtext-csv-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-perl/current/README?rev=41075&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/README (original)
+++ branches/upstream/libtext-csv-perl/current/README Sat Aug  1 12:16:26 2009
@@ -1,4 +1,4 @@
-Text::CSV version 1.12
+Text::CSV version 1.13
 ========================
 
 comma-separated values manipulator

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=41075&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/lib/Text/CSV.pm (original)
+++ branches/upstream/libtext-csv-perl/current/lib/Text/CSV.pm Sat Aug  1 12:16:26 2009
@@ -5,7 +5,7 @@
 use Carp ();
 
 BEGIN {
-    $Text::CSV::VERSION = '1.12';
+    $Text::CSV::VERSION = '1.13';
     $Text::CSV::DEBUG   = 0;
 }
 
@@ -270,7 +270,7 @@
 
 =head1 VERSION
 
-    1.12
+    1.13
 
 This module is compatible with Text::CSV_XS B<0.65> and later.
 

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=41075&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 Sat Aug  1 12:16:26 2009
@@ -11,7 +11,7 @@
 use vars qw($VERSION);
 use Carp ();
 
-$VERSION = '1.20';
+$VERSION = '1.21';
 
 sub PV  { 0 }
 sub IV  { 1 }
@@ -300,7 +300,13 @@
 *parse = \&_parse;
 
 sub _parse {
-    my ($self, $line) = @_;
+    my ($self, $line, $useio) = @_;
+    my $data;
+
+    if ( $useio ) {
+        return if eof($useio);
+        $line = $useio->getline();
+    }
 
     @{$self}{qw/_STRING _FIELDS _STATUS _ERROR_INPUT/} = ( \do{ defined $line ? "$line" : undef }, undef, 0, $line );
 
@@ -356,6 +362,10 @@
     my $utf8 = 1 if utf8::is_utf8( $line ); # if UTF8 marked, flag on.
 
     for my $col ( $line =~ /$re_split/g ) {
+
+        if ( $useio ) {
+#            print "=$line=";
+        }
 
         if ($keep_meta_info) {
             $flag = 0x0000;
@@ -435,6 +445,13 @@
         elsif ($col =~ $re_invalid_quot) {
 
             unless ($self->{allow_loose_quotes} and $col =~ /$re_quot_char/) {
+
+                if ( $useio ) {
+                    return if eof($useio);
+                    $line .= $useio->getline();
+                    next;
+                }
+
                 $self->_set_error_diag(
                       $col =~ /^\Q$quot\E(.*)\Q$quot\E.$/s  ? (2011, $pos - 2)
                     : $col =~ /^$re_quot_char/              ? (2027, $pos - 1)
@@ -571,19 +588,91 @@
 
     $self->{_EOF} = eof($io) ? 1 : '';
 
+#    $self->_parse( undef, $io ) or return;
+
+
     my $line = $io->getline();
     my $quot = $self->{quote_char};
-    my $re   = $self->binary ? qr/(?:\Q$quot\E)(?!0)/ : qr/(?:\Q$quot\E)/;
-
-    $line .= $io->getline() while ( defined $line and scalar(my @list = $line =~ /$re/g) % 2 and !eof($io) );
-
-    my $eol = $self->{eol};
+    my $sep  = $self->{sep_char};
+    my $eol  = $self->{eol};
+
+    my $re   = qr/(?:\Q$quot\E)/;
+
+    if ( defined $line and $line =~ /${re}0/ ) {
+#        print "=$line=\n";
+        while ( not $self->_parse($line) and !eof($io) ) {
+#            print $self->error_diag, "???\n";
+#            print "\t=$line=\n";
+            $line .= $io->getline();
+        }
+    }
+    else {
+        $line .= $io->getline() while ( defined $line and scalar(my @list = $line =~ /$re/g) % 2 and !eof($io) );
+
+        if (defined $eol and defined $line) {
+            $line =~ s/\Q$eol\E$//;
+        }
+
+        $self->_parse($line) or return;
+    }
+
+
+
+=pod
+
+    if ( $self->binary ) {
+        my $start = 0;
+        my $re   = qr/(?:\Q$quot\E)/;
+
+        while (
+                ( defined $line and !eof($io) ) and (
+                    ( $line !~ /[^$re]${re}0/ and scalar(my @list = $line =~ /$re/g) % 2 )
+                        or 
+                    ( scalar(my @list = $line =~ /(?![^$re]${re}0)/g) % 2 )
+#                        or 
+#                    ( scalar(my @list = $line =~ /(?:^|\Q$sep\E) *(?:\Q$quot\E)/g) % 2 )
+                )
+        )
+        {
+            $line .= $io->getline()
+        }
+#        if ( defined $line and $line =~ /(?:^|\Q$sep\E) *(?:\Q$quot\E)/ and !eof($io)  ){
+#            print "firstline\n";
+#        } # first line
+    }
+    else {
+        my $re   = qr/(?:\Q$quot\E)/;
+        $line .= $io->getline() while ( defined $line and scalar(my @list = $line =~ /$re/g) % 2 and !eof($io) );
+    }
 
     if (defined $eol and defined $line) {
         $line =~ s/\Q$eol\E$//;
     }
-
+print "=$line=\n";
     $self->_parse($line) or return;
+
+#=pod
+
+#    my $re   = qr/(?:\Q$quot\E)/;
+#    my $re   = $self->binary ? qr/(?:\Q$quot\E)(?!0)/ : qr/(?:\Q$quot\E)/;
+#    my $re   = $self->binary ? qr/(?:^|\Q$sep\E) *(?:\Q$quot\E)|(?:\Q$quot\E)(?:(?![0\Q$quot\E])|\Q$sep\E|$)/ : qr/(?:\Q$quot\E)/;
+#    my $re   = $self->binary ? qr/(?:\Q$quot\E)|(?:\Q$quot\E)(?![0\Q$quot\E])/ : qr/(?:\Q$quot\E)/;
+    my $re   = $self->binary ? qr/(?:^|\Q$sep\E) *(?:\Q$quot\E)|(?:\Q$quot$quot\E)*(?:\Q$quot\E)0/ : qr/(?:\Q$quot\E)/;
+
+#    $line .= $io->getline() while ( defined $line and scalar(my @list = $line =~ /$re/g) % 2 and !eof($io) );
+#print "=$line=\n";
+#    my $eol = $self->{eol};
+
+#    $line = $io->getline();
+#     while ( defined $line and scalar(my @list = $line =~ /$re/g) % 2 and !eof($io) );
+
+#    if (defined $eol and defined $line) {
+#        $line =~ s/\Q$eol\E$//;
+#    }
+#print "=====$line======\n";
+#    $self->_parse($line,1) or return;
+
+=cut
 
     if ( $self->{_BOUND_COLUMNS} ) {
         my @vals  = $self->_fields();

Modified: branches/upstream/libtext-csv-perl/current/t/71_pp.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-perl/current/t/71_pp.t?rev=41075&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/t/71_pp.t (original)
+++ branches/upstream/libtext-csv-perl/current/t/71_pp.t Sat Aug  1 12:16:26 2009
@@ -5,7 +5,7 @@
 use strict;
 $^W = 1;
 
-use Test::More tests => 7;
+use Test::More tests => 53;
 
 
 BEGIN { $ENV{PERL_TEXT_CSV} = $ARGV[0] || 0; }
@@ -14,6 +14,8 @@
     require_ok "Text::CSV";
     plan skip_all => "Cannot load Text::CSV" if $@;
 }
+
+#warn Text::CSV->backend;
 
 my $csv = Text::CSV->new( { sep_char => "\t", blank_is_undef => 1, allow_whitespace => 1 } );
 
@@ -32,6 +34,7 @@
 
 is( $csv->string, $str );
 
+#=pod
 
 # 2009-05-16
 # getline() handles having escaped null
@@ -45,6 +48,7 @@
 
 my $eol  = "\r\n";
 my $blob = ( join "", map { chr $_ } 0 .. 255 ) x 1;
+#my $blob = ( join "", map { chr $_ } 0 .. 2 ) x 1;
 
 $csv = Text::CSV->new( $opts );
 
@@ -67,5 +71,93 @@
 is( $colref->[0], $blob, "blob" );
 
 close( FH );
+
+#exit;
 unlink( '__test.csv' );
 
+#=cut
+
+# 2009-07-30
+# getline() handles a 0 staring multiline
+
+
+# writting
+open( FH, '>__test.csv' ) or die $!;
+binmode FH;
+
+
+ok( $csv->print( *FH, [ "00" ] ) );
+ok( $csv->print( *FH, [ "\00" ] ) );
+ok( $csv->print( *FH, [ "0\0" ] ) );
+ok( $csv->print( *FH, [ "\0\0" ] ) );
+
+ok( $csv->print( *FH, [ "0\n0" ] ) );
+ok( $csv->print( *FH, [ "\0\n0" ] ) );
+ok( $csv->print( *FH, [ "0\n\0" ] ) );
+ok( $csv->print( *FH, [ "\0\n\0" ] ) );
+
+ok( $csv->print( *FH, [ "\"0\n0" ] ) );
+ok( $csv->print( *FH, [ "\"\0\n0" ] ) );
+ok( $csv->print( *FH, [ "\"0\n\0" ] ) );
+ok( $csv->print( *FH, [ "\"\0\n\0" ] ) );
+
+ok( $csv->print( *FH, [ "\"0\n\"0" ] ) );
+ok( $csv->print( *FH, [ "\"\0\n\"0" ] ) );
+ok( $csv->print( *FH, [ "\"0\n\"\0" ] ) );
+ok( $csv->print( *FH, [ "\"\0\n\"\0" ] ) );
+
+ok( $csv->print( *FH, [ "0\n0", "0\n0" ] ) );
+ok( $csv->print( *FH, [ "\0\n0", "\0\n0" ] ) );
+ok( $csv->print( *FH, [ "0\n\0", "0\n\0" ] ) );
+ok( $csv->print( *FH, [ "\0\n\0", "\0\n\0" ] ) );
+
+$csv->always_quote(1);
+
+ok( $csv->print( *FH, [ "", undef, "0\n", "", "\0\n0" ] ) );
+
+
+close( FH );
+
+# reading
+open( FH, "__test.csv" ) or die $!;
+binmode FH;
+
+is( $csv->getline( *FH )->[0], "00",   '*00' ); # Test::More warns 00
+is( $csv->getline( *FH )->[0], "\00",  '\00' );
+is( $csv->getline( *FH )->[0], "0\0",  '0\0' );
+is( $csv->getline( *FH )->[0], "\0\0", '\0\0' );
+
+is( $csv->getline( *FH )->[0], "0\n0",   '*0\n0' ); # Test::More warns 00
+is( $csv->getline( *FH )->[0], "\0\n0",  '\0\n0' );
+is( $csv->getline( *FH )->[0], "0\n\0",  '0\n\0' );
+is( $csv->getline( *FH )->[0], "\0\n\0", '\0\n\0' );
+
+is( $csv->getline( *FH )->[0], "\"0\n0",   '\"0\n0' );
+is( $csv->getline( *FH )->[0], "\"\0\n0",  '\"\0\n0' );
+is( $csv->getline( *FH )->[0], "\"0\n\0",  '\"0\n\0' );
+is( $csv->getline( *FH )->[0], "\"\0\n\0", '\"\0\n\0' );
+
+is( $csv->getline( *FH )->[0], "\"0\n\"0",   '\"0\n\"0' );
+is( $csv->getline( *FH )->[0], "\"\0\n\"0",  '\"\0\n\"0' );
+is( $csv->getline( *FH )->[0], "\"0\n\"\0",  '\"0\n\"\0' );
+is( $csv->getline( *FH )->[0], "\"\0\n\"\0", '\"\0\n\"\0' );
+
+is( $csv->getline( *FH )->[1], "0\n0",   '*0\n0' ); # Test::More warns 00
+is( $csv->getline( *FH )->[1], "\0\n0",  '\0\n0' );
+is( $csv->getline( *FH )->[1], "0\n\0",  '0\n\0' );
+is( $csv->getline( *FH )->[1], "\0\n\0", '\0\n\0' );
+
+$csv->blank_is_undef(1);
+
+my $col = $csv->getline( *FH );
+
+is( $col->[0], "", '' );
+is( $col->[1], undef, '' );
+is( $col->[2], "0\n", '' );
+is( $col->[3], "", '' );
+is( $col->[4], "\0\n0", '' );
+
+close( FH );
+
+unlink( '__test.csv' );
+




More information about the Pkg-perl-cvs-commits mailing list