r21854 - in /branches/upstream/libtext-csv-xs-perl/current: CSV_XS.pm CSV_XS.xs ChangeLog META.yml t/50_utf8.t t/75_hashref.t

gregoa at users.alioth.debian.org gregoa at users.alioth.debian.org
Wed Jun 18 17:32:14 UTC 2008


Author: gregoa
Date: Wed Jun 18 17:32:14 2008
New Revision: 21854

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

Modified:
    branches/upstream/libtext-csv-xs-perl/current/CSV_XS.pm
    branches/upstream/libtext-csv-xs-perl/current/CSV_XS.xs
    branches/upstream/libtext-csv-xs-perl/current/ChangeLog
    branches/upstream/libtext-csv-xs-perl/current/META.yml
    branches/upstream/libtext-csv-xs-perl/current/t/50_utf8.t
    branches/upstream/libtext-csv-xs-perl/current/t/75_hashref.t

Modified: branches/upstream/libtext-csv-xs-perl/current/CSV_XS.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libtext-csv-xs-perl/current/CSV_XS.pm?rev=21854&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/CSV_XS.pm (original)
+++ branches/upstream/libtext-csv-xs-perl/current/CSV_XS.pm Wed Jun 18 17:32:14 2008
@@ -30,7 +30,7 @@
 use Carp;
 
 use vars   qw( $VERSION @ISA );
-$VERSION = "0.50";
+$VERSION = "0.51";
 @ISA     = qw( DynaLoader );
 
 sub PV { 0 }
@@ -118,9 +118,10 @@
     has_types		=> 21,
     verbatim		=> 22,
 
-    _is_bound		=> 23,
+    _is_bound		=> 23,	# 23 .. 26
     );
-sub _set_attr
+
+sub _set_attr_C
 {
     my ($self, $name, $val) = @_;
     $self->{$name} = $val;
@@ -128,28 +129,39 @@
     my @cache = unpack "C*", $self->{_CACHE};
     $cache[$_cache_id{$name}] = defined $val ? unpack "C", $val : 0;
     $self->{_CACHE} = pack "C*", @cache;
-    } # _set_attr
+    } # _set_attr_C
+
+sub _set_attr_N
+{
+    my ($self, $name, $val) = @_;
+    $self->{$name} = $val;
+    $self->{_CACHE} or return;
+    my @cache = unpack "C*", $self->{_CACHE};
+    my $i = $_cache_id{$name};
+    $cache[$i++] = $_ for unpack "C*", pack "N", defined $val ? $val : 0;
+    $self->{_CACHE} = pack "C*", @cache;
+    } # _set_attr_N
 
 # Accessor methods.
 #   It is unwise to change them halfway through a single file!
 sub quote_char
 {
     my $self = shift;
-    @_ and $self->_set_attr ("quote_char", shift);
+    @_ and $self->_set_attr_C ("quote_char", shift);
     $self->{quote_char};
     } # quote_char
 
 sub escape_char
 {
     my $self = shift;
-    @_ and $self->_set_attr ("escape_char", shift);
+    @_ and $self->_set_attr_C ("escape_char", shift);
     $self->{escape_char};
     } # escape_char
 
 sub sep_char
 {
     my $self = shift;
-    @_ and $self->_set_attr ("sep_char", shift);
+    @_ and $self->_set_attr_C ("sep_char", shift);
     $self->{sep_char};
     } # sep_char
 
