[Feature]Upload Modem source code
Change-Id: Id4294f30faced84d3e6fd6d5e61e1111bf287a37
diff --git a/mcu/tools/perl/Text/CSV_PP.pm b/mcu/tools/perl/Text/CSV_PP.pm
new file mode 100644
index 0000000..46430d4
--- /dev/null
+++ b/mcu/tools/perl/Text/CSV_PP.pm
@@ -0,0 +1,4916 @@
+package Text::CSV_PP;
+
+################################################################################
+#
+# Text::CSV_PP - Text::CSV_XS compatible pure-Perl module
+#
+################################################################################
+require 5.005;
+
+use strict;
+use Exporter ();
+use vars qw($VERSION @ISA @EXPORT_OK);
+use Carp;
+
+$VERSION = '1.95';
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(csv);
+
+sub PV { 0 }
+sub IV { 1 }
+sub NV { 2 }
+
+sub IS_QUOTED () { 0x0001; }
+sub IS_BINARY () { 0x0002; }
+sub IS_ERROR () { 0x0004; }
+sub IS_MISSING () { 0x0010; }
+
+sub HOOK_ERROR () { 0x0001; }
+sub HOOK_AFTER_PARSE () { 0x0002; }
+sub HOOK_BEFORE_PRINT () { 0x0004; }
+
+sub useIO_EOF () { 0x0010; }
+
+my $ERRORS = {
+ # Generic errors
+ 1000 => "INI - constructor failed",
+ 1001 => "INI - sep_char is equal to quote_char or escape_char",
+ 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",
+ 1008 => "INI - SEP undefined",
+
+ 1010 => "INI - the header is empty",
+ 1011 => "INI - the header contains more than one valid separator",
+ 1012 => "INI - the header contains an empty field",
+ 1013 => "INI - the header contains nun-unique fields",
+ 1014 => "INI - header called on undefined stream",
+
+ # Syntax errors
+ 1500 => "PRM - Invalid/unsupported arguments(s)",
+
+ # Parse errors
+ 2010 => "ECR - QUO char inside quotes followed by CR not part of EOL",
+ 2011 => "ECR - Characters after end of quoted field",
+ 2012 => "EOF - End of data in parsing input stream",
+ 2013 => "ESP - Specification error for fragments RFC7111",
+ 2014 => "ENF - Inconsistent number of fields",
+
+ # EIQ - Error Inside Quotes
+ 2021 => "EIQ - NL char inside quotes, binary off",
+ 2022 => "EIQ - CR char inside quotes, binary off",
+ 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",
+ 2027 => "EIQ - Quoted field not terminated",
+
+ # EIF - Error Inside Field
+ 2030 => "EIF - NL char inside unquoted verbatim, binary off",
+ 2031 => "EIF - CR char is first char of field, not part of EOL",
+ 2032 => "EIF - CR char inside unquoted, not part of EOL",
+ 2034 => "EIF - Loose unescaped quote",
+ 2035 => "EIF - Escaped EOF in unquoted field",
+ 2036 => "EIF - ESC error",
+ 2037 => "EIF - Binary character in unquoted field, binary off",
+
+ # Combine errors
+ 2110 => "ECB - Binary character in Combine, binary off",
+
+ # IO errors
+ 2200 => "EIO - print to IO failed. See errno",
+
+ # Hash-Ref errors
+ 3001 => "EHR - Unsupported syntax for column_names ()",
+ 3002 => "EHR - getline_hr () called before column_names ()",
+ 3003 => "EHR - bind_columns () and column_names () fields count mismatch",
+ 3004 => "EHR - bind_columns () only accepts refs to scalars",
+ 3006 => "EHR - bind_columns () did not pass enough refs for parsed fields",
+ 3007 => "EHR - bind_columns needs refs to writable scalars",
+ 3008 => "EHR - unexpected error in bound fields",
+ 3009 => "EHR - print_hr () called before column_names ()",
+ 3010 => "EHR - print_hr () called with invalid arguments",
+
+ # PP Only Error
+ 4002 => "EIQ - Unescaped ESC in quoted field",
+ 4003 => "EIF - ESC CR",
+ 4004 => "EUF - Field is terminated by the escape character (escape_char)",
+
+ 0 => "",
+};
+
+BEGIN {
+ if ( $] < 5.006 ) {
+ $INC{'bytes.pm'} = 1 unless $INC{'bytes.pm'}; # dummy
+ no strict 'refs';
+ *{"utf8::is_utf8"} = sub { 0; };
+ *{"utf8::decode"} = sub { };
+ }
+ elsif ( $] < 5.008 ) {
+ no strict 'refs';
+ *{"utf8::is_utf8"} = sub { 0; };
+ *{"utf8::decode"} = sub { };
+ *{"utf8::encode"} = sub { };
+ }
+ elsif ( !defined &utf8::is_utf8 ) {
+ require Encode;
+ *utf8::is_utf8 = *Encode::is_utf8;
+ }
+
+ eval q| require Scalar::Util |;
+ if ( $@ ) {
+ eval q| require B |;
+ if ( $@ ) {
+ Carp::croak $@;
+ }
+ else {
+ my %tmap = qw(
+ B::NULL SCALAR
+ B::HV HASH
+ B::AV ARRAY
+ B::CV CODE
+ B::IO IO
+ B::GV GLOB
+ B::REGEXP REGEXP
+ );
+ *Scalar::Util::reftype = sub (\$) {
+ my $r = shift;
+ return undef unless length(ref($r));
+ my $t = ref(B::svref_2object($r));
+ return
+ exists $tmap{$t} ? $tmap{$t}
+ : length(ref($$r)) ? 'REF'
+ : 'SCALAR';
+ };
+ *Scalar::Util::readonly = sub (\$) {
+ my $b = B::svref_2object( $_[0] );
+ $b->FLAGS & 0x00800000; # SVf_READONLY?
+ };
+ }
+ }
+}
+
+################################################################################
+#
+# Common pure perl methods, taken almost directly from Text::CSV_XS.
+# (These should be moved into a common class eventually, so that
+# both XS and PP don't need to apply the same changes.)
+#
+################################################################################
+
+################################################################################
+# version
+################################################################################
+
+sub version {
+ return $VERSION;
+}
+
+################################################################################
+# new
+################################################################################
+
+my %def_attr = (
+ eol => '',
+ sep_char => ',',
+ quote_char => '"',
+ escape_char => '"',
+ binary => 0,
+ decode_utf8 => 1,
+ auto_diag => 0,
+ diag_verbose => 0,
+ strict => 0,
+ blank_is_undef => 0,
+ empty_is_undef => 0,
+ allow_whitespace => 0,
+ allow_loose_quotes => 0,
+ allow_loose_escapes => 0,
+ allow_unquoted_escape => 0,
+ always_quote => 0,
+ quote_empty => 0,
+ quote_space => 1,
+ quote_binary => 1,
+ escape_null => 1,
+ keep_meta_info => 0,
+ verbatim => 0,
+ types => undef,
+ callbacks => undef,
+
+ _EOF => 0,
+ _RECNO => 0,
+ _STATUS => undef,
+ _FIELDS => undef,
+ _FFLAGS => undef,
+ _STRING => undef,
+ _ERROR_INPUT => undef,
+ _COLUMN_NAMES => undef,
+ _BOUND_COLUMNS => undef,
+ _AHEAD => undef,
+);
+
+my %attr_alias = (
+ quote_always => "always_quote",
+ verbose_diag => "diag_verbose",
+ quote_null => "escape_null",
+ );
+
+my $last_new_error = Text::CSV_PP->SetDiag(0);
+my $last_error;
+
+# NOT a method: is also used before bless
+sub _unhealthy_whitespace {
+ my $self = shift;
+ $_[0] or return 0; # no checks needed without allow_whitespace
+
+ my $quo = $self->{quote};
+ defined $quo && length ($quo) or $quo = $self->{quote_char};
+ my $esc = $self->{escape_char};
+
+ (defined $quo && $quo =~ m/^[ \t]/) || (defined $esc && $esc =~ m/^[ \t]/) and
+ return 1002;
+
+ return 0;
+ }
+
+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};
+ defined $quo && length ($quo) or $quo = $self->{quote_char};
+ my $esc = $self->{escape_char};
+
+# use DP;::diag ("SEP: '", DPeek ($sep),
+# "', QUO: '", DPeek ($quo),
+# "', ESC: '", DPeek ($esc),"'");
+
+ # sep_char should not be undefined
+ if (defined $sep && $sep ne "") {
+ length ($sep) > 16 and return 1006;
+ $sep =~ m/[\r\n]/ and return 1003;
+ }
+ else {
+ return 1008;
+ }
+ if (defined $quo) {
+ defined $sep && $quo eq $sep and return 1001;
+ length ($quo) > 16 and return 1007;
+ $quo =~ m/[\r\n]/ and return 1003;
+ }
+ if (defined $esc) {
+ defined $sep && $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});
+ }
+
+sub known_attributes {
+ sort grep !m/^_/ => "sep", "quote", keys %def_attr;
+ }
+
+sub new {
+ $last_new_error = Text::CSV_PP->SetDiag(1000,
+ 'usage: my $csv = Text::CSV_PP->new ([{ option => value, ... }]);');
+
+ my $proto = shift;
+ my $class = ref ($proto) || $proto or return;
+ @_ > 0 && ref $_[0] ne "HASH" and return;
+ my $attr = shift || {};
+ my %attr = map {
+ my $k = m/^[a-zA-Z]\w+$/ ? lc $_ : $_;
+ exists $attr_alias{$k} and $k = $attr_alias{$k};
+ $k => $attr->{$_};
+ } keys %$attr;
+
+ my $sep_aliased = 0;
+ if (exists $attr{sep}) {
+ $attr{sep_char} = delete $attr{sep};
+ $sep_aliased = 1;
+ }
+ my $quote_aliased = 0;
+ if (exists $attr{quote}) {
+ $attr{quote_char} = delete $attr{quote};
+ $quote_aliased = 1;
+ }
+ for (keys %attr) {
+ if (m/^[a-z]/ && exists $def_attr{$_}) {
+ # uncoverable condition false
+ defined $attr{$_} && m/_char$/ and utf8::decode ($attr{$_});
+ next;
+ }
+# croak?
+ $last_new_error = Text::CSV_PP->SetDiag(1000, "INI - Unknown attribute '$_'");
+ $attr{auto_diag} and error_diag ();
+ return;
+ }
+ if ($sep_aliased and defined $attr{sep_char}) {
+ my @b = unpack "U0C*", $attr{sep_char};
+ if (@b > 1) {
+ $attr{sep} = $attr{sep_char};
+ $attr{sep_char} = "\0";
+ }
+ else {
+ $attr{sep} = undef;
+ }
+ }
+ if ($quote_aliased and defined $attr{quote_char}) {
+ my @b = unpack "U0C*", $attr{quote_char};
+ if (@b > 1) {
+ $attr{quote} = $attr{quote_char};
+ $attr{quote_char} = "\0";
+ }
+ else {
+ $attr{quote} = undef;
+ }
+ }
+
+ my $self = { %def_attr, %attr };
+ if (my $ec = _check_sanity ($self)) {
+ $last_new_error = Text::CSV_PP->SetDiag($ec);
+ $attr{auto_diag} and error_diag ();
+ return;
+ }
+ if (defined $self->{callbacks} && ref $self->{callbacks} ne "HASH") {
+ Carp::carp "The 'callbacks' attribute is set but is not a hash: ignored\n";
+ $self->{callbacks} = undef;
+ }
+
+ $last_new_error = Text::CSV_PP->SetDiag(0);
+ defined $\ && !exists $attr{eol} and $self->{eol} = $\;
+ bless $self, $class;
+ defined $self->{types} and $self->types ($self->{types});
+ $self;
+}
+
+# Keep in sync with XS!
+my %_cache_id = ( # Only expose what is accessed from within PM
+ quote_char => 0,
+ escape_char => 1,
+ sep_char => 2,
+ sep => 39, # 39 .. 55
+ binary => 3,
+ keep_meta_info => 4,
+ always_quote => 5,
+ allow_loose_quotes => 6,
+ allow_loose_escapes => 7,
+ allow_unquoted_escape => 8,
+ allow_whitespace => 9,
+ blank_is_undef => 10,
+ eol => 11,
+ quote => 15,
+ verbatim => 22,
+ empty_is_undef => 23,
+ auto_diag => 24,
+ diag_verbose => 33,
+ quote_space => 25,
+ quote_empty => 37,
+ quote_binary => 32,
+ escape_null => 31,
+ decode_utf8 => 35,
+ _has_hooks => 36,
+ _is_bound => 26, # 26 .. 29
+ strict => 58,
+ );
+
+my %_hidden_cache_id = qw(
+ sep_len 38
+ eol_len 12
+ eol_is_cr 13
+ quo_len 16
+ _has_ahead 30
+ has_error_input 34
+);
+
+my %_reverse_cache_id = (
+ map({$_cache_id{$_} => $_} keys %_cache_id),
+ map({$_hidden_cache_id{$_} => $_} keys %_hidden_cache_id),
+);
+
+# A `character'
+sub _set_attr_C {
+ my ($self, $name, $val, $ec) = @_;
+ defined $val or $val = 0;
+ utf8::decode ($val);
+ $self->{$name} = $val;
+ $ec = _check_sanity ($self) and
+ croak ($self->SetDiag ($ec));
+ $self->_cache_set ($_cache_id{$name}, $val);
+ }
+
+# A flag
+sub _set_attr_X {
+ my ($self, $name, $val) = @_;
+ defined $val or $val = 0;
+ $self->{$name} = $val;
+ $self->_cache_set ($_cache_id{$name}, 0 + $val);
+ }
+
+# A number
+sub _set_attr_N {
+ my ($self, $name, $val) = @_;
+ $self->{$name} = $val;
+ $self->_cache_set ($_cache_id{$name}, 0 + $val);
+ }
+
+# Accessor methods.
+# It is unwise to change them halfway through a single file!
+sub quote_char {
+ my $self = shift;
+ if (@_) {
+ $self->_set_attr_C ("quote_char", shift);
+ $self->_cache_set ($_cache_id{quote}, "");
+ }
+ $self->{quote_char};
+ }
+
+sub quote {
+ my $self = shift;
+ if (@_) {
+ my $quote = shift;
+ defined $quote or $quote = "";
+ utf8::decode ($quote);
+ my @b = unpack "U0C*", $quote;
+ if (@b > 1) {
+ @b > 16 and croak ($self->SetDiag (1007));
+ $self->quote_char ("\0");
+ }
+ else {
+ $self->quote_char ($quote);
+ $quote = "";
+ }
+ $self->{quote} = $quote;
+
+ my $ec = _check_sanity ($self);
+ $ec and croak ($self->SetDiag ($ec));
+
+ $self->_cache_set ($_cache_id{quote}, $quote);
+ }
+ my $quote = $self->{quote};
+ defined $quote && length ($quote) ? $quote : $self->{quote_char};
+ }
+
+sub escape_char {
+ my $self = shift;
+ @_ and $self->_set_attr_C ("escape_char", shift);
+ $self->{escape_char};
+ }
+
+sub sep_char {
+ my $self = shift;
+ if (@_) {
+ $self->_set_attr_C ("sep_char", shift);
+ $self->_cache_set ($_cache_id{sep}, "");
+ }
+ $self->{sep_char};
+}
+
+sub sep {
+ my $self = shift;
+ if (@_) {
+ my $sep = shift;
+ defined $sep or $sep = "";
+ utf8::decode ($sep);
+ my @b = unpack "U0C*", $sep;
+ if (@b > 1) {
+ @b > 16 and croak ($self->SetDiag (1006));
+ $self->sep_char ("\0");
+ }
+ else {
+ $self->sep_char ($sep);
+ $sep = "";
+ }
+ $self->{sep} = $sep;
+
+ my $ec = _check_sanity ($self);
+ $ec and croak ($self->SetDiag ($ec));
+
+ $self->_cache_set ($_cache_id{sep}, $sep);
+ }
+ my $sep = $self->{sep};
+ defined $sep && length ($sep) ? $sep : $self->{sep_char};
+ }
+
+sub eol {
+ my $self = shift;
+ 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);
+ }
+ $self->{eol};
+ }
+
+sub always_quote {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("always_quote", shift);
+ $self->{always_quote};
+ }
+
+sub quote_space {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("quote_space", shift);
+ $self->{quote_space};
+ }
+
+sub quote_empty {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("quote_empty", shift);
+ $self->{quote_empty};
+ }
+
+sub escape_null {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("escape_null", shift);
+ $self->{escape_null};
+ }
+
+sub quote_null { goto &escape_null; }
+
+sub quote_binary {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("quote_binary", shift);
+ $self->{quote_binary};
+ }
+
+sub binary {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("binary", shift);
+ $self->{binary};
+ }
+
+sub strict {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("strict", shift);
+ $self->{strict};
+ }
+
+sub decode_utf8 {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("decode_utf8", shift);
+ $self->{decode_utf8};
+}
+
+sub keep_meta_info {
+ my $self = shift;
+ if (@_) {
+ my $v = shift;
+ !defined $v || $v eq "" and $v = 0;
+ $v =~ m/^[0-9]/ or $v = lc $v eq "false" ? 0 : 1; # true/truth = 1
+ $self->_set_attr_X ("keep_meta_info", $v);
+ }
+ $self->{keep_meta_info};
+ }
+
+sub allow_loose_quotes {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("allow_loose_quotes", shift);
+ $self->{allow_loose_quotes};
+ }
+
+sub allow_loose_escapes {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("allow_loose_escapes", shift);
+ $self->{allow_loose_escapes};
+ }
+
+sub allow_whitespace {
+ my $self = shift;
+ if (@_) {
+ my $aw = shift;
+ _unhealthy_whitespace ($self, $aw) and
+ croak ($self->SetDiag (1002));
+ $self->_set_attr_X ("allow_whitespace", $aw);
+ }
+ $self->{allow_whitespace};
+ }
+
+sub allow_unquoted_escape {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("allow_unquoted_escape", shift);
+ $self->{allow_unquoted_escape};
+ }
+
+sub blank_is_undef {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("blank_is_undef", shift);
+ $self->{blank_is_undef};
+ }
+
+sub empty_is_undef {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("empty_is_undef", shift);
+ $self->{empty_is_undef};
+ }
+
+sub verbatim {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("verbatim", shift);
+ $self->{verbatim};
+ }
+
+sub auto_diag {
+ my $self = shift;
+ if (@_) {
+ my $v = shift;
+ !defined $v || $v eq "" and $v = 0;
+ $v =~ m/^[0-9]/ or $v = lc $v eq "false" ? 0 : 1; # true/truth = 1
+ $self->_set_attr_X ("auto_diag", $v);
+ }
+ $self->{auto_diag};
+ }
+
+sub diag_verbose {
+ my $self = shift;
+ if (@_) {
+ my $v = shift;
+ !defined $v || $v eq "" and $v = 0;
+ $v =~ m/^[0-9]/ or $v = lc $v eq "false" ? 0 : 1; # true/truth = 1
+ $self->_set_attr_X ("diag_verbose", $v);
+ }
+ $self->{diag_verbose};
+ }
+
+################################################################################
+# status
+################################################################################
+
+sub status {
+ $_[0]->{_STATUS};
+}
+
+sub eof {
+ $_[0]->{_EOF};
+}
+
+sub types {
+ my $self = shift;
+
+ if (@_) {
+ if (my $types = shift) {
+ $self->{'_types'} = join("", map{ chr($_) } @$types);
+ $self->{'types'} = $types;
+ }
+ else {
+ delete $self->{'types'};
+ delete $self->{'_types'};
+ undef;
+ }
+ }
+ else {
+ $self->{'types'};
+ }
+}
+
+sub callbacks {
+ my $self = shift;
+ if (@_) {
+ my $cb;
+ my $hf = 0x00;
+ if (defined $_[0]) {
+ grep { !defined } @_ and croak ($self->SetDiag (1004));
+ $cb = @_ == 1 && ref $_[0] eq "HASH" ? shift
+ : @_ % 2 == 0 ? { @_ }
+ : croak ($self->SetDiag (1004));
+ foreach my $cbk (keys %$cb) {
+ (!ref $cbk && $cbk =~ m/^[\w.]+$/) && ref $cb->{$cbk} eq "CODE" or
+ croak ($self->SetDiag (1004));
+ }
+ exists $cb->{error} and $hf |= 0x01;
+ exists $cb->{after_parse} and $hf |= 0x02;
+ exists $cb->{before_print} and $hf |= 0x04;
+ }
+ elsif (@_ > 1) {
+ # (undef, whatever)
+ croak ($self->SetDiag (1004));
+ }
+ $self->_set_attr_X ("_has_hooks", $hf);
+ $self->{callbacks} = $cb;
+ }
+ $self->{callbacks};
+ }
+
+################################################################################
+# error_diag
+################################################################################
+
+sub error_diag {
+ my $self = shift;
+ my @diag = (0 + $last_new_error, $last_new_error, 0, 0, 0);
+
+ if ($self && ref $self && # Not a class method or direct call
+ $self->isa (__PACKAGE__) && defined $self->{_ERROR_DIAG}) {
+ $diag[0] = 0 + $self->{_ERROR_DIAG};
+ $diag[1] = $self->{_ERROR_DIAG};
+ $diag[2] = 1 + $self->{_ERROR_POS} if exists $self->{_ERROR_POS};
+ $diag[3] = $self->{_RECNO};
+ $diag[4] = $self->{_ERROR_FLD} if exists $self->{_ERROR_FLD};
+
+ $diag[0] && $self && $self->{callbacks} && $self->{callbacks}{error} and
+ return $self->{callbacks}{error}->(@diag);
+ }
+
+ my $context = wantarray;
+
+ unless (defined $context) { # Void context, auto-diag
+ if ($diag[0] && $diag[0] != 2012) {
+ my $msg = "# CSV_PP ERROR: $diag[0] - $diag[1] \@ rec $diag[3] pos $diag[2]\n";
+ $diag[4] and $msg =~ s/$/ field $diag[4]/;
+
+ 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;
+ }
+
+ return $context ? @diag : $diag[1];
+}
+
+sub record_number {
+ return shift->{_RECNO};
+}
+
+################################################################################
+# string
+################################################################################
+
+*string = \&_string;
+sub _string {
+ defined $_[0]->{_STRING} ? ${ $_[0]->{_STRING} } : undef;
+}
+
+################################################################################
+# fields
+################################################################################
+
+*fields = \&_fields;
+sub _fields {
+ ref($_[0]->{_FIELDS}) ? @{$_[0]->{_FIELDS}} : undef;
+}
+
+################################################################################
+# meta_info
+################################################################################
+
+sub meta_info {
+ $_[0]->{_FFLAGS} ? @{ $_[0]->{_FFLAGS} } : undef;
+}
+
+sub is_quoted {
+ return unless (defined $_[0]->{_FFLAGS});
+ return if( $_[1] =~ /\D/ or $_[1] < 0 or $_[1] > $#{ $_[0]->{_FFLAGS} } );
+
+ $_[0]->{_FFLAGS}->[$_[1]] & IS_QUOTED ? 1 : 0;
+}
+
+sub is_binary {
+ return unless (defined $_[0]->{_FFLAGS});
+ return if( $_[1] =~ /\D/ or $_[1] < 0 or $_[1] > $#{ $_[0]->{_FFLAGS} } );
+ $_[0]->{_FFLAGS}->[$_[1]] & IS_BINARY ? 1 : 0;
+}
+
+sub is_missing {
+ my ($self, $idx, $val) = @_;
+ return unless $self->{keep_meta_info}; # FIXME
+ $idx < 0 || !ref $self->{_FFLAGS} and return;
+ $idx >= @{$self->{_FFLAGS}} and return 1;
+ $self->{_FFLAGS}[$idx] & IS_MISSING ? 1 : 0;
+}
+
+################################################################################
+# combine
+################################################################################
+*combine = \&_combine;
+sub _combine {
+ my ($self, @fields) = @_;
+ my $str = "";
+ $self->{_FIELDS} = \@fields;
+ $self->{_STATUS} = (@fields > 0) && $self->__combine(\$str, \@fields, 0);
+ $self->{_STRING} = \$str;
+ $self->{_STATUS};
+ }
+
+################################################################################
+# parse
+################################################################################
+*parse = \&_parse;
+sub _parse {
+ my ($self, $str) = @_;
+
+ ref $str and croak ($self->SetDiag (1500));
+
+ my $fields = [];
+ my $fflags = [];
+ $self->{_STRING} = \$str;
+ if (defined $str && $self->__parse ($fields, $fflags, $str, 0)) {
+ $self->{_FIELDS} = $fields;
+ $self->{_FFLAGS} = $fflags;
+ $self->{_STATUS} = 1;
+ }
+ else {
+ $self->{_FIELDS} = undef;
+ $self->{_FFLAGS} = undef;
+ $self->{_STATUS} = 0;
+ }
+ $self->{_STATUS};
+ }
+
+sub column_names {
+ my ( $self, @columns ) = @_;
+
+ @columns or return defined $self->{_COLUMN_NAMES} ? @{$self->{_COLUMN_NAMES}} : ();
+ @columns == 1 && ! defined $columns[0] and return $self->{_COLUMN_NAMES} = undef;
+
+ if ( @columns == 1 && ref $columns[0] eq "ARRAY" ) {
+ @columns = @{ $columns[0] };
+ }
+ elsif ( join "", map { defined $_ ? ref $_ : "" } @columns ) {
+ croak $self->SetDiag( 3001 );
+ }
+
+ if ( $self->{_BOUND_COLUMNS} && @columns != @{$self->{_BOUND_COLUMNS}} ) {
+ croak $self->SetDiag( 3003 );
+ }
+
+ $self->{_COLUMN_NAMES} = [ map { defined $_ ? $_ : "\cAUNDEF\cA" } @columns ];
+ @{ $self->{_COLUMN_NAMES} };
+}
+
+sub header {
+ my ($self, $fh, @args) = @_;
+
+ $fh or croak ($self->SetDiag (1014));
+
+ my (@seps, %args);
+ for (@args) {
+ if (ref $_ eq "ARRAY") {
+ push @seps, @$_;
+ next;
+ }
+ if (ref $_ eq "HASH") {
+ %args = %$_;
+ next;
+ }
+ croak (q{usage: $csv->header ($fh, [ seps ], { options })});
+ }
+
+ defined $args{detect_bom} or $args{detect_bom} = 1;
+ defined $args{munge_column_names} or $args{munge_column_names} = "lc";
+ defined $args{set_column_names} or $args{set_column_names} = 1;
+
+ defined $args{sep_set} && ref $args{sep_set} eq "ARRAY" and
+ @seps = @{$args{sep_set}};
+
+ my $hdr = <$fh>;
+ defined $hdr && $hdr ne "" or croak ($self->SetDiag (1010));
+
+ my %sep;
+ @seps or @seps = (",", ";");
+ foreach my $sep (@seps) {
+ index ($hdr, $sep) >= 0 and $sep{$sep}++;
+ }
+
+ keys %sep >= 2 and croak ($self->SetDiag (1011));
+
+ $self->sep (keys %sep);
+ my $enc = "";
+ if ($args{detect_bom}) { # UTF-7 is not supported
+ if ($hdr =~ s/^\x00\x00\xfe\xff//) { $enc = "utf-32be" }
+ elsif ($hdr =~ s/^\xff\xfe\x00\x00//) { $enc = "utf-32le" }
+ elsif ($hdr =~ s/^\xfe\xff//) { $enc = "utf-16be" }
+ elsif ($hdr =~ s/^\xff\xfe//) { $enc = "utf-16le" }
+ elsif ($hdr =~ s/^\xef\xbb\xbf//) { $enc = "utf-8" }
+ elsif ($hdr =~ s/^\xf7\x64\x4c//) { $enc = "utf-1" }
+ elsif ($hdr =~ s/^\xdd\x73\x66\x73//) { $enc = "utf-ebcdic" }
+ elsif ($hdr =~ s/^\x0e\xfe\xff//) { $enc = "scsu" }
+ elsif ($hdr =~ s/^\xfb\xee\x28//) { $enc = "bocu-1" }
+ elsif ($hdr =~ s/^\x84\x31\x95\x33//) { $enc = "gb-18030" }
+
+ if ($enc) {
+ if ($enc =~ m/([13]).le$/) {
+ my $l = 0 + $1;
+ my $x;
+ $hdr .= "\0" x $l;
+ read $fh, $x, $l;
+ }
+ $enc = ":encoding($enc)";
+ binmode $fh, $enc;
+ }
+ }
+
+ $args{munge_column_names} eq "lc" and $hdr = lc $hdr;
+ $args{munge_column_names} eq "uc" and $hdr = uc $hdr;
+
+ my $hr = \$hdr; # Will cause croak on perl-5.6.x
+ open my $h, "<$enc", $hr;
+ my $row = $self->getline ($h) or croak;
+ close $h;
+
+ my @hdr = @$row or croak ($self->SetDiag (1010));
+ ref $args{munge_column_names} eq "CODE" and
+ @hdr = map { $args{munge_column_names}->($_) } @hdr;
+ my %hdr = map { $_ => 1 } @hdr;
+ exists $hdr{""} and croak ($self->SetDiag (1012));
+ keys %hdr == @hdr or croak ($self->SetDiag (1013));
+ $args{set_column_names} and $self->column_names (@hdr);
+ wantarray ? @hdr : $self;
+ }
+
+sub bind_columns {
+ my ( $self, @refs ) = @_;
+
+ @refs or return defined $self->{_BOUND_COLUMNS} ? @{$self->{_BOUND_COLUMNS}} : undef;
+ @refs == 1 && ! defined $refs[0] and return $self->{_BOUND_COLUMNS} = undef;
+
+ if ( $self->{_COLUMN_NAMES} && @refs != @{$self->{_COLUMN_NAMES}} ) {
+ croak $self->SetDiag( 3003 );
+ }
+
+ if ( grep { ref $_ ne "SCALAR" } @refs ) { # why don't use grep?
+ croak $self->SetDiag( 3004 );
+ }
+
+ $self->_set_attr_N("_is_bound", scalar @refs);
+ $self->{_BOUND_COLUMNS} = [ @refs ];
+ @refs;
+}
+
+sub getline_hr {
+ my ($self, @args, %hr) = @_;
+ $self->{_COLUMN_NAMES} or croak ($self->SetDiag (3002));
+ my $fr = $self->getline (@args) or return;
+ if (ref $self->{_FFLAGS}) { # missing
+ $self->{_FFLAGS}[$_] = IS_MISSING
+ for (@$fr ? $#{$fr} + 1 : 0) .. $#{$self->{_COLUMN_NAMES}};
+ @$fr == 1 && (!defined $fr->[0] || $fr->[0] eq "") and
+ $self->{_FFLAGS}[0] ||= IS_MISSING;
+ }
+ @hr{@{$self->{_COLUMN_NAMES}}} = @$fr;
+ \%hr;
+}
+
+sub getline_hr_all {
+ my ( $self, $io, @args ) = @_;
+ my %hr;
+
+ unless ( $self->{_COLUMN_NAMES} ) {
+ croak $self->SetDiag( 3002 );
+ }
+
+ my @cn = @{$self->{_COLUMN_NAMES}};
+
+ return [ map { my %h; @h{ @cn } = @$_; \%h } @{ $self->getline_all( $io, @args ) } ];
+}
+
+sub say {
+ my ($self, $io, @f) = @_;
+ my $eol = $self->eol;
+ defined $eol && $eol ne "" or $self->eol ($\ || $/);
+ my $state = $self->print ($io, @f);
+ $self->eol ($eol);
+ return $state;
+ }
+
+sub print_hr {
+ my ($self, $io, $hr) = @_;
+ $self->{_COLUMN_NAMES} or croak($self->SetDiag(3009));
+ ref $hr eq "HASH" or croak($self->SetDiag(3010));
+ $self->print ($io, [ map { $hr->{$_} } $self->column_names ]);
+}
+
+sub fragment {
+ my ($self, $io, $spec) = @_;
+
+ my $qd = qr{\s* [0-9]+ \s* }x; # digit
+ my $qs = qr{\s* (?: [0-9]+ | \* ) \s*}x; # digit or star
+ my $qr = qr{$qd (?: - $qs )?}x; # range
+ my $qc = qr{$qr (?: ; $qr )*}x; # list
+ defined $spec && $spec =~ m{^ \s*
+ \x23 ? \s* # optional leading #
+ ( row | col | cell ) \s* =
+ ( $qc # for row and col
+ | $qd , $qd (?: - $qs , $qs)? # for cell (ranges)
+ (?: ; $qd , $qd (?: - $qs , $qs)? )* # and cell (range) lists
+ ) \s* $}xi or croak ($self->SetDiag (2013));
+ my ($type, $range) = (lc $1, $2);
+
+ my @h = $self->column_names ();
+
+ my @c;
+ if ($type eq "cell") {
+ my @spec;
+ my $min_row;
+ my $max_row = 0;
+ for (split m/\s*;\s*/ => $range) {
+ my ($tlr, $tlc, $brr, $brc) = (m{
+ ^ \s* ([0-9]+ ) \s* , \s* ([0-9]+ ) \s*
+ (?: - \s* ([0-9]+ | \*) \s* , \s* ([0-9]+ | \*) \s* )?
+ $}x) or croak ($self->SetDiag (2013));
+ defined $brr or ($brr, $brc) = ($tlr, $tlc);
+ $tlr == 0 || $tlc == 0 ||
+ ($brr ne "*" && ($brr == 0 || $brr < $tlr)) ||
+ ($brc ne "*" && ($brc == 0 || $brc < $tlc))
+ and croak ($self->SetDiag (2013));
+ $tlc--;
+ $brc-- unless $brc eq "*";
+ defined $min_row or $min_row = $tlr;
+ $tlr < $min_row and $min_row = $tlr;
+ $brr eq "*" || $brr > $max_row and
+ $max_row = $brr;
+ push @spec, [ $tlr, $tlc, $brr, $brc ];
+ }
+ my $r = 0;
+ while (my $row = $self->getline ($io)) {
+ ++$r < $min_row and next;
+ my %row;
+ my $lc;
+ foreach my $s (@spec) {
+ my ($tlr, $tlc, $brr, $brc) = @$s;
+ $r < $tlr || ($brr ne "*" && $r > $brr) and next;
+ !defined $lc || $tlc < $lc and $lc = $tlc;
+ my $rr = $brc eq "*" ? $#$row : $brc;
+ $row{$_} = $row->[$_] for $tlc .. $rr;
+ }
+ push @c, [ @row{sort { $a <=> $b } keys %row } ];
+ if (@h) {
+ my %h; @h{@h} = @{$c[-1]};
+ $c[-1] = \%h;
+ }
+ $max_row ne "*" && $r == $max_row and last;
+ }
+ return \@c;
+ }
+
+ # row or col
+ my @r;
+ my $eod = 0;
+ for (split m/\s*;\s*/ => $range) {
+ my ($from, $to) = m/^\s* ([0-9]+) (?: \s* - \s* ([0-9]+ | \* ))? \s* $/x
+ or croak ($self->SetDiag (2013));
+ $to ||= $from;
+ $to eq "*" and ($to, $eod) = ($from, 1);
+ $from <= 0 || $to <= 0 || $to < $from and croak ($self->SetDiag (2013));
+ $r[$_] = 1 for $from .. $to;
+ }
+
+ my $r = 0;
+ $type eq "col" and shift @r;
+ $_ ||= 0 for @r;
+ while (my $row = $self->getline ($io)) {
+ $r++;
+ if ($type eq "row") {
+ if (($r > $#r && $eod) || $r[$r]) {
+ push @c, $row;
+ if (@h) {
+ my %h; @h{@h} = @{$c[-1]};
+ $c[-1] = \%h;
+ }
+ }
+ next;
+ }
+ push @c, [ map { ($_ > $#r && $eod) || $r[$_] ? $row->[$_] : () } 0..$#$row ];
+ if (@h) {
+ my %h; @h{@h} = @{$c[-1]};
+ $c[-1] = \%h;
+ }
+ }
+
+ return \@c;
+ }
+
+my $csv_usage = q{usage: my $aoa = csv (in => $file);};
+
+sub _csv_attr {
+ my %attr = (@_ == 1 && ref $_[0] eq "HASH" ? %{$_[0]} : @_) or croak;
+
+ $attr{binary} = 1;
+
+ my $enc = delete $attr{enc} || delete $attr{encoding} || "";
+ $enc eq "auto" and ($attr{detect_bom}, $enc) = (1, "");
+ $enc =~ m/^[-\w.]+$/ and $enc = ":encoding($enc)";
+
+ my $fh;
+ my $cls = 0; # If I open a file, I have to close it
+ my $in = delete $attr{in} || delete $attr{file} or croak $csv_usage;
+ my $out = delete $attr{out} || delete $attr{file};
+
+ ref $in eq "CODE" || ref $in eq "ARRAY" and $out ||= \*STDOUT;
+
+ if ($out) {
+ $in or croak $csv_usage; # No out without in
+ if ((ref $out and ref $out ne "SCALAR") or "GLOB" eq ref \$out) {
+ $fh = $out;
+ }
+ else {
+ open $fh, ">", $out or croak "$out: $!";
+ $cls = 1;
+ }
+ $enc and binmode $fh, $enc;
+ unless (defined $attr{eol}) {
+ my @layers = eval { PerlIO::get_layers ($fh) };
+ $attr{eol} = (grep m/crlf/ => @layers) ? "\n" : "\r\n";
+ }
+ }
+
+ if ( ref $in eq "CODE" or ref $in eq "ARRAY") {
+ # All done
+ }
+ elsif (ref $in eq "SCALAR") {
+ # Strings with code points over 0xFF may not be mapped into in-memory file handles
+ # "<$enc" does not change that :(
+ open $fh, "<", $in or croak "Cannot open from SCALAR using PerlIO";
+ $cls = 1;
+ }
+ elsif (ref $in or "GLOB" eq ref \$in) {
+ if (!ref $in && $] < 5.008005) {
+ $fh = \*$in; # uncoverable statement ancient perl version required
+ }
+ else {
+ $fh = $in;
+ }
+ }
+ else {
+ open $fh, "<$enc", $in or croak "$in: $!";
+ $cls = 1;
+ }
+ $fh or croak qq{No valid source passed. "in" is required};
+
+ my $hdrs = delete $attr{headers};
+ my $frag = delete $attr{fragment};
+ my $key = delete $attr{key};
+
+ my $cbai = delete $attr{callbacks}{after_in} ||
+ delete $attr{after_in} ||
+ delete $attr{callbacks}{after_parse} ||
+ delete $attr{after_parse};
+ my $cbbo = delete $attr{callbacks}{before_out} ||
+ delete $attr{before_out};
+ my $cboi = delete $attr{callbacks}{on_in} ||
+ delete $attr{on_in};
+
+ my $hd_s = delete $attr{sep_set} ||
+ delete $attr{seps};
+ my $hd_b = delete $attr{detect_bom} ||
+ delete $attr{bom};
+ my $hd_m = delete $attr{munge} ||
+ delete $attr{munge_column_names};
+ my $hd_c = delete $attr{set_column_names};
+
+ for ([ quo => "quote" ],
+ [ esc => "escape" ],
+ [ escape => "escape_char" ],
+ ) {
+ my ($f, $t) = @$_;
+ exists $attr{$f} and !exists $attr{$t} and $attr{$t} = delete $attr{$f};
+ }
+
+ my $fltr = delete $attr{filter};
+ my %fltr = (
+ not_blank => sub { @{$_[1]} > 1 or defined $_[1][0] && $_[1][0] ne "" },
+ not_empty => sub { grep { defined && $_ ne "" } @{$_[1]} },
+ filled => sub { grep { defined && m/\S/ } @{$_[1]} },
+ );
+ defined $fltr && !ref $fltr && exists $fltr{$fltr} and
+ $fltr = { 0 => $fltr{$fltr} };
+ ref $fltr eq "HASH" or $fltr = undef;
+
+ defined $attr{auto_diag} or $attr{auto_diag} = 1;
+ defined $attr{escape_null} or $attr{escape_null} = 0;
+ my $csv = delete $attr{csv} || Text::CSV_PP->new (\%attr)
+ or croak $last_new_error;
+
+ return {
+ csv => $csv,
+ attr => { %attr },
+ fh => $fh,
+ cls => $cls,
+ in => $in,
+ out => $out,
+ enc => $enc,
+ hdrs => $hdrs,
+ key => $key,
+ frag => $frag,
+ fltr => $fltr,
+ cbai => $cbai,
+ cbbo => $cbbo,
+ cboi => $cboi,
+ hd_s => $hd_s,
+ hd_b => $hd_b,
+ hd_m => $hd_m,
+ hd_c => $hd_c,
+ };
+ }
+
+sub csv {
+ @_ && (ref $_[0] eq __PACKAGE__ or ref $_[0] eq 'Text::CSV') and splice @_, 0, 0, "csv";
+ @_ or croak $csv_usage;
+
+ my $c = _csv_attr (@_);
+
+ my ($csv, $in, $fh, $hdrs) = @{$c}{"csv", "in", "fh", "hdrs"};
+ my %hdr;
+ if (ref $hdrs eq "HASH") {
+ %hdr = %$hdrs;
+ $hdrs = "auto";
+ }
+
+ if ($c->{out}) {
+ if (ref $in eq "CODE") {
+ my $hdr = 1;
+ while (my $row = $in->($csv)) {
+ if (ref $row eq "ARRAY") {
+ $csv->print ($fh, $row);
+ next;
+ }
+ if (ref $row eq "HASH") {
+ if ($hdr) {
+ $hdrs ||= [ map { $hdr{$_} || $_ } keys %$row ];
+ $csv->print ($fh, $hdrs);
+ $hdr = 0;
+ }
+ $csv->print ($fh, [ @{$row}{@$hdrs} ]);
+ }
+ }
+ }
+ elsif (ref $in->[0] eq "ARRAY") { # aoa
+ ref $hdrs and $csv->print ($fh, $hdrs);
+ for (@{$in}) {
+ $c->{cboi} and $c->{cboi}->($csv, $_);
+ $c->{cbbo} and $c->{cbbo}->($csv, $_);
+ $csv->print ($fh, $_);
+ }
+ }
+ else { # aoh
+ my @hdrs = ref $hdrs ? @{$hdrs} : keys %{$in->[0]};
+ defined $hdrs or $hdrs = "auto";
+ ref $hdrs || $hdrs eq "auto" and
+ $csv->print ($fh, [ map { $hdr{$_} || $_ } @hdrs ]);
+ for (@{$in}) {
+ local %_;
+ *_ = $_;
+ $c->{cboi} and $c->{cboi}->($csv, $_);
+ $c->{cbbo} and $c->{cbbo}->($csv, $_);
+ $csv->print ($fh, [ @{$_}{@hdrs} ]);
+ }
+ }
+
+ $c->{cls} and close $fh;
+ return 1;
+ }
+
+ if (defined $c->{hd_s} || defined $c->{hd_b} || defined $c->{hd_m} || defined $c->{hd_c}) {
+ my %harg;
+ defined $c->{hd_s} and $harg{set_set} = $c->{hd_s};
+ defined $c->{hd_d} and $harg{detect_bom} = $c->{hd_b};
+ defined $c->{hd_m} and $harg{munge_column_names} = $hdrs ? "none" : $c->{hd_m};
+ defined $c->{hd_c} and $harg{set_column_names} = $hdrs ? 0 : $c->{hd_c};
+ $csv->header ($fh, \%harg);
+ my @hdr = $csv->column_names;
+ @hdr and $hdrs ||= \@hdr;
+ }
+
+ my $key = $c->{key} and $hdrs ||= "auto";
+ $c->{fltr} && grep m/\D/ => keys %{$c->{fltr}} and $hdrs ||= "auto";
+ if (defined $hdrs) {
+ if (!ref $hdrs) {
+ if ($hdrs eq "skip") {
+ $csv->getline ($fh); # discard;
+ }
+ elsif ($hdrs eq "auto") {
+ my $h = $csv->getline ($fh) or return;
+ $hdrs = [ map { $hdr{$_} || $_ } @$h ];
+ }
+ elsif ($hdrs eq "lc") {
+ my $h = $csv->getline ($fh) or return;
+ $hdrs = [ map { lc ($hdr{$_} || $_) } @$h ];
+ }
+ elsif ($hdrs eq "uc") {
+ my $h = $csv->getline ($fh) or return;
+ $hdrs = [ map { uc ($hdr{$_} || $_) } @$h ];
+ }
+ }
+ elsif (ref $hdrs eq "CODE") {
+ my $h = $csv->getline ($fh) or return;
+ my $cr = $hdrs;
+ $hdrs = [ map { $cr->($hdr{$_} || $_) } @$h ];
+ }
+ }
+
+ if ($c->{fltr}) {
+ my %f = %{$c->{fltr}};
+ # convert headers to index
+ my @hdr;
+ if (ref $hdrs) {
+ @hdr = @{$hdrs};
+ for (0 .. $#hdr) {
+ exists $f{$hdr[$_]} and $f{$_ + 1} = delete $f{$hdr[$_]};
+ }
+ }
+ $csv->callbacks (after_parse => sub {
+ my ($CSV, $ROW) = @_; # lexical sub-variables in caps
+ foreach my $FLD (sort keys %f) {
+ local $_ = $ROW->[$FLD - 1];
+ local %_;
+ @hdr and @_{@hdr} = @$ROW;
+ $f{$FLD}->($CSV, $ROW) or return \"skip";
+ $ROW->[$FLD - 1] = $_;
+ }
+ });
+ }
+
+ my $frag = $c->{frag};
+ my $ref = ref $hdrs
+ ? # aoh
+ do {
+ $csv->column_names ($hdrs);
+ $frag ? $csv->fragment ($fh, $frag) :
+ $key ? { map { $_->{$key} => $_ } @{$csv->getline_hr_all ($fh)} }
+ : $csv->getline_hr_all ($fh);
+ }
+ : # aoa
+ $frag ? $csv->fragment ($fh, $frag)
+ : $csv->getline_all ($fh);
+ $ref or Text::CSV_PP->auto_diag;
+ $c->{cls} and close $fh;
+ if ($ref and $c->{cbai} || $c->{cboi}) {
+ foreach my $r (@{$ref}) {
+ local %_;
+ ref $r eq "HASH" and *_ = $r;
+ $c->{cbai} and $c->{cbai}->($csv, $r);
+ $c->{cboi} and $c->{cboi}->($csv, $r);
+ }
+ }
+
+ defined wantarray or
+ return csv (%{$c->{attr}}, in => $ref, headers => $hdrs, %{$c->{attr}});
+
+ return $ref;
+ }
+
+# The end of the common pure perl part.
+
+################################################################################
+#
+# The following are methods implemented in XS in Text::CSV_XS or
+# helper methods for Text::CSV_PP only
+#
+################################################################################
+
+sub _setup_ctx {
+ my $self = shift;
+
+ $last_error = undef;
+
+ my $ctx;
+ if ($self->{_CACHE}) {
+ $ctx = $self->{_CACHE};
+ } else {
+ $ctx ||= {};
+ # $ctx->{self} = $self;
+ $ctx->{pself} = ref $self || $self;
+
+ $ctx->{sep} = ',';
+ if (defined $self->{sep_char}) {
+ $ctx->{sep} = $self->{sep_char};
+ }
+ if (defined $self->{sep} and $self->{sep} ne '') {
+ use bytes;
+ $ctx->{sep} = $self->{sep};
+ my $sep_len = length($ctx->{sep});
+ $ctx->{sep_len} = $sep_len if $sep_len > 1;
+ }
+
+ $ctx->{quo} = '"';
+ if (exists $self->{quote_char}) {
+ my $quote_char = $self->{quote_char};
+ if (defined $quote_char and length $quote_char) {
+ $ctx->{quo} = $quote_char;
+ } else {
+ $ctx->{quo} = "\0";
+ }
+ }
+ if (defined $self->{quote} and $self->{quote} ne '') {
+ use bytes;
+ $ctx->{quo} = $self->{quote};
+ my $quote_len = length($ctx->{quo});
+ $ctx->{quo_len} = $quote_len if $quote_len > 1;
+ }
+
+ $ctx->{escape_char} = '"';
+ if (exists $self->{escape_char}) {
+ my $escape_char = $self->{escape_char};
+ if (defined $escape_char and length $escape_char) {
+ $ctx->{escape_char} = $escape_char;
+ } else {
+ $ctx->{escape_char} = "\0";
+ }
+ }
+
+ if (defined $self->{eol}) {
+ my $eol = $self->{eol};
+ my $eol_len = length($eol);
+ $ctx->{eol} = $eol;
+ $ctx->{eol_len} = $eol_len;
+ if ($eol_len == 1 and $eol eq "\015") {
+ $ctx->{eol_is_cr} = 1;
+ }
+ }
+
+ if (defined $self->{_types}) {
+ $ctx->{types} = $self->{_types};
+ $ctx->{types_len} = length($ctx->{types});
+ }
+
+ if (defined $self->{_is_bound}) {
+ $ctx->{is_bound} = $self->{_is_bound};
+ }
+
+ if (defined $self->{callbacks}) {
+ my $cb = $self->{callbacks};
+ $ctx->{has_hooks} = 0;
+ if (defined $cb->{after_parse} and ref $cb->{after_parse} eq 'CODE') {
+ $ctx->{has_hooks} |= HOOK_AFTER_PARSE;
+ }
+ if (defined $cb->{before_print} and ref $cb->{before_print} eq 'CODE') {
+ $ctx->{has_hooks} |= HOOK_BEFORE_PRINT;
+ }
+ }
+
+ for (qw/
+ binary decode_utf8 always_quote strict quote_empty
+ allow_loose_quotes allow_loose_escapes
+ allow_unquoted_escape allow_whitespace blank_is_undef
+ empty_is_undef verbatim auto_diag diag_verbose
+ keep_meta_info
+ /) {
+ $ctx->{$_} = defined $self->{$_} ? $self->{$_} : 0;
+ }
+ for (qw/quote_space escape_null quote_binary/) {
+ $ctx->{$_} = defined $self->{$_} ? $self->{$_} : 1;
+ }
+ # FIXME: readonly
+ $self->{_CACHE} = $ctx;
+ }
+
+ $ctx->{utf8} = 0;
+ $ctx->{size} = 0;
+ $ctx->{used} = 0;
+
+ if ($ctx->{is_bound}) {
+ my $bound = $self->{_BOUND_COLUMNS};
+ if ($bound and ref $bound eq 'ARRAY') {
+ $ctx->{bound} = $bound;
+ } else {
+ $ctx->{is_bound} = 0;
+ }
+ }
+
+ $ctx->{eol_pos} = -1;
+ $ctx->{eolx} = $ctx->{eol_len}
+ ? $ctx->{verbatim} || $ctx->{eol_len} >= 2
+ ? 1
+ : $ctx->{eol} =~ /\A[\015|\012]/ ? 0 : 1
+ : 0;
+
+ if ($ctx->{sep_len} and _is_valid_utf8($ctx->{sep})) {
+ $ctx->{utf8} = 1;
+ }
+ if ($ctx->{quo_len} and _is_valid_utf8($ctx->{quo})) {
+ $ctx->{utf8} = 1;
+ }
+
+ $ctx;
+}
+
+sub _cache_set {
+ my ($self, $idx, $value) = @_;
+ return unless exists $self->{_CACHE};
+ my $cache = $self->{_CACHE};
+
+ my $key = $_reverse_cache_id{$idx};
+ if (!defined $key) {
+ warn (sprintf "Unknown cache index %d ignored\n", $idx);
+ } elsif ($key eq 'sep_char') {
+ $cache->{sep} = $value;
+ $cache->{sep_len} = 0;
+ }
+ elsif ($key eq 'quote_char') {
+ $cache->{quo} = $value;
+ $cache->{quo_len} = 0;
+ }
+ elsif ($key eq '_has_hooks') {
+ $cache->{has_hooks} = $value;
+ }
+ elsif ($key eq '_is_bound') {
+ $cache->{is_bound} = $value;
+ }
+ elsif ($key eq 'sep') {
+ use bytes;
+ my $len = bytes::length($value);
+ $cache->{sep} = $value if $len;
+ $cache->{sep_len} = $len == 1 ? 0 : $len;
+ }
+ elsif ($key eq 'quote') {
+ use bytes;
+ my $len = bytes::length($value);
+ $cache->{quo} = $value if $len;
+ $cache->{quo_len} = $len == 1 ? 0 : $len;
+ }
+ elsif ($key eq 'eol') {
+ $cache->{eol} = $value if length($value);
+ $cache->{eol_is_cr} = $value eq "\015" ? 1 : 0;
+ }
+ else {
+ $cache->{$key} = $value;
+ }
+ return 1;
+}
+
+sub _cache_diag {
+ my $self = shift;
+ unless (exists $self->{_CACHE}) {
+ warn ("CACHE: invalid\n");
+ return;
+ }
+
+ my $cache = $self->{_CACHE};
+ warn ("CACHE:\n");
+ $self->__cache_show_char(quote_char => $cache->{quo});
+ $self->__cache_show_char(escape_char => $cache->{escape_char});
+ $self->__cache_show_char(sep_char => $cache->{sep});
+ for (qw/
+ binary decode_utf8 allow_loose_escapes allow_loose_quotes
+ allow_whitespace always_quote quote_empty quote_space
+ escape_null quote_binary auto_diag diag_verbose strict
+ has_error_input blank_is_undef empty_is_undef has_ahead
+ keep_meta_info verbatim has_hooks eol_is_cr eol_len
+ /) {
+ $self->__cache_show_byte($_ => $cache->{$_});
+ }
+ $self->__cache_show_str(eol => $cache->{eol_len}, $cache->{eol});
+ $self->__cache_show_byte(sep_len => $cache->{sep_len});
+ if ($cache->{sep_len} and $cache->{sep_len} > 1) {
+ $self->__cache_show_str(sep => $cache->{sep_len}, $cache->{sep});
+ }
+ $self->__cache_show_byte(quo_len => $cache->{quo_len});
+ if ($cache->{quo_len} and $cache->{quo_len} > 1) {
+ $self->__cache_show_str(quote => $cache->{quo_len}, $cache->{quo});
+ }
+}
+
+sub __cache_show_byte {
+ my ($self, $key, $value) = @_;
+ warn (sprintf " %-21s %02x:%3d\n", $key, defined $value ? ord($value) : 0, defined $value ? $value : 0);
+}
+
+sub __cache_show_char {
+ my ($self, $key, $value) = @_;
+ my $v = $value;
+ if (defined $value) {
+ my @b = unpack "U0C*", $value;
+ $v = pack "U*", $b[0];
+ }
+ warn (sprintf " %-21s %02x:%s\n", $key, defined $v ? ord($v) : 0, $self->__pretty_str($v, 1));
+}
+
+sub __cache_show_str {
+ my ($self, $key, $len, $value) = @_;
+ warn (sprintf " %-21s %02d:%s\n", $key, $len, $self->__pretty_str($value, $len));
+}
+
+sub __pretty_str { # FIXME
+ my ($self, $str, $len) = @_;
+ return '' unless defined $str;
+ $str = substr($str, 0, $len);
+ $str =~ s/"/\\"/g;
+ $str =~ s/([^\x09\x20-\x7e])/sprintf '\\x{%x}', ord($1)/eg;
+ qq{"$str"};
+}
+
+sub _hook {
+ my ($self, $name, $fields) = @_;
+ return 0 unless $self->{callbacks};
+
+ my $cb = $self->{callbacks}{$name};
+ return 0 unless $cb && ref $cb eq 'CODE';
+
+ my (@res) = $cb->($self, $fields);
+ if (@res) {
+ return 0 if ref $res[0] eq 'SCALAR' and ${$res[0]} eq "skip";
+ }
+ scalar @res;
+}
+
+################################################################################
+# methods for combine
+################################################################################
+
+sub __combine {
+ my ($self, $dst, $fields, $useIO) = @_;
+
+ my $ctx = $self->_setup_ctx;
+
+ my ($binary, $quot, $sep, $esc, $quote_space) = @{$ctx}{qw/binary quo sep escape_char quote_space/};
+
+ if(!defined $quot or $quot eq "\0"){ $quot = ''; }
+
+ my $re_esc;
+ if ($quot ne '') {
+ $re_esc = $self->{_re_comb_escape}->{$quot}->{$esc} ||= qr/(\Q$quot\E|\Q$esc\E)/;
+ } else {
+ $re_esc = $self->{_re_comb_escape}->{$quot}->{$esc} ||= qr/(\Q$esc\E)/;
+ }
+
+ my $re_sp = $self->{_re_comb_sp}->{$sep}->{$quote_space} ||= ( $quote_space ? qr/[\s\Q$sep\E]/ : qr/[\Q$sep\E]/ );
+
+ my $bound = 0;
+ my $n = @$fields - 1;
+ if ($n < 0 and $ctx->{is_bound}) {
+ $n = $ctx->{is_bound} - 1;
+ $bound = 1;
+ }
+
+ my $check_meta = ($ctx->{keep_meta_info} >= 10 and @{$self->{_FFLAGS} || []} >= $n) ? 1 : 0;
+
+ my $must_be_quoted;
+ my @results;
+ for(my $i = 0; $i <= $n; $i++) {
+ my $v_ref;
+ if ($bound) {
+ $v_ref = $self->__bound_field($ctx, $i, 1);
+ } else {
+ if (@$fields > $i) {
+ $v_ref = \($fields->[$i]);
+ }
+ }
+ next unless $v_ref;
+
+ my $value = $$v_ref;
+
+ unless (defined $value) {
+ push @results, '';
+ next;
+ }
+ elsif ( !$binary ) {
+ $binary = 1 if utf8::is_utf8 $value;
+ }
+
+ if (!$binary and $value =~ /[^\x09\x20-\x7E]/) {
+ # an argument contained an invalid character...
+ $self->{_ERROR_INPUT} = $value;
+ $self->SetDiag(2110);
+ return 0;
+ }
+
+ $must_be_quoted = 0;
+ if ($value eq '') {
+ $must_be_quoted++ if $ctx->{quote_empty} or ($check_meta && $self->is_quoted($i));
+ }
+ else {
+ if($value =~ s/$re_esc/$esc$1/g and $quot ne ''){
+ $must_be_quoted++;
+ }
+ if($value =~ /$re_sp/){
+ $must_be_quoted++;
+ }
+
+ if( $binary and $ctx->{escape_null} ){
+ use bytes;
+ $must_be_quoted++ if ( $value =~ s/\0/${esc}0/g || ($ctx->{quote_binary} && $value =~ /[\x00-\x1f\x7f-\xa0]/) );
+ }
+ }
+
+ if($ctx->{always_quote} or $must_be_quoted or ($check_meta && $self->is_quoted($i))){
+ $value = $quot . $value . $quot;
+ }
+ push @results, $value;
+ }
+
+ $$dst = join($sep, @results) . ( defined $ctx->{eol} ? $ctx->{eol} : '' );
+
+ return 1;
+}
+
+sub print {
+ my ($self, $io, $fields) = @_;
+
+ require IO::Handle;
+
+ if (!defined $fields) {
+ $fields = [];
+ } elsif(ref($fields) ne 'ARRAY'){
+ Carp::croak("Expected fields to be an array ref");
+ }
+
+ $self->_hook(before_print => $fields);
+
+ my $str = "";
+ $self->__combine(\$str, $fields, 1) or return '';
+
+ local $\ = '';
+
+ $io->print( $str ) or $self->_set_error_diag(2200);
+}
+
+################################################################################
+# methods for parse
+################################################################################
+
+
+sub __parse { # cx_xsParse
+ my ($self, $fields, $fflags, $src, $useIO) = @_;
+
+ my $ctx = $self->_setup_ctx;
+ my $state = $self->___parse($ctx, $fields, $fflags, $src, $useIO);
+ if ($state and ($ctx->{has_hooks} || 0) & HOOK_AFTER_PARSE) {
+ $self->_hook(after_parse => $fields);
+ }
+ return $state || !$last_error;
+}
+
+sub ___parse { # cx_c_xsParse
+ my ($self, $ctx, $fields, $fflags, $src, $useIO) = @_;
+
+ local $/ = $ctx->{eol} if $ctx->{eolx} or $ctx->{eol_is_cr};
+
+ if ($ctx->{useIO} = $useIO) {
+ require IO::Handle;
+
+ $ctx->{tmp} = undef;
+ if ($ctx->{has_ahead} and defined $self->{_AHEAD}) {
+ $ctx->{tmp} = $self->{_AHEAD};
+ $ctx->{size} = length $ctx->{tmp};
+ $ctx->{used} = 0;
+ }
+ } else {
+ $ctx->{tmp} = $src;
+ $ctx->{size} = length $src;
+ $ctx->{used} = 0;
+ $ctx->{utf8} = utf8::is_utf8($src);
+ }
+ if ($ctx->{has_error_input}) {
+ $self->{_ERROR_INPUT} = undef;
+ $ctx->{has_error_input} = 0;
+ }
+
+ my $result = $self->____parse($ctx, $src, $fields, $fflags);
+ $self->{_RECNO} = ++($ctx->{recno});
+ $self->{_EOF} = '';
+
+ if ($ctx->{strict}) {
+ $ctx->{strict_n} ||= $ctx->{fld_idx};
+ if ($ctx->{strict_n} != $ctx->{fld_idx}) {
+ $self->__parse_error($ctx, 2014, $ctx->{used});
+ return;
+ }
+ }
+
+ if ($ctx->{useIO}) {
+ if (defined $ctx->{tmp} and $ctx->{used} < $ctx->{size} and $ctx->{has_ahead}) {
+ $self->{_AHEAD} = substr($ctx->{tmp}, $ctx->{used}, $ctx->{size} - $ctx->{used});
+ } else {
+ $ctx->{has_ahead} = 0;
+ if ($ctx->{useIO} & useIO_EOF) {
+ $self->{_EOF} = 1;
+ }
+ }
+
+ if ($fflags) {
+ if ($ctx->{keep_meta_info}) {
+ $self->{_FFLAGS} = $fflags;
+ } else {
+ undef $fflags;
+ }
+ }
+ }
+
+ if ($result and $ctx->{types}) {
+ my $len = @$fields;
+ for(my $i = 0; $i <= $len && $i <= $ctx->{types_len}; $i++) {
+ my $value = $fields->[$i];
+ next unless defined $value;
+ my $type = ord(substr($ctx->{types}, $i, 1));
+ if ($type == IV) {
+ $fields->[$i] = int($value);
+ } elsif ($type == NV) {
+ $fields->[$i] = $value + 0.0;
+ }
+ }
+ }
+
+ $result;
+}
+
+sub ____parse { # cx_Parse
+ my ($self, $ctx, $src, $fields, $fflags) = @_;
+
+ my ($quot, $sep, $esc, $eol) = @{$ctx}{qw/quo sep escape_char eol/};
+
+ utf8::encode($sep) if !$ctx->{utf8} and $ctx->{sep_len};
+ utf8::encode($quot) if !$ctx->{utf8} and $ctx->{quo_len};
+ utf8::encode($eol) if !$ctx->{utf8} and $ctx->{eol_len};
+
+ my $seenSomething = 0;
+ my $waitingForField = 1;
+ my ($value, $v_ref);
+ $ctx->{fld_idx} = my $fnum = 0;
+ $ctx->{flag} = 0;
+
+ my $re_str = join '|', map({$_ eq "\0" ? '[\\0]' : quotemeta($_)} sort {length $b <=> length $a} grep {defined $_ and $_ ne ''} $sep, $quot, $esc, $eol), "\015", "\012", "\x09", " ";
+ $ctx->{_re} = qr/$re_str/;
+ my $re = qr/$re_str|[^\x09\x20-\x7E]|$/;
+
+LOOP:
+ while($self->__get_from_src($ctx, $src)) {
+ while($ctx->{tmp} =~ /\G(.*?)($re)/gs) {
+ my ($hit, $c) = ($1, $2);
+ $ctx->{used} = pos($ctx->{tmp});
+ if (!$waitingForField and $c eq '' and $hit ne '' and $ctx->{useIO} and !($ctx->{useIO} & useIO_EOF)) {
+ $self->{_AHEAD} = $hit;
+ $ctx->{has_ahead} = 1;
+ $ctx->{has_leftover} = 1;
+ last;
+ }
+ last if $seenSomething and $hit eq '' and $c eq ''; # EOF
+
+ # new field
+ if (!$v_ref) {
+ if ($ctx->{is_bound}) {
+ $v_ref = $self->__bound_field($ctx, $fnum++, 0);
+ } else {
+ $value = '';
+ $v_ref = \$value;
+ }
+ return unless $v_ref;
+ $ctx->{flag} = 0;
+ $ctx->{fld_idx}++;
+ }
+
+ $seenSomething = 1;
+
+ if (defined $hit and $hit ne '') {
+ if ($waitingForField) {
+ $waitingForField = 0;
+ }
+ if ($hit =~ /[^\x09\x20-\x7E]/) {
+ $ctx->{flag} |= IS_BINARY;
+ }
+ $$v_ref .= $hit;
+ }
+
+RESTART:
+ if (defined $c and defined $sep and $c eq $sep) {
+ if ($waitingForField) {
+ # ,1,"foo, 3",,bar,
+ # ^ ^
+ if ($ctx->{blank_is_undef} or $ctx->{empty_is_undef}) {
+ $$v_ref = undef;
+ } else {
+ $$v_ref = "";
+ }
+ unless ($ctx->{is_bound}) {
+ push @$fields, $$v_ref;
+ }
+ $v_ref = undef;
+ if ($ctx->{keep_meta_info} and $fflags) {
+ push @$fflags, $ctx->{flag};
+ }
+ } elsif ($ctx->{flag} & IS_QUOTED) {
+ # ,1,"foo, 3",,bar,
+ # ^
+ $$v_ref .= $c;
+ } else {
+ # ,1,"foo, 3",,bar,
+ # ^ ^ ^
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ $v_ref = undef;
+ $waitingForField = 1;
+ }
+ }
+ elsif (defined $c and defined $quot and $quot ne "\0" and $c eq $quot) {
+ if ($waitingForField) {
+ # ,1,"foo, 3",,bar,\r\n
+ # ^
+ $ctx->{flag} |= IS_QUOTED;
+ $waitingForField = 0;
+ next;
+ }
+ if ($ctx->{flag} & IS_QUOTED) {
+ # ,1,"foo, 3",,bar,\r\n
+ # ^
+ my $quoesc = 0;
+ my $c2 = $self->__get($ctx);
+
+ if ($ctx->{allow_whitespace}) {
+ # , 1 , "foo, 3" , , bar , \r\n
+ # ^
+ while($self->__is_whitespace($ctx, $c2)) {
+ if ($ctx->{allow_loose_quotes} and !(defined $esc and $c2 eq $esc)) {
+ $$v_ref .= $c;
+ $c = $c2;
+ }
+ $c2 = $self->__get($ctx);
+ }
+ }
+
+ if (!defined $c2) { # EOF
+ # ,1,"foo, 3"
+ # ^
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ return 1;
+ }
+
+ if (defined $c2 and defined $sep and $c2 eq $sep) {
+ # ,1,"foo, 3",,bar,\r\n
+ # ^
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ $v_ref = undef;
+ $waitingForField = 1;
+ next;
+ }
+ if (defined $c2 and ($c2 eq "\012" or (defined $eol and $c2 eq $eol))) { # FIXME: EOLX
+ # ,1,"foo, 3",,"bar"\n
+ # ^
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ return 1;
+ }
+
+ if (defined $esc and $c eq $esc) {
+ $quoesc = 1;
+ if (defined $c2 and $c2 eq '0') {
+ # ,1,"foo, 3"056",,bar,\r\n
+ # ^
+ $$v_ref .= "\0";
+ next;
+ }
+ if (defined $c2 and defined $quot and $c2 eq $quot) {
+ # ,1,"foo, 3""56",,bar,\r\n
+ # ^
+ if ($ctx->{utf8}) {
+ $ctx->{flag} |= IS_BINARY;
+ }
+ $$v_ref .= $c2;
+ next;
+ }
+ if ($ctx->{allow_loose_escapes} and defined $c2 and $c2 ne "\015") {
+ # ,1,"foo, 3"56",,bar,\r\n
+ # ^
+ $$v_ref .= $c;
+ $c = $c2;
+ goto RESTART;
+ }
+ }
+ if (defined $c2 and $c2 eq "\015") {
+ if ($ctx->{eol_is_cr}) {
+ # ,1,"foo, 3"\r
+ # ^
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ return 1;
+ }
+
+ my $c3 = $self->__get($ctx);
+ if (defined $c3 and $c3 eq "\012") {
+ # ,1,"foo, 3"\r\n
+ # ^
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ return 1;
+ }
+
+ if ($ctx->{useIO} and !$ctx->{eol_len} and $c3 !~ /[^\x09\x20-\x7E]/) {
+ # ,1,"foo\n 3",,"bar"\r
+ # baz,4
+ # ^
+ $self->__set_eol_is_cr($ctx);
+ $ctx->{used}--;
+ $ctx->{has_ahead} = 1;
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ return 1;
+ }
+
+ $self->__parse_error($ctx, $quoesc ? 2023 : 2010, $ctx->{used} - 2);
+ return;
+ }
+
+ if ($ctx->{allow_loose_quotes} and !$quoesc) {
+ # ,1,"foo, 3"456",,bar,\r\n
+ # ^
+ $$v_ref .= $c;
+ $c = $c2;
+ goto RESTART;
+ }
+ # 1,"foo" ",3
+ # ^
+ if ($quoesc) {
+ $ctx->{used}--;
+ $self->__error_inside_quotes($ctx, 2023);
+ return;
+ }
+ $self->__error_inside_quotes($ctx, 2011);
+ return;
+ }
+ # !waitingForField, !InsideQuotes
+ if ($ctx->{allow_loose_quotes}) { # 1,foo "boo" d'uh,1
+ $ctx->{flag} |= IS_ERROR;
+ $$v_ref .= $c;
+ } else {
+ $self->__error_inside_field($ctx, 2034);
+ return;
+ }
+ }
+ elsif (defined $c and defined $esc and $esc ne "\0" and $c eq $esc) {
+ # This means quote_char != escape_char
+ if ($waitingForField) {
+ $waitingForField = 0;
+ if ($ctx->{allow_unquoted_escape}) {
+ # The escape character is the first character of an
+ # unquoted field
+ # ... get and store next character
+ my $c2 = $self->__get($ctx);
+ $$v_ref = "";
+
+ if (!defined $c2) { # EOF
+ $ctx->{used}--;
+ $self->__error_inside_field($ctx, 2035);
+ return;
+ }
+ if ($c2 eq '0') {
+ $$v_ref .= "\0";
+ }
+ elsif (
+ (defined $quot and $c2 eq $quot) or
+ (defined $sep and $c2 eq $sep) or
+ (defined $esc and $c2 eq $esc) or
+ $ctx->{allow_loose_escapes}
+ ) {
+ if ($ctx->{utf8}) {
+ $ctx->{flag} |= IS_BINARY;
+ }
+ $$v_ref .= $c2;
+ } else {
+ $self->__parse_inside_quotes($ctx, 2025);
+ return;
+ }
+ }
+ }
+ elsif ($ctx->{flag} & IS_QUOTED) {
+ my $c2 = $self->__get($ctx);
+ if (!defined $c2) { # EOF
+ $ctx->{used}--;
+ $self->__error_inside_quotes($ctx, 2024);
+ return;
+ }
+ if ($c2 eq '0') {
+ $$v_ref .= "\0";
+ }
+ elsif (
+ (defined $quot and $c2 eq $quot) or
+ (defined $sep and $c2 eq $sep) or
+ (defined $esc and $c2 eq $esc) or
+ $ctx->{allow_loose_escapes}
+ ) {
+ if ($ctx->{utf8}) {
+ $ctx->{flag} |= IS_BINARY;
+ }
+ $$v_ref .= $c2;
+ } else {
+ $ctx->{used}--;
+ $self->__error_inside_quotes($ctx, 2025);
+ return;
+ }
+ }
+ elsif ($v_ref) {
+ my $c2 = $self->__get($ctx);
+ if (!defined $c2) { # EOF
+ $ctx->{used}--;
+ $self->__error_inside_field($ctx, 2035);
+ return;
+ }
+ $$v_ref .= $c2;
+ }
+ else {
+ $self->__error_inside_field($ctx, 2036);
+ return;
+ }
+ }
+ elsif (defined $c and ($c eq "\012" or $c eq '' or (defined $eol and $c eq $eol and $eol ne "\015"))) { # EOL
+ EOLX:
+ if ($waitingForField) {
+ # ,1,"foo, 3",,bar,
+ # ^
+ if ($ctx->{blank_is_undef} or $ctx->{empty_is_undef}) {
+ $$v_ref = undef;
+ } else {
+ $$v_ref = "";
+ }
+ unless ($ctx->{is_bound}) {
+ push @$fields, $$v_ref;
+ }
+ if ($ctx->{keep_meta_info} and $fflags) {
+ push @$fflags, $ctx->{flag};
+ }
+ return 1;
+ }
+ if ($ctx->{flag} & IS_QUOTED) {
+ # ,1,"foo\n 3",,bar,
+ # ^
+ $ctx->{flag} |= IS_BINARY;
+ unless ($ctx->{binary}) {
+ $self->__error_inside_quotes($ctx, 2021);
+ return;
+ }
+ $$v_ref .= $c;
+ }
+ elsif ($ctx->{verbatim}) {
+ # ,1,foo\n 3,,bar,
+ # This feature should be deprecated
+ $ctx->{flag} |= IS_BINARY;
+ unless ($ctx->{binary}) {
+ $self->__error_inside_field($ctx, 2030);
+ return;
+ }
+ $$v_ref .= $c unless $ctx->{eol} eq $c and $ctx->{useIO};
+ }
+ else {
+ # sep=,
+ # ^
+ if (!$ctx->{recno} and $ctx->{fld_idx} == 1 and $ctx->{useIO} and $hit =~ /^sep=(.{1,16})$/i) {
+ $ctx->{sep} = $1;
+ use bytes;
+ my $len = length $ctx->{sep};
+ if ($len <= 16) {
+ $ctx->{sep_len} = $len == 1 ? 0 : $len;
+ return $self->____parse($ctx, $src, $fields, $fflags);
+ }
+ }
+
+ # ,1,"foo\n 3",,bar
+ # ^
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ return 1;
+ }
+ }
+ elsif (defined $c and $c eq "\015" and !$ctx->{verbatim}) {
+ if ($waitingForField) {
+ $waitingForField = 0;
+ if ($ctx->{eol_is_cr}) {
+ # ,1,"foo\n 3",,bar,\r
+ # ^
+ $c = "\012";
+ goto RESTART;
+ }
+
+ my $c2 = $self->__get($ctx);
+ if (!defined $c2) { # EOF
+ # ,1,"foo\n 3",,bar,\r
+ # ^
+ $c = undef;
+ goto RESTART;
+ }
+ if ($c2 eq "\012") { # \r is not optional before EOLX!
+ # ,1,"foo\n 3",,bar,\r\n
+ # ^
+ $c = $c2;
+ goto RESTART;
+ }
+
+ if ($ctx->{useIO} and !$ctx->{eol_len} and $c2 !~ /[^\x09\x20-\x7E]/) {
+ # ,1,"foo\n 3",,bar,\r
+ # baz,4
+ # ^
+ $self->__set_eol_is_cr($ctx);
+ $ctx->{used}--;
+ $ctx->{has_ahead} = 1;
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ return 1;
+ }
+
+ # ,1,"foo\n 3",,bar,\r\t
+ # ^
+ $ctx->{used}--;
+ $self->__error_inside_field($ctx, 2031);
+ return;
+ }
+ if ($ctx->{flag} & IS_QUOTED) {
+ # ,1,"foo\r 3",,bar,\r\t
+ # ^
+ $ctx->{flag} |= IS_BINARY;
+ unless ($ctx->{binary}) {
+ $self->__error_inside_quotes($ctx, 2022);
+ return;
+ }
+ $$v_ref .= $c;
+ }
+ else {
+ if ($ctx->{eol_is_cr}) {
+ # ,1,"foo\n 3",,bar\r
+ # ^
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ return 1;
+ }
+
+ my $c2 = $self->__get($ctx);
+ if (defined $c2 and $c2 eq "\012") { # \r is not optional before EOLX!
+ # ,1,"foo\n 3",,bar\r\n
+ # ^
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ return 1;
+ }
+
+ if ($ctx->{useIO} and !$ctx->{eol_len} and $c2 !~ /[^\x09\x20-\x7E]/) {
+ # ,1,"foo\n 3",,bar\r
+ # baz,4
+ # ^
+ $self->__set_eol_is_cr($ctx);
+ $ctx->{used}--;
+ $ctx->{has_ahead} = 1;
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ return 1;
+ }
+
+ # ,1,"foo\n 3",,bar\r\t
+ # ^
+ $self->__error_inside_field($ctx, 2032);
+ return;
+ }
+ }
+ else {
+ if ($ctx->{eolx} and $c eq $eol) {
+ $c = '';
+ goto EOLX;
+ }
+
+ if ($waitingForField) {
+ if ($ctx->{allow_whitespace} and $self->__is_whitespace($ctx, $c)) {
+ do {
+ $c = $self->__get($ctx);
+ last if !defined $c;
+ } while $self->__is_whitespace($ctx, $c);
+ goto RESTART;
+ }
+ $waitingForField = 0;
+ goto RESTART;
+ }
+ if ($ctx->{flag} & IS_QUOTED) {
+ if (!defined $c or $c =~ /[^\x09\x20-\x7E]/) {
+ $ctx->{flag} |= IS_BINARY;
+ unless ($ctx->{binary} or $ctx->{utf8}) {
+ $self->__error_inside_quotes($ctx, 2026);
+ return;
+ }
+ }
+ $$v_ref .= $c;
+ } else {
+ if (!defined $c or $c =~ /[^\x09\x20-\x7E]/) {
+ $ctx->{flag} |= IS_BINARY;
+ unless ($ctx->{binary} or $ctx->{utf8}) {
+ $self->__error_inside_field($ctx, 2037);
+ return;
+ }
+ }
+ $$v_ref .= $c;
+ }
+ }
+ last LOOP if $ctx->{useIO} and $ctx->{verbatim} and $ctx->{used} == $ctx->{size};
+ }
+ }
+
+ if ($waitingForField) {
+ if ($seenSomething or !$ctx->{useIO}) {
+ # new field
+ if (!$v_ref) {
+ if ($ctx->{is_bound}) {
+ $v_ref = $self->__bound_field($ctx, $fnum++, 0);
+ } else {
+ $value = '';
+ $v_ref = \$value;
+ }
+ return unless $v_ref;
+ $ctx->{flag} = 0;
+ $ctx->{fld_idx}++;
+ }
+ if ($ctx->{blank_is_undef} or $ctx->{empty_is_undef}) {
+ $$v_ref = undef;
+ } else {
+ $$v_ref = "";
+ }
+ unless ($ctx->{is_bound}) {
+ push @$fields, $$v_ref;
+ }
+ if ($ctx->{keep_meta_info} and $fflags) {
+ push @$fflags, $ctx->{flag};
+ }
+ return 1;
+ }
+ $self->SetDiag(2012);
+ return;
+ }
+
+ if ($ctx->{flag} & IS_QUOTED) {
+ $self->__error_inside_quotes($ctx, 2027);
+ return;
+ }
+
+ if ($v_ref) {
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ }
+ return 1;
+}
+
+sub __get_from_src {
+ my ($self, $ctx, $src) = @_;
+ return 1 if defined $ctx->{tmp} and $ctx->{used} <= 0;
+ return 1 if $ctx->{used} < $ctx->{size};
+ return unless $ctx->{useIO};
+ my $res = $src->getline;
+ if (defined $res) {
+ if ($ctx->{has_ahead}) {
+ $ctx->{tmp} = $self->{_AHEAD};
+ $ctx->{tmp} .= $ctx->{eol} if $ctx->{eol_len};
+ $ctx->{tmp} .= $res;
+ $ctx->{has_ahead} = 0;
+ } else {
+ $ctx->{tmp} = $res;
+ }
+ if ($ctx->{size} = length $ctx->{tmp}) {
+ $ctx->{used} = -1;
+ $ctx->{utf8} = 1 if utf8::is_utf8($ctx->{tmp});
+ pos($ctx->{tmp}) = 0;
+ return 1;
+ }
+ } elsif (delete $ctx->{has_leftover}) {
+ $ctx->{tmp} = $self->{_AHEAD};
+ $ctx->{has_ahead} = 0;
+ $ctx->{useIO} |= useIO_EOF;
+ if ($ctx->{size} = length $ctx->{tmp}) {
+ $ctx->{used} = -1;
+ $ctx->{utf8} = 1 if utf8::is_utf8($ctx->{tmp});
+ pos($ctx->{tmp}) = 0;
+ return 1;
+ }
+ }
+ $ctx->{tmp} = '' unless defined $ctx->{tmp};
+ $ctx->{useIO} |= useIO_EOF;
+ return;
+}
+
+sub __set_eol_is_cr {
+ my ($self, $ctx) = @_;
+ $ctx->{eol} = "\015";
+ $ctx->{eol_is_cr} = 1;
+ $ctx->{eol_len} = 1;
+
+ $self->{eol} = $ctx->{eol};
+}
+
+sub __bound_field {
+ my ($self, $ctx, $i, $keep) = @_;
+ if ($i >= $ctx->{is_bound}) {
+ $self->SetDiag(3006);
+ return;
+ }
+ if (ref $ctx->{bound} eq 'ARRAY') {
+ my $ref = $ctx->{bound}[$i];
+ if (ref $ref) {
+ if ($keep) {
+ return $ref;
+ }
+ unless (Scalar::Util::readonly($$ref)) {
+ $$ref = "";
+ return $ref;
+ }
+ }
+ }
+ $self->SetDiag(3008);
+ return;
+}
+
+sub __get {
+ my ($self, $ctx) = @_;
+ return unless defined $ctx->{used};
+ return if $ctx->{used} >= $ctx->{size};
+ my $pos = pos($ctx->{tmp});
+ if ($ctx->{tmp} =~ /\G($ctx->{_re}|.)/gs) {
+ my $c = $1;
+ if ($c =~ /[^\x09\x20-\x7e]/) {
+ $ctx->{flag} |= IS_BINARY;
+ }
+ $ctx->{used} = pos($ctx->{tmp});
+ return $c;
+ } else {
+ pos($ctx->{tmp}) = $pos;
+ return;
+ }
+}
+
+sub __error_inside_quotes {
+ my ($self, $ctx, $error) = @_;
+ $self->__parse_error($ctx, $error, $ctx->{used} - 1);
+}
+
+sub __error_inside_field {
+ my ($self, $ctx, $error) = @_;
+ $self->__parse_error($ctx, $error, $ctx->{used} - 1);
+}
+
+sub __parse_error {
+ my ($self, $ctx, $error, $pos) = @_;
+ $self->{_ERROR_POS} = $pos;
+ $self->{_ERROR_FLD} = $ctx->{fld_idx};
+ $self->{_ERROR_INPUT} = $ctx->{tmp} if $ctx->{tmp};
+ $self->SetDiag($error);
+ return;
+}
+
+sub __is_whitespace {
+ my ($self, $ctx, $c) = @_;
+ return unless defined $c;
+ return (
+ (!defined $ctx->{sep} or $c ne $ctx->{sep}) &&
+ (!defined $ctx->{quo} or $c ne $ctx->{quo}) &&
+ (!defined $ctx->{escape_char} or $c ne $ctx->{escape_char}) &&
+ ($c eq " " or $c eq "\t")
+ );
+}
+
+sub __push_value { # AV_PUSH (part of)
+ my ($self, $ctx, $v_ref, $fields, $fflags, $flag) = @_;
+ utf8::encode($$v_ref) if $ctx->{utf8};
+ if (
+ (!defined $$v_ref or $$v_ref eq '') and
+ ($ctx->{empty_is_undef} or (!($flag & IS_QUOTED) and $ctx->{blank_is_undef}))
+ ) {
+ $$v_ref = undef;
+ } else {
+ if ($ctx->{allow_whitespace} && !($flag & IS_QUOTED)) {
+ $$v_ref =~ s/[ \t]+$//;
+ }
+ if ($flag & IS_BINARY and $ctx->{decode_utf8} and ($ctx->{utf8} || _is_valid_utf8($$v_ref))) {
+ utf8::decode($$v_ref);
+ }
+ }
+ unless ($ctx->{is_bound}) {
+ push @$fields, $$v_ref;
+ }
+ if ($ctx->{keep_meta_info} and $fflags) {
+ push @$fflags, $flag;
+ }
+}
+
+sub getline {
+ my ($self, $io) = @_;
+
+ my (@fields, @fflags);
+ my $res = $self->__parse(\@fields, \@fflags, $io, 1);
+ $res ? \@fields : undef;
+}
+
+sub getline_all {
+ my ( $self, $io, $offset, $len ) = @_;
+
+ my $ctx = $self->_setup_ctx;
+
+ my $tail = 0;
+ my $n = 0;
+ $offset ||= 0;
+
+ if ( $offset < 0 ) {
+ $tail = -$offset;
+ $offset = -1;
+ }
+
+ my (@row, @list);
+ while ($self->___parse($ctx, \@row, undef, $io, 1)) {
+ $ctx = $self->_setup_ctx;
+
+ if ($offset > 0) {
+ $offset--;
+ @row = ();
+ next;
+ }
+ if ($n++ >= $tail and $tail) {
+ shift @list;
+ $n--;
+ }
+ if (($ctx->{has_hooks} || 0) & HOOK_AFTER_PARSE) {
+ unless ($self->_hook(after_parse => \@row)) {
+ @row = ();
+ next;
+ }
+ }
+ push @list, [@row];
+ @row = ();
+
+ last if defined $len && $n >= $len and $offset >= 0; # exceeds limit size
+ }
+
+ if ( defined $len && $n > $len ) {
+ @list = splice( @list, 0, $len);
+ }
+
+ return \@list;
+}
+
+sub _is_valid_utf8 {
+ return ( $_[0] =~ /^(?:
+ [\x00-\x7F]
+ |[\xC2-\xDF][\x80-\xBF]
+ |[\xE0][\xA0-\xBF][\x80-\xBF]
+ |[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
+ |[\xED][\x80-\x9F][\x80-\xBF]
+ |[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
+ |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
+ |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
+ |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
+ )+$/x ) ? 1 : 0;
+}
+
+################################################################################
+# methods for errors
+################################################################################
+
+sub _set_error_diag {
+ my ( $self, $error, $pos ) = @_;
+
+ $self->SetDiag($error);
+
+ if (defined $pos) {
+ $_[0]->{_ERROR_POS} = $pos;
+ }
+
+ return;
+}
+
+sub error_input {
+ my $self = shift;
+ if ($self and ((Scalar::Util::reftype($self) || '') eq 'HASH' or (ref $self) =~ /^Text::CSV/)) {
+ return $self->{_ERROR_INPUT};
+ }
+ return;
+}
+
+sub _sv_diag {
+ my ($self, $error) = @_;
+ bless [$error, $ERRORS->{$error}], 'Text::CSV::ErrorDiag';
+}
+
+sub _set_diag {
+ my ($self, $ctx, $error) = @_;
+
+ $last_error = $self->_sv_diag($error);
+ $self->{_ERROR_DIAG} = $last_error;
+ if ($error == 0) {
+ $self->{_ERROR_POS} = 0;
+ $self->{_ERROR_FLD} = 0;
+ $self->{_ERROR_INPUT} = undef;
+ $ctx->{has_error_input} = 0;
+ }
+ if ($error == 2012) { # EOF
+ $self->{_EOF} = 1;
+ }
+ if ($ctx->{auto_diag}) {
+ $self->error_diag;
+ }
+ return $last_error;
+}
+
+sub SetDiag {
+ my ($self, $error, $errstr) = @_;
+ my $res;
+ if (ref $self) {
+ my $ctx = $self->_setup_ctx;
+ $res = $self->_set_diag($ctx, $error);
+
+ } else {
+ $res = $self->_sv_diag($error);
+ }
+ if (defined $errstr) {
+ $res->[1] = $errstr;
+ }
+ $res;
+}
+
+################################################################################
+package Text::CSV::ErrorDiag;
+
+use strict;
+use overload (
+ '""' => \&stringify,
+ '+' => \&numeric,
+ '-' => \&numeric,
+ '*' => \&numeric,
+ '/' => \&numeric,
+ fallback => 1,
+);
+
+
+sub numeric {
+ my ($left, $right) = @_;
+ return ref $left ? $left->[0] : $right->[0];
+}
+
+
+sub stringify {
+ $_[0]->[1];
+}
+################################################################################
+1;
+__END__
+
+=head1 NAME
+
+Text::CSV_PP - Text::CSV_XS compatible pure-Perl module
+
+
+=head1 SYNOPSIS
+
+ use Text::CSV_PP;
+
+ $csv = Text::CSV_PP->new(); # create a new object
+ # If you want to handle non-ascii char.
+ $csv = Text::CSV_PP->new({binary => 1});
+
+ $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 occurred, 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->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
+
+=head1 DESCRIPTION
+
+Text::CSV_PP is a pure-perl module that provides facilities for the
+composition and decomposition of comma-separated values. This is
+(almost) compatible with much faster L<Text::CSV_XS>, and mainly
+used as its fallback module when you use L<Text::CSV> module without
+having installed Text::CSV_XS. If you don't have any reason to use
+this module directly, use Text::CSV for speed boost and portability
+(or maybe Text::CSV_XS when you write an one-off script and don't need
+to care about portability).
+
+The following caveats are taken from the doc of Text::CSV_XS.
+
+=head2 Embedded newlines
+
+B<Important Note>: The default behavior is to accept only ASCII characters
+in the range from C<0x20> (space) to C<0x7E> (tilde). This means that the
+fields can not contain newlines. If your data contains newlines embedded in
+fields, or characters above C<0x7E> (tilde), or binary data, you B<I<must>>
+set C<< binary => 1 >> in the call to L</new>. To cover the widest range of
+parsing options, you will always want to set binary.
+
+But you still have the problem that you have to pass a correct line to the
+L</parse> method, which is more complicated from the usual point of usage:
+
+ my $csv = Text::CSV_PP->new ({ binary => 1, eol => $/ });
+ while (<>) { # WRONG!
+ $csv->parse ($_);
+ my @fields = $csv->fields ();
+ }
+
+this will break, as the C<while> might read broken lines: it does not care
+about the quoting. If you need to support embedded newlines, the way to go
+is to B<not> pass L<C<eol>|/eol> in the parser (it accepts C<\n>, C<\r>,
+B<and> C<\r\n> by default) and then
+
+ my $csv = Text::CSV_PP->new ({ binary => 1 });
+ open my $io, "<", $file or die "$file: $!";
+ while (my $row = $csv->getline ($io)) {
+ my @fields = @$row;
+ }
+
+The old(er) way of using global file handles is still supported
+
+ while (my $row = $csv->getline (*ARGV)) { ... }
+
+=head2 Unicode
+
+Unicode is only tested to work with perl-5.8.2 and up.
+
+The simplest way to ensure the correct encoding is used for in- and output
+is by either setting layers on the filehandles, or setting the L</encoding>
+argument for L</csv>.
+
+ open my $fh, "<:encoding(UTF-8)", "in.csv" or die "in.csv: $!";
+or
+ my $aoa = csv (in => "in.csv", encoding => "UTF-8");
+
+ open my $fh, ">:encoding(UTF-8)", "out.csv" or die "out.csv: $!";
+or
+ csv (in => $aoa, out => "out.csv", encoding => "UTF-8");
+
+On parsing (both for L</getline> and L</parse>), if the source is marked
+being UTF8, then all fields that are marked binary will also be marked UTF8.
+
+On combining (L</print> and L</combine>): if any of the combining fields
+was marked UTF8, the resulting string will be marked as UTF8. Note however
+that all fields I<before> the first field marked UTF8 and contained 8-bit
+characters that were not upgraded to UTF8, these will be C<bytes> in the
+resulting string too, possibly causing unexpected errors. If you pass data
+of different encoding, or you don't know if there is different encoding,
+force it to be upgraded before you pass them on:
+
+ $csv->print ($fh, [ map { utf8::upgrade (my $x = $_); $x } @data ]);
+
+For complete control over encoding, please use L<Text::CSV::Encoded>:
+
+ use Text::CSV::Encoded;
+ my $csv = Text::CSV::Encoded->new ({
+ encoding_in => "iso-8859-1", # the encoding comes into Perl
+ encoding_out => "cp1252", # the encoding comes out of Perl
+ });
+
+ $csv = Text::CSV::Encoded->new ({ encoding => "utf8" });
+ # combine () and print () accept *literally* utf8 encoded data
+ # parse () and getline () return *literally* utf8 encoded data
+
+ $csv = Text::CSV::Encoded->new ({ encoding => undef }); # default
+ # combine () and print () accept UTF8 marked data
+ # parse () and getline () return UTF8 marked data
+
+=head1 METHODS
+
+This whole section is also taken from Text::CSV_XS.
+
+=head2 version ()
+
+(Class method) Returns the current module version.
+
+=head2 new (\%attr)
+
+(Class method) Returns a new instance of Text::CSV_PP. The attributes
+are described by the (optional) hash ref C<\%attr>.
+
+ my $csv = Text::CSV_PP->new ({ attributes ... });
+
+The following attributes are available:
+
+=head3 eol
+
+ my $csv = Text::CSV_PP->new ({ eol => $/ });
+ $csv->eol (undef);
+ my $eol = $csv->eol;
+
+The end-of-line string to add to rows for L</print> or the record separator
+for L</getline>.
+
+When not passed in a B<parser> instance, the default behavior is to accept
+C<\n>, C<\r>, and C<\r\n>, so it is probably safer to not specify C<eol> at
+all. Passing C<undef> or the empty string behave the same.
+
+When not passed in a B<generating> instance, records are not terminated at
+all, so it is probably wise to pass something you expect. A safe choice for
+C<eol> on output is either C<$/> or C<\r\n>.
+
+Common values for C<eol> are C<"\012"> (C<\n> or Line Feed), C<"\015\012">
+(C<\r\n> or Carriage Return, Line Feed), and C<"\015"> (C<\r> or Carriage
+Return). The L<C<eol>|/eol> attribute cannot exceed 7 (ASCII) characters.
+
+If both C<$/> and L<C<eol>|/eol> equal C<"\015">, parsing lines that end on
+only a Carriage Return without Line Feed, will be L</parse>d correct.
+
+=head3 sep_char
+
+ my $csv = Text::CSV_PP->new ({ sep_char => ";" });
+ $csv->sep_char (";");
+ my $c = $csv->sep_char;
+
+The char used to separate fields, by default a comma. (C<,>). Limited to a
+single-byte character, usually in the range from C<0x20> (space) to C<0x7E>
+(tilde). When longer sequences are required, use L<C<sep>|/sep>.
+
+The separation character can not be equal to the quote character or to the
+escape character.
+
+=head3 sep
+
+ my $csv = Text::CSV_PP->new ({ sep => "\N{FULLWIDTH COMMA}" });
+ $csv->sep (";");
+ my $sep = $csv->sep;
+
+The chars used to separate fields, by default undefined. Limited to 8 bytes.
+
+When set, overrules L<C<sep_char>|/sep_char>. If its length is one byte it
+acts as an alias to L<C<sep_char>|/sep_char>.
+
+=head3 quote_char
+
+ my $csv = Text::CSV_PP->new ({ quote_char => "'" });
+ $csv->quote_char (undef);
+ my $c = $csv->quote_char;
+
+The character to quote fields containing blanks or binary data, by default
+the double quote character (C<">). A value of undef suppresses quote chars
+(for simple cases only). Limited to a single-byte character, usually in the
+range from C<0x20> (space) to C<0x7E> (tilde). When longer sequences are
+required, use L<C<quote>|/quote>.
+
+C<quote_char> can not be equal to L<C<sep_char>|/sep_char>.
+
+=head3 quote
+
+ my $csv = Text::CSV_PP->new ({ quote => "\N{FULLWIDTH QUOTATION MARK}" });
+ $csv->quote ("'");
+ my $quote = $csv->quote;
+
+The chars used to quote fields, by default undefined. Limited to 8 bytes.
+
+When set, overrules L<C<quote_char>|/quote_char>. If its length is one byte
+it acts as an alias to L<C<quote_char>|/quote_char>.
+
+=head3 escape_char
+
+ my $csv = Text::CSV_PP->new ({ escape_char => "\\" });
+ $csv->escape_char (undef);
+ my $c = $csv->escape_char;
+
+The character to escape certain characters inside quoted fields. This is
+limited to a single-byte character, usually in the range from C<0x20>
+(space) to C<0x7E> (tilde).
+
+The C<escape_char> defaults to being the double-quote mark (C<">). In other
+words the same as the default L<C<quote_char>|/quote_char>. This means that
+doubling the quote mark in a field escapes it:
+
+ "foo","bar","Escape ""quote mark"" with two ""quote marks""","baz"
+
+If you change the L<C<quote_char>|/quote_char> without changing the
+C<escape_char>, the C<escape_char> will still be the double-quote (C<">).
+If instead you want to escape the L<C<quote_char>|/quote_char> by doubling
+it you will need to also change the C<escape_char> to be the same as what
+you have changed the L<C<quote_char>|/quote_char> to.
+
+The escape character can not be equal to the separation character.
+
+=head3 binary
+
+ my $csv = Text::CSV_PP->new ({ binary => 1 });
+ $csv->binary (0);
+ my $f = $csv->binary;
+
+If this attribute is C<1>, you may use binary characters in quoted fields,
+including line feeds, carriage returns and C<NULL> bytes. (The latter could
+be escaped as C<"0>.) By default this feature is off.
+
+If a string is marked UTF8, C<binary> will be turned on automatically when
+binary characters other than C<CR> and C<NL> are encountered. Note that a
+simple string like C<"\x{00a0}"> might still be binary, but not marked UTF8,
+so setting C<< { binary => 1 } >> is still a wise option.
+
+=head3 strict
+
+ my $csv = Text::CSV_PP->new ({ strict => 1 });
+ $csv->strict (0);
+ my $f = $csv->strict;
+
+If this attribute is set to C<1>, any row that parses to a different number
+of fields than the previous row will cause the parser to throw error 2014.
+
+=head3 decode_utf8
+
+ my $csv = Text::CSV_PP->new ({ decode_utf8 => 1 });
+ $csv->decode_utf8 (0);
+ my $f = $csv->decode_utf8;
+
+This attributes defaults to TRUE.
+
+While I<parsing>, fields that are valid UTF-8, are automatically set to be
+UTF-8, so that
+
+ $csv->parse ("\xC4\xA8\n");
+
+results in
+
+ PV("\304\250"\0) [UTF8 "\x{128}"]
+
+Sometimes it might not be a desired action. To prevent those upgrades, set
+this attribute to false, and the result will be
+
+ PV("\304\250"\0)
+
+=head3 auto_diag
+
+ my $csv = Text::CSV_PP->new ({ auto_diag => 1 });
+ $csv->auto_diag (2);
+ my $l = $csv->auto_diag;
+
+Set this attribute to a number between C<1> and C<9> causes L</error_diag>
+to be automatically called in void context upon errors.
+
+In case of error C<2012 - EOF>, this call will be void.
+
+If C<auto_diag> is set to a numeric value greater than C<1>, it will C<die>
+on errors instead of C<warn>. If set to anything unrecognized, it will be
+silently ignored.
+
+Future extensions to this feature will include more reliable auto-detection
+of C<autodie> being active in the scope of which the error occurred which
+will increment the value of C<auto_diag> with C<1> the moment the error is
+detected.
+
+=head3 diag_verbose
+
+ my $csv = Text::CSV_PP->new ({ diag_verbose => 1 });
+ $csv->diag_verbose (2);
+ my $l = $csv->diag_verbose;
+
+Set the verbosity of the output triggered by C<auto_diag>. Currently only
+adds the current input-record-number (if known) to the diagnostic output
+with an indication of the position of the error.
+
+=head3 blank_is_undef
+
+ my $csv = Text::CSV_PP->new ({ blank_is_undef => 1 });
+ $csv->blank_is_undef (0);
+ my $f = $csv->blank_is_undef;
+
+Under normal circumstances, C<CSV> data makes no distinction between quoted-
+and unquoted empty fields. These both end up in an empty string field once
+read, thus
+
+ 1,"",," ",2
+
+is read as
+
+ ("1", "", "", " ", "2")
+
+When I<writing> C<CSV> files with either L<C<always_quote>|/always_quote>
+or L<C<quote_empty>|/quote_empty> set, the unquoted I<empty> field is the
+result of an undefined value. To enable this distinction when I<reading>
+C<CSV> data, the C<blank_is_undef> attribute will cause unquoted empty
+fields to be set to C<undef>, causing the above to be parsed as
+
+ ("1", "", undef, " ", "2")
+
+note that this is specifically important when loading C<CSV> fields into a
+database that allows C<NULL> values, as the perl equivalent for C<NULL> is
+C<undef> in L<DBI> land.
+
+=head3 empty_is_undef
+
+ my $csv = Text::CSV_PP->new ({ empty_is_undef => 1 });
+ $csv->empty_is_undef (0);
+ my $f = $csv->empty_is_undef;
+
+Going one step further than L<C<blank_is_undef>|/blank_is_undef>, this
+attribute converts all empty fields to C<undef>, so
+
+ 1,"",," ",2
+
+is read as
+
+ (1, undef, undef, " ", 2)
+
+Note that this effects only fields that are originally empty, not fields
+that are empty after stripping allowed whitespace. YMMV.
+
+=head3 allow_whitespace
+
+ my $csv = Text::CSV_PP->new ({ allow_whitespace => 1 });
+ $csv->allow_whitespace (0);
+ my $f = $csv->allow_whitespace;
+
+When this option is set to true, the whitespace (C<TAB>'s and C<SPACE>'s)
+surrounding the separation character is removed when parsing. If either
+C<TAB> or C<SPACE> is one of the three characters L<C<sep_char>|/sep_char>,
+L<C<quote_char>|/quote_char>, or L<C<escape_char>|/escape_char> it will not
+be considered whitespace.
+
+Now lines like:
+
+ 1 , "foo" , bar , 3 , zapp
+
+are parsed as valid C<CSV>, even though it violates the C<CSV> specs.
+
+Note that B<all> whitespace is stripped from both start and end of each
+field. That would make it I<more> than a I<feature> to enable parsing bad
+C<CSV> lines, as
+
+ 1, 2.0, 3, ape , monkey
+
+will now be parsed as
+
+ ("1", "2.0", "3", "ape", "monkey")
+
+even if the original line was perfectly acceptable C<CSV>.
+
+=head3 allow_loose_quotes
+
+ my $csv = Text::CSV_PP->new ({ allow_loose_quotes => 1 });
+ $csv->allow_loose_quotes (0);
+ my $f = $csv->allow_loose_quotes;
+
+By default, parsing unquoted fields containing L<C<quote_char>|/quote_char>
+characters like
+
+ 1,foo "bar" baz,42
+
+would result in parse error 2034. Though it is still bad practice to allow
+this format, we cannot help the fact that some vendors make their
+applications spit out lines styled this way.
+
+If there is B<really> bad C<CSV> data, like
+
+ 1,"foo "bar" baz",42
+
+or
+
+ 1,""foo bar baz"",42
+
+there is a way to get this data-line 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 L<C<escape_char>|/escape_char> is I<not> equal
+to L<C<quote_char>|/quote_char>.
+
+=head3 allow_loose_escapes
+
+ my $csv = Text::CSV_PP->new ({ allow_loose_escapes => 1 });
+ $csv->allow_loose_escapes (0);
+ my $f = $csv->allow_loose_escapes;
+
+Parsing fields that have L<C<escape_char>|/escape_char> characters that
+escape characters that do not need to be escaped, like:
+
+ my $csv = Text::CSV_PP->new ({ escape_char => "\\" });
+ $csv->parse (qq{1,"my bar\'s",baz,42});
+
+would result in parse error 2025. Though it is bad practice to allow this
+format, this attribute enables you to treat all escape character sequences
+equal.
+
+=head3 allow_unquoted_escape
+
+ my $csv = Text::CSV_PP->new ({ allow_unquoted_escape => 1 });
+ $csv->allow_unquoted_escape (0);
+ my $f = $csv->allow_unquoted_escape;
+
+A backward compatibility issue where L<C<escape_char>|/escape_char> differs
+from L<C<quote_char>|/quote_char> prevents L<C<escape_char>|/escape_char>
+to be in the first position of a field. If L<C<quote_char>|/quote_char> is
+equal to the default C<"> and L<C<escape_char>|/escape_char> is set to C<\>,
+this would be illegal:
+
+ 1,\0,2
+
+Setting this attribute to C<1> might help to overcome issues with backward
+compatibility and allow this style.
+
+=head3 always_quote
+
+ my $csv = Text::CSV_PP->new ({ always_quote => 1 });
+ $csv->always_quote (0);
+ my $f = $csv->always_quote;
+
+By default the generated fields are quoted only if they I<need> to be. For
+example, if they contain the separator character. If you set this attribute
+to C<1> then I<all> defined fields will be quoted. (C<undef> fields are not
+quoted, see L</blank_is_undef>). This makes it quite often easier to handle
+exported data in external applications.
+
+=head3 quote_space
+
+ my $csv = Text::CSV_PP->new ({ quote_space => 1 });
+ $csv->quote_space (0);
+ my $f = $csv->quote_space;
+
+By default, a space in a field would trigger quotation. As no rule exists
+this to be forced in C<CSV>, nor any for the opposite, the default is true
+for safety. You can exclude the space from this trigger by setting this
+attribute to 0.
+
+=head3 quote_empty
+
+ my $csv = Text::CSV_PP->new ({ quote_empty => 1 });
+ $csv->quote_empty (0);
+ my $f = $csv->quote_empty;
+
+By default the generated fields are quoted only if they I<need> to be. An
+empty (defined) field does not need quotation. If you set this attribute to
+C<1> then I<empty> defined fields will be quoted. (C<undef> fields are not
+quoted, see L</blank_is_undef>). See also L<C<always_quote>|/always_quote>.
+
+=head3 quote_binary
+
+ my $csv = Text::CSV_PP->new ({ quote_binary => 1 });
+ $csv->quote_binary (0);
+ my $f = $csv->quote_binary;
+
+By default, all "unsafe" bytes inside a string cause the combined field to
+be quoted. By setting this attribute to C<0>, you can disable that trigger
+for bytes >= C<0x7F>.
+
+=head3 escape_null or quote_null (deprecated)
+
+ my $csv = Text::CSV_PP->new ({ escape_null => 1 });
+ $csv->escape_null (0);
+ my $f = $csv->escape_null;
+
+By default, a C<NULL> byte in a field would be escaped. This option enables
+you to treat the C<NULL> byte as a simple binary character in binary mode
+(the C<< { binary => 1 } >> is set). The default is true. You can prevent
+C<NULL> escapes by setting this attribute to C<0>.
+
+The default when using the C<csv> function is C<false>.
+
+=head3 keep_meta_info
+
+ my $csv = Text::CSV_PP->new ({ keep_meta_info => 1 });
+ $csv->keep_meta_info (0);
+ my $f = $csv->keep_meta_info;
+
+By default, the parsing of input records is as simple and fast as possible.
+However, some parsing information - like quotation of the original field -
+is lost in that process. Setting this flag to true enables retrieving that
+information after parsing with the methods L</meta_info>, L</is_quoted>,
+and L</is_binary> described below. Default is false for performance.
+
+If you set this attribute to a value greater than 9, than you can control
+output quotation style like it was used in the input of the the last parsed
+record (unless quotation was added because of other reasons).
+
+ my $csv = Text::CSV_PP->new ({
+ binary => 1,
+ keep_meta_info => 1,
+ quote_space => 0,
+ });
+
+ my $row = $csv->parse (q{1,,"", ," ",f,"g","h""h",help,"help"});
+
+ $csv->print (*STDOUT, \@row);
+ # 1,,, , ,f,g,"h""h",help,help
+ $csv->keep_meta_info (11);
+ $csv->print (*STDOUT, \@row);
+ # 1,,"", ," ",f,"g","h""h",help,"help"
+
+=head3 verbatim
+
+ my $csv = Text::CSV_PP->new ({ verbatim => 1 });
+ $csv->verbatim (0);
+ my $f = $csv->verbatim;
+
+This is a quite controversial attribute to set, but makes some hard things
+possible.
+
+The rationale behind this attribute is to tell the parser that the normally
+special characters newline (C<NL>) and Carriage Return (C<CR>) will not be
+special when this flag is set, and be dealt with as being ordinary binary
+characters. This will ease working with data with embedded newlines.
+
+When C<verbatim> is used with L</getline>, L</getline> auto-C<chomp>'s
+every line.
+
+Imagine a file format like
+
+ M^^Hans^Janssen^Klas 2\n2A^Ja^11-06-2007#\r\n
+
+where, the line ending is a very specific C<"#\r\n">, and the sep_char is a
+C<^> (caret). None of the fields is quoted, but embedded binary data is
+likely to be present. With the specific line ending, this should not be too
+hard to detect.
+
+By default, Text::CSV_PP' parse function is instructed to only know about
+C<"\n"> and C<"\r"> to be legal line endings, and so has to deal with the
+embedded newline as a real C<end-of-line>, so it can scan the next line if
+binary is true, and the newline is inside a quoted field. With this option,
+we tell L</parse> to parse the line as if C<"\n"> is just nothing more than
+a binary character.
+
+For L</parse> this means that the parser has no more idea about line ending
+and L</getline> C<chomp>s line endings on reading.
+
+=head3 types
+
+A set of column types; the attribute is immediately passed to the L</types>
+method.
+
+=head3 callbacks
+
+See the L</Callbacks> section below.
+
+=head3 accessors
+
+To sum it up,
+
+ $csv = Text::CSV_PP->new ();
+
+is equivalent to
+
+ $csv = Text::CSV_PP->new ({
+ eol => undef, # \r, \n, or \r\n
+ sep_char => ',',
+ sep => undef,
+ quote_char => '"',
+ quote => undef,
+ escape_char => '"',
+ binary => 0,
+ decode_utf8 => 1,
+ auto_diag => 0,
+ diag_verbose => 0,
+ blank_is_undef => 0,
+ empty_is_undef => 0,
+ allow_whitespace => 0,
+ allow_loose_quotes => 0,
+ allow_loose_escapes => 0,
+ allow_unquoted_escape => 0,
+ always_quote => 0,
+ quote_empty => 0,
+ quote_space => 1,
+ escape_null => 1,
+ quote_binary => 1,
+ keep_meta_info => 0,
+ verbatim => 0,
+ types => undef,
+ callbacks => undef,
+ });
+
+For all of the above mentioned flags, an accessor method is available where
+you can inquire the current value, or change the value
+
+ my $quote = $csv->quote_char;
+ $csv->binary (1);
+
+It is not wise to change these settings halfway through writing C<CSV> data
+to a stream. If however you want to create a new stream using the available
+C<CSV> object, there is no harm in changing them.
+
+If the L</new> constructor call fails, it returns C<undef>, and makes the
+fail reason available through the L</error_diag> method.
+
+ $csv = Text::CSV_PP->new ({ ecs_char => 1 }) or
+ die "".Text::CSV_PP->error_diag ();
+
+L</error_diag> will return a string like
+
+ "INI - Unknown attribute 'ecs_char'"
+
+=head2 known_attributes
+
+ @attr = Text::CSV_PP->known_attributes;
+ @attr = Text::CSV_PP::known_attributes;
+ @attr = $csv->known_attributes;
+
+This method will return an ordered list of all the supported attributes as
+described above. This can be useful for knowing what attributes are valid
+in classes that use or extend Text::CSV_PP.
+
+=head2 print
+
+ $status = $csv->print ($io, $colref);
+
+Similar to L</combine> + L</string> + L</print>, but much 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 C<$io> object,
+typically an IO handle or any other object that offers a L</print> method.
+
+For performance reasons C<print> does not create a result string, so all
+L</string>, L</status>, L</fields>, and L</error_input> methods will return
+undefined information after executing this method.
+
+If C<$colref> is C<undef> (explicit, not through a variable argument) and
+L</bind_columns> was used to specify fields to be printed, it is possible
+to make performance improvements, as otherwise data would have to be copied
+as arguments to the method call:
+
+ $csv->bind_columns (\($foo, $bar));
+ $status = $csv->print ($fh, undef);
+
+=head2 say
+
+ $status = $csv->say ($io, $colref);
+
+Like L<C<print>|/print>, but L<C<eol>|/eol> defaults to C<$\>.
+
+=head2 print_hr
+
+ $csv->print_hr ($io, $ref);
+
+Provides an easy way to print a C<$ref> (as fetched with L</getline_hr>)
+provided the column names are set with L</column_names>.
+
+It is just a wrapper method with basic parameter checks over
+
+ $csv->print ($io, [ map { $ref->{$_} } $csv->column_names ]);
+
+=head2 combine
+
+ $status = $csv->combine (@fields);
+
+This method constructs a C<CSV> record from C<@fields>, returning success
+or failure. Failure can result from lack of arguments or an argument that
+contains an invalid character. Upon success, L</string> can be called to
+retrieve the resultant C<CSV> string. Upon failure, the value returned by
+L</string> is undefined and L</error_input> could be called to retrieve the
+invalid argument.
+
+=head2 string
+
+ $line = $csv->string ();
+
+This method returns the input to L</parse> or the resultant C<CSV> string
+of L</combine>, whichever was called more recently.
+
+=head2 getline
+
+ $colref = $csv->getline ($io);
+
+This is the counterpart to L</print>, as L</parse> is the counterpart to
+L</combine>: it parses a row from the C<$io> handle using the L</getline>
+method associated with C<$io> and parses this row into an array ref. This
+array ref is returned by the function or C<undef> for failure. When C<$io>
+does not support C<getline>, you are likely to hit errors.
+
+When fields are bound with L</bind_columns> the return value is a reference
+to an empty list.
+
+The L</string>, L</fields>, and L</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 L<getline ($io)|/getline> 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 getline_hr
+
+The L</getline_hr> and L</column_names> methods work together to allow you
+to have rows returned as hashrefs. You must call L</column_names> first to
+declare your column names.
+
+ $csv->column_names (qw( code name price description ));
+ $hr = $csv->getline_hr ($io);
+ print "Price for $hr->{name} is $hr->{price} EUR\n";
+
+L</getline_hr> will croak if called before L</column_names>.
+
+Note that L</getline_hr> creates a hashref for every row and will be much
+slower than the combined use of L</bind_columns> and L</getline> but still
+offering the same ease of use hashref inside the loop:
+
+ my @cols = @{$csv->getline ($io)};
+ $csv->column_names (@cols);
+ while (my $row = $csv->getline_hr ($io)) {
+ print $row->{price};
+ }
+
+Could easily be rewritten to the much faster:
+
+ my @cols = @{$csv->getline ($io)};
+ my $row = {};
+ $csv->bind_columns (\@{$row}{@cols});
+ while ($csv->getline ($io)) {
+ print $row->{price};
+ }
+
+Your mileage may vary for the size of the data and the number of rows.
+
+=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 L<getline_hr ($io)|/getline_hr>
+results. In this call, L<C<keep_meta_info>|/keep_meta_info> is disabled.
+
+=head2 parse
+
+ $status = $csv->parse ($line);
+
+This method decomposes a C<CSV> string into fields, returning success or
+failure. Failure can result from a lack of argument or the given C<CSV>
+string is improperly formatted. Upon success, L</fields> can be called to
+retrieve the decomposed fields. Upon failure calling L</fields> will return
+undefined data and L</error_input> can be called to retrieve the invalid
+argument.
+
+You may use the L</types> method for setting column types. See L</types>'
+description below.
+
+The C<$line> argument is supposed to be a simple scalar. Everything else is
+supposed to croak and set error 1500.
+
+=head2 fragment
+
+This function tries to implement RFC7111 (URI Fragment Identifiers for the
+text/csv Media Type) - http://tools.ietf.org/html/rfc7111
+
+ my $AoA = $csv->fragment ($io, $spec);
+
+In specifications, C<*> is used to specify the I<last> item, a dash (C<->)
+to indicate a range. All indices are C<1>-based: the first row or column
+has index C<1>. Selections can be combined with the semi-colon (C<;>).
+
+When using this method in combination with L</column_names>, the returned
+reference will point to a list of hashes instead of a list of lists. A
+disjointed cell-based combined selection might return rows with different
+number of columns making the use of hashes unpredictable.
+
+ $csv->column_names ("Name", "Age");
+ my $AoH = $csv->fragment ($io, "col=3;8");
+
+If the L</after_parse> callback is active, it is also called on every line
+parsed and skipped before the fragment.
+
+=over 2
+
+=item row
+
+ row=4
+ row=5-7
+ row=6-*
+ row=1-2;4;6-*
+
+=item col
+
+ col=2
+ col=1-3
+ col=4-*
+ col=1-2;4;7-*
+
+=item cell
+
+In cell-based selection, the comma (C<,>) is used to pair row and column
+
+ cell=4,1
+
+The range operator (C<->) using C<cell>s can be used to define top-left and
+bottom-right C<cell> location
+
+ cell=3,1-4,6
+
+The C<*> is only allowed in the second part of a pair
+
+ cell=3,2-*,2 # row 3 till end, only column 2
+ cell=3,2-3,* # column 2 till end, only row 3
+ cell=3,2-*,* # strip row 1 and 2, and column 1
+
+Cells and cell ranges may be combined with C<;>, possibly resulting in rows
+with different number of columns
+
+ cell=1,1-2,2;3,3-4,4;1,4;4,1
+
+Disjointed selections will only return selected cells. The cells that are
+not specified will not be included in the returned set, not even as
+C<undef>. As an example given a C<CSV> like
+
+ 11,12,13,...19
+ 21,22,...28,29
+ : :
+ 91,...97,98,99
+
+with C<cell=1,1-2,2;3,3-4,4;1,4;4,1> will return:
+
+ 11,12,14
+ 21,22
+ 33,34
+ 41,43,44
+
+Overlapping cell-specs will return those cells only once, So
+C<cell=1,1-3,3;2,2-4,4;2,3;4,2> will return:
+
+ 11,12,13
+ 21,22,23,24
+ 31,32,33,34
+ 42,43,44
+
+=back
+
+L<RFC7111|http://tools.ietf.org/html/rfc7111> does B<not> allow different
+types of specs to be combined (either C<row> I<or> C<col> I<or> C<cell>).
+Passing an invalid fragment specification will croak and set error 2013.
+
+=head2 column_names
+
+Set the "keys" that will be used in the L</getline_hr> calls. If no keys
+(column names) are passed, it will return the current setting as a list.
+
+L</column_names> accepts a list of scalars (the column names) or a single
+array_ref, so you can pass the return value from L</getline> too:
+
+ $csv->column_names ($csv->getline ($io));
+
+L</column_names> does B<no> checking on duplicates at all, which might lead
+to unexpected results. Undefined entries will be replaced with the string
+C<"\cAUNDEF\cA">, so
+
+ $csv->column_names (undef, "", "name", "name");
+ $hr = $csv->getline_hr ($io);
+
+Will set C<< $hr->{"\cAUNDEF\cA"} >> to the 1st field, C<< $hr->{""} >> to
+the 2nd field, and C<< $hr->{name} >> to the 4th field, discarding the 3rd
+field.
+
+L</column_names> croaks on invalid arguments.
+
+=head2 header
+
+This method does NOT work in perl-5.6.x
+
+Parse the CSV header and set L<C<sep>|/sep>, column_names and encoding.
+
+ my @hdr = $csv->header ($fh);
+ $csv->header ($fh, { sep_set => [ ";", ",", "|", "\t" ] });
+ $csv->header ($fh, { detect_bom => 1, munge_column_names => "lc" });
+
+The first argument should be a file handle.
+
+Assuming that the file opened for parsing has a header, and the header does
+not contain problematic characters like embedded newlines, read the first
+line from the open handle then auto-detect whether the header separates the
+column names with a character from the allowed separator list.
+
+If any of the allowed separators matches, and none of the I<other> allowed
+separators match, set L<C<sep>|/sep> to that separator for the current
+CSV_PP instance and use it to parse the first line, map those to lowercase,
+and use that to set the instance L</column_names>:
+
+ my $csv = Text::CSV_PP->new ({ binary => 1, auto_diag => 1 });
+ open my $fh, "<", "file.csv";
+ binmode $fh; # for Windows
+ $csv->header ($fh);
+ while (my $row = $csv->getline_hr ($fh)) {
+ ...
+ }
+
+If the header is empty, contains more than one unique separator out of the
+allowed set, contains empty fields, or contains identical fields (after
+folding), it will croak with error 1010, 1011, 1012, or 1013 respectively.
+
+If the header contains embedded newlines or is not valid CSV in any other
+way, this method will croak and leave the parse error untouched.
+
+A successful call to C<header> will always set the L<C<sep>|/sep> of the
+C<$csv> object. This behavior can not be disabled.
+
+=head3 return value
+
+On error this method will croak.
+
+In list context, the headers will be returned whether they are used to set
+L</column_names> or not.
+
+In scalar context, the instance itself is returned. B<Note>: the values as
+found in the header will effectively be B<lost> if C<set_column_names> is
+false.
+
+=head3 Options
+
+=over 2
+
+=item sep_set
+
+ $csv->header ($fh, { sep_set => [ ";", ",", "|", "\t" ] });
+
+The list of legal separators defaults to C<[ ";", "," ]> and can be changed
+by this option. As this is probably the most often used option, it can be
+passed on its own as an unnamed argument:
+
+ $csv->header ($fh, [ ";", ",", "|", "\t", "::", "\x{2063}" ]);
+
+Multi-byte sequences are allowed, both multi-character and Unicode. See
+L<C<sep>|/sep>.
+
+=item detect_bom
+
+ $csv->header ($fh, { detect_bom => 1 });
+
+The default behavior is to detect if the header line starts with a BOM. If
+the header has a BOM, use that to set the encoding of C<$fh>. This default
+behavior can be disabled by passing a false value to C<detect_bom>.
+
+Supported encodings from BOM are: UTF-8, UTF-16BE, UTF-16LE, UTF-32BE, and
+UTF-32LE. BOM's also support UTF-1, UTF-EBCDIC, SCSU, BOCU-1, and GB-18030
+but L<Encode> does not (yet). UTF-7 is not supported.
+
+The encoding is set using C<binmode> on C<$fh>.
+
+If the handle was opened in a (correct) encoding, this method will B<not>
+alter the encoding, as it checks the leading B<bytes> of the first line.
+
+=item munge_column_names
+
+This option offers the means to modify the column names into something that
+is most useful to the application. The default is to map all column names
+to lower case.
+
+ $csv->header ($fh, { munge_column_names => "lc" });
+
+The following values are available:
+
+ lc - lower case
+ uc - upper case
+ none - do not change
+ \&cb - supply a callback
+
+ $csv->header ($fh, { munge_column_names => sub { fc } });
+ $csv->header ($fh, { munge_column_names => sub { "column_".$col++ } });
+ $csv->header ($fh, { munge_column_names => sub { lc (s/\W+/_/gr) } });
+
+As this callback is called in a C<map>, you can use C<$_> directly.
+
+=item set_column_names
+
+ $csv->header ($fh, { set_column_names => 1 });
+
+The default is to set the instances column names using L</column_names> if
+the method is successful, so subsequent calls to L</getline_hr> can return
+a hash. Disable setting the header can be forced by using a false value for
+this option.
+
+=back
+
+=head3 Validation
+
+When receiving CSV files from external sources, this method can be used to
+protect against changes in the layout by restricting to known headers (and
+typos in the header fields).
+
+ my %known = (
+ "record key" => "c_rec",
+ "rec id" => "c_rec",
+ "id_rec" => "c_rec",
+ "kode" => "code",
+ "code" => "code",
+ "vaule" => "value",
+ "value" => "value",
+ );
+ my $csv = Text::CSV_PP->new ({ binary => 1, auto_diag => 1 });
+ open my $fh, "<", $source or die "$source: $!";
+ $csv->header ($fh, { munge_column_names => sub {
+ s/\s+$//;
+ s/^\s+//;
+ $known{lc $_} or die "Unknown column '$_' in $source";
+ }});
+ while (my $row = $csv->getline_hr ($fh)) {
+ say join "\t", $row->{c_rec}, $row->{code}, $row->{value};
+ }
+
+=head2 bind_columns
+
+Takes a list of scalar references to be used for output with L</print> or
+to store in the fields fetched by L</getline>. When you do not pass enough
+references to store the fetched fields in, L</getline> will fail with error
+C<3006>. If you pass more than there are fields to return, the content of
+the remaining references is left untouched.
+
+ $csv->bind_columns (\$code, \$name, \$price, \$description);
+ while ($csv->getline ($io)) {
+ print "The price of a $name is \x{20ac} $price\n";
+ }
+
+To reset or clear all column binding, call L</bind_columns> with the single
+argument C<undef>. This will also clear column names.
+
+ $csv->bind_columns (undef);
+
+If no arguments are passed at all, L</bind_columns> will return the list of
+current bindings or C<undef> if no binds are active.
+
+Note that in parsing with C<bind_columns>, the fields are set on the fly.
+That implies that if the third field of a row causes an error, the first
+two fields already have been assigned the values of the current row, while
+the rest of the fields will still hold the values of the previous row.
+If you want the parser to fail in these cases, use the L<C<strict>|/strict> attribute.
+
+=head2 eof
+
+ $eof = $csv->eof ();
+
+If L</parse> or L</getline> was used with an IO stream, this method will
+return true (1) if the last call hit end of file, otherwise it will return
+false (''). This is useful to see the difference between a failure and end
+of file.
+
+Note that if the parsing of the last line caused an error, C<eof> is still
+true. That means that if you are I<not> using L</auto_diag>, an idiom like
+
+ while (my $row = $csv->getline ($fh)) {
+ # ...
+ }
+ $csv->eof or $csv->error_diag;
+
+will I<not> report the error. You would have to change that to
+
+ while (my $row = $csv->getline ($fh)) {
+ # ...
+ }
+ +$csv->error_diag and $csv->error_diag;
+
+=head2 types
+
+ $csv->types (\@tref);
+
+This method is used to force that (all) columns are of a given type. For
+example, if you have an integer column, two columns with doubles and a
+string column, then you might do a
+
+ $csv->types ([Text::CSV_PP::IV (),
+ Text::CSV_PP::NV (),
+ Text::CSV_PP::NV (),
+ Text::CSV_PP::PV ()]);
+
+Column types are used only for I<decoding> columns while parsing, in other
+words by the L</parse> and L</getline> methods.
+
+You can unset column types by doing a
+
+ $csv->types (undef);
+
+or fetch the current type settings with
+
+ $types = $csv->types ();
+
+=over 4
+
+=item IV
+
+Set field type to integer.
+
+=item NV
+
+Set field type to numeric/float.
+
+=item PV
+
+Set field type to string.
+
+=back
+
+=head2 fields
+
+ @columns = $csv->fields ();
+
+This method returns the input to L</combine> or the resultant decomposed
+fields of a successful L</parse>, whichever was called more recently.
+
+Note that the return value is undefined after using L</getline>, which does
+not fill the data structures returned by L</parse>.
+
+=head2 meta_info
+
+ @flags = $csv->meta_info ();
+
+This method returns the "flags" of the input to L</combine> or the flags of
+the resultant decomposed fields of L</parse>, whichever was called more
+recently.
+
+For each field, a meta_info field will hold flags that inform something
+about the field returned by the L</fields> method or passed to the
+L</combine> method. The flags are bit-wise-C<or>'d like:
+
+=over 2
+
+=item C< >0x0001
+
+The field was quoted.
+
+=item C< >0x0002
+
+The field was binary.
+
+=back
+
+See the C<is_***> methods below.
+
+=head2 is_quoted
+
+ my $quoted = $csv->is_quoted ($column_idx);
+
+Where C<$column_idx> is the (zero-based) index of the column in the last
+result of L</parse>.
+
+This returns a true value if the data in the indicated column was enclosed
+in L<C<quote_char>|/quote_char> quotes. This might be important for fields
+where content C<,20070108,> is to be treated as a numeric value, and where
+C<,"20070108",> is explicitly marked as character string data.
+
+This method is only valid when L</keep_meta_info> is set to a true value.
+
+=head2 is_binary
+
+ my $binary = $csv->is_binary ($column_idx);
+
+Where C<$column_idx> is the (zero-based) index of the column in the last
+result of L</parse>.
+
+This returns a true value if the data in the indicated column contained any
+byte in the range C<[\x00-\x08,\x10-\x1F,\x7F-\xFF]>.
+
+This method is only valid when L</keep_meta_info> is set to a true value.
+
+=head2 is_missing
+
+ my $missing = $csv->is_missing ($column_idx);
+
+Where C<$column_idx> is the (zero-based) index of the column in the last
+result of L</getline_hr>.
+
+ $csv->keep_meta_info (1);
+ while (my $hr = $csv->getline_hr ($fh)) {
+ $csv->is_missing (0) and next; # This was an empty line
+ }
+
+When using L</getline_hr>, it is impossible to tell if the parsed fields
+are C<undef> because they where not filled in the C<CSV> stream or because
+they were not read at all, as B<all> the fields defined by L</column_names>
+are set in the hash-ref. If you still need to know if all fields in each
+row are provided, you should enable L<C<keep_meta_info>|/keep_meta_info> so
+you can check the flags.
+
+If L<C<keep_meta_info>|/keep_meta_info> is C<false>, C<is_missing> will
+always return C<undef>, regardless of C<$column_idx> being valid or not. If
+this attribute is C<true> it will return either C<0> (the field is present)
+or C<1> (the field is missing).
+
+A special case is the empty line. If the line is completely empty - after
+dealing with the flags - this is still a valid CSV line: it is a record of
+just one single empty field. However, if C<keep_meta_info> is set, invoking
+C<is_missing> with index C<0> will now return true.
+
+=head2 status
+
+ $status = $csv->status ();
+
+This method returns the status of the last invoked L</combine> or L</parse>
+call. Status is success (true: C<1>) or failure (false: C<undef> or C<0>).
+
+=head2 error_input
+
+ $bad_argument = $csv->error_input ();
+
+This method returns the erroneous argument (if it exists) of L</combine> or
+L</parse>, whichever was called more recently. If the last invocation was
+successful, C<error_input> will return C<undef>.
+
+=head2 error_diag
+
+ Text::CSV_PP->error_diag ();
+ $csv->error_diag ();
+ $error_code = 0 + $csv->error_diag ();
+ $error_str = "" . $csv->error_diag ();
+ ($cde, $str, $pos, $rec, $fld) = $csv->error_diag ();
+
+If (and only if) an error occurred, this function returns the diagnostics
+of that error.
+
+If called in void context, this will print the internal error code and the
+associated error message to STDERR.
+
+If called in list context, this will return the error code and the error
+message in that order. If the last error was from parsing, the rest of the
+values returned are a best guess at the location within the line that was
+being parsed. Their values are 1-based. The position currently is index of
+the byte at which the parsing failed in the current record. It might change
+to be the index of the current character in a later release. The records is
+the index of the record parsed by the csv instance. The field number is the
+index of the field the parser thinks it is currently trying to parse. See
+F<examples/csv-check> for how this can be used.
+
+If called in scalar context, it will return the diagnostics in a single
+scalar, a-la C<$!>. 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 diagnostics
+are that of the last L</new> call.
+
+=head2 record_number
+
+ $recno = $csv->record_number ();
+
+Returns the records parsed by this csv instance. This value should be more
+accurate than C<$.> when embedded newlines come in play. Records written by
+this instance are not counted.
+
+=head2 SetDiag
+
+ $csv->SetDiag (0);
+
+Use to reset the diagnostics if you are dealing with errors.
+
+=head1 FUNCTIONS
+
+This whole section is also taken from Text::CSV_XS.
+
+=head2 csv
+
+This function is not exported by default and should be explicitly requested:
+
+ use Text::CSV_PP qw( csv );
+
+This is an high-level function that aims at simple (user) interfaces. This
+can be used to read/parse a C<CSV> file or stream (the default behavior) or
+to produce a file or write to a stream (define the C<out> attribute). It
+returns an array- or hash-reference on parsing (or C<undef> on fail) or the
+numeric value of L</error_diag> on writing. When this function fails you
+can get to the error using the class call to L</error_diag>
+
+ my $aoa = csv (in => "test.csv") or
+ die Text::CSV_PP->error_diag;
+
+This function takes the arguments as key-value pairs. This can be passed as
+a list or as an anonymous hash:
+
+ my $aoa = csv ( in => "test.csv", sep_char => ";");
+ my $aoh = csv ({ in => $fh, headers => "auto" });
+
+The arguments passed consist of two parts: the arguments to L</csv> itself
+and the optional attributes to the C<CSV> object used inside the function
+as enumerated and explained in L</new>.
+
+If not overridden, the default option used for CSV is
+
+ auto_diag => 1
+ escape_null => 0
+
+The option that is always set and cannot be altered is
+
+ binary => 1
+
+As this function will likely be used in one-liners, it allows C<quote> to
+be abbreviated as C<quo>, and C<escape_char> to be abbreviated as C<esc>
+or C<escape>.
+
+Alternative invocations:
+
+ my $aoa = Text::CSV_PP::csv (in => "file.csv");
+
+ my $csv = Text::CSV_PP->new ();
+ my $aoa = $csv->csv (in => "file.csv");
+
+In the latter case, the object attributes are used from the existing object
+and the attribute arguments in the function call are ignored:
+
+ my $csv = Text::CSV_PP->new ({ sep_char => ";" });
+ my $aoh = $csv->csv (in => "file.csv", bom => 1);
+
+will parse using C<;> as C<sep_char>, not C<,>.
+
+=head3 in
+
+Used to specify the source. C<in> can be a file name (e.g. C<"file.csv">),
+which will be opened for reading and closed when finished, a file handle
+(e.g. C<$fh> or C<FH>), a reference to a glob (e.g. C<\*ARGV>), the glob
+itself (e.g. C<*STDIN>), or a reference to a scalar (e.g. C<\q{1,2,"csv"}>).
+
+When used with L</out>, C<in> should be a reference to a CSV structure (AoA
+or AoH) or a CODE-ref that returns an array-reference or a hash-reference.
+The code-ref will be invoked with no arguments.
+
+ my $aoa = csv (in => "file.csv");
+
+ open my $fh, "<", "file.csv";
+ my $aoa = csv (in => $fh);
+
+ my $csv = [ [qw( Foo Bar )], [ 1, 2 ], [ 2, 3 ]];
+ my $err = csv (in => $csv, out => "file.csv");
+
+If called in void context without the L</out> attribute, the resulting ref
+will be used as input to a subsequent call to csv:
+
+ csv (in => "file.csv", filter => { 2 => sub { length > 2 }})
+
+will be a shortcut to
+
+ csv (in => csv (in => "file.csv", filter => { 2 => sub { length > 2 }}))
+
+where, in the absence of the C<out> attribute, this is a shortcut to
+
+ csv (in => csv (in => "file.csv", filter => { 2 => sub { length > 2 }}),
+ out => *STDOUT)
+
+=head3 out
+
+In output mode, the default CSV options when producing CSV are
+
+ eol => "\r\n"
+
+The L</fragment> attribute is ignored in output mode.
+
+C<out> can be a file name (e.g. C<"file.csv">), which will be opened for
+writing and closed when finished, a file handle (e.g. C<$fh> or C<FH>), a
+reference to a glob (e.g. C<\*STDOUT>), or the glob itself (e.g. C<*STDOUT>).
+
+ csv (in => sub { $sth->fetch }, out => "dump.csv");
+ csv (in => sub { $sth->fetchrow_hashref }, out => "dump.csv",
+ headers => $sth->{NAME_lc});
+
+When a code-ref is used for C<in>, the output is generated per invocation,
+so no buffering is involved. This implies that there is no size restriction
+on the number of records. The C<csv> function ends when the coderef returns
+a false value.
+
+=head3 encoding
+
+If passed, it should be an encoding accepted by the C<:encoding()> option
+to C<open>. There is no default value. This attribute does not work in perl
+5.6.x. C<encoding> can be abbreviated to C<enc> for ease of use in command
+line invocations.
+
+If C<encoding> is set to the literal value C<"auto">, the method L</header>
+will be invoked on the opened stream to check if there is a BOM and set the
+encoding accordingly. This is equal to passing a true value in the option
+L<C<detect_bom>|/detect_bom>.
+
+=head3 detect_bom
+
+If C<detect_bom> is given, the method L</header> will be invoked on the
+opened stream to check if there is a BOM and set the encoding accordingly.
+
+C<detect_bom> can be abbreviated to C<bom>.
+
+This is the same as setting L<C<encoding>|/encoding> to C<"auto">.
+
+Note that as L</header> is invoked, its default is to also set the headers.
+
+=head3 headers
+
+If this attribute is not given, the default behavior is to produce an array
+of arrays.
+
+If C<headers> is supplied, it should be an anonymous list of column names,
+an anonymous hashref, a coderef, or a literal flag: C<auto>, C<lc>, C<uc>,
+or C<skip>.
+
+=over 2
+
+=item skip
+
+When C<skip> is used, the header will not be included in the output.
+
+ my $aoa = csv (in => $fh, headers => "skip");
+
+=item auto
+
+If C<auto> is used, the first line of the C<CSV> source will be read as the
+list of field headers and used to produce an array of hashes.
+
+ my $aoh = csv (in => $fh, headers => "auto");
+
+=item lc
+
+If C<lc> is used, the first line of the C<CSV> source will be read as the
+list of field headers mapped to lower case and used to produce an array of
+hashes. This is a variation of C<auto>.
+
+ my $aoh = csv (in => $fh, headers => "lc");
+
+=item uc
+
+If C<uc> is used, the first line of the C<CSV> source will be read as the
+list of field headers mapped to upper case and used to produce an array of
+hashes. This is a variation of C<auto>.
+
+ my $aoh = csv (in => $fh, headers => "uc");
+
+=item CODE
+
+If a coderef is used, the first line of the C<CSV> source will be read as
+the list of mangled field headers in which each field is passed as the only
+argument to the coderef. This list is used to produce an array of hashes.
+
+ my $aoh = csv (in => $fh,
+ headers => sub { lc ($_[0]) =~ s/kode/code/gr });
+
+this example is a variation of using C<lc> where all occurrences of C<kode>
+are replaced with C<code>.
+
+=item ARRAY
+
+If C<headers> is an anonymous list, the entries in the list will be used
+as field names. The first line is considered data instead of headers.
+
+ my $aoh = csv (in => $fh, headers => [qw( Foo Bar )]);
+ csv (in => $aoa, out => $fh, headers => [qw( code description price )]);
+
+=item HASH
+
+If C<headers> is an hash reference, this implies C<auto>, but header fields
+for that exist as key in the hashref will be replaced by the value for that
+key. Given a CSV file like
+
+ post-kode,city,name,id number,fubble
+ 1234AA,Duckstad,Donald,13,"X313DF"
+
+using
+
+ csv (headers => { "post-kode" => "pc", "id number" => "ID" }, ...
+
+will return an entry like
+
+ { pc => "1234AA",
+ city => "Duckstad",
+ name => "Donald",
+ ID => "13",
+ fubble => "X313DF",
+ }
+
+=back
+
+See also L<C<munge_column_names>|/munge_column_names> and
+L<C<set_column_names>|/set_column_names>.
+
+=head3 munge_column_names
+
+If C<munge_column_names> is set, the method L</header> is invoked on the
+opened stream with all matching arguments to detect and set the headers.
+
+C<munge_column_names> can be abbreviated to C<munge>.
+
+=head3 key
+
+If passed, will default L<C<headers>|/headers> to C<"auto"> and return a
+hashref instead of an array of hashes.
+
+ my $ref = csv (in => "test.csv", key => "code");
+
+with test.csv like
+
+ code,product,price,color
+ 1,pc,850,gray
+ 2,keyboard,12,white
+ 3,mouse,5,black
+
+will return
+
+ { 1 => {
+ code => 1,
+ color => 'gray',
+ price => 850,
+ product => 'pc'
+ },
+ 2 => {
+ code => 2,
+ color => 'white',
+ price => 12,
+ product => 'keyboard'
+ },
+ 3 => {
+ code => 3,
+ color => 'black',
+ price => 5,
+ product => 'mouse'
+ }
+ }
+
+=head3 fragment
+
+Only output the fragment as defined in the L</fragment> method. This option
+is ignored when I<generating> C<CSV>. See L</out>.
+
+Combining all of them could give something like
+
+ use Text::CSV_PP qw( csv );
+ my $aoh = csv (
+ in => "test.txt",
+ encoding => "utf-8",
+ headers => "auto",
+ sep_char => "|",
+ fragment => "row=3;6-9;15-*",
+ );
+ say $aoh->[15]{Foo};
+
+=head3 sep_set
+
+If C<sep_set> is set, the method L</header> is invoked on the opened stream
+to detect and set L<C<sep_char>|/sep_char> with the given set.
+
+C<sep_set> can be abbreviated to C<seps>.
+
+Note that as L</header> is invoked, its default is to also set the headers.
+
+=head3 set_column_names
+
+If C<set_column_names> is passed, the method L</header> is invoked on the
+opened stream with all arguments meant for L</header>.
+
+=head2 Callbacks
+
+Callbacks enable actions triggered from the I<inside> of Text::CSV_PP.
+
+While most of what this enables can easily be done in an unrolled loop as
+described in the L</SYNOPSIS> callbacks can be used to meet special demands
+or enhance the L</csv> function.
+
+=over 2
+
+=item error
+
+ $csv->callbacks (error => sub { $csv->SetDiag (0) });
+
+the C<error> callback is invoked when an error occurs, but I<only> when
+L</auto_diag> is set to a true value. A callback is invoked with the values
+returned by L</error_diag>:
+
+ my ($c, $s);
+
+ sub ignore3006
+ {
+ my ($err, $msg, $pos, $recno, $fldno) = @_;
+ if ($err == 3006) {
+ # ignore this error
+ ($c, $s) = (undef, undef);
+ Text::CSV_PP->SetDiag (0);
+ }
+ # Any other error
+ return;
+ } # ignore3006
+
+ $csv->callbacks (error => \&ignore3006);
+ $csv->bind_columns (\$c, \$s);
+ while ($csv->getline ($fh)) {
+ # Error 3006 will not stop the loop
+ }
+
+=item after_parse
+
+ $csv->callbacks (after_parse => sub { push @{$_[1]}, "NEW" });
+ while (my $row = $csv->getline ($fh)) {
+ $row->[-1] eq "NEW";
+ }
+
+This callback is invoked after parsing with L</getline> only if no error
+occurred. The callback is invoked with two arguments: the current C<CSV>
+parser object and an array reference to the fields parsed.
+
+The return code of the callback is ignored unless it is a reference to the
+string "skip", in which case the record will be skipped in L</getline_all>.
+
+ sub add_from_db
+ {
+ my ($csv, $row) = @_;
+ $sth->execute ($row->[4]);
+ push @$row, $sth->fetchrow_array;
+ } # add_from_db
+
+ my $aoa = csv (in => "file.csv", callbacks => {
+ after_parse => \&add_from_db });
+
+This hook can be used for validation:
+
+=over 2
+
+=item FAIL
+
+Die if any of the records does not validate a rule:
+
+ after_parse => sub {
+ $_[1][4] =~ m/^[0-9]{4}\s?[A-Z]{2}$/ or
+ die "5th field does not have a valid Dutch zipcode";
+ }
+
+=item DEFAULT
+
+Replace invalid fields with a default value:
+
+ after_parse => sub { $_[1][2] =~ m/^\d+$/ or $_[1][2] = 0 }
+
+=item SKIP
+
+Skip records that have invalid fields (only applies to L</getline_all>):
+
+ after_parse => sub { $_[1][0] =~ m/^\d+$/ or return \"skip"; }
+
+=back
+
+=item before_print
+
+ my $idx = 1;
+ $csv->callbacks (before_print => sub { $_[1][0] = $idx++ });
+ $csv->print (*STDOUT, [ 0, $_ ]) for @members;
+
+This callback is invoked before printing with L</print> only if no error
+occurred. The callback is invoked with two arguments: the current C<CSV>
+parser object and an array reference to the fields passed.
+
+The return code of the callback is ignored.
+
+ sub max_4_fields
+ {
+ my ($csv, $row) = @_;
+ @$row > 4 and splice @$row, 4;
+ } # max_4_fields
+
+ csv (in => csv (in => "file.csv"), out => *STDOUT,
+ callbacks => { before print => \&max_4_fields });
+
+This callback is not active for L</combine>.
+
+=back
+
+=head3 Callbacks for csv ()
+
+The L</csv> allows for some callbacks that do not integrate in XS internals
+but only feature the L</csv> function.
+
+ csv (in => "file.csv",
+ callbacks => {
+ filter => { 6 => sub { $_ > 15 } }, # first
+ after_parse => sub { say "AFTER PARSE"; }, # first
+ after_in => sub { say "AFTER IN"; }, # second
+ on_in => sub { say "ON IN"; }, # third
+ },
+ );
+
+ csv (in => $aoh,
+ out => "file.csv",
+ callbacks => {
+ on_in => sub { say "ON IN"; }, # first
+ before_out => sub { say "BEFORE OUT"; }, # second
+ before_print => sub { say "BEFORE PRINT"; }, # third
+ },
+ );
+
+=over 2
+
+=item filter
+
+This callback can be used to filter records. It is called just after a new
+record has been scanned. The callback accepts a hashref where the keys are
+the index to the row (the field number, 1-based) and the values are subs to
+return a true or false value.
+
+ csv (in => "file.csv", filter => {
+ 3 => sub { m/a/ }, # third field should contain an "a"
+ 5 => sub { length > 4 }, # length of the 5th field minimal 5
+ });
+
+ csv (in => "file.csv", filter => "not_blank");
+ csv (in => "file.csv", filter => "not_empty");
+ csv (in => "file.csv", filter => "filled");
+
+If the keys to the filter hash contain any character that is not a digit it
+will also implicitly set L</headers> to C<"auto"> unless L</headers> was
+already passed as argument. When headers are active, returning an array of
+hashes, the filter is not applicable to the header itself.
+
+ csv (in => "file.csv", filter => { foo => sub { $_ > 4 }});
+
+All sub results should match, as in AND.
+
+The context of the callback sets C<$_> localized to the field indicated by
+the filter. The two arguments are as with all other callbacks, so the other
+fields in the current row can be seen:
+
+ filter => { 3 => sub { $_ > 100 ? $_[1][1] =~ m/A/ : $_[1][6] =~ m/B/ }}
+
+If the context is set to return a list of hashes (L</headers> is defined),
+the current record will also be available in the localized C<%_>:
+
+ filter => { 3 => sub { $_ > 100 && $_{foo} =~ m/A/ && $_{bar} < 1000 }}
+
+If the filter is used to I<alter> the content by changing C<$_>, make sure
+that the sub returns true in order not to have that record skipped:
+
+ filter => { 2 => sub { $_ = uc }}
+
+will upper-case the second field, and then skip it if the resulting content
+evaluates to false. To always accept, end with truth:
+
+ filter => { 2 => sub { $_ = uc; 1 }}
+
+B<Predefined filters>
+
+Given a file like (line numbers prefixed for doc purpose only):
+
+ 1:1,2,3
+ 2:
+ 3:,
+ 4:""
+ 5:,,
+ 6:, ,
+ 7:"",
+ 8:" "
+ 9:4,5,6
+
+=over 2
+
+=item not_blank
+
+Filter out the blank lines
+
+This filter is a shortcut for
+
+ filter => { 0 => sub { @{$_[1]} > 1 or
+ defined $_[1][0] && $_[1][0] ne "" } }
+
+Due to the implementation, it is currently impossible to also filter lines
+that consists only of a quoted empty field. These lines are also considered
+blank lines.
+
+With the given example, lines 2 and 4 will be skipped.
+
+=item not_empty
+
+Filter out lines where all the fields are empty.
+
+This filter is a shortcut for
+
+ filter => { 0 => sub { grep { defined && $_ ne "" } @{$_[1]} } }
+
+A space is not regarded being empty, so given the example data, lines 2, 3,
+4, 5, and 7 are skipped.
+
+=item filled
+
+Filter out lines that have no visible data
+
+This filter is a shortcut for
+
+ filter => { 0 => sub { grep { defined && m/\S/ } @{$_[1]} } }
+
+This filter rejects all lines that I<not> have at least one field that does
+not evaluate to the empty string.
+
+With the given example data, this filter would skip lines 2 through 8.
+
+=back
+
+=item after_in
+
+This callback is invoked for each record after all records have been parsed
+but before returning the reference to the caller. The hook is invoked with
+two arguments: the current C<CSV> parser object and a reference to the
+record. The reference can be a reference to a HASH or a reference to an
+ARRAY as determined by the arguments.
+
+This callback can also be passed as an attribute without the C<callbacks>
+wrapper.
+
+=item before_out
+
+This callback is invoked for each record before the record is printed. The
+hook is invoked with two arguments: the current C<CSV> parser object and a
+reference to the record. The reference can be a reference to a HASH or a
+reference to an ARRAY as determined by the arguments.
+
+This callback can also be passed as an attribute without the C<callbacks>
+wrapper.
+
+This callback makes the row available in C<%_> if the row is a hashref. In
+this case C<%_> is writable and will change the original row.
+
+=item on_in
+
+This callback acts exactly as the L</after_in> or the L</before_out> hooks.
+
+This callback can also be passed as an attribute without the C<callbacks>
+wrapper.
+
+This callback makes the row available in C<%_> if the row is a hashref. In
+this case C<%_> is writable and will change the original row. So e.g. with
+
+ my $aoh = csv (
+ in => \"foo\n1\n2\n",
+ headers => "auto",
+ on_in => sub { $_{bar} = 2; },
+ );
+
+C<$aoh> will be:
+
+ [ { foo => 1,
+ bar => 2,
+ }
+ { foo => 2,
+ bar => 2,
+ }
+ ]
+
+=item csv
+
+The I<function> L</csv> can also be called as a method or with an existing
+Text::CSV_PP object. This could help if the function is to be invoked a lot
+of times and the overhead of creating the object internally over and over
+again would be prevented by passing an existing instance.
+
+ my $csv = Text::CSV_PP->new ({ binary => 1, auto_diag => 1 });
+
+ my $aoa = $csv->csv (in => $fh);
+ my $aoa = csv (in => $fh, csv => $csv);
+
+both act the same. Running this 20000 times on a 20 lines CSV file, showed
+a 53% speedup.
+
+=back
+
+=head1 DIAGNOSTICS
+
+This section is also taken from Text::CSV_XS.
+
+If an error occurs, C<< $csv->error_diag >> can be used to get information
+on the cause of the failure. Note that for speed reasons the internal value
+is never cleared on success, so using the value returned by L</error_diag>
+in normal cases - when no error occurred - may cause unexpected results.
+
+If the constructor failed, the cause can be found using L</error_diag> as a
+class method, like C<< Text::CSV_PP->error_diag >>.
+
+The C<< $csv->error_diag >> method is automatically invoked upon error when
+the contractor was called with L<C<auto_diag>|/auto_diag> set to C<1> or
+C<2>, or when L<autodie> is in effect. When set to C<1>, this will cause a
+C<warn> with the error message, when set to C<2>, it will C<die>. C<2012 -
+EOF> is excluded from L<C<auto_diag>|/auto_diag> reports.
+
+Errors can be (individually) caught using the L</error> callback.
+
+The errors as described below are available. I have tried to make the error
+itself explanatory enough, but more descriptions will be added. For most of
+these errors, the first three capitals describe the error category:
+
+=over 2
+
+=item *
+INI
+
+Initialization error or option conflict.
+
+=item *
+ECR
+
+Carriage-Return related parse error.
+
+=item *
+EOF
+
+End-Of-File related parse error.
+
+=item *
+EIQ
+
+Parse error inside quotation.
+
+=item *
+EIF
+
+Parse error inside field.
+
+=item *
+ECB
+
+Combine error.
+
+=item *
+EHR
+
+HashRef parse related error.
+
+=back
+
+And below should be the complete list of error codes that can be returned:
+
+=over 2
+
+=item *
+1001 "INI - sep_char is equal to quote_char or escape_char"
+X<1001>
+
+The L<separation character|/sep_char> cannot be equal to L<the quotation
+character|/quote_char> or to L<the escape character|/escape_char>, as this
+would invalidate all parsing rules.
+
+=item *
+1002 "INI - allow_whitespace with escape_char or quote_char SP or TAB"
+X<1002>
+
+Using the L<C<allow_whitespace>|/allow_whitespace> attribute when either
+L<C<quote_char>|/quote_char> or L<C<escape_char>|/escape_char> is equal to
+C<SPACE> or C<TAB> is too ambiguous to allow.
+
+=item *
+1003 "INI - \r or \n in main attr not allowed"
+X<1003>
+
+Using default L<C<eol>|/eol> characters in either L<C<sep_char>|/sep_char>,
+L<C<quote_char>|/quote_char>, or L<C<escape_char>|/escape_char> is not
+allowed.
+
+=item *
+1004 "INI - callbacks should be undef or a hashref"
+X<1004>
+
+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 *
+1008 "INI - SEP undefined"
+X<1008>
+
+The value passed for SEP should be defined and not empty.
+
+=item *
+1010 "INI - the header is empty"
+X<1010>
+
+The header line parsed in the L</header> is empty.
+
+=item *
+1011 "INI - the header contains more than one valid separator"
+X<1011>
+
+The header line parsed in the L</header> contains more than one (unique)
+separator character out of the allowed set of separators.
+
+=item *
+1012 "INI - the header contains an empty field"
+X<1012>
+
+The header line parsed in the L</header> is contains an empty field.
+
+=item *
+1013 "INI - the header contains nun-unique fields"
+X<1013>
+
+The header line parsed in the L</header> contains at least two identical
+fields.
+
+=item *
+1014 "INI - header called on undefined stream"
+X<1014>
+
+The header line cannot be parsed from an undefined sources.
+
+=item *
+1500 "PRM - Invalid/unsupported argument(s)"
+X<1500>
+
+Function or method called with invalid argument(s) or parameter(s).
+
+=item *
+2010 "ECR - QUO char inside quotes followed by CR not part of EOL"
+X<2010>
+
+When L<C<eol>|/eol> has been set to anything but the default, like
+C<"\r\t\n">, and the C<"\r"> is following the B<second> (closing)
+L<C<quote_char>|/quote_char>, where the characters following the C<"\r"> do
+not make up the L<C<eol>|/eol> sequence, this is an error.
+
+=item *
+2011 "ECR - Characters after end of quoted field"
+X<2011>
+
+Sequences like C<1,foo,"bar"baz,22,1> are not allowed. C<"bar"> is a quoted
+field and after the closing double-quote, there should be either a new-line
+sequence or a separation character.
+
+=item *
+2012 "EOF - End of data in parsing input stream"
+X<2012>
+
+Self-explaining. End-of-file while inside parsing a stream. Can happen only
+when reading from streams with L</getline>, as using L</parse> is done on
+strings that are not required to have a trailing L<C<eol>|/eol>.
+
+=item *
+2013 "INI - Specification error for fragments RFC7111"
+X<2013>
+
+Invalid specification for URI L</fragment> specification.
+
+=item *
+2014 "ENF - Inconsistent number of fields"
+X<2014>
+
+Inconsistent number of fields under strict parsing.
+
+=item *
+2021 "EIQ - NL char inside quotes, binary off"
+X<2021>
+
+Sequences like C<1,"foo\nbar",22,1> are allowed only when the binary option
+has been selected with the constructor.
+
+=item *
+2022 "EIQ - CR char inside quotes, binary off"
+X<2022>
+
+Sequences like C<1,"foo\rbar",22,1> are allowed only when the binary option
+has been selected with the constructor.
+
+=item *
+2023 "EIQ - QUO character not allowed"
+X<2023>
+
+Sequences like C<"foo "bar" baz",qu> and C<2023,",2008-04-05,"Foo, Bar",\n>
+will cause this error.
+
+=item *
+2024 "EIQ - EOF cannot be escaped, not even inside quotes"
+X<2024>
+
+The escape character is not allowed as last character in an input stream.
+
+=item *
+2025 "EIQ - Loose unescaped escape"
+X<2025>
+
+An escape character should escape only characters that need escaping.
+
+Allowing the escape for other characters is possible with the attribute
+L</allow_loose_escape>.
+
+=item *
+2026 "EIQ - Binary character inside quoted field, binary off"
+X<2026>
+
+Binary characters are not allowed by default. Exceptions are fields that
+contain valid UTF-8, that will automatically be upgraded if the content is
+valid UTF-8. Set L<C<binary>|/binary> to C<1> to accept binary data.
+
+=item *
+2027 "EIQ - Quoted field not terminated"
+X<2027>
+
+When parsing a field that started with a quotation character, the field is
+expected to be closed with a quotation character. When the parsed line is
+exhausted before the quote is found, that field is not terminated.
+
+=item *
+2030 "EIF - NL char inside unquoted verbatim, binary off"
+X<2030>
+
+=item *
+2031 "EIF - CR char is first char of field, not part of EOL"
+X<2031>
+
+=item *
+2032 "EIF - CR char inside unquoted, not part of EOL"
+X<2032>
+
+=item *
+2034 "EIF - Loose unescaped quote"
+X<2034>
+
+=item *
+2035 "EIF - Escaped EOF in unquoted field"
+X<2035>
+
+=item *
+2036 "EIF - ESC error"
+X<2036>
+
+=item *
+2037 "EIF - Binary character in unquoted field, binary off"
+X<2037>
+
+=item *
+2110 "ECB - Binary character in Combine, binary off"
+X<2110>
+
+=item *
+2200 "EIO - print to IO failed. See errno"
+X<2200>
+
+=item *
+3001 "EHR - Unsupported syntax for column_names ()"
+X<3001>
+
+=item *
+3002 "EHR - getline_hr () called before column_names ()"
+X<3002>
+
+=item *
+3003 "EHR - bind_columns () and column_names () fields count mismatch"
+X<3003>
+
+=item *
+3004 "EHR - bind_columns () only accepts refs to scalars"
+X<3004>
+
+=item *
+3006 "EHR - bind_columns () did not pass enough refs for parsed fields"
+X<3006>
+
+=item *
+3007 "EHR - bind_columns needs refs to writable scalars"
+X<3007>
+
+=item *
+3008 "EHR - unexpected error in bound fields"
+X<3008>
+
+=item *
+3009 "EHR - print_hr () called before column_names ()"
+X<3009>
+
+=item *
+3010 "EHR - print_hr () called with invalid arguments"
+X<3010>
+
+=back
+
+=head1 SEE ALSO
+
+L<Text::CSV_XS>, L<Text::CSV>
+
+Older versions took many regexp from L<http://www.din.or.jp/~ohzaki/perl.htm>
+
+=head1 AUTHOR
+
+Kenichi Ishigaki, E<lt>ishigaki[at]cpan.orgE<gt>
+Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
+
+Text::CSV_XS was written by E<lt>joe[at]ispsoft.deE<gt>
+and maintained by E<lt>h.m.brand[at]xs4all.nlE<gt>.
+
+Text::CSV was written by E<lt>alan[at]mfgrtl.comE<gt>.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2017- by Kenichi Ishigaki, E<lt>ishigaki[at]cpan.orgE<gt>
+Copyright 2005-2015 by Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
+
+Most of the code and doc is directly taken from the pure perl part of
+Text::CSV_XS.
+
+Copyright (C) 2007-2016 H.Merijn Brand. All rights reserved.
+Copyright (C) 1998-2001 Jochen Wiedmann. All rights reserved.
+Copyright (C) 1997 Alan Citterman. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut