r45379 - in /branches/upstream/libtext-csv-xs-perl/current: CSV_XS.pm CSV_XS.xs ChangeLog MANIFEST META.yml examples/csv-check examples/csv2xls examples/csvdiff
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Mon Oct 5 13:14:00 UTC 2009
Author: ansgar-guest
Date: Mon Oct 5 13:13:49 2009
New Revision: 45379
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=45379
Log:
[svn-upgrade] Integrating new upstream version, libtext-csv-xs-perl (0.68)
Added:
branches/upstream/libtext-csv-xs-perl/current/examples/csvdiff (with props)
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/examples/csv-check
branches/upstream/libtext-csv-xs-perl/current/examples/csv2xls
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=45379&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/CSV_XS.pm (original)
+++ branches/upstream/libtext-csv-xs-perl/current/CSV_XS.pm Mon Oct 5 13:13:49 2009
@@ -30,7 +30,7 @@
use Carp;
use vars qw( $VERSION @ISA );
-$VERSION = "0.67";
+$VERSION = "0.68";
@ISA = qw( DynaLoader );
bootstrap Text::CSV_XS $VERSION;
@@ -355,10 +355,25 @@
}
my $context = wantarray;
- unless (defined $context) { # Void context
- if ($diag[0]) {
+ unless (defined $context) { # Void context, auto-diag
+ if ($diag[0] && $diag[0] != 2012 && $self && ref $self) {
my $msg = "# CSV_XS ERROR: $diag[0] - $diag[1]\n";
- $self && ref $self && $self->{auto_diag} > 1 ? die $msg : warn $msg;
+
+ my $lvl = $self->{auto_diag};
+ if ($lvl < 2) {
+ my @c = caller (2);
+ if (@c >= 11 && $c[10] && ref $c[10] eq "HASH") {
+ my $hints = $c[10];
+ (exists $hints->{autodie} && $hints->{autodie} or
+ exists $hints->{"guard Fatal"} &&
+ !exists $hints->{"no Fatal"}) and
+ $lvl++;
+ # Future releases of autodie will probably set $^H{autodie}
+ # to "autodie @args", like "autodie :all" or "autodie open"
+ # so we can/should check for "open" or "new"
+ }
+ }
+ $lvl > 1 ? die $msg : warn $msg;
}
return;
}
@@ -556,31 +571,21 @@
use Text::CSV_XS;
- $csv = Text::CSV_XS->new (); # create a new object
- $csv = Text::CSV_XS->new (\%attr); # create a new object
-
- $status = $csv->combine (@columns); # combine columns into a string
- $line = $csv->string (); # get the combined string
-
- $status = $csv->parse ($line); # parse a CSV string into fields
- @columns = $csv->fields (); # get the parsed fields
-
- $status = $csv->status (); # get the most recent status
- $bad_argument = $csv->error_input (); # get the most recent bad argument
- $diag = $csv->error_diag (); # if an error occured, explains WHY
-
- $status = $csv->print ($io, $colref); # Write an array of fields
- # immediately to a file $io
- $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
- # getline () hit End Of File
-
- $csv->types (\@t_array); # Set column types
+ my @rows;
+ my $csv = Text::CSV_XS->new ({ binary => 1 }) or
+ die "Cannot use CSV: ".Text::CSV->error_diag ();
+ open my $fh, "<:encoding(utf8)", "test.csv" or die "test.csv: $!";
+ while (my $row = $csv->getline ($fh)) {
+ $row->[2] =~ m/pattern/ or next; # 3rd field should match
+ push @rows, $row;
+ }
+ $csv->eof or $csv->error_diag ();
+ close $fh;
+
+ $csv->eol ("\r\n");
+ open $fh, ">:encoding(utf8)", "new.csv" or die "new.csv: $!";
+ $csv->print ($fh, $_) for @rows;
+ close $fh or die "new.csv: $!";
=head1 DESCRIPTION
@@ -786,7 +791,7 @@
are now correctly parsed, even though it violates the CSV specs.
Note that B<all> whitespace is stripped from start and end of each
-field. That would make is more a I<feature> than a way to be able
+field. That would make it more a I<feature> than a way to be able
to parse bad CSV lines, as
1, 2.0, 3, ape , monkey
@@ -968,12 +973,14 @@
Set to true will cause C<error_diag ()> to be automatically be called
in void context upon errors.
+In case of error C<2012 - EOF>), this call will be void.
+
If set to a value greater than 1, it will die on errors instead of
warn.
-Future extensions to this feature will include auto-detection of the
-C<autodie> module being enabled, which will raise the value of C<auto_diag>
-with C<1> on the moment the error is detected.
+Future extensions to this feature will include more reliable auto-detection
+of the C<autodie> module being enabled, which will raise the value of
+C<auto_diag> with C<1> on the moment the error is detected.
=back
@@ -1021,6 +1028,29 @@
"INI - Unknown attribute 'ecs_char'"
+=head2 print
+
+ $status = $csv->print ($io, $colref);
+
+Similar to C<combine () + string () + print>, but more efficient. It
+expects an array ref as input (not an array!) and the resulting string is
+not really created, but immediately written to the I<$io> object, typically
+an IO handle or any other object that offers a I<print> method. Note, this
+implies that the following is wrong in perl 5.005_xx and older:
+
+ open FILE, ">", "whatever";
+ $status = $csv->print (\*FILE, $colref);
+
+as in perl 5.005 and older, the glob C<\*FILE> is not an object, thus it
+doesn't have a print method. The solution is to use an IO::File object or
+to hide the glob behind an IO::Wrap object. See L<IO::File> and L<IO::Wrap>
+for details.
+
+For performance reasons the print method doesn't create a result string.
+In particular the I<$csv-E<gt>string ()>, I<$csv-E<gt>status ()>,
+I<$csv->fields ()> and I<$csv-E<gt>error_input ()> methods are meaningless
+after executing this method.
+
=head2 combine
$status = $csv->combine (@columns);
@@ -1032,35 +1062,27 @@
C<string ()> is undefined and C<error_input ()> can be called to retrieve an
invalid argument.
-=head2 print
-
- $status = $csv->print ($io, $colref);
-
-Similar to combine, but it expects an array ref as input (not an array!)
-and the resulting string is not really created, but immediately written
-to the I<$io> object, typically an IO handle or any other object that
-offers a I<print> method. Note, this implies that the following is wrong
-in perl 5.005_xx and older:
-
- open FILE, ">", "whatever";
- $status = $csv->print (\*FILE, $colref);
-
-as in perl 5.005 and older, the glob C<\*FILE> is not an object, thus it
-doesn't have a print method. The solution is to use an IO::File object or
-to hide the glob behind an IO::Wrap object. See L<IO::File> and L<IO::Wrap>
-for details.
-
-For performance reasons the print method doesn't create a result string.
-In particular the I<$csv-E<gt>string ()>, I<$csv-E<gt>status ()>,
-I<$csv->fields ()> and I<$csv-E<gt>error_input ()> methods are meaningless
-after executing this method.
-
=head2 string
$line = $csv->string ();
This object function returns the input to C<parse ()> or the resultant CSV
string of C<combine ()>, whichever was called more recently.
+
+=head2 getline
+
+ $colref = $csv->getline ($io);
+
+This is the counterpart to print, like parse is the counterpart to
+combine: It reads a row from the IO object $io using $io->getline ()
+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.
=head2 parse
@@ -1075,21 +1097,6 @@
You may use the I<types ()> method for setting column types. See the
description below.
-
-=head2 getline
-
- $colref = $csv->getline ($io);
-
-This is the counterpart to print, like parse is the counterpart to
-combine: It reads a row from the IO object $io using $io->getline ()
-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.
=head2 getline_hr
@@ -1370,7 +1377,9 @@
close $csv_fh or die "hello.csv: $!";
For more extended examples, see the C<examples/> subdirectory in the
-original distribution. The following files can be found there:
+original distribution or the git repository at
+http://repo.or.cz/w/Text-CSV_XS.git?a=tree;f=examples. The following files
+can be found there:
=over 2
@@ -1395,6 +1404,14 @@
A script to convert CSV to Microsoft Excel. This requires L<Date::Calc>
and L<Spreadsheet::WriteExcel>. The converter accepts various options and
can produce UTF-8 Excel files.
+
+=item csvdiff
+
+A script that provides colorized diff on sorted CSV files, assuming first
+line is header and first field is the key. Output options include colorized
+ANSI escape codes or HTML.
+
+ $ csvdiff --html --output=diff.html file1.csv file2.csv
=back
@@ -1505,9 +1522,9 @@
class method, like C<Text::CSV_XS->error_diag ()>.
C<$csv->error_diag ()> is automatically called upon error when the contractor
-was called with C<auto_diag> set to 1 or 2, or when C<autodie> is in effect
-(NYI). When set to 1, this will cause a C<warn ()> with the error message,
-when set to 2, it will C<die ()>.
+was called with C<auto_diag> set to 1 or 2, or when C<autodie> is in effect.
+When set to 1, this will cause a C<warn ()> with the error message, when set
+to 2, it will C<die ()>. C<2012 - EOF> is excluded from C<auto_diag> reports.
Currently errors as described below are available. I've tried to make the error
itself explanatory enough, but more descriptions will be added. For most of
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=45379&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/CSV_XS.xs (original)
+++ branches/upstream/libtext-csv-xs-perl/current/CSV_XS.xs Mon Oct 5 13:13:49 2009
@@ -211,7 +211,7 @@
static SV *cx_SetDiag (pTHX_ csv_t *csv, int xse)
{
dSP;
- SV *err = SvDiag (xse);
+ SV *err = SvDiag (xse);
if (err)
(void)hv_store (csv->self, "_ERROR_DIAG", 11, err, 0);
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=45379&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/ChangeLog (original)
+++ branches/upstream/libtext-csv-xs-perl/current/ChangeLog Mon Oct 5 13:13:49 2009
@@ -1,3 +1,11 @@
+2009-09-25 0.68 - H.Merijn Brand <h.m.brand at xs4all.nl>
+
+ * Attribute auto_diag now localizes to +1 if autodie is active
+ * Output name generation in csv2xls (RT#48954)
+ * Added csvdiff to examples/
+ * Reordered docs. Rewrote SYNOPSIS to be more like a real-world
+ code example
+
2009-08-08 0.67 - H.Merijn Brand <h.m.brand at xs4all.nl>
* Fix empty_diag typo for attribute handler
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=45379&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/MANIFEST (original)
+++ branches/upstream/libtext-csv-xs-perl/current/MANIFEST Mon Oct 5 13:13:49 2009
@@ -1,11 +1,12 @@
ChangeLog Change history
README Docs
MANIFEST This file
+META.yml Module meta-data
CSV_XS.PL Modify CSV_XS.pm for older perl versions
CSV_XS.pm Perl part of the module
CSV_XS.xs C part of the module
Makefile.PL Makefile generator
-ppport.h
+ppport.h Perl/Pollution/Portability script/include file
t/00_pod.t Check if pod is valid
t/01_pod.t Check if pod covers all
t/10_base.t Base tests (combine and parse only)
@@ -30,7 +31,7 @@
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/csvdiff Script to shoff diff between sorted CSV files
examples/parser-xs.pl Parse CSV stream, be forgiving on bad lines
examples/speed.pl Small benchmark script
files/utf8.csv A UTF-8 encode test file
-META.yml Module meta-data (added by MakeMaker)
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=45379&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/META.yml (original)
+++ branches/upstream/libtext-csv-xs-perl/current/META.yml Mon Oct 5 13:13:49 2009
@@ -1,6 +1,6 @@
--- #YAML:1.1
name: Text-CSV_XS
-version: 0.67
+version: 0.68
abstract: Comma-Separated Values manipulation routines
license: perl
author:
@@ -10,11 +10,13 @@
provides:
Text::CSV_XS:
file: CSV_XS.pm
- version: 0.67
+ version: 0.68
requires:
perl: 5.005
DynaLoader: 0
IO::Handle: 0
+recommends:
+ perl: 5.010001
configure_requires:
ExtUtils::MakeMaker: 0
build_requires:
Modified: branches/upstream/libtext-csv-xs-perl/current/examples/csv-check
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-xs-perl/current/examples/csv-check?rev=45379&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/examples/csv-check (original)
+++ branches/upstream/libtext-csv-xs-perl/current/examples/csv-check Mon Oct 5 13:13:49 2009
@@ -65,6 +65,7 @@
quote_char => $quo,
binary => 1,
keep_meta_info => 1,
+ auto_diag => 1,
});
sub done
Modified: branches/upstream/libtext-csv-xs-perl/current/examples/csv2xls
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-xs-perl/current/examples/csv2xls?rev=45379&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/examples/csv2xls (original)
+++ branches/upstream/libtext-csv-xs-perl/current/examples/csv2xls Mon Oct 5 13:13:49 2009
@@ -6,7 +6,7 @@
use strict;
use warnings;
-our $VERSION = "1.6";
+our $VERSION = "1.61";
sub usage
{
@@ -53,7 +53,7 @@
) or usage (1);
my $title = @ARGV && -f $ARGV[0] ? $ARGV[0] : "csv2xls";
-($xls ||= $title) =~ s/\.csv$/.xls/;
+($xls ||= $title) =~ s/(?:\.csv)?$/.xls/i;
-s $xls && $frc and unlink $xls;
if (-s $xls) {
Added: branches/upstream/libtext-csv-xs-perl/current/examples/csvdiff
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-xs-perl/current/examples/csvdiff?rev=45379&op=file
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/examples/csvdiff (added)
+++ branches/upstream/libtext-csv-xs-perl/current/examples/csvdiff Mon Oct 5 13:13:49 2009
@@ -1,0 +1,131 @@
+#!/pro/bin/perl
+
+use strict;
+use warnings;
+
+sub usage
+{
+ my $err = shift and select STDERR;
+ print "usage: csvdiff [--no-color] [--html] file.csv file.csv\n",
+ " provides colorized diff on sorted CSV files\n",
+ " assuming first line is header and first field is the key\n";
+ exit $err;
+ } # usage
+
+use Getopt::Long qw(:config bundling nopermute );
+my $opt_c = 1;
+my $opt_h = 0;
+my $opt_o = "";
+GetOptions (
+ "help|?" => sub { usage (0); },
+
+ "c|color|colour!" => \$opt_c,
+ "h|html" => \$opt_h,
+
+ "o|output=s" => \$opt_o,
+ ) or usage (1);
+
+ at ARGV == 2 or usage (1);
+
+if ($opt_o) {
+ open STDOUT, ">", $opt_o or die "$opt_o: $!\n";
+ }
+
+use HTML::Entities;
+use Term::ANSIColor qw(:constants);
+use Text::CSV_XS;
+my $csv = Text::CSV_XS->new ({ binary => 1, auto_diag => 0 });
+
+if ($opt_h) {
+ binmode STDOUT, ":utf8";
+ print <<EOH;
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
+<head>
+ <title>CFI School updates</title>
+ <meta name="Generator" content="perl $]" />
+ <meta name="Author" content="@{[scalar getpwuid $<]}" />
+ <meta name="Description" content="CSV diff @ARGV" />
+ <style type="text/css">
+ .rd { background: #ffe0e0; }
+ .gr { background: #e0ffe0; }
+ .b0 { background: #e0e0e0; }
+ .b1 { background: #f0f0f0; }
+ .r { color: red; }
+ .g { color: green; }
+ </style>
+ </head>
+<body>
+
+<h1>CSV diff @ARGV</h1>
+
+<table>
+EOH
+ $::{RED} = sub { "\cA\rr"; };
+ $::{GREEN} = sub { "\cA\rg"; };
+ $::{RESET} = sub { ""; };
+ }
+elsif (!$opt_c) {
+ $::{$_} = sub { "" } for qw( RED GREEN RESET );
+ }
+
+my @f;
+foreach my $x (0, 1) {
+ open my $fh, "<", $ARGV[$x] or die "$ARGV[$x]: $!\n";
+ while (1) { $_ = $csv->getline ($fh) or last; @$_ and push @{$f[$x]}, $_ }
+ }
+my @n = map { $#{$f[$_]} } 0, 1;
+my @i = (1, 1);
+my $hdr = "# csvdiff < $ARGV[0] > $ARGV[1]\n";
+
+$f[$_][1+$n[$_]][0] = "\xff\xff\xff\xff" for 0, 1;
+
+my %cls;
+ %cls = (
+ "b" => 0,
+ "-" => sub { "rd" },
+ "+" => sub { "gr" },
+ "<" => sub { $cls{b} ^= 1; "b$cls{b}" },
+ ">" => sub { "b$cls{b}" },
+ );
+
+sub show
+{
+ my ($pfx, $x) = @_;
+ my $row = $f[$x][$i[$x]++];
+
+ if ($opt_h) {
+ my $bg = $cls{$pfx}->();
+ print qq{ <tr class="$bg">},
+ (map{"<td".(s/^\cA\r([gr])//?qq{ class="$1"}:"").">$_</td>"}@$row),
+ "</tr>\n";
+ return;
+ }
+
+ print $hdr, $pfx, " ", $pfx eq "-" ? RED : $pfx eq "+" ? GREEN : "";
+ $csv->print (*STDOUT, $row);
+ print RESET, "\n";
+ $hdr = "";
+ } # show
+
+while ($i[0] <= $n[0] || $i[1] <= $n[1]) {
+ $f[0][$i[0]][0] lt $f[1][$i[1]][0] and show ("-", 0), next;
+ $f[0][$i[0]][0] gt $f[1][$i[1]][0] and show ("+", 1), next;
+
+ "@{[@{$f[0][$i[0]]}]}" eq "@{[@{$f[1][$i[1]]}]}" and
+ $i[0]++, $i[1]++, next;
+
+ foreach my $c (1 .. $#{$f[0][0]}) {
+ $f[0][$i[0]][$c] eq $f[1][$i[1]][$c] and next;
+ $f[0][$i[0]][$c] = RED . $f[0][$i[0]][$c] . RESET;
+ $f[1][$i[1]][$c] = GREEN . $f[1][$i[1]][$c] . RESET;
+ }
+
+ show ("<", 0);
+ show (">", 1);
+ }
+
+$opt_h and print " </table>\n</body>\n</html>\n";
+
+close STDOUT;
Propchange: branches/upstream/libtext-csv-xs-perl/current/examples/csvdiff
------------------------------------------------------------------------------
svn:executable = *
More information about the Pkg-perl-cvs-commits
mailing list