File Coverage

blib/lib/Text/CSV_PP.pm

Criterion	Covered	Total	%
statement	1856	1993	93.1
branch	1359	1550	87.6
condition	866	1065	81.2
subroutine	136	136	100.0
pod	68	69	98.5
total	4285	4813	89.0

package Text::CSV_PP;

################################################################################
#
# Text::CSV_PP - Text::CSV_XS compatible pure-Perl module
#
################################################################################
require 5.006001;

use strict;
use Exporter ();
use vars     qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
use Carp;

$VERSION = '2.06';
@ISA     = qw(Exporter);

sub PV { 0 }
sub IV { 1 }
sub NV { 2 }

sub CSV_TYPE_PV { PV }
sub CSV_TYPE_IV { IV }
sub CSV_TYPE_NV { NV }

sub IS_QUOTED ()  { 0x0001; }
sub IS_BINARY ()  { 0x0002; }
sub IS_ERROR ()   { 0x0004; }
sub IS_MISSING () { 0x0010; }

sub CSV_FLAGS_IS_QUOTED      { IS_QUOTED }
sub CSV_FLAGS_IS_BINARY      { IS_BINARY }
sub CSV_FLAGS_ERROR_IN_FIELD { IS_ERROR }
sub CSV_FLAGS_IS_MISSING     { IS_MISSING }

sub HOOK_ERROR ()        { 0x0001; }
sub HOOK_AFTER_PARSE ()  { 0x0002; }
sub HOOK_BEFORE_PRINT () { 0x0004; }

sub EOL_TYPE_UNDEF () { 0 }
sub EOL_TYPE_NL ()    { 1 }
sub EOL_TYPE_CR ()    { 2 }
sub EOL_TYPE_CRNL ()  { 3 }
sub EOL_TYPE_OTHER () { 4 }

sub useIO_EOF () { 0x0010; }

%EXPORT_TAGS = (
    CONSTANTS => [qw(
            CSV_FLAGS_IS_QUOTED
            CSV_FLAGS_IS_BINARY
            CSV_FLAGS_ERROR_IN_FIELD
            CSV_FLAGS_IS_MISSING

            CSV_TYPE_PV
            CSV_TYPE_IV
            CSV_TYPE_NV
    )],
);
@EXPORT_OK = (qw(csv PV IV NV), @{$EXPORT_TAGS{'CONSTANTS'}});

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)",
    1501 => "PRM - The key attribute is passed as an unsupported type",
    1502 => "PRM - The value attribute is passed without the key attribute",
    1503 => "PRM - The value attribute is passed as an unsupported type",

    # 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",
    2015 => "ERW - Empty row",
    2016 => "EOL - Inconsistent EOL",

    # 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",

    4001 => "PRM - The key does not exist as field in the data",

    5001 => "PRM - The result does not match the output to append to",
    5002 => "PRM - Unsupported output",

    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,
    strict_eol            => 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,
    formula               => 0,
    skip_empty_rows       => 0,
    undef_str             => undef,
    comment_str           => undef,
    types                 => undef,
    callbacks             => undef,

    _EOF           => "",
    _RECNO         => 0,
    _STATUS        => undef,
    _FIELDS        => undef,
    _FFLAGS        => undef,
    _STRING        => undef,
    _ERROR_INPUT   => undef,
    _COLUMN_NAMES  => undef,
    _BOUND_COLUMNS => undef,
    _AHEAD         => undef,
    _FORMULA_CB    => undef,
    _EMPTROW_CB    => undef,

    ENCODING => undef,
);

my %attr_alias = (
    quote_always => "always_quote",
    verbose_diag => "diag_verbose",
    quote_null   => "escape_null",
    escape       => "escape_char",
    comment      => "comment_str",
);

my $last_err = Text::CSV_PP->SetDiag(0);
my $ebcdic   = ord("A") == 0xC1;        # Faster than $Config{'ebcdic'}
my @internal_kh;

# NOT a method: is also used before bless
sub _unhealthy_whitespace {
    my ($self, $aw) = @_;
    $aw 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]/ and return 1002;
    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
    $sep ne "" or return 1008;
    length($sep) > 16 and return 1006;
    $sep =~ m/[\r\n]/ and return 1003;

    if (defined $quo) {
        $quo eq $sep      and return 1001;
        length($quo) > 16 and return 1007;
        $quo =~ m/[\r\n]/ and return 1003;
    }
    if (defined $esc) {
        $esc eq $sep and return 1001;
        $esc =~ m/[\r\n]/ and return 1003;
    }
    if (defined $eol) {
        length($eol) > 16 and return 1005;
    }

    return _unhealthy_whitespace($self, $self->{allow_whitespace});
}

sub known_attributes {
    sort grep !m/^_/ => "sep", "quote", keys %def_attr;
}

sub new {
    $last_err = 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;
    }
    exists $attr{formula_handling} and
        $attr{formula} = delete $attr{formula_handling};
    my $attr_formula = delete $attr{formula};

    for (keys %attr) {
        if (m/^[a-z]/ && exists $def_attr{$_}) {
            # uncoverable condition false
            defined $attr{$_} && m/_char$/ and utf8::decode($attr{$_});
            next;
        }
#        croak?
        $last_err = Text::CSV_PP->SetDiag(1000, "INI - Unknown attribute '$_'");
        $attr{auto_diag} and error_diag();
        return;
    }
    if ($sep_aliased) {
        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_err = Text::CSV_PP->SetDiag($ec);
        $attr{auto_diag} and error_diag();
        return;
    }
    if (defined $self->{callbacks} && ref $self->{callbacks} ne "HASH") {
        carp("The 'callbacks' attribute is set but is not a hash: ignored\n");
        $self->{callbacks} = undef;
    }

    $last_err = Text::CSV_PP->SetDiag(0);
    defined $\ && !exists $attr{eol} and $self->{eol} = $\;
    bless $self, $class;
    defined $self->{'types'}           and $self->types($self->{'types'});
    defined $self->{'skip_empty_rows'} and $self->{'skip_empty_rows'} = _supported_skip_empty_rows($self, $self->{'skip_empty_rows'});
    defined $attr_formula              and $self->{'formula'}         = _supported_formula($self, $attr_formula);
    $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,
    always_quote          => 4,
    quote_empty           => 5,
    quote_space           => 6,
    quote_binary          => 7,
    allow_loose_quotes    => 8,
    allow_loose_escapes   => 9,
    allow_unquoted_escape => 10,
    allow_whitespace      => 11,
    blank_is_undef        => 12,
    empty_is_undef        => 13,
    auto_diag             => 14,
    diag_verbose          => 15,
    escape_null           => 16,
    formula               => 18,
    decode_utf8           => 21,
    verbatim              => 23,
    strict_eol            => 24,
    eol_type              => 27,
    strict                => 28,
    skip_empty_rows       => 29,
    binary                => 30,
    keep_meta_info        => 31,
    _has_hooks            => 32,
    _has_ahead            => 33,
    _is_bound             => 44,
    eol                   => 100,
    sep                   => 116,
    quote                 => 132,
    undef_str             => 148,
    comment_str           => 156,
    types                 => 92,
);

