Import of HMBRAND/Text-CSV_XS-0.54 from CPAN.

gitpan-cpan-distribution: Text-CSV_XS
gitpan-cpan-version:      0.54
gitpan-cpan-path:         HMBRAND/Text-CSV_XS-0.54.tgz
gitpan-cpan-author:       HMBRAND
gitpan-cpan-maturity:     released

CSV_XS.pm

@@ -30,7 +30,7 @@ use DynaLoader ();
 use Carp;
 
 use vars   qw( $VERSION @ISA );
-$VERSION = "0.53";
+$VERSION = "0.54";
 @ISA     = qw( DynaLoader );
 
 sub PV { 0 }
@@ -1487,6 +1487,8 @@ exhausted before the quote is found, that field is not terminated.
 
 =item 2110 "ECB - Binary character in Combine, binary off"
 
+=item 2200 "EIO - print to IO failed. See errno"
+
 =item 3001 "EHR - Unsupported syntax for column_names ()"
 
 =item 3002 "EHR - getline_hr () called before column_names ()"

CSV_XS.xs

@@ -151,6 +151,9 @@ xs_error_t xs_errors[] =  {
     /* Combine errors */
     { 2110, "ECB - Binary character in Combine, binary off"			},
 
+    /* IO errors */
+    { 2200, "EIO - print to IO failed. See errno"				},
+
     /* Hash-Ref errors */
     { 3001, "EHR - Unsupported syntax for column_names ()"			},
     { 3002, "EHR - getline_hr () called before column_names ()"			},
@@ -357,8 +360,11 @@ static int Print (csv_t *csv, SV *dst)
 	PUTBACK;
 	result = call_method ("print", G_SCALAR);
 	SPAGAIN;
-	if (result)
+	if (result) {
 	    result = POPi;
+	    unless (result)
+		SetDiag (csv, 2200);
+	    }
 	PUTBACK;
 	SvREFCNT_dec (tmp);
 	}
@@ -373,8 +379,10 @@ static int Print (csv_t *csv, SV *dst)
     } /* Print */
 
 #define CSV_PUT(csv,dst,c) {				\
-    if ((csv)->used == sizeof ((csv)->buffer) - 1)	\
-        Print ((csv), (dst));				\
+    if ((csv)->used == sizeof ((csv)->buffer) - 1) {	\
+        unless (Print ((csv), (dst)))			\
+	    return FALSE;				\
+        }						\
     (csv)->buffer[(csv)->used++] = (c);			\
     }
 
@@ -444,10 +452,10 @@ static int Combine (csv_t *csv, SV *dst, AV *fields)
 			return FALSE;
 			}
 		    }
-		if (csv->quote_char  && c == csv->quote_char)
+		if (c == csv->quote_char  && csv->quote_char)
 		    e = 1;
 		else
-		if (csv->escape_char && c == csv->escape_char)
+		if (c == csv->escape_char && csv->escape_char)
 		    e = 1;
 		else
 		if (c == (char)0) {
@@ -470,7 +478,7 @@ static int Combine (csv_t *csv, SV *dst, AV *fields)
 	    CSV_PUT (csv, dst, *ptr++);
 	}
     if (csv->used)
-	Print (csv, dst);
+	return Print (csv, dst);
     return TRUE;
     } /* Combine */
 
@@ -799,7 +807,7 @@ restart:
 		}
 	    } /* CH_CR */
 	else