@@ -178,56 +190,56 @@
 sub always_quote
 {
     my $self = shift;
-    @_ and $self->_set_attr ("always_quote", shift);
+    @_ and $self->_set_attr_C ("always_quote", shift);
     $self->{always_quote};
     } # always_quote
 
 sub binary
 {
     my $self = shift;
-    @_ and $self->_set_attr ("binary", shift);
+    @_ and $self->_set_attr_C ("binary", shift);
     $self->{binary};
     } # binary
 
 sub keep_meta_info
 {
     my $self = shift;
-    @_ and $self->_set_attr ("keep_meta_info", shift);
+    @_ and $self->_set_attr_C ("keep_meta_info", shift);
     $self->{keep_meta_info};
     } # keep_meta_info
 
 sub allow_loose_quotes
 {
     my $self = shift;
-    @_ and $self->_set_attr ("allow_loose_quotes", shift);
+    @_ and $self->_set_attr_C ("allow_loose_quotes", shift);
     $self->{allow_loose_quotes};
     } # allow_loose_quotes
 
 sub allow_loose_escapes
 {
     my $self = shift;
-    @_ and $self->_set_attr ("allow_loose_escapes", shift);
+    @_ and $self->_set_attr_C ("allow_loose_escapes", shift);
     $self->{allow_loose_escapes};
     } # allow_loose_escapes
 
 sub allow_whitespace
 {
     my $self = shift;
-    @_ and $self->_set_attr ("allow_whitespace", shift);
+    @_ and $self->_set_attr_C ("allow_whitespace", shift);
     $self->{allow_whitespace};
     } # allow_whitespace
 
 sub blank_is_undef
 {
     my $self = shift;
-    @_ and $self->_set_attr ("blank_is_undef", shift);
+    @_ and $self->_set_attr_C ("blank_is_undef", shift);
     $self->{blank_is_undef};
     } # blank_is_undef
 
 sub verbatim
 {
     my $self = shift;
-    @_ and $self->_set_attr ("verbatim", shift);
+    @_ and $self->_set_attr_C ("verbatim", shift);
     $self->{verbatim};
     } # verbatim
 
@@ -408,7 +420,7 @@
 	croak ($self->SetDiag (3001));
 	}
 
-    $self->{_is_bound} && @keys != unpack "C", $self->{_is_bound} and
+    $self->{_is_bound} && @keys != $self->{_is_bound} and
 	croak ($self->SetDiag (3003));
 
     $self->{_COLUMN_NAMES} = [ @keys ];
@@ -427,12 +439,10 @@
     $self->{_COLUMN_NAMES} && @refs != @{$self->{_COLUMN_NAMES}} and
 	croak ($self->SetDiag (3003));
 
-    @refs > 255 and croak ($self->SetDiag (3005));
-
     join "", map { ref $_ eq "SCALAR" ? "" : "*" } @refs and
 	croak ($self->SetDiag (3004));
 
-    $self->_set_attr ("_is_bound", pack "C" => scalar @refs);
+    $self->_set_attr_N ("_is_bound", scalar @refs);
     $self->{_BOUND_COLUMNS} = [ @refs ];
     @refs;
     } # column_names