my %_hidden_cache_id = (
    has_error_input => 20,
    eol_is_cr       => 26,
    eol_len         => 36,
    sep_len         => 37,
    quo_len         => 38,
);

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 and 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;
    if (@_) {
        my $ec = shift;
        $self->_set_attr_C("escape_char", $ec);
        $ec or $self->_set_attr_X("escape_null", 0);
    }
    $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 = ""; # Also reset strict_eol?
        length($eol) > 16 and croak($self->SetDiag(1005));
        $self->{eol} = $eol;
        $self->_cache_set($_cache_id{eol}, $eol);
    }
    $self->{eol};
}

sub eol_type {
    my $self = shift;
    $self->_cache_get_eolt;
}

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 strict_eol {
    my $self = shift;
    @_ and $self->_set_attr_X("strict_eol", shift);
    $self->{'strict_eol'};
}

sub _supported_skip_empty_rows {
    my ($self, $f) = @_;
    defined $f or return 0;
    if ($self && $f && ref $f && ref $f eq "CODE") {
        $self->{'_EMPTROW_CB'} = $f;
        return 6;
    }
    $f     =~ m/^(?: 0 | undef         )$/xi ? 0 :
        $f =~ m/^(?: 1 | skip          )$/xi ? 1 :
        $f =~ m/^(?: 2 | eof   | stop  )$/xi ? 2 :
        $f =~ m/^(?: 3 | die           )$/xi ? 3 :
        $f =~ m/^(?: 4 | croak         )$/xi ? 4 :
        $f =~ m/^(?: 5 | error         )$/xi ? 5 :
        $f =~ m/^(?: 6 | cb            )$/xi ? 6 : do {
            $self ||= "Text::CSV_PP";
            croak($self->_SetDiagInfo(1500, "skip_empty_rows '$f' is not supported"));
        };
}

sub skip_empty_rows {
    my $self = shift;
    @_ and $self->_set_attr_N("skip_empty_rows", _supported_skip_empty_rows($self, shift));
    my $ser = $self->{'skip_empty_rows'};
    $ser == 6 or $self->{'_EMPTROW_CB'} = undef;
    $ser <= 1 ? $ser : $ser == 2 ? "eof" : $ser == 3 ? "die" :
        $ser == 4 ? "croak" : $ser == 5 ? "error" :
        $self->{'_EMPTROW_CB'};
}

sub _SetDiagInfo {
    my ($self, $err, $msg) = @_;
    $self->SetDiag($err);
    my $em = $self->error_diag();
    $em =~ s/^\d+$// and $msg =~ s/^/# /;
    my $sep = $em =~ m/[;\n]$/ ? "\n\t" : ": ";
    join $sep => grep m/\S\S\S/ => $em, $msg;
}

sub _supported_formula {
    my ($self, $f) = @_;
    defined $f or return 5;
    if ($self && $f && ref $f && ref $f eq "CODE") {
        $self->{_FORMULA_CB} = $f;
        return 6;
    }
    $f     =~ m/^(?: 0 | none    )$/xi ? 0 :
        $f =~ m/^(?: 1 | die     )$/xi ? 1 :
        $f =~ m/^(?: 2 | croak   )$/xi ? 2 :
        $f =~ m/^(?: 3 | diag    )$/xi ? 3 :
        $f =~ m/^(?: 4 | empty | )$/xi ? 4 :
        $f =~ m/^(?: 5 | undef   )$/xi ? 5 :
        $f =~ m/^(?: 6 | cb      )$/xi ? 6 : do {
            $self ||= "Text::CSV_PP";
            croak($self->_SetDiagInfo(1500, "formula-handling '$f' is not supported"));
        };
}

sub formula {
    my $self = shift;
    @_ and $self->_set_attr_N("formula", _supported_formula($self, shift));
    $self->{formula} == 6 or $self->{_FORMULA_CB} = undef;
    [qw( none die croak diag empty undef cb )]->[_supported_formula($self, $self->{formula})];
}
sub formula_handling {
    my $self = shift;
    $self->formula(@_);
}

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 undef_str {
    my $self = shift;
    if (@_) {
        my $v = shift;
        $self->{undef_str} = defined $v ? "$v" : undef;
        $self->_cache_set($_cache_id{undef_str}, $self->{undef_str});
    }
    $self->{undef_str};
}

sub comment_str {
    my $self = shift;
    if (@_) {
        my $v = shift;
        $self->{comment_str} = defined $v ? "$v" : undef;
        $self->_cache_set($_cache_id{comment_str}, $self->{comment_str});
    }
    $self->{comment_str};
}

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 {
    my $self = shift;
    return $self->{_STATUS};
}

sub eof {
    my $self = shift;
    return $self->{_EOF};
}

sub types {
    my $self = shift;

    if (@_) {
        if (my $types = shift) {
            $self->{'_types'} = join "", map { chr } @{$types};
            $self->{'types'}  = $types;
            $self->_cache_set($_cache_id{'types'}, $self->{'_types'});
        }
        else {
            delete $self->{'types'};
            delete $self->{'_types'};
            $self->_cache_set($_cache_id{'types'}, undef);
            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}) {
                # A key cannot be a ref. That would be stored as the *string
                # 'SCALAR(0x1f3e710)' or 'ARRAY(0x1a5ae18)'
                $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_err, $last_err, 0, 0, 0, 0);

    # Docs state to NEVER use UNIVERSAL::isa, because it will *never* call an
    # overridden isa method in any class. Well, that is exacly what I want here
    if ($self && ref $self and # Not a class method or direct call
        UNIVERSAL::isa($self, __PACKAGE__) && exists $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[5] = $self->{_ERROR_SRC} if exists $self->{_ERROR_SRC} && $self->{diag_verbose};

        $diag[0] && $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]/;
            $diag[5] and $msg =~ s/$/ (PP#$diag[5])/;

            unless ($self && ref $self) { # auto_diag
                # called without args in void context
                warn $msg;
                return;
            }

            $self->{diag_verbose} && $self->{_ERROR_INPUT} and
                $msg .= $self->{_ERROR_INPUT} . "\n" .
                (" " x ($diag[2] - 1)) . "^\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 {
    my $self = shift;
    return $self->{_RECNO};
}

################################################################################
# string
################################################################################

*string = \&_string;
sub _string {
    my $self = shift;
    return ref $self->{_STRING} ? ${$self->{_STRING}} : undef;
}

################################################################################
# fields
################################################################################

*fields = \&_fields;
sub _fields {
    my $self = shift;
    return ref $self->{_FIELDS} ? @{$self->{_FIELDS}} : undef;
}

################################################################################
# meta_info
################################################################################

sub meta_info {
    my $self = shift;
    return ref $self->{_FFLAGS} ? @{$self->{_FFLAGS}} : undef;
}

sub is_quoted {
    my ($self, $idx) = @_;
    ref $self->{_FFLAGS} &&
        $idx >= 0 && $idx < @{$self->{_FFLAGS}} or return;
    $self->{_FFLAGS}[$idx] & CSV_FLAGS_IS_QUOTED() ? 1 : 0;
}

sub is_binary {
    my ($self, $idx) = @_;
    ref $self->{_FFLAGS} &&
        $idx >= 0 && $idx < @{$self->{_FFLAGS}} or return;
    $self->{_FFLAGS}[$idx] & CSV_FLAGS_IS_BINARY() ? 1 : 0;
}

sub is_missing {
    my ($self, $idx) = @_;
    $idx < 0 || !ref $self->{_FFLAGS} and return;
    $idx >= @{$self->{_FFLAGS}} and return 1;
    $self->{_FFLAGS}[$idx] & CSV_FLAGS_IS_MISSING() ? 1 : 0;
}

################################################################################
# combine
################################################################################
*combine = \&_combine;
sub _combine {
    my $self = shift;
    my $str  = "";
    $self->{_FIELDS} = \@_;
    $self->{_STATUS} = (@_ > 0) && $self->__combine(\$str, \@_, 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, @keys) = @_;

    @keys or
        return defined $self->{_COLUMN_NAMES} ? @{$self->{_COLUMN_NAMES}} : ();
    @keys == 1 && !defined $keys[0] and
        return $self->{_COLUMN_NAMES} = undef;

    if (@keys == 1 && ref $keys[0] eq "ARRAY") {
        @keys = @{$keys[0]};
    }
    elsif (join "", map { defined $_ ? ref $_ : "" } @keys) {
        croak($self->SetDiag(3001));
    }

    $self->{_BOUND_COLUMNS} && @keys != @{$self->{_BOUND_COLUMNS}} and
        croak($self->SetDiag(3003));

    $self->{_COLUMN_NAMES} = [map { defined $_ ? $_ : "\cAUNDEF\cA" } @keys];
    @{$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('usage: $csv->header ($fh, [ seps ], { options })');
    }

    defined $args{munge} && !defined $args{munge_column_names} and
        $args{munge_column_names} = $args{munge}; # munge as alias
    defined $args{detect_bom}         or $args{detect_bom}         = 1;
    defined $args{set_column_names}   or $args{set_column_names}   = 1;
    defined $args{munge_column_names} or $args{munge_column_names} = "lc";

    # Reset any previous leftovers
    $self->{_RECNO}         = 0;
    $self->{_AHEAD}         = undef;
    $self->{_COLUMN_NAMES}  = undef if $args{set_column_names};
    $self->{_BOUND_COLUMNS} = undef if $args{set_column_names};
    $self->_cache_set($_cache_id{'_has_ahead'}, 0);

    if (defined $args{sep_set}) {
        ref $args{sep_set} eq "ARRAY" or
            croak($self->_SetDiagInfo(1500, "sep_set should be an array ref"));
        @seps = @{$args{sep_set}};
    }

    $^O eq "MSWin32" and binmode $fh;
    my $hdr = <$fh>;
    # check if $hdr can be empty here, I don't think so
    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" }
        elsif ($hdr =~ s/^\x{feff}//)         { $enc = "" }

        $self->{ENCODING} = $enc ? uc $enc : undef;

        $hdr eq "" and croak($self->SetDiag(1010));

        if ($enc) {
            $ebcdic && $enc eq "utf-ebcdic" and $enc = "";
            if ($enc =~ m/([13]).le$/) {
                my $l = 0 + $1;
                my $x;
                $hdr .= "\0" x $l;
                read $fh, $x, $l;
            }
            if ($enc) {
                if ($enc ne "utf-8") {
                    require Encode;
                    $hdr = Encode::decode($enc, $hdr);
                }
                binmode $fh, ":encoding($enc)";
            }
        }
    }

    my ($ahead, $eol);
    if ($hdr and $hdr =~ s/\Asep=(\S)([\r\n]+)//i) { # Also look in xs:Parse
        $self->sep($1);
        length $hdr or $hdr = <$fh>;
    }

    if ($hdr =~ s/^([^\r\n]+)([\r\n]+)([^\r\n].+)\z/$1/s) {
        $eol   = $2;
        $ahead = $3;
    }

    my $hr = \$hdr;                                  # Will cause croak on perl-5.6.x
    open my $h, "<", $hr or croak($self->SetDiag(1010));

    my $row = $self->getline($h) or croak();
    close $h;

    if ($args{'munge_column_names'} eq "lc") {
        $_ = lc for @{$row};
    }
    elsif ($args{'munge_column_names'} eq "uc") {
        $_ = uc for @{$row};
    }
    elsif ($args{'munge_column_names'} eq "db") {
        for (@{$row}) {
            s/\W+/_/g;
            s/^_+//;
            $_ = lc;
        }
    }

    if ($ahead) { # Must be after getline, which creates the cache
        $self->_cache_set($_cache_id{_has_ahead}, 1);
        $self->{_AHEAD} = $ahead;
        $eol =~ m/^\r([^\n]|\z)/ and $self->eol($eol);
    }

    my @hdr = @{$row};
    ref $args{munge_column_names} eq "CODE" and
        @hdr = map { $args{munge_column_names}->($_) } @hdr;
    ref $args{munge_column_names} eq "HASH" and
        @hdr = map { $args{munge_column_names}->{$_} || $_ } @hdr;
    my %hdr; $hdr{$_}++ for @hdr;
    exists $hdr{''} and croak($self->SetDiag(1012));
    unless (keys %hdr == @hdr) {
        croak($self->_SetDiagInfo(1013, join ", " =>
                    map { "$_ ($hdr{$_})" } grep { $hdr{$_} > 1 } keys %hdr));
    }
    $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;
    if (@refs == 1 && !defined $refs[0]) {
        $self->{_COLUMN_NAMES} = undef;
        return $self->{_BOUND_COLUMNS} = undef;
    }

    $self->{_COLUMN_NAMES} && @refs != @{$self->{_COLUMN_NAMES}} and
        croak($self->SetDiag(3003));
    join "", map { ref $_ eq "SCALAR" ? "" : "*" } @refs and
        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}[$_] = CSV_FLAGS_IS_MISSING()
            for (@{$fr} ? $#{$fr} + 1 : 0) .. $#{$self->{_COLUMN_NAMES}};
        @{$fr} == 1 && (!defined $fr->[0] || $fr->[0] eq "") and
            $self->{_FFLAGS}[0] ||= CSV_FLAGS_IS_MISSING();
    }
    @hr{@{$self->{_COLUMN_NAMES}}} = @{$fr};
    \%hr;
}

sub getline_hr_all {
    my ($self, @args) = @_;

    $self->{_COLUMN_NAMES} or croak($self->SetDiag(3002));

    my @cn = @{$self->{_COLUMN_NAMES}};

    [map { my %h; @h{@cn} = @{$_}; \%h } @{$self->getline_all(@args)}];
}

