r18479 - in /trunk/libtext-csv-perl: CSV_XS.pm CSV_XS.xs ChangeLog META.yml Makefile.PL debian/changelog examples/csv2xls t/75_hashref.t t/80_diag.t
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Sat Apr 12 10:30:50 UTC 2008
Author: gregoa-guest
Date: Sat Apr 12 10:30:49 2008
New Revision: 18479
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=18479
Log:
New upstream release.
Modified:
trunk/libtext-csv-perl/CSV_XS.pm
trunk/libtext-csv-perl/CSV_XS.xs
trunk/libtext-csv-perl/ChangeLog
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/75_hashref.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=18479&op=diff
==============================================================================
--- trunk/libtext-csv-perl/CSV_XS.pm (original)
+++ trunk/libtext-csv-perl/CSV_XS.pm Sat Apr 12 10:30:49 2008
@@ -30,7 +30,7 @@
use Carp;
use vars qw( $VERSION @ISA );
-$VERSION = "0.40";
+$VERSION = "0.41";
@ISA = qw( DynaLoader );
sub PV { 0 }
@@ -267,15 +267,20 @@
sub error_diag
{
my $self = shift;
- $self && ref $self eq __PACKAGE__ or return $last_new_err;
- exists $self->{_ERROR_DIAG} or return;
- my $diag = $self->{_ERROR_DIAG};
+ my @diag = (0, $last_new_err);
+
+ 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});
+ }
my $context = wantarray;
unless (defined $context) { # Void context
- print STDERR "# CSV_XS ERROR: ", 0 + $diag, " - $diag\n";
+ $diag[0] and print STDERR "# CSV_XS ERROR: $diag[0] - $diag[1]\n";
return;
}
- return $context ? (0 + $diag, "$diag") : $diag;
+ return $context ? @diag : $diag[1];
} # error_diag
# string
@@ -491,6 +496,7 @@
$colref = $csv->getline ($io); # Read a line from file $io,
# parse it and return an array
# ref of fields
+ $csv->bind_columns (@refs); # Set return fields for getline ()
$csv->column_names (@names); # Set column names for getline_hr ()
$ref = $csv->getline_hr ($io); # getline (), but returns a hashref
$eof = $csv->eof (); # Indicate if last parse or
@@ -790,7 +796,7 @@
binary characters. This will ease working with data with embedded
newlines.
-When C<verbatim> is used with C<getline ()>, getline
+When C<verbatim> is used with C<getline ()>, C<getline ()>
auto-chomp's every line.
Imagine a file format like
@@ -919,6 +925,9 @@
and parses this row into an array ref. This array ref is returned
by the function or undef for failure.
+When fields are bound with C<bind_columns ()>, the return value is a
+reference to an empty list.
+
The I<$csv-E<gt>string ()>, I<$csv-E<gt>fields ()> and I<$csv-E<gt>status ()>
methods are meaningless, again.
@@ -949,7 +958,7 @@
=head2 bind_columns
Takes a list of references to scalars (max 255) to store the fields fetched
-C<by getline_hr ()> in. When you don't pass enough references to store the
+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.
@@ -1078,6 +1087,7 @@
=head2 error_diag
+ Text::CSV_XS->error_diag ();
$csv->error_diag ();
$error_code = 0 + $csv->error_diag ();
$error_str = "" . $csv->error_diag ();
@@ -1095,6 +1105,9 @@
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
the diagnostics message in string context.
+
+When called as a class method or a direct function call, the error diag
+is that of the last C<new ()> call.
=head1 INTERNALS
Modified: trunk/libtext-csv-perl/CSV_XS.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-perl/CSV_XS.xs?rev=18479&op=diff
==============================================================================
--- trunk/libtext-csv-perl/CSV_XS.xs (original)
+++ trunk/libtext-csv-perl/CSV_XS.xs Sat Apr 12 10:30:49 2008
@@ -1,4 +1,4 @@
-/* Copyright (c) 2007-2007 H.Merijn Brand. All rights reserved.
+/* Copyright (c) 2007-2008 H.Merijn Brand. All rights reserved.
* Copyright (c) 1998-2001 Jochen Wiedmann. All rights reserved.
* This program is free software; you can redistribute it and/or
* modify it under the same terms as Perl itself.
@@ -116,7 +116,8 @@
xs_error_t xs_errors[] = {
/* Generic errors */
- { 1001, "INI - sep_char is equal to quote_char or escape_char" },
+ { 1000, "INI - constructor failed" },
+ { 1001, "INI - sep_char is equal to quote_char or escape_char" },
/* Parse errors */
{ 2010, "ECR - QUO char inside quotes followed by CR not part of EOL" },
@@ -693,7 +694,7 @@
if (csv->verbatim) {
f |= CSV_FLAGS_BIN;
unless (csv->binary)
- ERROR_INSIDE_FIELD (2030);
+/* uncovered */ ERROR_INSIDE_FIELD (2030);
CSV_PUT_SV (sv, c);
}
@@ -784,8 +785,8 @@
#if ALLOW_ALLOW
if (csv->allow_whitespace) {
- while (c2 == CH_SPACE || c2 == CH_TAB) {
- c2 = CSV_GET;
+/* uncovered */ while (c2 == CH_SPACE || c2 == CH_TAB) {
+/* uncovered */ c2 = CSV_GET;
}
}
#endif
@@ -800,11 +801,11 @@
int c3;
if (csv->eol_is_cr)
- return TRUE;
+/* uncovered */ return TRUE;
c3 = CSV_GET;
if (c3 == CH_NL)
- return TRUE;
+/* uncovered */ return TRUE;
ParseError (csv, 2010);
return FALSE;
@@ -866,11 +867,11 @@
#if ALLOW_ALLOW
if (csv->allow_whitespace) {
while (c2 == CH_SPACE || c2 == CH_TAB) {
- c2 = CSV_GET;
+/* uncovered */ c2 = CSV_GET;
}
if (c2 == csv->sep_char || c2 == EOF) {
- c = c2;
- goto restart;
+/* uncovered */ c = c2;
+/* uncovered */ goto restart;
}
}
#endif
@@ -927,7 +928,7 @@
CSV_PUT_SV (sv, c2);
}
else
- ERROR_INSIDE_FIELD (2036); /* I think there's no way to get here */
+/* uncovered */ ERROR_INSIDE_FIELD (2036); /* I think there's no way to get here */
} /* ESC char */
else {
#if MAINT_DEBUG > 1
Modified: trunk/libtext-csv-perl/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-perl/ChangeLog?rev=18479&op=diff
==============================================================================
--- trunk/libtext-csv-perl/ChangeLog (original)
+++ trunk/libtext-csv-perl/ChangeLog Sat Apr 12 10:30:49 2008
@@ -1,3 +1,12 @@
+2008-04-11 0.41 - H.Merijn Brand <h.m.brand at xs4all.nl>
+
+ * error_diag () subclassable
+ * typo in bind_columns () docs
+ * examples/csv2xls now uses getline ()
+ * better test for getline in t/75_hashref.t (makamata)
+ * document return value of getline () with bind_columns ()
+ * add perl version prereq to META.yml
+
2008-04-07 0.40 - H.Merijn Brand <h.m.brand at xs4all.nl>
* Implemented getline_hr () and column_names () RT 34474
Modified: trunk/libtext-csv-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-perl/META.yml?rev=18479&op=diff
==============================================================================
--- trunk/libtext-csv-perl/META.yml (original)
+++ trunk/libtext-csv-perl/META.yml Sat Apr 12 10:30:49 2008
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Text-CSV_XS
-version: 0.40
+version: 0.41
abstract: Comma-Separated Values manipulation routines
license: perl
author:
@@ -8,6 +8,7 @@
generated_by: ExtUtils::MakeMaker version 6.44
distribution_type: module
requires:
+ perl: 5.005
Config: 0
DynaLoader: 0
IO::Handle: 0
Modified: trunk/libtext-csv-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-perl/Makefile.PL?rev=18479&op=diff
==============================================================================
--- trunk/libtext-csv-perl/Makefile.PL (original)
+++ trunk/libtext-csv-perl/Makefile.PL Sat Apr 12 10:30:49 2008
@@ -2,7 +2,7 @@
# Copyright PROCURA B.V. (c) 2006-2008 H.Merijn Brand
-require 5.005;
+require 5.005; # <- also see postamble at the bottom for META.yml
use strict;
use ExtUtils::MakeMaker;
@@ -59,7 +59,10 @@
' find * -name \*.gcov -exec gcov2perl {} \;',
' cover',
'',
- 'tgzdist: $(DISTVNAME).tar.gz',
+ 'fixmeta: distmeta',
+ ' $(PERL) -pi -e"/^ Config/ and print qq{ perl: 5.005\n}" */META.yml',
+ '',
+ 'tgzdist: fixmeta $(DISTVNAME).tar.gz',
' - at mv -f $(DISTVNAME).tar.gz $(DISTVNAME).tgz',
'',
'test_speed: pure_all',
Modified: trunk/libtext-csv-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-perl/debian/changelog?rev=18479&op=diff
==============================================================================
--- trunk/libtext-csv-perl/debian/changelog (original)
+++ trunk/libtext-csv-perl/debian/changelog Sat Apr 12 10:30:49 2008
@@ -1,3 +1,9 @@
+libtext-csv-perl (0.41-1) UNRELEASED; urgency=low
+
+ * New upstream release.
+
+ -- gregor herrmann <gregor+debian at comodo.priv.at> Sat, 12 Apr 2008 12:29:04 +0200
+
libtext-csv-perl (0.40-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=18479&op=diff
==============================================================================
--- trunk/libtext-csv-perl/examples/csv2xls (original)
+++ trunk/libtext-csv-perl/examples/csv2xls Sat Apr 12 10:30:49 2008
@@ -6,7 +6,7 @@
use strict;
use warnings;
-our $VERSION = "1.4";
+our $VERSION = "1.5"; # 2008-04-10
sub usage
{
@@ -83,8 +83,10 @@
);
my ($h, $w, @w) = (0, 1); # data height, -width, and default column widths
-while (<>) {
- unless ($csv) {
+my $row;
+my $firstline;
+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 :
@@ -100,18 +102,25 @@
# Yeah I know it should be a ',' (hence Csv), but the majority
# of the csv files to be shown comes from fucking Micky$hit,
# that uses semiColon ';' instead.
- $csv = Text::CSV_XS-> new ({
- sep_char => $sep,
- quote_char => $quo,
- binary => 1,
- keep_meta_info => 1,
- });
+ $firstline = $_;
+ last;
}
- $csv->parse ($_);
- my @row = $csv->fields () or next;
+ }
+$csv = Text::CSV_XS-> new ({
+ sep_char => $sep,
+ quote_char => $quo,
+ binary => 1,
+ keep_meta_info => 1,
+ });
+if ($firstline) {
+ $csv->parse ($firstline) or die $csv->error_diag ();
+ $row = [ $csv->fields ];
+ }
+while ($row && @$row or $row = $csv->getline (*ARGV)) {
+ my @row = @$row;
@row > $w and push @w, ($wdt) x (($w = @row) - @w);
foreach my $c (0 .. $#row) {
- my $val = $row[$c];
+ my $val = $row[$c] || "";
my $l = length $val;
$l > $w[$c] and $w[$c] = $l;
@@ -147,7 +156,7 @@
$wks->write ($h, $c, $val);
}
++$h % 100 or printf STDERR "%6d x %6d\r", $w, $h;
- }
+ } continue { $row = undef }
printf STDERR "%6d x %6d\n", $w, $h;
$wks->set_column ($_, $_, $w[$_]) for 0 .. $#w;
Modified: trunk/libtext-csv-perl/t/75_hashref.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-perl/t/75_hashref.t?rev=18479&op=diff
==============================================================================
--- trunk/libtext-csv-perl/t/75_hashref.t (original)
+++ trunk/libtext-csv-perl/t/75_hashref.t Sat Apr 12 10:30:49 2008
@@ -83,10 +83,10 @@
ok ($csv->bind_columns (@bcr), "Bind columns");
ok ($csv->column_names ($row), "column_names from array_ref");
is_deeply ([ $csv->column_names ], [ @$row ], "Keys set");
-my @row = $csv->getline (*FH);
+$row = $csv->getline (*FH);
is_deeply ([ $csv->bind_columns ], [ @bcr ], "check refs");
-is_deeply ([ @row ], [ [] ], "return from getline with bind_columns");
+is_deeply ($row, [], "return from getline with bind_columns");
is ($csv->column_names (undef), undef, "reset column headers");
is ($csv->bind_columns (undef), undef, "reset bound columns");
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=18479&op=diff
==============================================================================
--- trunk/libtext-csv-perl/t/80_diag.t (original)
+++ trunk/libtext-csv-perl/t/80_diag.t Sat Apr 12 10:30:49 2008
@@ -3,7 +3,7 @@
use strict;
$^W = 1;
- use Test::More tests => 66;
+ use Test::More tests => 71;
#use Test::More "no_plan";
my %err;
@@ -37,10 +37,10 @@
is ($s_diag, $s_err, "Str diag in list context");
} # parse_err
-parse_err 2023, qq{2023,",2008-04-05,"Foo, Bar",\n};
+parse_err 2023, qq{2023,",2008-04-05,"Foo, Bar",\n}; # "
$csv = Text::CSV_XS->new ({ escape_char => "+", eol => "\n" });
-is ($csv->error_diag (), undef, "No errors yet");
+is ($csv->error_diag (), "", "No errors yet");
parse_err 2010, qq{"x"\r};
parse_err 2011, qq{"x"x};
@@ -59,7 +59,28 @@
$csv->error_diag ();
is (Text::CSV_XS->new ({ ecs_char => ":" }), undef, "Unsupported option");
+
is (Text::CSV_XS::error_diag (), "Unknown attribute 'ecs_char'",
"Last failure for new () - FAIL");
is (Text::CSV_XS->error_diag (), "Unknown attribute 'ecs_char'",
"Last failure for new () - FAIL");
+is (Text::CSV_XS::error_diag (bless {}, "Foo"), "Unknown attribute 'ecs_char'",
+ "Last failure for new () - FAIL");
+
+package Text::CSV_XS::Subclass;
+
+use base "Text::CSV_XS";
+
+use Test::More;
+
+ok (1, "Subclassed");
+
+my $csvs = Text::CSV_XS::Subclass->new ();
+is ($csvs->error_diag (), "", "Last failure for new () - OK");
+
+is (Text::CSV_XS::Subclass->new ({ ecs_char => ":" }), undef, "Unsupported option");
+
+is (Text::CSV_XS::Subclass->error_diag (),
+ "Unknown attribute 'ecs_char'", "Last failure for new () - FAIL");
+
+1;
More information about the Pkg-perl-cvs-commits
mailing list