@@ -1,6 +1,6 @@
package Text::CSV_XS;
-# Copyright (c) 2007-2014 H.Merijn Brand. All rights reserved.
+# Copyright (c) 2007-2015 H.Merijn Brand. All rights reserved.
# Copyright (c) 1998-2001 Jochen Wiedmann. All rights reserved.
# Copyright (c) 1997 Alan Citterman. All rights reserved.
#
@@ -9,14 +9,12 @@ package Text::CSV_XS;
# HISTORY
#
-# Written by:
+# 0.24 -
+# H.Merijn Brand (h.m.brand@xs4all.nl)
+# 0.10 - 0.23
# Jochen Wiedmann <joe@ispsoft.de>
-#
-# Based on Text::CSV by:
+# Based on (the original) Text::CSV by:
# Alan Citterman <alan@mfgrtl.com>
-#
-# Extended and Remodelled by:
-# H.Merijn Brand (h.m.brand@xs4all.nl)
require 5.006001;
@@ -28,7 +26,7 @@ use DynaLoader ();
use Carp;
use vars qw( $VERSION @ISA @EXPORT_OK );
-$VERSION = "1.12";
+$VERSION = "1.13";
@ISA = qw( DynaLoader Exporter );
@EXPORT_OK = qw( csv );
bootstrap Text::CSV_XS $VERSION;
@@ -37,6 +35,11 @@ sub PV { 0 }
sub IV { 1 }
sub NV { 2 }
+if ($] < 5.008002) {
+ no warnings "redefine";
+ *utf8::decode = sub {};
+ }
+
# version
#
# class/object method expecting no arguments and returning the version
@@ -114,6 +117,7 @@ sub _check_sanity
{
my $self = shift;
+ my $eol = $self->{eol};
my $sep = $self->{sep};
defined $sep && length ($sep) or $sep = $self->{sep_char};
my $quo = $self->{quote};
@@ -123,11 +127,22 @@ sub _check_sanity
# use DP;::diag ("SEP: '", DPeek ($sep),
# "', QUO: '", DPeek ($quo),
# "', ESC: '", DPeek ($esc),"'");
- # sep_char cannot be undefined
- defined $quo && $quo eq $sep and return 1001;
- defined $esc && $esc eq $sep and return 1001;
-
- defined $_ && $_ =~ m/[\r\n]/ and return 1003 for $sep, $quo, $esc;
+ if (defined $sep) { # sep_char cannot be undefined
+ length ($sep) > 16 and return 1006;
+ $sep =~ m/[\r\n]/ and return 1003;
+ }
+ if (defined $quo) {
+ $quo eq $sep and return 1001;
+ length ($quo) > 16 and return 1007;
+ $quo =~ m/[\r\n]/ and return 1003;
+ }
+ if (defined $esc) {
+ $esc eq $sep and return 1001;
+ $esc =~ m/[\r\n]/ and return 1003;
+ }
+ if (defined $eol) {
+ length ($eol) > 16 and return 1005;
+ }
return _unhealthy_whitespace ($self, $self->{allow_whitespace});
} # _check_sanity
@@ -160,8 +175,7 @@ sub new
for (keys %attr) {
if (m/^[a-z]/ && exists $def_attr{$_}) {
# uncoverable condition false
- defined $attr{$_} && $] >= 5.008002 && m/_char$/ and
- utf8::decode ($attr{$_});
+ defined $attr{$_} && m/_char$/ and utf8::decode ($attr{$_});
next;
}
# croak?
@@ -241,7 +255,7 @@ sub _set_attr_C
{
my ($self, $name, $val, $ec) = @_;
defined $val or $val = 0;
- $] >= 5.008002 and utf8::decode ($val);
+ utf8::decode ($val);
$self->{$name} = $val;
$ec = _check_sanity ($self) and
croak ($self->SetDiag ($ec));
@@ -283,9 +297,10 @@ sub quote
if (@_) {
my $quote = shift;
defined $quote or $quote = "";
- $] >= 5.008002 and utf8::decode ($quote);
+ utf8::decode ($quote);
my @b = unpack "U0C*", $quote;
if (@b > 1) {
+ @b > 16 and croak ($self->SetDiag (1007));
$self->quote_char ("\0");
}
else {
@@ -326,9 +341,10 @@ sub sep
if (@_) {
my $sep = shift;
defined $sep or $sep = "";
- $] >= 5.008002 and utf8::decode ($sep);
+ utf8::decode ($sep);
my @b = unpack "U0C*", $sep;
if (@b > 1) {
+ @b > 16 and croak ($self->SetDiag (1006));
$self->sep_char ("\0");
}
else {
@@ -352,6 +368,7 @@ sub eol
if (@_) {
my $eol = shift;
defined $eol or $eol = "";
+ length ($eol) > 16 and croak ($self->SetDiag (1005));
$self->{eol} = $eol;
$self->_cache_set ($_cache_id{eol}, $eol);
}
@@ -578,32 +595,34 @@ sub error_diag
if ($diag[0] && $diag[0] != 2012) {
my $msg = "# CSV_XS ERROR: $diag[0] - $diag[1] \@ rec $diag[3] pos $diag[2]\n";
$diag[4] and $msg =~ s/$/ field $diag[4]/;
- if ($self && ref $self) { # auto_diag
- if ($self->{diag_verbose} and $self->{_ERROR_INPUT}) {
- $msg .= "$self->{_ERROR_INPUT}'\n";
- $msg .= " " x ($diag[2] - 1);
- $msg .= "^\n";
- }
- 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;
- }
- else { # called without args in void context
+ unless ($self && ref $self) { # auto_diag
+ # called without args in void context
warn $msg;
+ return;
}
+
+ if ($self->{diag_verbose} and $self->{_ERROR_INPUT}) {
+ $msg .= "$self->{_ERROR_INPUT}'\n";
+ $msg .= " " x ($diag[2] - 1);
+ $msg .= "^\n";
+ }
+
+ 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;
}
@@ -946,7 +965,7 @@ sub _csv_attr
}
elsif (ref $in or "GLOB" eq ref \$in) {
if (!ref $in && $] < 5.008005) {
- $fh = \*$in;
+ $fh = \*$in; # uncoverable statement ancient perl version required
}
else {
$fh = $in;
@@ -1030,10 +1049,10 @@ sub csv
}
}
else { # aoh
- my @hdrs = ref $hdrs ? @{$hdrs}
- : map { $hdr{$_} || $_ } keys %{$in->[0]};
+ my @hdrs = ref $hdrs ? @{$hdrs} : keys %{$in->[0]};
defined $hdrs or $hdrs = "auto";
- ref $hdrs || $hdrs eq "auto" and $csv->print ($fh, \@hdrs);
+ ref $hdrs || $hdrs eq "auto" and
+ $csv->print ($fh, [ map { $hdr{$_} || $_ } @hdrs ]);
for (@{$in}) {
$c->{cboi} and $c->{cboi}->($csv, $_);
$c->{cbbo} and $c->{cbbo}->($csv, $_);
@@ -1045,8 +1064,6 @@ sub csv
return 1;
}
- ref $in eq "CODE" and croak "CODE only valid fro in when using out";
-
my $key = $c->{key} and $hdrs ||= "auto";
if (defined $hdrs && !ref $hdrs) {
if ($hdrs eq "skip") {
@@ -1085,7 +1102,7 @@ sub csv
__END__
-=encoding iso-8859-1
+=encoding utf-8
=head1 NAME
@@ -1691,7 +1708,7 @@ record (unless quotation was added because of other reasons).
quote_space => 0,
});
- my $row = $csv->parse (q{1,,"", ," ",f,"g","h""h",hëlp,"hélp"});
+ my $row = $csv->parse (q{1,,"", ," ",f,"g","h""h",hëlp,"hélp"});
$csv->print (*STDOUT, \@row);
# 1,,, , ,f,g,"h""h",h?lp,h?lp
@@ -3043,6 +3060,24 @@ The L<C<callbacks>|/Callbacks> attribute only allows one to be C<undef> or
a hash reference.
=item *
+1005 "INI - EOL too long"
+X<1005>
+
+The value passed for EOL is exceeding its maximum length (16).
+
+=item *
+1006 "INI - SEP too long"
+X<1006>
+
+The value passed for SEP is exceeding its maximum length (16).
+
+=item *
+1007 "INI - QUOTE too long"
+X<1007>
+
+The value passed for QUOTE is exceeding its maximum length (16).
+
+=item *
2010 "ECR - QUO char inside quotes followed by CR not part of EOL"
X<2010>
@@ -3230,7 +3265,7 @@ L</csv> function. See ChangeLog releases 0.25 and on.
=head1 COPYRIGHT AND LICENSE
- Copyright (C) 2007-2014 H.Merijn Brand. All rights reserved.
+ Copyright (C) 2007-2015 H.Merijn Brand. All rights reserved.
Copyright (C) 1998-2001 Jochen Wiedmann. All rights reserved.
Copyright (C) 1997 Alan Citterman. All rights reserved.
@@ -1,4 +1,4 @@
-/* Copyright (c) 2007-2014 H.Merijn Brand. All rights reserved.
+/* Copyright (c) 2007-2015 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.
@@ -28,9 +28,8 @@
#define CSV_XS_TYPE_IV 1
#define CSV_XS_TYPE_NV 2
-#define MAX_SEP_LEN 16
-#define MAX_EOL_LEN 16
-#define MAX_QUO_LEN 16
+/* maximum length for EOL, SEP, and QUOTE - keep in sync with .pm */
+#define MAX_ATTR_LEN 16
#define CSV_FLAGS_QUO 0x0001
#define CSV_FLAGS_BIN 0x0002
@@ -160,9 +159,9 @@ typedef struct {
int eol_pos;
STRLEN size;
STRLEN used;
- byte eol[MAX_EOL_LEN];
- byte sep[MAX_SEP_LEN];
- byte quo[MAX_QUO_LEN];
+ byte eol[MAX_ATTR_LEN];
+ byte sep[MAX_ATTR_LEN];
+ byte quo[MAX_ATTR_LEN];
char buffer[BUFFER_SIZE];
} csv_t;
@@ -185,6 +184,9 @@ xs_error_t xs_errors[] = {
{ 1002, "INI - allow_whitespace with escape_char or quote_char SP or TAB" },
{ 1003, "INI - \r or \n in main attr not allowed" },
{ 1004, "INI - callbacks should be undef or a hashref" },
+ { 1005, "INI - EOL too long" },
+ { 1006, "INI - SEP too long" },
+ { 1007, "INI - QUOTE too long" },
/* Parse errors */
{ 2010, "ECR - QUO char inside quotes followed by CR not part of EOL" },
@@ -365,7 +367,7 @@ static void cx_xs_cache_set (pTHX_ HV *hv, int idx, SV *val)
if (SvIOK (val))
iv = SvIV (val);
else if (SvNOK (val)) /* Needed for 5.6.x but safe for 5.8.x+ */
- iv = (IV)SvNV (val);
+ iv = (IV)SvNV (val); /* uncoverable statement ancient perl required */
else
iv = *cp;
@@ -409,25 +411,19 @@ static void cx_xs_cache_set (pTHX_ HV *hv, int idx, SV *val)
/* string */
case CACHE_ID_sep:
- if (len < MAX_SEP_LEN) {
- memcpy (csv->sep, cp, len);
- csv->sep_len = len == 1 ? 0 : len;
- }
+ memcpy (csv->sep, cp, len);
+ csv->sep_len = len == 1 ? 0 : len;
break;
case CACHE_ID_quo:
- if (len < MAX_QUO_LEN) {
- memcpy (csv->quo, cp, len);
- csv->quo_len = len == 1 ? 0 : len;
- }
+ memcpy (csv->quo, cp, len);
+ csv->quo_len = len == 1 ? 0 : len;
break;
case CACHE_ID_eol:
- if (len < MAX_EOL_LEN) {
- memcpy (csv->eol, cp, len);
- csv->eol_len = len;
- csv->eol_is_cr = len == 1 && *cp == CH_CR ? 1 : 0;
- }
+ memcpy (csv->eol, cp, len);
+ csv->eol_len = len;
+ csv->eol_is_cr = len == 1 && *cp == CH_CR ? 1 : 0;
break;
default:
@@ -541,11 +537,9 @@ static void cx_SetupCsv (pTHX_ csv_t *csv, HV *self, SV *pself)
CH_SEP = *SvPV (*svp, len);
if ((svp = hv_fetchs (self, "sep", FALSE)) && *svp && SvOK (*svp)) {
ptr = SvPV (*svp, len);
- if (len < MAX_SEP_LEN) {
- memcpy (csv->sep, ptr, len);
- if (len > 1)
- csv->sep_len = len;
- }
+ memcpy (csv->sep, ptr, len);
+ if (len > 1)
+ csv->sep_len = len;
}
CH_QUOTE = '"';
@@ -559,11 +553,9 @@ static void cx_SetupCsv (pTHX_ csv_t *csv, HV *self, SV *pself)
}
if ((svp = hv_fetchs (self, "quote", FALSE)) && *svp && SvOK (*svp)) {
ptr = SvPV (*svp, len);
- if (len < MAX_QUO_LEN) {
- memcpy (csv->quo, ptr, len);
- if (len > 1)
- csv->quo_len = len;
- }
+ memcpy (csv->quo, ptr, len);
+ if (len > 1)
+ csv->quo_len = len;
}
csv->escape_char = '"';
@@ -578,12 +570,10 @@ static void cx_SetupCsv (pTHX_ csv_t *csv, HV *self, SV *pself)
if ((svp = hv_fetchs (self, "eol", FALSE)) && *svp && SvOK (*svp)) {
char *eol = SvPV (*svp, len);
- if (len < MAX_EOL_LEN) {
- memcpy (csv->eol, eol, len);
- csv->eol_len = len;
- if (len == 1 && *csv->eol == CH_CR)
- csv->eol_is_cr = 1;
- }
+ memcpy (csv->eol, eol, len);
+ csv->eol_len = len;
+ if (len == 1 && *csv->eol == CH_CR)
+ csv->eol_is_cr = 1;
}
if ((svp = hv_fetchs (self, "_types", FALSE)) && *svp && SvOK (*svp)) {
@@ -821,11 +811,14 @@ static int cx_Combine (pTHX_ csv_t *csv, SV *dst, AV *fields)
for (ptr2 = ptr, l = len; l; ++ptr2, --l) {
byte c = *ptr2;
- if (c < csv->first_safe_char ||
- (csv->quote_binary && c >= 0x7f && c <= 0xa0) ||
- (CH_QUOTE && c == CH_QUOTE) ||
- (CH_SEP && c == CH_SEP) ||
- (csv->escape_char && c == csv->escape_char)) {
+ if ((CH_QUOTE && c == CH_QUOTE) ||
+ (CH_SEP && c == CH_SEP) ||
+ (csv->escape_char && c == csv->escape_char) ||
+ (csv->quote_binary ? c >= 0x7f && c <= 0xa0 ||
+ c < csv->first_safe_char
+ : c == CH_NL || c == CH_CR ||
+ (csv->quote_space && (
+ c == CH_SPACE || c == CH_TAB)))) {
/* Binary character */
break;
}
@@ -848,7 +841,7 @@ static int cx_Combine (pTHX_ csv_t *csv, SV *dst, AV *fields)
SvREFCNT_inc (sv);
csv->has_error_input = 1;
unless (hv_store (csv->self, "_ERROR_INPUT", 12, sv, 0))
-/* uncovered */ SvREFCNT_dec (sv);
+ SvREFCNT_dec (sv); /* uncoverable statement memory fail */
(void)SetDiag (csv, 2110);
return FALSE;
}
@@ -1406,7 +1399,7 @@ restart:
CSV_PUT_SV (c2);
}
else
-/* uncovered */ ERROR_INSIDE_FIELD (2036); /* I think there's no way to get here */
+ ERROR_INSIDE_FIELD (2036); /* uncoverable statement I think there's no way to get here */
} /* ESC char */
else
if (c == CH_NL || is_EOL (c)) {
@@ -1743,7 +1736,7 @@ static void hook (pTHX_ HV *hv, char *cb_name, AV *av)
fprintf (stderr, "# HOOK %s %x\n", cb_name, av);
#endif
unless ((svp = hv_fetchs (hv, "callbacks", FALSE)) && _is_hashref (*svp))
- return;
+ return; /* uncoverable statement defensive programming */
cb = (HV *)SvRV (*svp);
svp = hv_fetch (cb, cb_name, strlen (cb_name), FALSE);
@@ -1,3 +1,9 @@
+1.13 - 2015-01-01, H.Merijn Brand
+ - Simplify code path for old perl
+ - Fix quote_binary (#RT100676)
+ - Fix csv () for hashrefs with aliased headers
+ - Update copyright to 2015
+
1.12 - 2014-11-01, H.Merijn Brand
* Add field number to error_diag
* Fixed non-IO parsing multi-byte EOL
@@ -8,7 +14,7 @@
* Fix parallel testing issue
* Allow csv as method call (not using the object)
* Rename quote_null to escape_null
- * Give meaning to keep_meta_info on output
+ * Give meaning to keep_meta_info on output (RT#99941)
1.11 - 2014-08-16, H.Merijn Brand
* Fixed eof (RT#97742)
@@ -1,65 +1,65 @@
{
- "generated_by" : "Author",
- "release_status" : "stable",
- "provides" : {
- "Text::CSV_XS" : {
- "file" : "CSV_XS.pm",
- "version" : "1.12"
- }
- },
- "license" : [
- "perl_5"
- ],
- "meta-spec" : {
- "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
- "version" : "2"
- },
- "version" : "1.12",
+ "version" : "1.13",
"prereqs" : {
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
"runtime" : {
"requires" : {
- "IO::Handle" : "0",
"perl" : "5.006001",
+ "IO::Handle" : "0",
"DynaLoader" : "0"
},
"recommends" : {
- "perl" : "5.020001",
- "Encode" : "2.64"
+ "Encode" : "2.67",
+ "perl" : "5.020001"
}
},
"test" : {
"requires" : {
- "Test::More" : "0",
- "Tie::Scalar" : "0"
+ "Tie::Scalar" : "0",
+ "Test::More" : "0"
}
},
"build" : {
"requires" : {
"Config" : "0"
}
- },
- "configure" : {
- "requires" : {
- "ExtUtils::MakeMaker" : "0"
- }
}
},
+ "license" : [
+ "perl_5"
+ ],
+ "abstract" : "Comma-Separated Values manipulation routines",
+ "generated_by" : "Author",
"resources" : {
+ "x_IRC" : "irc://irc.perl.org/#csv",
"repository" : {
"type" : "git",
- "web" : "http://repo.or.cz/w/Text-CSV_XS.git",
- "url" : "http://repo.or.cz/r/Text-CSV_XS.git"
+ "url" : "http://repo.or.cz/r/Text-CSV_XS.git",
+ "web" : "http://repo.or.cz/w/Text-CSV_XS.git"
},
"homepage" : "https://metacpan.org/pod/Text::CSV_XS",
"license" : [
"http://dev.perl.org/licenses/"
- ],
- "x_IRC" : "irc://irc.perl.org/#csv"
+ ]
},
+ "provides" : {
+ "Text::CSV_XS" : {
+ "version" : "1.13",
+ "file" : "CSV_XS.pm"
+ }
+ },
+ "name" : "Text-CSV_XS",
+ "release_status" : "stable",
"author" : [
"H.Merijn Brand <h.m.brand@xs4all.nl>"
],
- "dynamic_config" : 1,
- "name" : "Text-CSV_XS",
- "abstract" : "Comma-Separated Values manipulation routines"
+ "meta-spec" : {
+ "version" : "2",
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec"
+ },
+ "dynamic_config" : 1
}
@@ -7,7 +7,7 @@ build_requires:
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
-generated_by: Author, CPAN::Meta::Converter version 2.142690
+generated_by: Author, CPAN::Meta::Converter version 2.143240
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -16,9 +16,9 @@ name: Text-CSV_XS
provides:
Text::CSV_XS:
file: CSV_XS.pm
- version: '1.12'
+ version: '1.13'
recommends:
- Encode: '2.64'
+ Encode: '2.67'
perl: '5.020001'
requires:
DynaLoader: 0
@@ -31,4 +31,4 @@ resources:
homepage: https://metacpan.org/pod/Text::CSV_XS
license: http://dev.perl.org/licenses/
repository: http://repo.or.cz/r/Text-CSV_XS.git
-version: '1.12'
+version: '1.13'
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# Copyright PROCURA B.V. (c) 2006-2014 H.Merijn Brand
+# Copyright PROCURA B.V. (c) 2006-2015 H.Merijn Brand
require 5.006001; # <- also see postamble at the bottom for META.yml
use strict;
@@ -7,7 +7,7 @@ Description:
combine fields into a CSV string and parse a CSV string into fields.
Copying:
- Copyright (c) 2007-2014 H.Merijn Brand. All rights reserved.
+ Copyright (c) 2007-2015 H.Merijn Brand. All rights reserved.
Copyright (c) 1998-2001 Jochen Wiedmann. All rights reserved.
Portions Copyright (c) 1997 Alan Citterman. All rights reserved.
@@ -1,7 +1,7 @@
#!/pro/bin/perl
# csv-check: Check validity of CSV file and report
-# (m)'13 [10 Jul 2013] Copyright H.M.Brand 2007-2014
+# (m)'13 [10 Jul 2013] Copyright H.M.Brand 2007-2015
# This code requires the defined-or feature and PerlIO
@@ -1,7 +1,7 @@
#!/pro/bin/perl
# csv2xls: Convert csv to xls
-# (m)'14 [20 May 2014] Copyright H.M.Brand 2007-2014
+# (m)'14 [20 May 2014] Copyright H.M.Brand 2007-2015
use strict;
use warnings;
@@ -3,7 +3,7 @@
# This script can be used as a base to parse unreliable CSV streams
# Modify to your own needs
#
-# (m)'08 [23 Apr 2008] Copyright H.M.Brand 2008-2014
+# (m)'08 [23 Apr 2008] Copyright H.M.Brand 2008-2015
use strict;
use warnings;
@@ -1,14 +1,15 @@
#!/usr/bin/perl -w
# speed.pl: compare different versions of Text-CSV* modules
-# (m)'08 [07 Apr 2008] Copyright H.M.Brand 2007-2014
+# (m)'08 [07 Apr 2008] Copyright H.M.Brand 2007-2015
require 5.006001;
use strict;
use IO::Handle;
use Text::CSV_XS;
-use Benchmark qw(:all :hireswallclock);
+use Benchmark "timethese";
+eval { Benchmark->import (":hireswallclock"); };
our $csv = Text::CSV_XS->new ({ eol => "\n" });
@@ -4,7 +4,7 @@
/*
----------------------------------------------------------------------
- ppport.h -- Perl/Pollution/Portability Version 3.24
+ ppport.h -- Perl/Pollution/Portability Version 3.25
Automatically created by Devel::PPPort running under perl 5.020001.
@@ -21,7 +21,7 @@ SKIP
=head1 NAME
-ppport.h - Perl/Pollution/Portability version 3.24
+ppport.h - Perl/Pollution/Portability version 3.25
=head1 SYNOPSIS
@@ -219,6 +219,7 @@ same function or variable in your project.
-----------------------------------------------------------------------------------------
PL_parser NEED_PL_parser NEED_PL_parser_GLOBAL
PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
+ caller_cx() NEED_caller_cx NEED_caller_cx_GLOBAL
eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
@@ -380,7 +381,7 @@ use strict;
# Disable broken TRIE-optimization
BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
-my $VERSION = 3.24;
+my $VERSION = 3.25;
my %opt = (
quiet => 0,
@@ -1200,7 +1201,7 @@ call_list||5.004000|
call_method|5.006000||p
call_pv|5.006000||p
call_sv|5.006000||p
-caller_cx||5.013005|
+caller_cx|5.013005|5.013005|p
calloc||5.007002|n
cando|||
cast_i32||5.006000|
@@ -6566,6 +6567,90 @@ DPPP_(my_sv_unmagicext)(pTHX_ SV *const sv, const int type, MGVTBL *vtbl)
#endif
#endif /* USE_ITHREADS */
+
+#if (PERL_BCDVERSION >= 0x5006000)
+#ifndef caller_cx
+
+# if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
+static I32
+DPPP_dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock)
+{
+ I32 i;
+
+ for (i = startingblock; i >= 0; i--) {
+ register const PERL_CONTEXT * const cx = &cxstk[i];
+ switch (CxTYPE(cx)) {
+ default:
+ continue;
+ case CXt_EVAL:
+ case CXt_SUB:
+ case CXt_FORMAT:
+ return i;
+ }
+ }
+ return i;
+}
+# endif
+
+# if defined(NEED_caller_cx)
+static const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
+static
+#else
+extern const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
+#endif
+
+#ifdef caller_cx
+# undef caller_cx
+#endif
+#define caller_cx(a,b) DPPP_(my_caller_cx)(aTHX_ a,b)
+#define Perl_caller_cx DPPP_(my_caller_cx)
+
+#if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
+
+const PERL_CONTEXT *
+DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp)
+{
+ register I32 cxix = DPPP_dopoptosub_at(cxstack, cxstack_ix);
+ register const PERL_CONTEXT *cx;
+ register const PERL_CONTEXT *ccstack = cxstack;
+ const PERL_SI *top_si = PL_curstackinfo;
+
+ for (;;) {
+ /* we may be in a higher stacklevel, so dig down deeper */
+ while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
+ top_si = top_si->si_prev;
+ ccstack = top_si->si_cxstack;
+ cxix = DPPP_dopoptosub_at(ccstack, top_si->si_cxix);
+ }
+ if (cxix < 0)
+ return NULL;
+ /* caller() should not report the automatic calls to &DB::sub */
+ if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
+ ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
+ count++;
+ if (!count--)
+ break;
+ cxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
+ }
+
+ cx = &ccstack[cxix];
+ if (dbcxp) *dbcxp = cx;
+
+ if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
+ const I32 dbcxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
+ /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
+ field below is defined for any cx. */
+ /* caller() should not report the automatic calls to &DB::sub */
+ if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
+ cx = &ccstack[dbcxix];
+ }
+
+ return cx;
+}
+
+# endif
+#endif /* caller_cx */
+#endif /* 5.6.0 */
#ifndef IN_PERL_COMPILETIME
# define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
#endif
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 155;
+use Test::More tests => 177;
BEGIN {
use_ok "Text::CSV_XS";
@@ -96,6 +96,20 @@ is ($csv->sep_char (), "\0", "sep_char");
is ($csv->quote ("++"), "++", "quote (\"++\")");
is ($csv->quote_char (), "\0", "quote_char");
+# Test single-byte specials in UTF-8 mode
+is ($csv->sep ("|"), "|", "sep |");
+is ($csv->sep_char (), "|", "sep_char");
+chop (my $s = "|\x{20ac}");
+is ($csv->sep ($s), "|", "sep |");
+is ($csv->sep (), "|", "sep_char");
+is ($csv->sep_char (), "|", "sep_char");
+is ($csv->quote ("'"), "'", "quote '");
+is ($csv->quote_char (), "'", "quote_char");
+chop (my $q = "'\x{20ac}");
+is ($csv->quote ($q), "'", "quote '");
+is ($csv->quote (), "'", "quote_char");
+is ($csv->quote_char (), "'", "quote_char");
+
# Funny settings, all three translate to \0 internally
ok ($csv = Text::CSV_XS->new ({
sep_char => undef,
@@ -160,6 +174,28 @@ foreach my $attr (qw( sep_char quote_char escape_char )) {
is (($csv->error_diag)[0], 1003, "not allowed");
}
+# Too long attr (max 16)
+$csv = Text::CSV_XS->new ({ quote => "'" });
+my $xl = "X" x 32;
+eval { $csv->eol ($xl); };
+is (($csv->error_diag)[0], 1005, "eol too long");
+is ($csv->eol (), "", "eol unchanged");
+eval { $csv->sep ($xl); };
+is (($csv->error_diag)[0], 1006, "sep too long");
+is ($csv->sep (), ",", "sep unchanged");
+eval { $csv->quote ($xl); };
+is (($csv->error_diag)[0], 1007, "quo too long");
+is ($csv->quote (), "'", "quo unchanged");
+eval { $csv = Text::CSV_XS->new ({ eol => $xl }); };
+is ($csv, undef, "new with EOL too long");
+is ((Text::CSV_XS::error_diag)[0], 1005, "error set");
+eval { $csv = Text::CSV_XS->new ({ sep => $xl }); };
+is ($csv, undef, "new with SEP too long");
+is ((Text::CSV_XS::error_diag)[0], 1006, "error set");
+eval { $csv = Text::CSV_XS->new ({ quote => $xl }); };
+is ($csv, undef, "new with QUO too long");
+is ((Text::CSV_XS::error_diag)[0], 1007, "error set");
+
# And test erroneous calls
is (Text::CSV_XS::new (0), undef, "new () as function");
is (Text::CSV_XS::error_diag (), "usage: my \$csv = Text::CSV_XS->new ([{ option => value, ... }]);",
@@ -10,7 +10,7 @@ BEGIN {
plan skip_all => "UTF8 tests useless in this ancient perl version";
}
else {
- plan tests => 91;
+ plan tests => 93;
}
}
@@ -102,6 +102,10 @@ ok ($csv->quote_binary (1), "quote binary on");
ok ($csv->combine (" ", 1, "\x{20ac} "), "Combine");
is ($csv->string, qq{" ",1,"\x{20ac} "}, "String 1-1");
+ok ($csv->parse (qq{,1,"f\x{014d}o, 3""56",,bar,\r\n}), "example from XS");
+is_deeply ([$csv->fields], [
+ "", 1, qq{f\x{014d}o, 3"56}, "", "bar", "" ], "content");
+
open my $fh, ">:encoding(utf-8)", "_50test.csv";
print $fh "euro\n\x{20ac}\neuro\n";
close $fh;
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 25102;
+use Test::More tests => 25107;
BEGIN {
require_ok "Text::CSV_XS";
@@ -126,4 +126,18 @@ foreach my $fail (sort keys %fail) {
printf STDERR "%-20s - %s\n", map { _readable $_ } $combi, $fail{$fail}{$combi};
}
}
+
+{ my $err = "";
+ local $SIG{__WARN__} = sub { $err = shift; };
+ is (Text::CSV_XS->new ({ sep => ",", quote => ",", auto_diag => 1 }),
+ undef, "New (illegal combo + auto_diag)");
+ like ($err, qr{\bERROR: 1001 - INI -}, "Error message");
+
+ $err = "";
+ ok (my $csv = Text::CSV_XS->new ({ auto_diag => 1 }), "new auto_diag");
+ eval { $csv->sep ('"'); };
+ like ($err, qr{\bERROR: 1001 - INI -}, "Error message");
+ is ($csv->sep_char (), '"', "sep changed anyway");
+ }
+
1;
@@ -15,7 +15,7 @@ BEGIN {
plan skip_all => "No reliable perlIO available";
}
else {
- plan tests => 18;
+ plan tests => 22;
}
}
@@ -53,6 +53,9 @@ my @test = (
"cell=7,7-8,*" => [[ 77,78,79 ], [ 87,88,89 ]],
"cell=7,7-*,*" => [[ 77,78,79 ], [ 87,88,89 ], [ 97,98,99 ]],
+ "cell=7,7;7,8;8,7;8,8" => [[ 77,78 ], [ 87,88 ]],
+ "cell=8,8;8,7;7,8;7,7" => [[ 77,78 ], [ 87,88 ]],
+
"cell=1,1-2,2;3,3-4,4" => [
[11,12],
[21,22],
@@ -82,10 +85,21 @@ while (my ($spec, $expect) = splice @test, 0, 2) {
is_deeply ($aoa, $expect, "${todo}Fragment $spec");
}
-$csv->column_names ("c3","c4");
-open my $io, "<", \$data;
-is_deeply ($csv->fragment ($io, "cell=3,2-4,3"),
- [ { c3 => 32, c4 =>33 }, { c3 => 42, c4 => 43 }], "Fragment to AoH");
+{ $csv->column_names ("c3", "c4");
+ open my $io, "<", \$data;
+ is_deeply ($csv->fragment ($io, "cell=3,2-4,3"),
+ [ { c3 => 32, c4 => 33 }, { c3 => 42, c4 => 43 }], "Fragment to AoH");
+ }
+{ $csv->column_names ("C1", "C2");
+ open my $io, "<", \$data;
+ is_deeply ($csv->fragment ($io, "row=3"),
+ [ { C1 => 31, C2 => 32 }], "Fragment row with headers to AoH");
+ }
+{ $csv->column_names ("C1");
+ open my $io, "<", \$data;
+ is_deeply ($csv->fragment ($io, "col=2"),
+ [ map +{ C1 => $_.2 } => 1 .. 9 ], "Fragment col with headers to AoH");
+ }
#$csv->eol ("\n");
#foreach my $r (1..9){$csv->print(*STDOUT,[map{$r.$_}1..9])}
@@ -3,7 +3,7 @@
use strict;
use warnings;
- use Test::More tests => 225;
+ use Test::More tests => 263;
#use Test::More "no_plan";
my %err;
@@ -141,9 +141,28 @@ $csv = Text::CSV_XS->new ({ auto_diag => 1 });
{ my @warn;
local $SIG{__WARN__} = sub { push @warn, @_ };
- Text::CSV_XS->new ()->_cache_diag ();
+
+ # Invalid error_input calls
+ is (Text::CSV_XS::error_input (undef), undef, "Bad error_input call");
+ is (Text::CSV_XS::error_input (""), undef, "Bad error_input call");
+ is (Text::CSV_XS::error_input ([]), undef, "Bad error_input call");
+ is (Text::CSV_XS->error_input, undef, "Bad error_input call");
+
+ ok (my $csv = Text::CSV_XS->new (), "new for cache diag");
+ $csv->_cache_diag ();
ok (@warn == 1, "Got warn");
is ($warn[0], "CACHE: invalid\n", "Uninitialized cache");
+
+ @warn = ();
+ ok ($csv->parse ("1"), "parse"); # initialize cache
+ $csv->_cache_set (987, 10);
+ ok (@warn == 1, "Got warn");
+ is ($warn[0], "Unknown cache index 987 ignored\n", "Ignore bad cache calls");
+
+ is ($csv->parse ('"'), 0, "Bad parse");
+ is ($csv->error_input, '"', "Error input");
+ ok ($csv->_cache_set (34, 0), "Reset error input (dangerous!)");
+ is ($csv->error_input, '"', "Error input not reset");
}
{ my $csv = Text::CSV_XS->new ();
@@ -158,11 +177,17 @@ foreach my $spec (
"row=0", # row > 0
"col=0", # col > 0
"cell=0", # cell = r,c
- "cell=0,0", # col & row > 0
+ "cell=0,0", # TL col > 0
+ "cell=1,0", # TL row > 0
+ "cell=1,1;0,1", # BR col > 0
+ "cell=1,1;1,0", # BR row > 0
"row=*", # * only after n-
"col=3-1", # to >= from
"cell=4,1;1", # cell has no ;
"cell=3,3-2,1", # bottom-right should be right to and below top-left
+ "cell=3,3-2,*", # bottom-right should be right to and below top-left
+ "cell=3,3-4,1", # bottom-right should be right to and below top-left
+ "cell=3,3-*,1", # bottom-right should be right to and below top-left
"cell=1,*", # * in single cell col
"cell=*,1", # * in single cell row
"cell=*,*", # * in single cell row and column
@@ -184,6 +209,9 @@ foreach my $spec (
my $diag_file = "_$$.out";
open EH, ">&STDERR";
open STDERR, ">", $diag_file;
+# Trigger extra output for longer quote and sep
+is ($csv->sep ("--"), "--", "set longer sep");
+is ($csv->quote ("^^"), "^^", "set longer quote");
ok ($csv->_cache_diag, "Cache debugging output");
close STDERR;
open STDERR, ">&EH";
@@ -195,4 +223,14 @@ while (<EH>) {
close EH;
unlink $diag_file;
+{ my $err = "";
+ local $SIG{__DIE__} = sub { $err = shift; };
+ ok (my $csv = Text::CSV_XS->new, "new");
+ eval { $csv->print_hr (*STDERR, {}); };
+ is (0 + $csv->error_diag, 3009, "Missing column names");
+ ok ($csv->column_names ("foo"), "set columns");
+ eval { $csv->print_hr (*STDERR, []); };
+ is (0 + $csv->error_diag, 3010, "print_hr needs a hashref");
+ }
+
1;
@@ -5,7 +5,7 @@ use warnings;
use Config;
#use Test::More "no_plan";
- use Test::More tests => 29;
+ use Test::More tests => 40;
BEGIN {
use_ok "Text::CSV_XS", ("csv");
@@ -56,7 +56,7 @@ my @aoa = @{$aoa}[1,2];
is_deeply (csv (file => $file, headers => "skip"), \@aoa, "AOA skip");
is_deeply (csv (file => $file, fragment => "row=2-3"), \@aoa, "AOA fragment");
-if ($] >= 5.008) {
+if ($] >= 5.008001) {
is_deeply (csv (in => $file, encoding => "utf-8", headers => ["a", "b", "c"],
fragment => "row=2", sep_char => ","),
[{ a => 1, b => 2, c => 3 }], "AOH headers fragment");
@@ -89,9 +89,58 @@ is_deeply (csv (in => $file, headers => "auto"), $aoh, "data from CODE/HR");
$idx = 0;
ok (csv (in => \&getrowh, out => $file), "out from CODE/HR (auto headers)");
is_deeply (csv (in => $file, headers => "auto"), $aoh, "data from CODE/HR");
-
unlink $file;
+# Basic "key" checks
+SKIP: {
+ $] < 5.008 and skip "No ScalarIO support for $]", 2;
+ is_deeply (csv (in => \"key,value\n1,2\n", key => "key"),
+ { 1 => { key => 1, value => 2 }}, "key");
+ is_deeply (csv (in => \"1,2\n", key => "key", headers => [qw( key value )]),
+ { 1 => { key => 1, value => 2 }}, "key");
+ }
+
+# Some "out" checks
+open my $fh, ">", $file;
+csv (in => [{ a => 1 }], out => $fh);
+csv (in => [{ a => 1 }], out => $fh, headers => undef);
+csv (in => [{ a => 1 }], out => $fh, headers => "auto");
+csv (in => [{ a => 1 }], out => $fh, headers => ["a"]);
+csv (in => [{ b => 1 }], out => $fh, headers => { b => "a" });
+close $fh;
+open $fh, "<", $file;
+is (do {local $/; <$fh>}, "a\r\n1\r\n" x 5, "AoH to out");
+close $fh;
+
+# check internal defaults
+{
+ my $ad = 1;
+
+ sub check
+ {
+ my ($csv, $ar) = @_;
+ is ($csv->auto_diag, $ad, "default auto_diag ($ad)");
+ is ($csv->binary, 1, "default binary");
+ is ($csv->eol, "\r\n", "default eol");
+ } # check
+
+ open my $fh, ">", \my $out;
+ csv (in => [[1,2]], out => $fh, on_in => \&check);
+
+ # Check that I can overrule auto_diag
+ $ad = 0;
+ csv (in => [[1,2]], out => $fh, on_in => \&check, auto_diag => 0);
+ }
+
+# errors
+{ my $err;
+ local $SIG{__DIE__} = sub { $err = shift; };
+ my $r = eval { csv (in => undef); };
+ is ($r, undef, "csv needs in or file");
+ like ($err, qr{^usage:}, "error");
+ undef $err;
+ }
+
eval {
exists $Config{useperlio} &&
defined $Config{useperlio} &&