sub say {
    my ($self, $io, @f) = @_;
    my $eol = $self->eol();
    # say ($fh, undef) does not propage actual undef to print ()
    my $state = $self->print($io, @f == 1 && !defined $f[0] ? undef : @f);
    unless (length $eol) {
        $eol = $self->eol_type() || $\ || $/;
        print $io $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);
        # $to cannot be <= 0 due to regex and ||=
        $from <= 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;
    $attr{strict_eol} = 1;

    my $enc = delete $attr{enc} || delete $attr{encoding} || "";
    $enc eq "auto" and ($attr{detect_bom}, $enc) = (1, "");
    my $stack = $enc =~ s/(:\w.*)// ? $1 : "";
    $enc =~ m/^[-\w.]+$/ and $enc = ":encoding($enc)";
    $enc .= $stack;

    my $hdrs = delete $attr{'headers'};
    my $frag = delete $attr{'fragment'};
    my $key  = delete $attr{'key'};
    my $val  = delete $attr{'value'};
    my $kh   = delete $attr{'keep_headers'} ||
        delete $attr{'keep_column_names'} ||
        delete $attr{'kh'};

    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 $cboe = delete $attr{'callbacks'}{'on_error'} ||
        delete $attr{'on_error'};

    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'};

    my $fh;
    my $sink = 0;
    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  = exists $attr{out} && !$attr{out} ? \"skip"
        :   delete $attr{out} || delete $attr{file};

    ref $in eq "CODE" || ref $in eq "ARRAY" and $out ||= \*STDOUT;

    my ($fho, $fho_cls);
    if ($in && $out and (!ref $in || ref $in eq "GLOB" || ref \$in eq "GLOB")
        and (!ref $out || ref $out eq "GLOB" || ref \$out eq "GLOB")) {
        if (ref $out or "GLOB" eq ref \$out) {
            $fho = $out;
        }
        else {
            open $fho, ">", $out or croak "$out: $!\n";
            if (my $e = $attr{'encoding'}) {
                binmode $fho, ":encoding($e)";
                $hd_b and print $fho "\x{feff}";
            }
            $fho_cls = 1;
        }
        if ($cboi && !$cbai) {
            $cbai = $cboi;
            $cboi = undef;
        }
        if ($cbai) {
            my $cb = $cbai;
            $cbai = sub { $cb->(@_); $_[0]->say($fho, $_[1]); 0 };
        }
        else {
            $cbai = sub { $_[0]->say($fho, $_[1]); 0 };
        }

        # Put all callbacks back in place for streaming behavior
        $attr{'callbacks'}{'after_parse'} = $cbai; $cbai = undef;
        $attr{'callbacks'}{'before_out'}  = $cbbo; $cbbo = undef;
        $attr{'callbacks'}{'on_in'}       = $cboi; $cboi = undef;
        $attr{'callbacks'}{'on_error'}    = $cboe; $cboe = undef;
        $out                              = undef;
        $sink                             = 1;
    }

    if ($out) {
        if (ref $out and ("ARRAY" eq ref $out or "HASH" eq ref $out)) {
            delete $attr{out};
            $sink = 1;
        }
        elsif ((ref $out and "SCALAR" ne ref $out) or "GLOB" eq ref \$out) {
            $fh = $out;
        }
        elsif (ref $out and "SCALAR" eq ref $out and defined ${$out} and ${$out} eq "skip") {
            delete $attr{out};
            $sink = 1;
        }
        else {
            open $fh, ">", $out or croak("$out: $!");
            $cls = 1;
        }
        if ($fh) {
            if ($enc) {
                binmode $fh, $enc;
                my $fn = fileno $fh; # This is a workaround for a bug in PerlIO::via::gzip
            }
            unless (defined $attr{eol} || defined $fho) {
                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 || $sink or croak(qq{No valid source passed. "in" is required});

    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 "CODE" and $fltr = {0 => $fltr};
    ref $fltr eq "HASH" or $fltr = undef;

    my $form = delete $attr{formula};

    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_err);
    defined $form and $csv->formula($form);
    defined $cboe and $csv->callbacks(error => $cboe);

    $kh && !ref $kh && $kh =~ m/^(?:1|yes|true|internal|auto)$/i and
        $kh = \@internal_kh;

    return {
        csv  => $csv,
        attr => {%attr},
        fh   => $fh,
        cls  => $cls,
        in   => $in,
        sink => $sink,
        out  => $out,
        enc  => $enc,
        fho  => $fho,
        fhoc => $fho_cls,
        hdrs => $hdrs,
        key  => $key,
        val  => $val,
        kh   => $kh,
        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}{qw( csv in fh hdrs )};
    my %hdr;
    if (ref $hdrs eq "HASH") {
        %hdr  = %{$hdrs};
        $hdrs = "auto";
    }

    if ($c->{out} && !$c->{sink}) {
        !$hdrs && ref $c->{'kh'} && $c->{'kh'} == \@internal_kh and
            $hdrs = $c->{'kh'};

        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 (@{$in} == 0 or 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 @hdrs 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;
        $c->{fho_cls} and close $c->{fho};
        return 1;
    }

    my @row1;
    if (defined $c->{hd_s} || defined $c->{hd_b} || defined $c->{hd_m} || defined $c->{hd_c}) {
        my %harg;
        !defined $c->{'hd_s'} && $c->{'attr'}{'sep_char'} and
            $c->{'hd_s'} = [$c->{'attr'}{'sep_char'}];
        !defined $c->{'hd_s'} && $c->{'attr'}{'sep'} and
            $c->{'hd_s'} = [$c->{'attr'}{'sep'}];
        defined $c->{'hd_s'} and $harg{'sep_set'}            = $c->{'hd_s'};
        defined $c->{'hd_b'} 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'};
        @row1 = $csv->header($fh, \%harg);
        my @hdr = $csv->column_names();
        @hdr and $hdrs ||= \@hdr;
    }

    if ($c->{kh}) {
        @internal_kh = ();
        ref $c->{kh} eq "ARRAY" or croak($csv->SetDiag(1501));
        $hdrs ||= "auto";
    }

    my $key = $c->{key};
    if ($key) {
        !ref $key or ref $key eq "ARRAY" && @{$key} > 1 or croak($csv->SetDiag(1501));
        $hdrs ||= "auto";
    }
    my $val = $c->{val};
    if ($val) {
        $key or croak($csv->SetDiag(1502));
        !ref $val or ref $val eq "ARRAY" && @{$val} > 0 or croak($csv->SetDiag(1503));
    }

    $c->{fltr} && grep m/\D/ => keys %{$c->{fltr}} and $hdrs ||= "auto";
    if (defined $hdrs) {
        if (!ref $hdrs or ref $hdrs eq "CODE") {
            my $h = $c->{'hd_b'}
                ? [$csv->column_names()]
                : $csv->getline($fh);
            my $has_h = $h && @$h;

            if (ref $hdrs) {
                $has_h or return;
                my $cr = $hdrs;
                $hdrs = [map { $cr->($hdr{$_} || $_) } @{$h}];
            }
            elsif ($hdrs eq "skip") {
                # discard;
            }
            elsif ($hdrs eq "auto") {
                $has_h or return;
                $hdrs = [map { $hdr{$_} || $_ } @{$h}];
            }
            elsif ($hdrs eq "lc") {
                $has_h or return;
                $hdrs = [map { lc($hdr{$_} || $_) } @{$h}];
            }
            elsif ($hdrs eq "uc") {
                $has_h or return;
                $hdrs = [map { uc($hdr{$_} || $_) } @{$h}];
            }
        }
        $c->{kh} and $hdrs and @{$c->{kh}} = @{$hdrs};
    }

    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 {
            my @h = $csv->column_names($hdrs);
            my %h; $h{$_}++ for @h;
            exists $h{''} and croak($csv->SetDiag(1012));
            unless (keys %h == @h) {
                croak($csv->_SetDiagInfo(1013, join ", " =>
                        map { "$_ ($h{$_})" } grep { $h{$_} > 1 } keys %h));
            }
            $frag ? $csv->fragment($fh, $frag) :
            $key  ? do {
                my ($k, $j, @f) = ref $key ? (undef, @{$key}) : ($key);
                if (my @mk = grep { !exists $h{$_} } grep { defined } $k, @f) {
                    croak($csv->_SetDiagInfo(4001, join ", " => @mk));
                }
                +{map {
                        my $r = $_;
                        my $K = defined $k ? $r->{$k} : join $j => @{$r}{@f};
                        ($K => (
                                $val
                                ? ref $val
                                    ? {map { $_ => $r->{$_} } @{$val}}
                                    : $r->{$val}
                                : $r));
                } @{$csv->getline_hr_all($fh)}};
            }
            : $csv->getline_hr_all($fh);
        }
        : # aoa
        $frag ? $csv->fragment($fh, $frag)
        :       $csv->getline_all($fh);
    if ($ref) {
        @row1 && !$c->{hd_c} && !ref $hdrs and unshift @{$ref}, \@row1;
    }
    else {
        Text::CSV_PP->auto_diag();
    }
    $c->{cls}     and close $fh;
    $c->{fho_cls} and close $c->{fho};
    if ($ref and $c->{cbai} || $c->{cboi}) {
        # Default is ARRAYref, but with key =>, you'll get a hashref
        foreach my $r (ref $ref eq "ARRAY" ? @{$ref} : values %{$ref}) {
            local %_;
            ref $r eq "HASH" and *_ = $r;
            $c->{cbai} and $c->{cbai}->($csv, $r);
            $c->{cboi} and $c->{cboi}->($csv, $r);
        }
    }

    if ($c->{sink}) {
        my $ro = ref $c->{out} or return;

        $ro eq "SCALAR" && ${$c->{out}} eq "skip" and
            return;

        $ro eq ref $ref or
            croak($csv->_SetDiagInfo(5001, "Output type mismatch"));

        if ($ro eq "ARRAY") {
            if (@{$c->{out}} and @$ref and ref $c->{out}[0] eq ref $ref->[0]) {
                push @{$c->{out}} => @$ref;
                return $c->{out};
            }
            croak($csv->_SetDiagInfo(5001, "Output type mismatch"));
        }

        if ($ro eq "HASH") {
            @{$c->{out}}{keys %{$ref}} = values %{$ref};
            return $c->{out};
        }

        croak($csv->_SetDiagInfo(5002, "Unsupported output type"));
    }

    defined wantarray or
        return csv(
            in      => $ref,
            headers => $hdrs,
            %{$c->{attr}},
        );

    $last_err ||= $csv->{_ERROR_DIAG};
    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
#
################################################################################

my $last_error;
sub _setup_ctx {
    my $self = shift;

    $last_error = undef;

    my $ctx;
    if ($self->{_CACHE}) {
        %$ctx = %{$self->{_CACHE}};
    } else {
        $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;
                $ctx->{eol_type}  = EOL_TYPE_CR;
            }
            elsif ($eol_len == 1 && $eol eq "\012") {
                $ctx->{eol_type} = EOL_TYPE_NL;
            }
            elsif ($eol_len == 2 && $eol eq "\015\012") {
                $ctx->{eol_type} = EOL_TYPE_CRNL;
            }
        }

        $ctx->{undef_flg} = 0;
        if (defined $self->{undef_str}) {
            $ctx->{undef_str} = $self->{undef_str};
            $ctx->{undef_flg} = 3 if utf8::is_utf8($self->{undef_str});
        } else {
            $ctx->{undef_str} = undef;
        }
        if (defined $self->{comment_str}) {
            $ctx->{comment_str} = $self->{comment_str};
        }

        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 strict_eol 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 formula skip_empty_rows
            /) {
            $ctx->{$_} = defined $self->{$_} ? $self->{$_} : 0;
        }
        for (qw/quote_space escape_null quote_binary/) {
            $ctx->{$_} = defined $self->{$_} ? $self->{$_} : 1;
        }
        if ($ctx->{escape_char} eq "\0") {
            $ctx->{escape_null} = 0;
        }

        # 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->{eol_type} && $ctx->{strict_eol} && !$ctx->{eol}) {
        $ctx->{eol_is_cr} = 0;
    }
    if ($ctx->{sep_len} and $ctx->{sep_len} > 1 and _is_valid_utf8($ctx->{sep})) {
        $ctx->{utf8} = 1;
    }
    if ($ctx->{quo_len} and $ctx->{quo_len} > 1 and _is_valid_utf8($ctx->{quo})) {
        $ctx->{utf8} = 1;
    }

    if ($ctx->{strict} && !$ctx->{strict_n} && $self->{_COLUMN_NAMES} && ref $self->{_COLUMN_NAMES} eq 'ARRAY') {
        $ctx->{strict_n} = @{$self->{_COLUMN_NAMES}};
    }
    $ctx;
}

sub _eol_type {
    my $c = shift;
    return EOL_TYPE_NL if $c eq "\012";
    return EOL_TYPE_CR if $c eq "\015";
    return EOL_TYPE_OTHER;
}

sub _set_eol_type {
    my ($self, $ctx, $type) = @_;
    if (!$ctx->{eol_type}) {
        $ctx->{eol_type} = $type;
        $self->_cache_set($_cache_id{eol_type} => $type);
    }
}

sub _cache_get_eolt {
    my $self = shift;
    return unless exists $self->{_CACHE};
    my $cache = $self->{_CACHE};

    my $eol_type = $cache->{eol_type} || 0;
    return "\012"        if $eol_type == EOL_TYPE_NL;
    return "\015"        if $eol_type == EOL_TYPE_CR;
    return "\015\012"    if $eol_type == EOL_TYPE_CRNL;
    return $cache->{eol} if $eol_type == EOL_TYPE_OTHER;
    return;
}

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_ahead') {
        $cache->{has_ahead} = $value;
    }
    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;
        $cache->{eol_len}  = my $len = defined $value ? length($value) : 0;
        $cache->{eol_type} = $len == 0                ? EOL_TYPE_UNDEF
            : $len == 1 && $value eq "\012"     ? EOL_TYPE_NL
            : $len == 1 && $value eq "\015"     ? EOL_TYPE_CR
            : $len == 2 && $value eq "\015\012" ? EOL_TYPE_CRNL
            :                                     EOL_TYPE_OTHER;
        $cache->{eol_is_cr} = $cache->{eol_type} == EOL_TYPE_CR ? 1 : 0;
    }
    elsif ($key eq 'undef_str') {
        if (defined $value) {
            $cache->{undef_str} = $value;
            $cache->{undef_flg} = 3 if utf8::is_utf8($value);
        } else {
            $cache->{undef_str} = undef;
            $cache->{undef_flg} = 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_unquoted_escape
        allow_whitespace always_quote quote_empty quote_space
        escape_null quote_binary auto_diag diag_verbose formula strict strict_n strict_eol eol_type skip_empty_rows
        has_error_input blank_is_undef empty_is_undef has_ahead
        keep_meta_info verbatim useIO 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});
    }
    if ($cache->{types_len}) {
        $self->__cache_show_str(types => $cache->{types_len}, $cache->{types});
    } else {
        $self->__cache_show_str(types => 0, "");
    }
    if ($cache->{bptr}) {
        $self->__cache_show_str(bptr => length($cache->{bptr}), $cache->{bptr});
    }
    if ($cache->{tmp}) {
        $self->__cache_show_str(tmp => length($cache->{tmp}), $cache->{tmp});
    }
}

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 ($esc ne '' and $esc ne "\0") {
        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 $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;

        if (!defined $value) {
            if ($ctx->{undef_str}) {
                if ($ctx->{undef_flg}) {
                    $ctx->{utf8}   = 1;
                    $ctx->{binary} = 1;
                }
                push @results, $ctx->{undef_str};
            } else {
                push @results, '';
            }
            next;
        }

        if (substr($value, 0, 1) eq '=' && $ctx->{formula}) {
            $value = $self->_formula($ctx, $value, $i);
            if (!defined $value) {
                push @results, '';
                next;
            }
        }

        $must_be_quoted = $ctx->{always_quote} ? 1 : 0;
        if ($value eq '') {
            $must_be_quoted++ if $ctx->{quote_empty} or ($check_meta && $self->is_quoted($i));
        }
        else {

            if (utf8::is_utf8 $value) {
                $ctx->{utf8}   = 1;
                $ctx->{binary} = 1;
            }

            $must_be_quoted++ if $check_meta && $self->is_quoted($i);

            if (!$must_be_quoted and $quot ne '') {
                use bytes;
                $must_be_quoted++ if
                    ($value =~ /\Q$quot\E/)                                    ||
                    ($sep ne '' and $sep ne "\0" and $value =~ /\Q$sep\E/)     ||
                    ($esc ne '' and $esc ne "\0" and $value =~ /\Q$esc\E/)     ||
                    ($ctx->{quote_binary} && $value =~ /[\x00-\x1f\x7f-\xa0]/) ||
                    ($ctx->{quote_space} && $value =~ /[\x09\x20]/);
            }

            if (!$ctx->{binary} and $value =~ /[^\x09\x20-\x7E]/) {
                # an argument contained an invalid character...
                $self->{_ERROR_INPUT} = $value;
                $self->SetDiag(2110);
                return 0;
            }

            if ($re_esc) {
                $value =~ s/($re_esc)/$esc$1/g;
            }
            if ($ctx->{escape_null}) {
                $value =~ s/\0/${esc}0/g;
            }
        }

        if ($must_be_quoted) {
            $value = $quot . $value . $quot;
        }
        push @results, $value;
    }

    $$dst = join($sep, @results) . (defined $ctx->{eol} ? $ctx->{eol} : '');

    return 1;
}