@@ -783,6 +793,11 @@
 including line feeds, carriage returns and NULL bytes. (The latter must
 be escaped as C<"0>.) By default this feature is off.
 
+If a string is marked UTF8, binary will be turned on automatically when
+binary characters other than CR or NL are encountered. Note that a simple
+string like C<"\x{00a0}"> might still be binary, but not marked UTF8, so
+setting C<{ binary => 1 }> is still a wise option.
+
 =item types
 
 A set of column types; this attribute is immediately passed to the
@@ -979,7 +994,7 @@
 
 =head2 bind_columns
 
-Takes a list of references to scalars (max 255) to store the fields fetched
+Takes a list of references to scalars to store the fields fetched
 C<getline ()> in. When you don't pass enough references to store the
 fetched fields in, C<getline ()> will fail. If you pass more than there are
 fields to return, the remaining references are left untouched.
@@ -1138,7 +1153,7 @@
 
  $csv->SetDiag (0);
 
-Use to reset the diagnosticts if you are dealing with errors.
+Use to reset the diagnostics if you are dealing with errors.
 
 =head1 INTERNALS
 
@@ -1347,7 +1362,7 @@
 normal cases - when no error occured - may cause unexpected results.
 
 Currently errors as described below are available. I've tried to make the error
-itself explainatory enough, but more descriptions will be added. For most of
+itself explanatory enough, but more descriptions will be added. For most of
 these errors, the first three capitals describe the error category:
 
 =over 2
@@ -1362,7 +1377,7 @@
 
 =item EOF
 
-Enf-Of-File related parse error.
+End-Of-File related parse error.
 
 =item EIQ
 
@@ -1454,8 +1469,6 @@
 =item 3003 "EHR - bind_columns () and column_names () fields count mismatch"
 
 =item 3004 "EHR - bind_columns () only accepts refs to scalars"
-
-=item 3005 "EHR - bind_columns () takes 254 refs max"
 
 =item 3006 "EHR - bind_columns () did not pass enough refs for parsed fields"
 

Modified: branches/upstream/libtext-csv-xs-perl/current/CSV_XS.xs
URL: http://svn.debian.org/wsvn/branches/upstream/libtext-csv-xs-perl/current/CSV_XS.xs?rev=21854&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/CSV_XS.xs (original)
+++ branches/upstream/libtext-csv-xs-perl/current/CSV_XS.xs Wed Jun 18 17:32:14 2008
@@ -90,7 +90,7 @@
 
     byte	blank_is_undef;
     byte	verbatim;
-    byte	is_bound;
+    long	is_bound;
     byte	reserved1;
 #endif
 
@@ -156,7 +156,6 @@
     { 3002, "EHR - getline_hr () called before column_names ()"			},
     { 3003, "EHR - bind_columns () and column_names () fields count mismatch"	},
     { 3004, "EHR - bind_columns () only accepts refs to scalars"		},
-    { 3005, "EHR - bind_columns () takes 254 refs max"				},
     { 3006, "EHR - bind_columns () did not pass enough refs for parsed fields"	},
     { 3007, "EHR - bind_columns needs refs to writeable scalars"		},
     { 3008, "EHR - unexpected error in bound fields"				},
@@ -221,7 +220,6 @@
 	csv->blank_is_undef		= csv->cache[CACHE_ID_blank_is_undef	];
 	csv->verbatim			= csv->cache[CACHE_ID_verbatim		];
 #endif
-	csv->is_bound			= csv->cache[CACHE_ID__is_bound		];
 	csv->eol_is_cr			= csv->cache[CACHE_ID_eol_is_cr		];
 	csv->eol_len			= csv->cache[CACHE_ID_eol_len		];
 	if (csv->eol_len < 8)
@@ -236,6 +234,11 @@
 		csv->eol_is_cr = 0;
 		}
 	    }
