r66358 - in /branches/upstream/libtext-csv-xs-perl/current: CSV_XS.pm CSV_XS.xs ChangeLog MANIFEST META.yml t/70_rt.t t/77_getall.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sat Dec 25 19:17:33 UTC 2010
Author: jawnsy-guest
Date: Sat Dec 25 19:17:11 2010
New Revision: 66358
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=66358
Log:
[svn-upgrade] new version libtext-csv-xs-perl (0.80)
Added:
branches/upstream/libtext-csv-xs-perl/current/t/77_getall.t
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/MANIFEST
branches/upstream/libtext-csv-xs-perl/current/META.yml
branches/upstream/libtext-csv-xs-perl/current/t/70_rt.t
Modified: branches/upstream/libtext-csv-xs-perl/current/CSV_XS.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-xs-perl/current/CSV_XS.pm?rev=66358&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/CSV_XS.pm (original)
+++ branches/upstream/libtext-csv-xs-perl/current/CSV_XS.pm Sat Dec 25 19:17:11 2010
@@ -30,7 +30,7 @@
use Carp;
use vars qw( $VERSION @ISA );
-$VERSION = "0.79";
+$VERSION = "0.80";
@ISA = qw( DynaLoader );
bootstrap Text::CSV_XS $VERSION;
@@ -551,6 +551,14 @@
\%hr;
} # getline_hr
+sub getline_hr_all
+{
+ my ($self, @args, %hr) = @_;
+ $self->{_COLUMN_NAMES} or croak ($self->SetDiag (3002));
+ my @cn = @{$self->{_COLUMN_NAMES}};
+ [ map { my %h; @h{@cn} = @$_; \%h } @{$self->getline_all (@args)} ];
+ } # getline_hr_all
+
sub types
{
my $self = shift;
@@ -1118,6 +1126,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);
@@ -1143,6 +1175,15 @@
print "Price for $hr->{name} is $hr->{price} EUR\n";
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
@@ -1498,9 +1539,9 @@
=item Parse the whole file at once
-Implement a new methods that enables the parsing of a complete file
-at once, returning a list of hashes. Possible extension to this could
-be to enable a column selection on the call:
+Implement new methods that enable parsing of a complete file at once,
+returning a list of hashes. Possible extension to this could be to
+enable a column selection on the call:
my @AoH = $csv->parse_file ($filename, { cols => [ 1, 4..8, 12 ]});
@@ -1508,13 +1549,14 @@
[ { fields => [ 1, 2, "foo", 4.5, undef, "", 8 ],
flags => [ ... ],
- errors => [ ... ],
},
{ fields => [ ... ],
.
- .
},
]
+
+Note that C<getline_all ()> already returns all rows for an open
+stream, but this will not return flags.
=item EBCDIC
Modified: branches/upstream/libtext-csv-xs-perl/current/CSV_XS.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-xs-perl/current/CSV_XS.xs?rev=66358&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/CSV_XS.xs (original)
+++ branches/upstream/libtext-csv-xs-perl/current/CSV_XS.xs Sat Dec 25 19:17:11 2010
@@ -25,6 +25,9 @@
#ifndef PERLIO_F_UTF8
# define PERLIO_F_UTF8 0x00008000
# endif
+#ifndef MAXINT
+# define MAXINT ((int)(~(unsigned)0 >> 1))
+# endif
#define MAINT_DEBUG 0
@@ -83,7 +86,7 @@
if (!self || !SvOK (self) || !SvROK (self) || \
SvTYPE (SvRV (self)) != SVt_PVHV) \
croak ("self is not a hash ref"); \
- hv = (HV*)SvRV (self)
+ hv = (HV *)SvRV (self)
#define byte unsigned char
typedef struct {
@@ -566,6 +569,7 @@
csv->is_bound = 0;
}
+ csv->eol_pos = -1;
csv->eolx = csv->eol_len
? csv->verbatim || csv->eol_len >= 2
? 1
@@ -770,6 +774,7 @@
}
PUTBACK;
#if MAINT_DEBUG > 4
+ fprintf (stderr, "getline () returned:\n");
sv_dump (csv->tmp);
#endif
}
@@ -858,7 +863,7 @@
int CSV_GET_ (csv_t *csv, SV *src, int l)
{
int c;
- fprintf (stderr, "# 1-CSV_GET @ %4d: (used: %d, size: %d, eol_pos: %d)\n", l, csv->used, csv->size, csv->eol_pos);
+ fprintf (stderr, "# 1-CSV_GET @ %4d: (used: %d, size: %d, eol_pos: %d, eolx = %d)\n", l, csv->used, csv->size, csv->eol_pos, csv->eolx);
c = CSV_GET1;
fprintf (stderr, "# 2-CSV_GET @ %4d: 0x%02x '%c'\n", l, c, isprint (c) ? c : '?');
return (c);
@@ -883,7 +888,7 @@
} \
PUSH_RPT; \
sv = NULL; \
- if (csv->keep_meta_info) \
+ if (csv->keep_meta_info && fflags) \
av_push (fflags, newSViv (f)); \
waitingForField = 1; \
}
@@ -984,7 +989,7 @@
unless (csv->is_bound)
av_push (fields, sv);
sv = NULL;
- if (csv->keep_meta_info)
+ if (csv->keep_meta_info && fflags)
av_push (fflags, newSViv (f));
}
else
@@ -1006,7 +1011,7 @@
sv_setpvn (sv, "", 0);
unless (csv->is_bound)
av_push (fields, sv);
- if (csv->keep_meta_info)
+ if (csv->keep_meta_info && fflags)
av_push (fflags, newSViv (f));
return TRUE;
}
@@ -1209,6 +1214,14 @@
c3 = CSV_GET;
if (c3 == CH_NL || c3 == CH_EOLX) {
+ AV_PUSH;
+ return TRUE;
+ }
+
+ if (csv->useIO && csv->eol_len == 0 && !is_csv_binary (c3)) {
+ set_eol_is_cr (csv);
+ csv->used--;
+ csv->has_ahead++;
AV_PUSH;
return TRUE;
}
@@ -1326,7 +1339,7 @@
sv_setpvn (sv, "", 0);
unless (csv->is_bound)
av_push (fields, sv);
- if (csv->keep_meta_info)
+ if (csv->keep_meta_info && fflags)
av_push (fflags, newSViv (f));
return TRUE;
}
@@ -1345,13 +1358,10 @@
return TRUE;
} /* Parse */
-#define xsParse(self,hv,av,avf,src,useIO) cx_xsParse (aTHX_ self, hv, av, avf, src, useIO)
-static int cx_xsParse (pTHX_ SV *self, HV *hv, AV *av, AV *avf, SV *src, bool useIO)
-{
- csv_t csv;
+#define c_xsParse(csv,hv,av,avf,src,useIO) cx_c_xsParse (aTHX_ csv, hv, av, avf, src, useIO)
+static int cx_c_xsParse (pTHX_ csv_t csv, HV *hv, AV *av, AV *avf, SV *src, bool useIO)
+{
int result, ahead = 0;
-
- SetupCsv (&csv, hv, self);
if ((csv.useIO = useIO)) {
csv.tmp = NULL;
@@ -1386,13 +1396,15 @@
}
csv.cache[CACHE_ID__has_ahead] = csv.has_ahead;
- if (csv.keep_meta_info) {
- (void)hv_delete (hv, "_FFLAGS", 7, G_DISCARD);
- (void)hv_store (hv, "_FFLAGS", 7, newRV_noinc ((SV *)avf), 0);
- }
- else {
- av_undef (avf);
- sv_free ((SV *)avf);
+ if (avf) {
+ if (csv.keep_meta_info) {
+ (void)hv_delete (hv, "_FFLAGS", 7, G_DISCARD);
+ (void)hv_store (hv, "_FFLAGS", 7, newRV_noinc ((SV *)avf), 0);
+ }
+ else {
+ av_undef (avf);
+ sv_free ((SV *)avf);
+ }
}
}
if (result && csv.types) {
@@ -1418,7 +1430,84 @@
}
}
return result;
+ } /* c_xsParse */
+
+#define xsParse(self,hv,av,avf,src,useIO) cx_xsParse (aTHX_ self, hv, av, avf, src, useIO)
+static int cx_xsParse (pTHX_ SV *self, HV *hv, AV *av, AV *avf, SV *src, bool useIO)
+{
+ csv_t csv;
+ SetupCsv (&csv, hv, self);
+ return (c_xsParse (csv, hv, av, avf, src, useIO));
} /* xsParse */
+
+#define av_empty(av) cx_av_empty (aTHX_ av)
+static void cx_av_empty (pTHX_ AV *av)
+{
+ while (av_len (av) >= 0)
+ sv_free (av_pop (av));
+ } /* av_empty */
+
+#define av_free(av) cx_av_free (aTHX_ av)
+static void cx_av_free (pTHX_ AV *av)
+{
+ av_empty (av);
+ sv_free ((SV *)av);
+ } /* av_free */
+
+#define rav_free(rv) cx_rav_free (aTHX_ rv)
+static void cx_rav_free (pTHX_ SV *rv)
+{
+ av_free ((AV *)SvRV (rv));
+ sv_free (rv);
+ } /* rav_free */
+
+#define xsParse_all(self,hv,io,off,len) cx_xsParse_all (aTHX_ self, hv, io, off, len)
+static SV *cx_xsParse_all (pTHX_ SV *self, HV *hv, SV *io, SV *off, SV *len)
+{
+ csv_t csv;
+ int n = 0, skip = 0, length = MAXINT, tail = MAXINT;
+ AV *avr = newAV ();
+ AV *row = newAV ();
+
+ SetupCsv (&csv, hv, self);
+ csv.keep_meta_info = 0;
+
+ if (SvIOK (off)) {
+ skip = SvIV (off);
+ if (skip < 0) {
+ tail = -skip;
+ skip = -1;
+ }
+ }
+ if (SvIOK (len))
+ length = SvIV (len);
+
+ while (c_xsParse (csv, hv, row, NULL, io, 1)) {
+ if (skip > 0) {
+ skip--;
+ av_empty (row); /* re-use */
+ continue;
+ }
+
+ if (n++ >= tail) {
+ rav_free (av_shift (avr));
+ n--;
+ }
+
+ av_push (avr, newRV ((SV *)row));
+
+ if (n >= length && skip >= 0)
+ break; /* We have enough */
+
+ row = newAV ();
+ }
+ while (n > length) {
+ rav_free (av_pop (avr));
+ n--;
+ }
+
+ return (SV *)sv_2mortal (newRV_noinc ((SV *)avr));
+ } /* xsParse_all */
#define xsCombine(self,hv,av,io,useIO) cx_xsCombine (aTHX_ self, hv, av, io, useIO)
static int cx_xsCombine (pTHX_ SV *self, HV *hv, AV *av, SV *io, bool useIO)
@@ -1507,8 +1596,8 @@
AV *avf;
CSV_XS_SELF;
- av = (AV*)SvRV (fields);
- avf = (AV*)SvRV (fflags);
+ av = (AV *)SvRV (fields);
+ avf = (AV *)SvRV (fflags);
ST (0) = xsParse (self, hv, av, avf, src, 0) ? &PL_sv_yes : &PL_sv_no;
XSRETURN (1);
@@ -1528,7 +1617,7 @@
unless (_is_arrayref (fields))
croak ("Expected fields to be an array ref");
- av = (AV*)SvRV (fields);
+ av = (AV *)SvRV (fields);
ST (0) = xsCombine (self, hv, av, io, 1) ? &PL_sv_yes : &PL_sv_no;
XSRETURN (1);
@@ -1554,6 +1643,24 @@
/* XS getline */
void
+getline_all (self, io, ...)
+ SV *self
+ SV *io
+
+ PPCODE:
+ HV *hv;
+ SV *offset, *length;
+
+ CSV_XS_SELF;
+
+ offset = items > 2 ? ST (2) : &PL_sv_undef;
+ length = items > 3 ? ST (3) : &PL_sv_undef;
+
+ ST (0) = xsParse_all (self, hv, io, offset, length);
+ XSRETURN (1);
+ /* XS getline_all */
+
+void
_cache_set (self, idx, val)
SV *self
int idx
Modified: branches/upstream/libtext-csv-xs-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-xs-perl/current/ChangeLog?rev=66358&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/ChangeLog (original)
+++ branches/upstream/libtext-csv-xs-perl/current/ChangeLog Sat Dec 25 19:17:11 2010
@@ -1,3 +1,7 @@
+2010-12-24 0.80 - H.Merijn Brand <h.m.brand at xs4all.nl>
+ * Implement getline_all () and getaline_hr_all ()
+ * Fixed another parsing for eol = \r (RT#61525)
+
2010-11-26 0.79 - H.Merijn Brand <h.m.brand at xs4all.nl>
* Use correct type for STRLEN (HP-UX/PA-RISC/32)
* More code coverage
Modified: branches/upstream/libtext-csv-xs-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-xs-perl/current/MANIFEST?rev=66358&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/MANIFEST (original)
+++ branches/upstream/libtext-csv-xs-perl/current/MANIFEST Sat Dec 25 19:17:11 2010
@@ -27,7 +27,8 @@
t/65_allow.t Allow bad formats
t/70_rt.t Tests based on RT reports
t/75_hashref.t getline_hr related tests
-t/76_magic.t array_ref from magig
+t/76_magic.t array_ref from magic
+t/77_getall.t gat all rows at once
t/80_diag.t Error diagnostics
t/81_subclass.t Subclassed
t/util.pl Extra test utilities
Modified: branches/upstream/libtext-csv-xs-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-xs-perl/current/META.yml?rev=66358&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/META.yml (original)
+++ branches/upstream/libtext-csv-xs-perl/current/META.yml Sat Dec 25 19:17:11 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Text-CSV_XS
-version: 0.79
+version: 0.80
abstract: Comma-Separated Values manipulation routines
license: perl
author:
@@ -10,7 +10,7 @@
provides:
Text::CSV_XS:
file: CSV_XS.pm
- version: 0.79
+ version: 0.80
requires:
perl: 5.005
DynaLoader: 0
Modified: branches/upstream/libtext-csv-xs-perl/current/t/70_rt.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-xs-perl/current/t/70_rt.t?rev=66358&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/t/70_rt.t (original)
+++ branches/upstream/libtext-csv-xs-perl/current/t/70_rt.t Sat Dec 25 19:17:11 2010
@@ -4,11 +4,12 @@
$^W = 1;
#use Test::More "no_plan";
- use Test::More tests => 397;
+ use Test::More tests => 438;
BEGIN {
use_ok "Text::CSV_XS", ();
plan skip_all => "Cannot load Text::CSV_XS" if $@;
+ require "t/util.pl";
}
my $csv_file = "_70test.csv";
@@ -275,6 +276,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_XS->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";
@@ -288,7 +307,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_XS->new ({
binary => 1,
sep_char => ":",
@@ -296,12 +318,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_XS->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");
@@ -358,3 +407,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-xs-perl/current/t/77_getall.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-xs-perl/current/t/77_getall.t?rev=66358&op=file
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/t/77_getall.t (added)
+++ branches/upstream/libtext-csv-xs-perl/current/t/77_getall.t Sat Dec 25 19:17:11 2010
@@ -1,0 +1,69 @@
+#!/usr/bin/perl
+
+use strict;
+$^W = 1;
+
+use Test::More tests => 29;
+
+BEGIN {
+ require_ok "Text::CSV_XS";
+ plan skip_all => "Cannot load Text::CSV_XS" 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_XS->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_XS->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_XS->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";
More information about the Pkg-perl-cvs-commits
mailing list