sub _formula {
    my ($self, $ctx, $value, $i) = @_;

    my $fa = $ctx->{formula} or return;
    if ($fa == 1) { die "Formulas are forbidden\n" }
    if ($fa == 2) { die "Formulas are forbidden\n" } # XS croak behaves like PP's "die"

    if ($fa == 3) {
        my $rec = '';
        if ($ctx->{recno}) {
            $rec = sprintf " in record %lu", $ctx->{recno} + 1;
        }
        my $field        = '';
        my $column_names = $self->{_COLUMN_NAMES};
        if (ref $column_names eq 'ARRAY' and @$column_names >= $i - 1) {
            my $column_name = $column_names->[$i - 1];
            $field = sprintf " (column: '%.100s')", $column_name if defined $column_name;
        }
        warn sprintf("Field %d%s%s contains formula '%s'\n", $i, $field, $rec, $value);
        return $value;
    }

    if ($fa == 4) {
        return '';
    }
    if ($fa == 5) {
        return undef;
    }

    if ($fa == 6) {
        if (ref $self->{_FORMULA_CB} eq 'CODE') {
            local $_ = $value;
            return $self->{_FORMULA_CB}->();
        }
    }
    return;
}

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}) {
        my $nf = $ctx->{is_bound} ? $ctx->{fld_idx} : @$fields;
        if ($nf and !$ctx->{strict_n}) {
            $ctx->{strict_n} = $nf;
        }
        if ($ctx->{strict_n} > 0 and $nf != $ctx->{strict_n}) {
            unless ($ctx->{useIO} & useIO_EOF) {
                unless ($last_error || (!$ctx->{useIO} and $ctx->{has_ahead})) {
                    $self->__parse_error($ctx, 2014, $ctx->{used});
                }
            }
            if ($last_error) {
                $result = undef;
            }
        }
    }

    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;
            }
        }
        %{$self->{_CACHE}} = %$ctx;

        if ($fflags) {
            if ($ctx->{keep_meta_info}) {
                $self->{_FFLAGS} = $fflags;
            } else {
                undef $fflags;
            }
        }
    } else {
        %{$self->{_CACHE}} = %$ctx;
    }

    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 $spl             = -1;
    my $waitingForField = 1;
    my ($value, $v_ref, $c0);
    $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;
                }
                $fnum++;
                return unless $v_ref;
                $ctx->{flag} = 0;
                $ctx->{fld_idx}++;
                $c0 = '';
            }

            $seenSomething = 1;
            $spl++;

            if (defined $hit and $hit ne '') {
                if ($waitingForField) {
                    if (!$spl && $ctx->{comment_str} && $ctx->{tmp} =~ /\A\Q$ctx->{comment_str}/) {
                        $ctx->{used}    = $ctx->{size};
                        $ctx->{fld_idx} = $ctx->{strict_n} ? $ctx->{strict_n} : 0;
                        $seenSomething  = 0;
                        unless ($ctx->{useIO}) {
                            $ctx->{has_ahead} = 214;
                        }
                        next LOOP;
                    }
                    $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}, $fnum);
                    $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, $src);

                    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, $src);
                        }
                    }

                    if (!defined $c2) { # EOF
                        # ,1,"foo, 3"
                        #            ^
                        $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag}, $fnum);
                        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}, $fnum);
                        $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
                        #                   ^
                        my $eolt = _eol_type($c2);
                        if ($ctx->{strict_eol} and $ctx->{eol_type} and $ctx->{eol_type} != $eolt) {
                            $self->__error_eol($ctx) or return;
                        }
                        $self->_set_eol_type($ctx, $eolt);
                        $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag}, $fnum);
                        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}, $fnum);
                            return 1;
                        }

                        my $c3 = $self->__get($ctx, $src);
                        if (defined $c3 and $c3 eq "\012") {
                            # ,1,"foo, 3"\r\n
                            #              ^
                            if ($ctx->{strict_eol} and $ctx->{eol_type} and $ctx->{eol_type} != EOL_TYPE_CRNL) {
                                $self->__error_eol($ctx) or return;
                            }
                            $self->_set_eol_type($ctx, EOL_TYPE_CRNL);
                            $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag}, $fnum);
                            return 1;
                        }

                        if ($ctx->{useIO} and !$ctx->{eol_len}) {
                            if ($c3 eq "\015") { # \r followed by an empty line
                                # ,1,"foo, 3"\r\r
                                #              ^
                                if ($ctx->{strict_eol} and $ctx->{eol_type}) {
                                    unless ($ctx->{eol_type} == EOL_TYPE_CR) {
                                        $self->__error_eol($ctx) or return;
                                    }
                                    $ctx->{used}--;
                                    $ctx->{has_ahead}++;
                                    $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag}, $fnum);
                                    return 1;
                                }
                                $self->__set_eol_is_cr($ctx);
                                if ($ctx->{flag} & IS_QUOTED) {
                                    $ctx->{flag} ^= IS_QUOTED;
                                }
                                $c = $c0 = "\015";
                                goto EOLX;
                            }
                            if ($c3 !~ /[^\x09\x20-\x7E]/) {
                                # ,1,"foo\n 3",,"bar"\r
                                # baz,4
                                # ^
                                if ($ctx->{strict_eol} and $ctx->{eol_type}) {
                                    unless ($ctx->{eol_type} == EOL_TYPE_CR) {
                                        $self->__error_eol($ctx) or return;
                                    }
                                    $ctx->{eol_is_cr} = 1;
                                } else {
                                    $self->__set_eol_is_cr($ctx);
                                }
                                $ctx->{used}--;
                                $ctx->{has_ahead} = 1;
                                $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag}, $fnum);
                                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, $src);
                        $$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, $src);
                    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, $src);
                    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:
                my $eolt = (($c eq "\012" || $c eq "\015") && $c0 eq "\015") ? EOL_TYPE_CRNL : _eol_type($c);
                $c0 = '';
                unless ($ctx->{flag} & CSV_FLAGS_IS_QUOTED) {
                    if ($ctx->{strict_eol} and $ctx->{eol_type} and $ctx->{eol_type} != $eolt) {
                        $self->__error_eol($ctx) or return;
                    }
                    $self->_set_eol_type($ctx, $eolt);
                }
                if ($fnum == 1 && $ctx->{flag} == 0 && (!$v_ref || $$v_ref eq '') && $ctx->{skip_empty_rows}) {
                    ### SkipEmptyRow
                    my $ser = $ctx->{skip_empty_rows};
                    if ($ser == 3) { $self->SetDiag(2015); die "Empty row\n"; }
                    if ($ser == 4) { $self->SetDiag(2015); die "Empty row\n"; }
                    if ($ser == 5) { $self->SetDiag(2015); return undef; }

                    if ($ser <= 2) { # skip & eof
                        $ctx->{fld_idx} = 0;
                        $c = $self->__get($ctx, $src);
                        if (!defined $c or $ser == 2) { # EOF
                            $v_ref         = undef;
                            $seenSomething = 0;
                            if ($ser == 2) { return undef; }
                            last LOOP;
                        }
                    }

                    if ($ser == 6) {
                        my $cb = $self->{_EMPTROW_CB};
                        unless ($cb && ref $cb eq 'CODE') {
                            return undef; # A callback is wanted, but none found
                        }
                        local $_ = $v_ref;
                        my $rv = $cb->();
                        # Result should be a ref to a list.
                        unless (ref $rv eq 'ARRAY') {
                            return undef;
                        }
                        my $n = @$rv;
                        if ($n <= 0) {
                            return 1;
                        }
                        if ($ctx->{is_bound} && $ctx->{is_bound} < $n) {
                            $n = $ctx->{is_bound} - 1;
                        }
                        for (my $i = 0; $i < $n; $i++) {
                            my $rvi = $rv->[$i];
                            $self->__push_value($ctx, \$rvi, $fields, $fflags, $ctx->{flag}, $fnum);
                        }
                        return 1;
                    }
                    goto RESTART;
                }

                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}, $fnum);
                    return 1;
                }
            }
            elsif (defined $c and $c eq "\015" and !$ctx->{verbatim}) {
                $c0 = "\015";
                if ($waitingForField) {
                    if ($ctx->{eol_is_cr}) {
                        # ,1,"foo\n 3",,bar,\r
                        #                   ^
                        $c = "\012";
                        goto EOLX;
                    }

                    my $c2 = $self->__get($ctx, $src);
                    if (!defined $c2) { # EOF
                        # ,1,"foo\n 3",,bar,\r
                        #                     ^
                        $c = undef;
                        last unless $seenSomething;
                        goto RESTART;
                    }
                    if ($c2 eq "\012") { # \r is not optional before EOLX!
                        # ,1,"foo\n 3",,bar,\r\n
                        #                     ^
                        if ($ctx->{strict_eol} and $ctx->{eol_type} and $ctx->{eol_type} != EOL_TYPE_CRNL) {
                            $self->__error_eol($ctx) or return;
                        }
                        $self->_set_eol_type($ctx, EOL_TYPE_CRNL);
                        $c = $c2;
                        goto EOLX;
                    }

                    if ($ctx->{useIO} and !$ctx->{eol_len}) {
                        if ($c2 eq "\012") { # \r followed by an empty line
                            # ,1,"foo\n 3",,bar,\r\r
                            #                     ^
                            if ($ctx->{strict_eol} and $ctx->{eol_type}) {
                                unless ($ctx->{eol_type} == EOL_TYPE_CR) {
                                    $self->__error_eol($ctx) or return;
                                }
                                $ctx->{eol_is_cr} = 1;
                            } else {
                                $self->__set_eol_is_cr($ctx);
                            }
                            goto EOLX;
                        }
                        $waitingForField = 0;
                        if ($c2 !~ /[^\x09\x20-\x7E]/) {
                            # ,1,"foo\n 3",,bar,\r
                            # baz,4
                            # ^
                            if ($ctx->{strict_eol} and $ctx->{eol_type}) {
                                unless ($ctx->{eol_type} == EOL_TYPE_CR) {
                                    $self->__error_eol($ctx) or return;
                                }
                            } else {
                                $self->__set_eol_is_cr($ctx);
                            }
                            $ctx->{used}--;
                            $ctx->{has_ahead} = 1;
                            if ($fnum == 1 && $ctx->{flag} == 0 && (!$v_ref or $$v_ref eq '') && $ctx->{skip_empty_rows}) {
                                ### SkipEmptyRow
                                my $ser = $ctx->{skip_empty_rows};
                                if ($ser == 3) { $self->SetDiag(2015); die "Empty row\n"; }
                                if ($ser == 4) { $self->SetDiag(2015); die "Empty row\n"; }
                                if ($ser == 5) { $self->SetDiag(2015); return undef; }

                                if ($ser <= 2) { # skip & eof
                                    $ctx->{fld_idx} = 0;
                                    $c = $self->__get($ctx, $src);
                                    if (!defined $c) { # EOF
                                        $v_ref           = undef;
                                        $waitingForField = 1;
                                        $seenSomething   = 0;
                                        last LOOP;
                                    }
                                }

                                if ($ser == 6) {
                                    my $cb = $self->{_EMPTROW_CB};
                                    unless ($cb && ref $cb eq 'CODE') {
                                        return undef; # A callback is wanted, but none found
                                    }
                                    local $_ = $v_ref;
                                    my $rv = $cb->();
                                    # Result should be a ref to a list.
                                    unless (ref $rv eq 'ARRAY') {
                                        return undef;
                                    }
                                    my $n = @$rv;
                                    if ($n <= 0) {
                                        return 1;
                                    }
                                    if ($ctx->{is_bound} && $ctx->{is_bound} < $n) {
                                        $n = $ctx->{is_bound} - 1;
                                    }
                                    for (my $i = 0; $i < $n; $i++) {
                                        my $rvi = $rv->[$i];
                                        $self->__push_value($ctx, \$rvi, $fields, $fflags, $ctx->{flag}, $fnum);
                                    }
                                    return 1;
                                }

                                $$v_ref = $c2;
                                goto RESTART;
                            }
                            $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag}, $fnum);
                            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
                        #                  ^
                        goto EOLX;
                    }

                    my $c2 = $self->__get($ctx, $src);
                    if (defined $c2 and $c2 eq "\012") { # \r is not optional before EOLX!
                        # ,1,"foo\n 3",,bar\r\n
                        #                    ^
                        if ($ctx->{strict_eol} and $ctx->{eol_type} and $ctx->{eol_type} != EOL_TYPE_CRNL) {
                            $self->__error_eol($ctx) or return;
                        }
                        $self->_set_eol_type($ctx, EOL_TYPE_CRNL);
                        goto EOLX;
                    }

                    if ($ctx->{useIO} and !$ctx->{eol_len}) {
                        if ($c2 !~ /[^\x09\x20-\x7E]/
                            # ,1,"foo\n 3",,bar\r
                            # baz,4
                            # ^
                            or $c2 eq "\015"
                            # ,1,"foo\n 3",,bar,\r\r
                            #                     ^
                        ) {
                            if ($ctx->{strict_eol} and $ctx->{eol_type}) {
                                unless ($ctx->{eol_type} == EOL_TYPE_CR) {
                                    $self->__error_eol($ctx) or return;
                                }
                            } else {
                                $self->__set_eol_is_cr($ctx);
                            }
                            $ctx->{used}--;
                            $ctx->{has_ahead} = 1;
                            if ($fnum == 1 && $ctx->{flag} == 0 && (!$v_ref or $$v_ref eq '') && $ctx->{skip_empty_rows}) {
                                ### SKipEmptyRow
                                my $ser = $ctx->{skip_empty_rows};
                                if ($ser == 3) { $self->SetDiag(2015); die "Empty row\n"; }
                                if ($ser == 4) { $self->SetDiag(2015); die "Empty row\n"; }
                                if ($ser == 5) { $self->SetDiag(2015); return undef; }

                                if ($ser <= 2) { # skip & eof
                                    $ctx->{fld_idx} = 0;
                                    $c = $self->__get($ctx, $src);
                                    if (!defined $c) { # EOL
                                        $v_ref         = undef;
                                        $seenSomething = 0;
                                        last LOOP;
                                    }
                                }

                                if ($ser == 6) {
                                    my $cb = $self->{_EMPTROW_CB};
                                    unless ($cb && ref $cb eq 'CODE') {
                                        return undef; # A callback is wanted, but none found
                                    }
                                    local $_ = $v_ref;
                                    my $rv = $cb->();
                                    # Result should be a ref to a list.
                                    unless (ref $rv eq 'ARRAY') {
                                        return undef;
                                    }
                                    my $n = @$rv;
                                    if ($n <= 0) {
                                        return 1;
                                    }
                                    if ($ctx->{is_bound} && $ctx->{is_bound} < $n) {
                                        $n = $ctx->{is_bound} - 1;
                                    }
                                    for (my $i = 0; $i < $n; $i++) {
                                        my $rvi = $rv->[$i];
                                        $self->__push_value($ctx, \$rvi, $fields, $fflags, $ctx->{flag}, $fnum);
                                    }
                                    return 1;
                                }
                                goto RESTART;
                            }
                            $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag}, $fnum);
                            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 (!$spl && $ctx->{comment_str} && $ctx->{tmp} =~ /\A$ctx->{comment_str}/) {
                        $ctx->{used}    = $ctx->{size};
                        $ctx->{fld_idx} = $ctx->{strict_n} ? $ctx->{strict_n} - 1 : 0;
                        $seenSomething  = 0;
                        unless ($ctx->{useIO}) {
                            $ctx->{has_ahead} = 214; # abuse
                        }
                        next LOOP;
                    }
                    if ($ctx->{allow_whitespace} and $self->__is_whitespace($ctx, $c)) {
                        do {
                            $c = $self->__get($ctx, $src);
                            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]/) {
                        last if $ctx->{useIO} && !defined $c;
                        $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) {
        unless ($ctx->{useIO}) {
            if ($ctx->{has_ahead} and $ctx->{has_ahead} == 214) {
                return 1;
            }
            $seenSomething++;
        }
        if ($seenSomething) {
            # new field
            if (!$v_ref) {
                if ($ctx->{is_bound}) {
                    $v_ref = $self->__bound_field($ctx, $fnum, 0);
                } else {
                    $value = '';
                    $v_ref = \$value;
                }
                $fnum++;
                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}, $fnum);
    } elsif ($ctx->{flag} == 0 && $fnum == 1 && $ctx->{skip_empty_rows} == 1) {
        return undef;
    }
    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_is_cr} = 1;
    $ctx->{eol_len}   = 1;
    $ctx->{eol}       = "\015";
    $ctx->{eol_type}  = EOL_TYPE_CR;
    %{$self->{_CACHE}} = %$ctx;

    $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, $src) = @_;
    return unless defined $ctx->{used};
    if ($ctx->{used} >= $ctx->{size}) {
        if ($self->__get_from_src($ctx, $src)) {
            return $self->__get($ctx, $src);
        }
        return;
    }
    my $pos = pos($ctx->{tmp});
    if ($ctx->{tmp} =~ /\G($ctx->{_re}|.)/gs) {
        my $c = $1;
        if ($c =~ /[^\x09\012\015\x20-\x7e]/) {
            $ctx->{flag} |= IS_BINARY;
        }
        $ctx->{used} = pos($ctx->{tmp});
        return $c;
    } else {
        if ($self->__get_from_src($ctx, $src)) {
            return $self->__get($ctx, $src);
        }
        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, $line) = @_;
    $line ||= (caller(1))[2];
    $self->{_ERROR_POS}   = $pos;
    $self->{_ERROR_FLD}   = $ctx->{fld_idx};
    $self->{_ERROR_INPUT} = $ctx->{tmp} if $ctx->{tmp};
    $self->_set_diag($ctx, $error, $line);
    return;
}

sub __error_eol {
    my ($self, $ctx) = @_;
    unless ($ctx->{strict_eol} & 0x40) {
        $self->__parse_error($ctx, 2016, $ctx->{used} - 1);
    }
    if ($ctx->{strict_eol} & 0x0e) {
        if (!$ctx->{is_bound}) {
            return;
        }
    }
    $ctx->{strict_eol} |= 0x40;
}

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, $fnum) = @_;
    utf8::encode($$v_ref) if $ctx->{utf8};
    if ($ctx->{formula} && defined $$v_ref && substr($$v_ref, 0, 1) eq '=') {
        my $value = $self->_formula($ctx, $$v_ref, $fnum);
        push @$fields, defined $value ? $value : undef;
        return;
    }
    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, $line) = @_;

    $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 ($line) {
        $self->{_ERROR_SRC} = $line;
    }
    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 {
        $last_error = $error;
        $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__