+	csv->is_bound			=
+	    (csv->cache[CACHE_ID__is_bound    ] << 24) |
+	    (csv->cache[CACHE_ID__is_bound + 1] << 16) |
+	    (csv->cache[CACHE_ID__is_bound + 2] <<  8) |
+	    (csv->cache[CACHE_ID__is_bound + 3]);
 
 	csv->types = NULL;
 	if (csv->cache[CACHE_ID_has_types]) {
@@ -315,12 +318,15 @@
 	csv->cache[CACHE_ID_blank_is_undef]		= csv->blank_is_undef;
 	csv->cache[CACHE_ID_verbatim]			= csv->verbatim;
 #endif
-	csv->cache[CACHE_ID__is_bound]			= csv->is_bound;
 	csv->cache[CACHE_ID_eol_is_cr]			= csv->eol_is_cr;
 	csv->cache[CACHE_ID_eol_len]			= csv->eol_len;
 	if (csv->eol_len > 0 && csv->eol_len < 8 && csv->eol)
 	    strcpy ((char *)&csv->cache[CACHE_ID_eol], csv->eol);
 	csv->cache[CACHE_ID_has_types]			= csv->types ? 1 : 0;
+	csv->cache[CACHE_ID__is_bound    ] = (csv->is_bound & 0xFF000000) >> 24;
+	csv->cache[CACHE_ID__is_bound + 1] = (csv->is_bound & 0x00FF0000) >> 16;
+	csv->cache[CACHE_ID__is_bound + 2] = (csv->is_bound & 0x0000FF00) >>  8;
+	csv->cache[CACHE_ID__is_bound + 3] = (csv->is_bound & 0x000000FF);
 
 	if ((csv->tmp = newSVpvn ((char *)csv->cache, CACHE_SIZE)))
 	    hv_store (self, "_CACHE", 6, csv->tmp, 0);
@@ -428,11 +434,15 @@
 		int	e = 0;
 
 		if (!csv->binary && is_csv_binary (c)) {
-		    SvREFCNT_inc (*svp);
-		    unless (hv_store (csv->self, "_ERROR_INPUT", 12, *svp, 0))
-			SvREFCNT_dec (*svp);
-		    (void)SetDiag (csv, 2110);
-		    return FALSE;
+		    if (SvUTF8 (*svp))
+			csv->binary = 1;
+		    else {
+			SvREFCNT_inc (*svp);
+			unless (hv_store (csv->self, "_ERROR_INPUT", 12, *svp, 0))
+			    SvREFCNT_dec (*svp);
+			(void)SetDiag (csv, 2110);
+			return FALSE;
+			}
 		    }
 		if (csv->quote_char  && c == csv->quote_char)
 		    e = 1;
@@ -1004,7 +1014,7 @@
 	    if (f & CSV_FLAGS_QUO) {
 		if (is_csv_binary (c)) {
 		    f |= CSV_FLAGS_BIN;
-		    unless (csv->binary)
+		    unless (csv->binary || csv->utf8)
 			ERROR_INSIDE_QUOTES (2026);
 		    }
 		CSV_PUT_SV (c);
@@ -1012,7 +1022,7 @@
 	    else {
 		if (is_csv_binary (c)) {
 		    f |= CSV_FLAGS_BIN;
-		    unless (csv->binary)
+		    unless (csv->binary || csv->utf8)
 			ERROR_INSIDE_FIELD (2037);
 		    }
 		CSV_PUT_SV (c);

Modified: branches/upstream/libtext-csv-xs-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/branches/upstream/libtext-csv-xs-perl/current/ChangeLog?rev=21854&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/ChangeLog (original)
+++ branches/upstream/libtext-csv-xs-perl/current/ChangeLog Wed Jun 18 17:32:14 2008
@@ -1,3 +1,9 @@
+2008-06-17  0.51 - H.Merijn Brand   <h.m.brand at xs4all.nl>
+
+	* Allow UTF8 even without binary => 1
+	* Fixed a few pod typo's
+	* Lifted the max of 255 for bind_columns
+
 2008-06-04  0.50 - H.Merijn Brand   <h.m.brand at xs4all.nl>
 
 	* Skip a few tests in automated testing, as they confuse
@@ -13,8 +19,8 @@
 	* Use Test::MinimumVersion (not distributed)
 	* Added option -F to examples/csv2xls
 	* More source code cleanup
-	* Nailed the UTF-8 issues for parsing
-	* Nailed the UTF-8 issues for combining
+	* Nailed the UTF8 issues for parsing
+	* Nailed the UTF8 issues for combining
 
 2008-04-23  0.45 - H.Merijn Brand   <h.m.brand at xs4all.nl>
 

Modified: branches/upstream/libtext-csv-xs-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libtext-csv-xs-perl/current/META.yml?rev=21854&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/META.yml (original)
+++ branches/upstream/libtext-csv-xs-perl/current/META.yml Wed Jun 18 17:32:14 2008
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:              Text-CSV_XS
-version:           0.50
+version:           0.51
 abstract:          Comma-Separated Values manipulation routines
 license:           perl
 author:              
@@ -10,7 +10,7 @@
 provides:
     Text::CSV_XS:
         file:      CSV_XS.pm
-        version:   0.50
+        version:   0.51
 requires:     
     perl:          5.005
     DynaLoader:    0

Modified: branches/upstream/libtext-csv-xs-perl/current/t/50_utf8.t
URL: http://svn.debian.org/wsvn/branches/upstream/libtext-csv-xs-perl/current/t/50_utf8.t?rev=21854&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/t/50_utf8.t (original)
+++ branches/upstream/libtext-csv-xs-perl/current/t/50_utf8.t Wed Jun 18 17:32:14 2008
@@ -10,7 +10,7 @@
 	plan skip_all => "UTF8 tests useless in this ancient perl version";
 	}
     else {
-	plan tests => 64;
+	plan tests => 67;
 	}
     }
 
@@ -20,8 +20,8 @@
     require "t/util.pl";
     }
 