-	if (csv->quote_char && c == csv->quote_char) {
+	if (c == csv->quote_char && csv->quote_char) {
 #if MAINT_DEBUG > 1
 	    fprintf (stderr, "# %d/%d/%02x pos %d = QUO '%c'\n",
 		waitingForField ? 1 : 0, sv ? 1 : 0, f, spl, c);
@@ -938,7 +946,7 @@ restart:
 		ERROR_INSIDE_FIELD (2034);
 	    } /* QUO char */
 	else
-	if (csv->escape_char && c == csv->escape_char) {
+	if (c == csv->escape_char && csv->escape_char) {
 #if MAINT_DEBUG > 1
 	    fprintf (stderr, "# %d/%d/%02x pos %d = ESC '%c'\n",
 		waitingForField ? 1 : 0, sv ? 1 : 0, f, spl, c);
@@ -1022,7 +1030,7 @@ restart:
 
 	/* continue */
 #if ALLOW_ALLOW
-	if (csv->useIO && csv->verbatim && csv->used == csv->size)
+	if (csv->verbatim && csv->useIO && csv->used == csv->size)
 	    break;
 #endif
 	}

ChangeLog

@@ -1,3 +1,7 @@
+2008-09-04 0.54 - H.Merijn Brand   <h.m.brand@xs4all.nl>
+
+	* IO failure in print () was not propagated (ilmari, RT#38960)
+
 2008-09-01 0.53 - H.Merijn Brand   <h.m.brand@xs4all.nl>
 
 	* SvUPGRADE is a safer choice than sv_upgrade (Lubomir Rintel, RT#38890)

META.yml

@@ -1,6 +1,6 @@
 --- #YAML:1.4
 name:              Text-CSV_XS
-version:           0.53
+version:           0.54
 abstract:          Comma-Separated Values manipulation routines
 license:           perl
 author:              
@@ -10,7 +10,7 @@ distribution_type: module
 provides:
     Text::CSV_XS:
         file:      CSV_XS.pm
-        version:   0.53
+        version:   0.54
 requires:     
     perl:          5.005
     DynaLoader:    0

Makefile.PL

@@ -83,10 +83,13 @@ sub postamble
 	'leaktest:',
 	q{	sandbox/leaktest $(FULLPERLRUN) "test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES)},
 	'',
+	'checkmeta:',
+	'	perl sandbox/genMETA.pl -c',
+	'',
 	'fixmeta:	distmeta',
 	'	perl sandbox/genMETA.pl',
 	'',
-	'tgzdist:	fixmeta $(DISTVNAME).tar.gz distcheck',
+	'tgzdist:	checkmeta fixmeta $(DISTVNAME).tar.gz distcheck',
 	'	-@mv -f $(DISTVNAME).tar.gz $(DISTVNAME).tgz',
 	'	-@cpants_lint.pl $(DISTVNAME).tgz',
 	'',

README

@@ -15,7 +15,7 @@ Copying:
     it under the same terms as Perl itself.
 
     Recent changes can be (re)viewed in the public GIT repository at
-    git://repo.or.cz/Text-CSV_XS.git
+    http://repo.or.cz/w/Text-CSV_XS.git
 
 Prerequisites:
     perl 5.005_03. 5.005 will not be able to build the manual pages.
@@ -27,7 +27,7 @@ Build/Installation:
 	make
 	make test
 	make install
-    (The 'make' step cannot be ommitted for perl-5.005)
+    (The 'make' step cannot be omitted for perl-5.005)
 
 Author:
     H.Merijn Brand <h.m.brand@xs4all.nl>

t/70_rt.t

@@ -4,13 +4,16 @@ use strict;
 $^W = 1;
 
 #use Test::More "no_plan";
- use Test::More tests => 69;
+ use Test::More tests => 73;
 
 BEGIN {
     use_ok "Text::CSV_XS", ();
     plan skip_all => "Cannot load Text::CSV_XS" if $@;
     }
 
+my $csv_file = "_test.csv";
+END { unlink $csv_file }
+
 my $rt_no;
 my %input;
 while (<DATA>) {
@@ -41,11 +44,11 @@ while (<DATA>) {
 {   # http://rt.cpan.org/Ticket/Display.html?id=21530
     # 21530: getline () does not return documented value at end of filehandle
     # IO::Handle  was first released with perl 5.00307
-    open  FH, ">_test.csv";
+    open  FH, ">$csv_file";
     print FH @{$input{21530}};
     close FH;
     ok (my $csv = Text::CSV_XS->new ({ binary => 1 }), "RT-21530: getline () return at eof");
-    open  FH, "<_test.csv";
+    open  FH, "<$csv_file";
     my $row;
     foreach my $line (1 .. 5) {
 	ok ($row = $csv->getline (*FH), "getline $line");
@@ -55,7 +58,7 @@ while (<DATA>) {
     ok (eof FH, "EOF");
     is ($row = $csv->getline (*FH), undef, "getline EOF");
     close FH;
-    unlink "_test.csv";
+    unlink $csv_file;
     }
 
 {   # http://rt.cpan.org/Ticket/Display.html?id=21530
@@ -92,12 +95,12 @@ while (<DATA>) {
 
 {   # http://rt.cpan.org/Ticket/Display.html?id=34474
     # 34474: wish: integrate row-as-hashref feature from Parse::CSV
-    open  FH, ">_test.csv";
+    open  FH, ">$csv_file";
     print FH @{$input{34474}};
     close FH;
     ok (my $csv = Text::CSV_XS->new (),		"RT-34474: getline_hr ()");
     is ($csv->column_names, undef,		"No headers yet");
-    open  FH, "<_test.csv";
+    open  FH, "<$csv_file";
     my $row;
     ok ($row = $csv->getline (*FH),		"getline headers");
     is ($row->[0], "code",			"Header line");
@@ -110,7 +113,24 @@ while (<DATA>) {
 	like ($hr->{name}, qr/^[A-Z][a-z]+$/,	"Name");
 	}
     close FH;
-    unlink "_test.csv";
+    unlink $csv_file;
+    }
+
+{   # http://rt.cpan.org/Ticket/Display.html?id=38960
+    # 38960: print () on invalid filehandle warns and returns success
+    open  FH, ">$csv_file";
+    print FH "";
+    close FH;
+    my $err = "";
+    open  FH, "<$csv_file";
+    ok (my $csv = Text::CSV_XS->new (),		"RT-38960: print () fails");
+    local $SIG{__WARN__} = sub { $err = "Warning" };
+    ok (!$csv->print (*FH, [ 1 .. 4 ]),		"print ()");
+    is ($err, "Warning",			"IO::Handle triggered a warning");
+    my @err = $csv->error_diag ();
+    is ($err[0], 2200,	"error 2200");
+    close FH;
+    unlink $csv_file;
     }
 
 __END__