r19027 - in /trunk/libtext-csv-perl: CSV_XS.pm CSV_XS.xs ChangeLog MANIFEST META.yml Makefile.PL debian/changelog examples/csv-check examples/csv2xls t/65_allow.t t/76_magic.t t/80_diag.t
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Tue Apr 22 19:14:44 UTC 2008
Author: gregoa
Date: Tue Apr 22 19:14:43 2008
New Revision: 19027
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=19027
Log:
New upstream release.
Added:
trunk/libtext-csv-perl/examples/csv-check
- copied unchanged from r19026, branches/upstream/libtext-csv-perl/current/examples/csv-check
Modified:
trunk/libtext-csv-perl/CSV_XS.pm
trunk/libtext-csv-perl/CSV_XS.xs
trunk/libtext-csv-perl/ChangeLog
trunk/libtext-csv-perl/MANIFEST
trunk/libtext-csv-perl/META.yml
trunk/libtext-csv-perl/Makefile.PL
trunk/libtext-csv-perl/debian/changelog
trunk/libtext-csv-perl/examples/csv2xls
trunk/libtext-csv-perl/t/65_allow.t
trunk/libtext-csv-perl/t/76_magic.t
trunk/libtext-csv-perl/t/80_diag.t
Modified: trunk/libtext-csv-perl/CSV_XS.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-perl/CSV_XS.pm?rev=19027&op=diff
==============================================================================
--- trunk/libtext-csv-perl/CSV_XS.pm (original)
+++ trunk/libtext-csv-perl/CSV_XS.pm Tue Apr 22 19:14:43 2008
@@ -30,7 +30,7 @@
use Carp;
use vars qw( $VERSION @ISA );
-$VERSION = "0.42";
+$VERSION = "0.43";
@ISA = qw( DynaLoader );
sub PV { 0 }
@@ -267,13 +267,14 @@
sub error_diag
{
my $self = shift;
- my @diag = (0, $last_new_err);
+ my @diag = (0, $last_new_err, 0);
unless ($self && ref $self) { # Class method or direct call
$last_new_err and $diag[0] = 1000;
}
elsif ($self->isa (__PACKAGE__) && exists $self->{_ERROR_DIAG}) {
@diag = (0 + $self->{_ERROR_DIAG}, $self->{_ERROR_DIAG});
+ exists $self->{_ERROR_POS} and $diag[2] = 1 + $self->{_ERROR_POS};
}
my $context = wantarray;
unless (defined $context) { # Void context
@@ -724,6 +725,18 @@
allow this format, we cannot help there are some vendors that make
their applications spit out lines styled like this.
+In case there is B<really> bad CSV data, like
+
+ 1,"foo "bar" baz",42
+
+or
+
+ 1,""foo bar baz"",42
+
+there is a way to get that parsed, and leave the quotes inside the quoted
+field as-is. This can be achieved by setting C<allow_loose_quotes> B<AND>
+making sure that the C<escape_char> is I<not> equal to C<quote_char>.
+
=item escape_char
The character used for escaping certain characters inside quoted fields.
@@ -1089,9 +1102,9 @@
Text::CSV_XS->error_diag ();
$csv->error_diag ();
- $error_code = 0 + $csv->error_diag ();
- $error_str = "" . $csv->error_diag ();
- ($cde, $str) = $csv->error_diag ();
+ $error_code = 0 + $csv->error_diag ();
+ $error_str = "" . $csv->error_diag ();
+ ($cde, $str, $pos) = $csv->error_diag ();
If (and only if) an error occured, this function returns the diagnostics
of that error.
@@ -1100,7 +1113,9 @@
associated error message to STDERR.
If called in list context, it will return the error code and the error
-message in that order.
+message in that order. If the last error was from parsing, the third
+value returned is the best guess at the location within the line that was
+being parsed. It's value is 1-based.
If called in scalar context, it will return the diagnostics in a single
scalar, a-la $!. It will contain the error code in numeric context, and
@@ -1109,6 +1124,12 @@
When called as a class method or a direct function call, the error diag
is that of the last C<new ()> call.
+=head2 SetDiag
+
+ $csv->SetDiag (0);
+
+Use to reset the diagnosticts if you are dealing with errors.
+
=head1 INTERNALS
=over 4
@@ -1116,8 +1137,6 @@
=item Combine (...)
=item Parse (...)
-
-=item SetDiag (...)
=back
@@ -1187,6 +1206,9 @@
}
close $fh;
+For more extended examples, see the C<examples/> subdirectory in the
+original distribution.
+
=head1 TODO
=over 2
@@ -1395,8 +1417,8 @@
=item 2023 "EIQ - QUO ..."
-I have not been able yet to generate this error. Please inform me how you
-got it when you get it.
+Sequences like C<"foo "bar" baz",quux> and C<2023,",2008-04-05,"Foo, Bar",\n>
+will cause this error.
=item 2024 "EIQ - EOF cannot be escaped, not even inside quotes"
Modified: trunk/libtext-csv-perl/CSV_XS.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-perl/CSV_XS.xs?rev=19027&op=diff
==============================================================================
--- trunk/libtext-csv-perl/CSV_XS.xs (original)
+++ trunk/libtext-csv-perl/CSV_XS.xs Tue Apr 22 19:14:43 2008
@@ -128,7 +128,7 @@
/* EIQ - Error Inside Quotes */
{ 2021, "EIQ - NL char inside quotes, binary off" },
{ 2022, "EIQ - CR char inside quotes, binary off" },
- { 2023, "EIQ - QUO ..." },
+ { 2023, "EIQ - QUO character not allowed" },
{ 2024, "EIQ - EOF cannot be escaped, not even inside quotes" },
{ 2025, "EIQ - Loose unescaped escape" },
{ 2026, "EIQ - Binary character inside quoted field, binary off" },
@@ -182,6 +182,8 @@
SvIOK_on (err);
hv_store (csv->self, "_ERROR_DIAG", 11, err, 0);
}
+ if (xse == 0)
+ hv_store (csv->self, "_ERROR_POS", 10, newSViv (0), 0);
return (err);
} /* SetDiag */
@@ -377,11 +379,15 @@
if (i > 0)
CSV_PUT (csv, dst, csv->sep_char);
- if ((svp = av_fetch (fields, i, 0)) && *svp && SvOK (*svp)) {
+ if ((svp = av_fetch (fields, i, 0)) && *svp) {
STRLEN len;
- char *ptr = SvPV (*svp, len);
+ char *ptr;
int quoteMe = csv->always_quote;
+ unless ((SvOK (*svp) || (
+ (SvMAGICAL (*svp) && (mg_get (*svp), 1) && SvOK (*svp)))
+ )) continue;
+ ptr = SvPV (*svp, len);
/* Do we need quoting? We do quote, if the user requested
* (always_quote), if binary or blank characters are found
* and if the string contains quote or escape characters.
@@ -450,8 +456,9 @@
#if MAINT_DEBUG
static char str_parsed[40];
#endif
-static void ParseError (csv_t *csv, int xse)
+static void ParseError (csv_t *csv, int xse, int pos)
{
+ hv_store (csv->self, "_ERROR_POS", 10, newSViv (pos), 0);
if (csv->tmp) {
if (hv_store (csv->self, "_ERROR_INPUT", 12, csv->tmp, 0))
SvREFCNT_inc (csv->tmp);
@@ -507,12 +514,12 @@
#define ERROR_INSIDE_QUOTES(diag_code) { \
SvREFCNT_dec (sv); \
- ParseError (csv, diag_code); \
+ ParseError (csv, diag_code, spl); \
return FALSE; \
}
#define ERROR_INSIDE_FIELD(diag_code) { \
SvREFCNT_dec (sv); \
- ParseError (csv, diag_code); \
+ ParseError (csv, diag_code, spl); \
return FALSE; \
}
@@ -615,8 +622,8 @@
STRLEN len;
int seenSomething = FALSE;
int fnum = 0;
+ int spl = -1;
#if MAINT_DEBUG
- int spl = -1;
memset (str_parsed, 0, 40);
#endif
@@ -630,8 +637,9 @@
NewField;
seenSomething = TRUE;
+ spl++;
#if MAINT_DEBUG
- if (++spl < 39) str_parsed[spl] = c;
+ if (spl < 39) str_parsed[spl] = c;
#endif
restart:
if (c == csv->sep_char) {
@@ -781,7 +789,6 @@
if (!csv->escape_char || c != csv->escape_char) {
/* Field is terminated */
- AV_PUSH;
c2 = CSV_GET;
#if ALLOW_ALLOW
@@ -792,30 +799,46 @@
}
#endif
- if (c2 == csv->sep_char)
+ if (c2 == csv->sep_char) {
+ AV_PUSH;
continue;
-
- if (c2 == EOF)
+ }
+
+ if (c2 == EOF) {
+ AV_PUSH;
return TRUE;
+ }
if (c2 == CH_CR) {
int c3;
- if (csv->eol_is_cr)
+ if (csv->eol_is_cr) {
+ AV_PUSH;
/* uncovered */ return TRUE;
+ }
c3 = CSV_GET;
- if (c3 == CH_NL)
+ if (c3 == CH_NL) {
+ AV_PUSH;
/* uncovered */ return TRUE;
-
- ParseError (csv, 2010);
+ }
+
+ ParseError (csv, 2010, spl);
return FALSE;
}
- if (c2 == CH_NL)
+ if (c2 == CH_NL) {
+ AV_PUSH;
return TRUE;
-
- ParseError (csv, 2011);
+ }
+
+ if (csv->allow_loose_quotes) {
+ CSV_PUT_SV (sv, c);
+ c = c2;
+ goto restart;
+ }
+
+ ParseError (csv, 2011, spl);
return FALSE;
}
@@ -865,6 +888,12 @@
return TRUE;
}
}
+
+ if (csv->allow_loose_quotes && csv->escape_char != csv->quote_char) {
+ CSV_PUT_SV (sv, c);
+ c = c2;
+ goto restart;
+ }
#if ALLOW_ALLOW
if (csv->allow_whitespace) {
while (c2 == CH_SPACE || c2 == CH_TAB) {
@@ -876,6 +905,7 @@
}
}
#endif
+
ERROR_INSIDE_QUOTES (2023);
}
}
@@ -1105,7 +1135,7 @@
AV *av;
CSV_XS_SELF;
- av = (AV*)SvRV (fields);
+ av = (AV *)SvRV (fields);
ST (0) = xsCombine (hv, av, dst, useIO) ? &PL_sv_yes : &PL_sv_undef;
XSRETURN (1);
/* XS Combine */
Modified: trunk/libtext-csv-perl/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-perl/ChangeLog?rev=19027&op=diff
==============================================================================
--- trunk/libtext-csv-perl/ChangeLog (original)
+++ trunk/libtext-csv-perl/ChangeLog Tue Apr 22 19:14:43 2008
@@ -1,3 +1,11 @@
+2008-04-21 0.43 - H.Merijn Brand <h.m.brand at xs4all.nl>
+
+ * parse errors try to remember failing position
+ * used valgrind to test for leaks (devel-only)
+ * used Test::Valgrind as alternative leak check (devel-only)
+ * improve documentation for error 2023
+ * nailed the loose quotes in quoted fields
+
2008-04-16 0.42 - H.Merijn Brand <h.m.brand at xs4all.nl>
* Generate META.yml myself. I won't use Build.PL
Modified: trunk/libtext-csv-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-perl/MANIFEST?rev=19027&op=diff
==============================================================================
--- trunk/libtext-csv-perl/MANIFEST (original)
+++ trunk/libtext-csv-perl/MANIFEST Tue Apr 22 19:14:43 2008
@@ -27,5 +27,6 @@
t/80_diag.t Error diagnostics
t/util.pl Extra test utilities
examples/csv2xls Script to onvert CSV files to M$Excel
+examples/csv-check Script to check a CSV file/stream
examples/speed.pl Small benchmark script
META.yml Module meta-data (added by MakeMaker)
Modified: trunk/libtext-csv-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-perl/META.yml?rev=19027&op=diff
==============================================================================
--- trunk/libtext-csv-perl/META.yml (original)
+++ trunk/libtext-csv-perl/META.yml Tue Apr 22 19:14:43 2008
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Text-CSV_XS
-version: 0.42
+version: 0.43
abstract: Comma-Separated Values manipulation routines
license: perl
author:
@@ -10,7 +10,7 @@
provides:
Text::CSV_XS:
file: CSV_XS.pm
- version: 0.42
+ version: 0.43
requires:
perl: 5.005
DynaLoader: 0
Modified: trunk/libtext-csv-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-perl/Makefile.PL?rev=19027&op=diff
==============================================================================
--- trunk/libtext-csv-perl/Makefile.PL (original)
+++ trunk/libtext-csv-perl/Makefile.PL Tue Apr 22 19:14:43 2008
@@ -37,6 +37,7 @@
CSV_XS.gcno
CSV_XS.xs.gcov
cover_db
+ valgrind.log
)
},
);
@@ -50,6 +51,19 @@
sub postamble
{
+ my $valgrind = join " ", qw(
+ PERL_DESTRUCT_LEVEL=2 PERL_DL_NONLAZY=1
+ valgrind
+ --suppressions=sandbox/perl.supp
+ --leak-check=yes
+ --leak-resolution=high
+ --show-reachable=yes
+ --num-callers=50
+ --log-fd=3
+ $(FULLPERLRUN) "-MExtUtils::Command::MM" "-e"
+ "test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')"
+ $(TEST_FILES) 3>valgrind.log
+ );
join "\n" =>
'cover test_cover:',
' cover -delete',
@@ -58,6 +72,13 @@
' gcov CSV_XS.c 2>/dev/null',
' find * -name \*.gcov -exec gcov2perl {} \;',
' cover',
+ '',
+ 'leakcheck:',
+ " $valgrind",
+ ' - at tail -5 valgrind.log',
+ '',
+ 'leaktest:',
+ q{ sandbox/leaktest $(FULLPERLRUN) "test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES)},
'',
'fixmeta: distmeta',
' perl genMETA.pl',
Modified: trunk/libtext-csv-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-perl/debian/changelog?rev=19027&op=diff
==============================================================================
--- trunk/libtext-csv-perl/debian/changelog (original)
+++ trunk/libtext-csv-perl/debian/changelog Tue Apr 22 19:14:43 2008
@@ -1,3 +1,9 @@
+libtext-csv-perl (0.43-1) UNRELEASED; urgency=low
+
+ * New upstream release.
+
+ -- gregor herrmann <gregoa at debian.org> Tue, 22 Apr 2008 21:11:49 +0200
+
libtext-csv-perl (0.42-1) unstable; urgency=low
* New upstream release.
Modified: trunk/libtext-csv-perl/examples/csv2xls
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-perl/examples/csv2xls?rev=19027&op=diff
==============================================================================
--- trunk/libtext-csv-perl/examples/csv2xls (original)
+++ trunk/libtext-csv-perl/examples/csv2xls Tue Apr 22 19:14:43 2008
@@ -88,9 +88,7 @@
unless ($sep) { # No sep char passed, try to auto-detect;
while (<>) {
m/\S/ or next; # Skip empty leading blank lines
- $sep = # If explicitely set, use it
- defined $sep ? $sep :
- # otherwise start auto-detect with quoted strings
+ $sep = # start auto-detect with quoted strings
m/["\d];["\d;]/ ? ";" :
m/["\d],["\d,]/ ? "," :
m/["\d]\t["\d,]/ ? "\t" :
Modified: trunk/libtext-csv-perl/t/65_allow.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-perl/t/65_allow.t?rev=19027&op=diff
==============================================================================
--- trunk/libtext-csv-perl/t/65_allow.t (original)
+++ trunk/libtext-csv-perl/t/65_allow.t Tue Apr 22 19:14:43 2008
@@ -4,7 +4,7 @@
$^W = 1;
#use Test::More "no_plan";
- use Test::More tests => 803;
+ use Test::More tests => 829;
BEGIN {
use_ok "Text::CSV_XS", ();
@@ -38,6 +38,32 @@
#$csv = Text::CSV_XS->new ({ quote_char => '"', escape_char => "=" });
#ok (!$csv->parse (qq{foo,d'uh"bar}), "should fail");
+ }
+
+ok (1, "Allow loose quotes inside quoted");
+# Allow unescaped quotes inside a quoted field
+{ my @bad = (
+ # valid, line
+ [ 1, 1, qq{foo,bar,"baz",quux}, ],
+ [ 2, 0, qq{rj,bs,"r"jb"s",rjbs}, ],
+ [ 3, 0, qq{"some "spaced" quote data",2,3,4}, ],
+ [ 4, 1, qq{and an,entirely,quoted,"field"}, ],
+ [ 5, 1, qq{and then,"one with ""quoted"" quotes",okay,?}, ],
+ );
+
+ for (@bad) {
+ my ($tst, $valid, $bad) = @$_;
+ $csv = Text::CSV_XS->new ();
+ ok ($csv, "$tst - new (alq => 0)");
+ is ($csv->parse ($bad), $valid, "$tst - parse () fail");
+
+ $csv->allow_loose_quotes (1);
+ is ($csv->parse ($bad), $valid, "$tst - parse () fail with lq");
+
+ $csv->escape_char (undef);
+ ok ($csv->parse ($bad), "$tst - parse () pass");
+ ok (my @f = $csv->fields, "$tst - fields");
+ }
}
ok (1, "Allow loose escapes");
Modified: trunk/libtext-csv-perl/t/76_magic.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-perl/t/76_magic.t?rev=19027&op=diff
==============================================================================
--- trunk/libtext-csv-perl/t/76_magic.t (original)
+++ trunk/libtext-csv-perl/t/76_magic.t Tue Apr 22 19:14:43 2008
@@ -4,7 +4,7 @@
$^W = 1;
#use Test::More "no_plan";
- use Test::More tests => 5;
+ use Test::More tests => 7;
BEGIN {
use_ok "Text::CSV_XS", ();
@@ -15,6 +15,14 @@
my $foo;
my @foo = ("#", 1..3);
+
+SKIP: {
+ $] < 5.006 and skip "Need perl 5.6.0 or higher for magic here", 2;
+ tie $foo, "Foo";
+ ok ($csv->combine (@$foo), "combine () from magic");
+ untie $foo;
+ is_deeply ([$csv->fields], \@foo, "column_names ()");
+ }
tie $foo, "Foo";
open FH, ">_test.csv";
Modified: trunk/libtext-csv-perl/t/80_diag.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-perl/t/80_diag.t?rev=19027&op=diff
==============================================================================
--- trunk/libtext-csv-perl/t/80_diag.t (original)
+++ trunk/libtext-csv-perl/t/80_diag.t Tue Apr 22 19:14:43 2008
@@ -3,7 +3,7 @@
use strict;
$^W = 1;
- use Test::More tests => 71;
+ use Test::More tests => 84;
#use Test::More "no_plan";
my %err;
@@ -23,37 +23,39 @@
my $csv = Text::CSV_XS->new ();
is (Text::CSV_XS::error_diag (), "", "Last failure for new () - OK");
+is_deeply ([ $csv->error_diag ], [ 0, "", 0], "OK in list context");
-sub parse_err ($$)
+sub parse_err ($$$)
{
- my ($n_err, $str) = @_;
+ my ($n_err, $p_err, $str) = @_;
my $s_err = $err{$n_err};
my $STR = _readable ($str);
- is ($csv->parse ($str), 0, "parse ('$STR')");
- is ($csv->error_diag () + 0, $n_err, "Diag in numerical context");
- is ($csv->error_diag (), $s_err, "Diag in string context");
- my ($c_diag, $s_diag) = $csv->error_diag ();
- is ($c_diag, $n_err, "Num diag in list context");
- is ($s_diag, $s_err, "Str diag in list context");
+ is ($csv->parse ($str), 0, "$n_err - Err for parse ('$STR')");
+ is ($csv->error_diag () + 0, $n_err, "$n_err - Diag in numerical context");
+ is ($csv->error_diag (), $s_err, "$n_err - Diag in string context");
+ my ($c_diag, $s_diag, $p_diag) = $csv->error_diag ();
+ is ($c_diag, $n_err, "$n_err - Num diag in list context");
+ is ($s_diag, $s_err, "$n_err - Str diag in list context");
+ is ($p_diag, $p_err, "$n_err - Pos diag in list context");
} # parse_err
-parse_err 2023, qq{2023,",2008-04-05,"Foo, Bar",\n}; # "
+parse_err 2023, 19, qq{2023,",2008-04-05,"Foo, Bar",\n}; # "
$csv = Text::CSV_XS->new ({ escape_char => "+", eol => "\n" });
is ($csv->error_diag (), "", "No errors yet");
-parse_err 2010, qq{"x"\r};
-parse_err 2011, qq{"x"x};
+parse_err 2010, 3, qq{"x"\r};
+parse_err 2011, 3, qq{"x"x};
-parse_err 2021, qq{"\n"};
-parse_err 2022, qq{"\r"};
-parse_err 2025, qq{"+ "};
-parse_err 2026, qq{"\0 "};
-parse_err 2027, '"';
-parse_err 2031, qq{\r };
-parse_err 2032, qq{ \r};
-parse_err 2034, qq{1, "bar",2};
-parse_err 2037, qq{\0 };
+parse_err 2021, 2, qq{"\n"};
+parse_err 2022, 2, qq{"\r"};
+parse_err 2025, 2, qq{"+ "};
+parse_err 2026, 2, qq{"\0 "};
+parse_err 2027, 1, '"';
+parse_err 2031, 1, qq{\r };
+parse_err 2032, 2, qq{ \r};
+parse_err 2034, 4, qq{1, "bar",2};
+parse_err 2037, 1, qq{\0 };
diag ("Next line should be an error message");
$csv->error_diag ();
More information about the Pkg-perl-cvs-commits
mailing list