+# No binary => 1, as UTF8 is supposed to be allowed without it
 my $csv = Text::CSV_XS->new ({
-    binary         => 1,
     always_quote   => 1,
     keep_meta_info => 1,
     });
@@ -44,7 +44,7 @@
   #  characters in 128..255
   ) {
     my ($u, $msg) = @$test;
-    utf8::encode ($u);
+    ($u = "$u\x{0123}") =~ s/.$//;	# Make sure it's marked UTF8
     my @in  = ("", " ", $u, "");
     my $exp = join ",", map { qq{"$_"} } @in;
 
@@ -61,6 +61,11 @@
 	is_binary ($in[$_], $out[$_],	"field $_ $msg");
 	}
     }
+
+# Test if the UTF8 part is accepted, but the \n is not
+is ($csv->parse (qq{"\x{0123}\n\x{20ac}"}), 0, "\\n still needs binary");
+is ($csv->binary, 0, "bin flag still unset");
+is ($csv->error_diag + 0, 2021, "Error 2021");
 
 # As all utf tests are skipped for older pers, It's safe to use 3-arg open this way
 my $file = "files/utf8.csv";

Modified: branches/upstream/libtext-csv-xs-perl/current/t/75_hashref.t
URL: http://svn.debian.org/wsvn/branches/upstream/libtext-csv-xs-perl/current/t/75_hashref.t?rev=21854&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/t/75_hashref.t (original)
+++ branches/upstream/libtext-csv-xs-perl/current/t/75_hashref.t Wed Jun 18 17:32:14 2008
@@ -67,8 +67,6 @@
 eval { $csv->bind_columns ({}, {}, {}, {}) };
 is ($csv->error_diag () + 0, 3004,		"bad arg types");
 is ($csv->column_names (undef), undef,		"reset column_names");
-eval { $csv->bind_columns ((\$code) x 300) };
-is ($csv->error_diag () + 0, 3005,		"too many args");
 ok ($csv->bind_columns (\($code, $name, $price)), "Bind columns");
 
 eval { $csv->column_names ("foo") };
@@ -96,9 +94,12 @@
 ($code, $name, $price, $desc, $foo) = (101 .. 105);
 ok ($csv->getline (*FH),			"fetch less than expected");
 is_deeply ( [ $code, $name, $price, $desc, $foo ],
-	    [ 2, "Drinks", "82.78", "Drinks", 105 ],		"unfetched not reset");
+	    [ 2, "Drinks", "82.78", "Drinks", 105 ],	"unfetched not reset");
 
-ok ($csv->bind_columns (\1, \2, \3, \""),	"bind too many columns");
+my @foo = (0) x 0x012345;
+ok ($csv->bind_columns (\(@foo)),		"bind a lot of columns");
+
+ok ($csv->bind_columns (\1, \2, \3, \""),	"bind too constant columns");
 is ($csv->getline (*FH), undef,			"fetch to read-only ref");
 is ($csv->error_diag () + 0, 3008,		"Read-only");
 




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