File Coverage

blib/lib/Text/CSV_PP.pm

Criterion	Covered	Total	%
statement	1687	1819	92.8
branch	1251	1414	88.4
condition	763	948	80.3
subroutine	128	128	100.0
pod	66	67	98.5
total	3895	4376	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.03';
@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 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",

        # 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,
    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			=> 0,
    _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_new_error = Text::CSV_PP->SetDiag(0);
my $ebcdic         = ord("A") == 0xC1;  # Faster than $Config{'ebcdic'}
my @internal_kh;
my $last_error;

# 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_new_error   = Text::CSV_PP->SetDiag(1000,
        'usage: my $csv = Text::CSV_PP->new ([{ option => value, ... }]);');

    my $proto = shift;
    my $class = ref $proto || $proto	or  return;
    @_ > 0 &&   ref $_[0] ne "HASH"	and return;
    my $attr  = shift || {};
    my %attr  = map {
        my $k = m/^[a-zA-Z]\w+$/ ? lc $_ : $_;
        exists $attr_alias{$k} and $k = $attr_alias{$k};
        ($k => $attr->{$_});
        } keys %$attr;

    my $sep_aliased = 0;
    if (exists $attr{sep}) {
        $attr{sep_char} = delete $attr{sep};
        $sep_aliased = 1;
        }
    my $quote_aliased = 0;
    if (exists $attr{quote}) {
        $attr{quote_char} = delete $attr{quote};
        $quote_aliased = 1;
        }
    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_new_error = 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_new_error   = Text::CSV_PP->SetDiag($ec);
        $attr{auto_diag} and error_diag ();
        return;
        }
    if (defined $self->{callbacks} && ref $self->{callbacks} ne "HASH") {
        Carp::carp "The 'callbacks' attribute is set but is not a hash: ignored\n";
        $self->{callbacks} = undef;
        }

    $last_new_error = Text::CSV_PP->SetDiag(0);
    defined $\ && !exists $attr{eol} and $self->{eol} = $\;
    bless $self, $class;
    defined $self->{'types'}           and $self->types($self->{'types'});
    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,
    sep				=> 39,	# 39 .. 55
    binary			=>  3,
    keep_meta_info		=>  4,
    always_quote		=>  5,
    allow_loose_quotes		=>  6,
    allow_loose_escapes		=>  7,
    allow_unquoted_escape	=>  8,
    allow_whitespace		=>  9,
    blank_is_undef		=> 10,
    eol				=> 11,
    quote			=> 15,
    verbatim			=> 22,
    empty_is_undef		=> 23,
    auto_diag			=> 24,
    diag_verbose		=> 33,
    quote_space			=> 25,
    quote_empty			=> 37,
    quote_binary		=> 32,
    escape_null			=> 31,
    decode_utf8			=> 35,
    _has_ahead			=> 30,
    _has_hooks			=> 36,
    _is_bound			=> 26,	# 26 .. 29
    formula			=> 38,
    strict   			=> 42,
    skip_empty_rows     => 43,
    undef_str  		=> 46,
    comment_str     => 54,
    types           => 62,
    );

my %_hidden_cache_id = qw(
    sep_len		38
    eol_len		12
    eol_is_cr		13
    quo_len		16
    has_error_input		34
);

my %_reverse_cache_id = (
    map({$_cache_id{$_} => $_} keys %_cache_id),
    map({$_hidden_cache_id{$_} => $_} keys %_hidden_cache_id),
);

# A `character'
sub _set_attr_C {
    my ($self, $name, $val, $ec) = @_;
    defined $val 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 = "";
        length ($eol) > 16 and croak ($self->SetDiag (1005));
        $self->{eol} = $eol;
        $self->_cache_set ($_cache_id{eol}, $eol);
        }
    $self->{eol};
    }

sub always_quote {
    my $self = shift;
    @_ and $self->_set_attr_X ("always_quote", shift);
    $self->{always_quote};
    }

sub quote_space {
    my $self = shift;
    @_ and $self->_set_attr_X ("quote_space", shift);
    $self->{quote_space};
    }

sub quote_empty {
    my $self = shift;
    @_ and $self->_set_attr_X ("quote_empty", shift);
    $self->{quote_empty};
    }

sub escape_null {
    my $self = shift;
    @_ and $self->_set_attr_X ("escape_null", shift);
    $self->{escape_null};
    }

sub quote_null { goto &escape_null; }

sub quote_binary {
    my $self = shift;
    @_ and $self->_set_attr_X ("quote_binary", shift);
    $self->{quote_binary};
    }

sub binary {
    my $self = shift;
    @_ and $self->_set_attr_X ("binary", shift);
    $self->{binary};
    }

sub strict {
    my $self = shift;
    @_ and $self->_set_attr_X ("strict", shift);
    $self->{strict};
    }

sub _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 {
    $_[0]->{_STATUS};
}

sub eof {
    $_[0]->{_EOF};
}

sub types {
    my $self = shift;

    if (@_) {
        if (my $types = shift) {
            $self->{'_types'} = join("", map{ chr($_) } @$types);
            $self->{'types'} = $types;
            $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_new_error, $last_new_error, 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 && # 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[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]/;

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

            $self->{diag_verbose} and $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 {
    return shift->{_RECNO};
}

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

*string = \&_string;
sub _string {
    defined $_[0]->{_STRING} ? ${ $_[0]->{_STRING} } : undef;
}

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

*fields = \&_fields;
sub _fields {
    ref($_[0]->{_FIELDS}) ?  @{$_[0]->{_FIELDS}} : undef;
}

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

sub meta_info {
    $_[0]->{_FFLAGS} ? @{ $_[0]->{_FFLAGS} } : undef;
}

sub is_quoted {
    return unless (defined $_[0]->{_FFLAGS});
    return if( $_[1] =~ /\D/ or $_[1] < 0 or  $_[1] > $#{ $_[0]->{_FFLAGS} } );

    $_[0]->{_FFLAGS}->[$_[1]] & IS_QUOTED ? 1 : 0;
}

sub is_binary {
    return unless (defined $_[0]->{_FFLAGS});
    return if( $_[1] =~ /\D/ or $_[1] < 0 or  $_[1] > $#{ $_[0]->{_FFLAGS} } );
    $_[0]->{_FFLAGS}->[$_[1]] & IS_BINARY ? 1 : 0;
}

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

################################################################################
# combine
################################################################################
*combine = \&_combine;
sub _combine {
    my ($self, @fields) = @_;
    my $str  = "";
    $self->{_FIELDS} = \@fields;
    $self->{_STATUS} = (@fields > 0) && $self->__combine(\$str, \@fields, 0);
    $self->{_STRING} = \$str;
    $self->{_STATUS};
    }

################################################################################
# parse
################################################################################
*parse = \&_parse;
sub _parse {
    my ($self, $str) = @_;

    ref $str and croak ($self->SetDiag (1500));

    my $fields = [];
    my $fflags = [];
    $self->{_STRING} = \$str;
    if (defined $str && $self->__parse ($fields, $fflags, $str, 0)) {
        $self->{_FIELDS} = $fields;
        $self->{_FFLAGS} = $fflags;
        $self->{_STATUS} = 1;
        }
    else {
        $self->{_FIELDS} = undef;
        $self->{_FFLAGS} = undef;
        $self->{_STATUS} = 0;
        }
    $self->{_STATUS};
    }

sub column_names {
    my ( $self, @columns ) = @_;

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

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

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

    $self->{_COLUMN_NAMES} = [ map { defined $_ ? $_ : "\cAUNDEF\cA" } @columns ];
    @{ $self->{_COLUMN_NAMES} };
}

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

    $fh or croak ($self->SetDiag (1014));

    my (@seps, %args);
    for (@args) {
        if (ref $_ eq "ARRAY") {
            push @seps, @$_;
            next;
            }
        if (ref $_ eq "HASH") {
            %args = %$_;
            next;
            }
        croak (q{usage: $csv->header ($fh, [ seps ], { options })});
        }

    defined $args{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;
    @refs == 1 && ! defined $refs[0] and return $self->{_BOUND_COLUMNS} = undef;

    if ( $self->{_COLUMN_NAMES} && @refs != @{$self->{_COLUMN_NAMES}} ) {
        croak $self->SetDiag( 3003 );
    }

    if ( grep { ref $_ ne "SCALAR" } @refs ) { # why don't use grep?
        croak $self->SetDiag( 3004 );
    }

    $self->_set_attr_N("_is_bound", scalar @refs);
    $self->{_BOUND_COLUMNS} = [ @refs ];
    @refs;
}

sub getline_hr {
    my ($self, @args, %hr) = @_;
    $self->{_COLUMN_NAMES} or croak ($self->SetDiag (3002));
    my $fr = $self->getline (@args) or return;
    if (ref $self->{_FFLAGS}) { # missing
        $self->{_FFLAGS}[$_] = IS_MISSING
            for (@$fr ? $#{$fr} + 1 : 0) .. $#{$self->{_COLUMN_NAMES}};
        @$fr == 1 && (!defined $fr->[0] || $fr->[0] eq "") and
            $self->{_FFLAGS}[0] ||= IS_MISSING;
        }
    @hr{@{$self->{_COLUMN_NAMES}}} = @$fr;
    \%hr;
}

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

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

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

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

sub say {
    my ($self, $io, @f) = @_;
    my $eol = $self->eol;
    $eol eq "" and $self->eol ($\ || $/);
    # say ($fh, undef) does not propage actual undef to print ()
    my $state = $self->print ($io, @f == 1 && !defined $f[0] ? undef : @f);
    $self->eol ($eol);
    return $state;
    }

sub print_hr {
    my ($self, $io, $hr) = @_;
    $self->{_COLUMN_NAMES} or croak($self->SetDiag(3009));
    ref $hr eq "HASH"      or croak($self->SetDiag(3010));
    $self->print ($io, [ map { $hr->{$_} } $self->column_names ]);
}

sub fragment {
    my ($self, $io, $spec) = @_;

    my $qd = qr{\s* [0-9]+ \s* }x;                # digit
    my $qs = qr{\s* (?: [0-9]+ | \* ) \s*}x;        # digit or star
    my $qr = qr{$qd (?: - $qs )?}x;                # range
    my $qc = qr{$qr (?: ; $qr )*}x;                # list
    defined $spec && $spec =~ m{^ \s*
        \x23 ? \s*                                # optional leading #
        ( row | col | cell ) \s* =
        ( $qc                                        # for row and col
        | $qd , $qd (?: - $qs , $qs)?                # for cell (ranges)
          (?: ; $qd , $qd (?: - $qs , $qs)? )*        # and cell (range) lists
        ) \s* $}xi or croak ($self->SetDiag (2013));
    my ($type, $range) = (lc $1, $2);

    my @h = $self->column_names ();

    my @c;
    if ($type eq "cell") {
        my @spec;
        my $min_row;
        my $max_row = 0;
        for (split m/\s*;\s*/ => $range) {
            my ($tlr, $tlc, $brr, $brc) = (m{
                    ^ \s* ([0-9]+     ) \s* , \s* ([0-9]+     ) \s*
                (?: - \s* ([0-9]+ | \*) \s* , \s* ([0-9]+ | \*) \s* )?
                    $}x) or croak ($self->SetDiag (2013));
            defined $brr or ($brr, $brc) = ($tlr, $tlc);
            $tlr == 0 || $tlc == 0 ||
                ($brr ne "*" && ($brr == 0 || $brr < $tlr)) ||
                ($brc ne "*" && ($brc == 0 || $brc < $tlc))
                    and croak ($self->SetDiag (2013));
            $tlc--;
            $brc-- unless $brc eq "*";
            defined $min_row or $min_row = $tlr;
            $tlr < $min_row and $min_row = $tlr;
            $brr eq "*" || $brr > $max_row and
                $max_row = $brr;
            push @spec, [ $tlr, $tlc, $brr, $brc ];
            }
        my $r = 0;
        while (my $row = $self->getline ($io)) {
            ++$r < $min_row and next;
            my %row;
            my $lc;
            foreach my $s (@spec) {
                my ($tlr, $tlc, $brr, $brc) = @$s;
                $r <  $tlr || ($brr ne "*" && $r > $brr) and next;
                !defined $lc || $tlc < $lc and $lc = $tlc;
                my $rr = $brc eq "*" ? $#$row : $brc;
                $row{$_} = $row->[$_] for $tlc .. $rr;
                }
            push @c, [ @row{sort { $a <=> $b } keys %row } ];
            if (@h) {
                my %h; @h{@h} = @{$c[-1]};
                $c[-1] = \%h;
                }
            $max_row ne "*" && $r == $max_row and last;
            }
        return \@c;
        }

    # row or col
    my @r;
    my $eod = 0;
    for (split m/\s*;\s*/ => $range) {
        my ($from, $to) = m/^\s* ([0-9]+) (?: \s* - \s* ([0-9]+ | \* ))? \s* $/x
            or croak ($self->SetDiag (2013));
        $to ||= $from;
        $to eq "*" and ($to, $eod) = ($from, 1);
        # $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;

    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 $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;

    $in && $out && !ref $in && !ref $out and croak join "\n" =>
       qq{Cannot use a string for both in and out. Instead use:},
       qq{ csv (in => csv (in => "$in"), out => "$out");\n};

    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}) {
                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};

    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 $hd_s = delete $attr{sep_set}                ||
               delete $attr{seps};
    my $hd_b = delete $attr{detect_bom}             ||
               delete $attr{bom};
    my $hd_m = delete $attr{munge}                  ||
               delete $attr{munge_column_names};
    my $hd_c = delete $attr{set_column_names};

    for ([ quo    => "quote"                ],
         [ esc    => "escape"                ],
         [ escape => "escape_char"        ],
         ) {
        my ($f, $t) = @$_;
        exists $attr{$f} and !exists $attr{$t} and $attr{$t} = delete $attr{$f};
        }

    my $fltr = delete $attr{filter};
    my %fltr = (
        not_blank => sub { @{$_[1]} > 1 or defined $_[1][0] && $_[1][0] ne "" },
        not_empty => sub { grep { defined && $_ ne "" } @{$_[1]} },
        filled    => sub { grep { defined && m/\S/    } @{$_[1]} },
        );
    defined $fltr && !ref $fltr && exists $fltr{$fltr} and
        $fltr = { 0 => $fltr{$fltr} };
    ref $fltr eq "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_new_error;
    defined $form and $csv->formula ($form);

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

    return $ref;
    }

# The end of the common pure perl part.

################################################################################
#
# The following are methods implemented in XS in Text::CSV_XS or
# helper methods for Text::CSV_PP only
#
################################################################################

sub _setup_ctx {
    my $self = shift;

    $last_error = undef;

    my $ctx;
    if ($self->{_CACHE}) {
        %$ctx = %{$self->{_CACHE}};
    } else {
        $ctx->{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->{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 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->{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;
    }

    $ctx;
}

sub _cache_set {
    my ($self, $idx, $value) = @_;
    return unless exists $self->{_CACHE};
    my $cache = $self->{_CACHE};

    my $key = $_reverse_cache_id{$idx};
    if (!defined $key) {
        warn (sprintf "Unknown cache index %d ignored\n", $idx);
    } elsif ($key eq 'sep_char') {
        $cache->{sep} = $value;
        $cache->{sep_len} = 0;
    }
    elsif ($key eq 'quote_char') {
        $cache->{quo} = $value;
        $cache->{quo_len} = 0;
    }
    elsif ($key eq '_has_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') {
        if (defined($value)) {
            $cache->{eol} = $value;
            $cache->{eol_len} = length($value);
        }
        $cache->{eol_is_cr} = $value eq "\015" ? 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 skip_empty_rows
        has_error_input blank_is_undef empty_is_undef has_ahead
        keep_meta_info verbatim has_hooks eol_is_cr eol_len
    /) {
        $self->__cache_show_byte($_ => $cache->{$_});
    }
    $self->__cache_show_str(eol => $cache->{eol_len}, $cache->{eol});
    $self->__cache_show_byte(sep_len => $cache->{sep_len});
    if ($cache->{sep_len} and $cache->{sep_len} > 1) {
        $self->__cache_show_str(sep => $cache->{sep_len}, $cache->{sep});
    }
    $self->__cache_show_byte(quo_len => $cache->{quo_len});
    if ($cache->{quo_len} and $cache->{quo_len} > 1) {
        $self->__cache_show_str(quote => $cache->{quo_len}, $cache->{quo});
    }
    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}) {
        $ctx->{strict_n} ||= $ctx->{fld_idx};
        if ($ctx->{strict_n} != $ctx->{fld_idx}) {
            unless ($ctx->{useIO} & useIO_EOF) {
                $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);
    $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}++;
            }

            $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};
                        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
                        #                   ^
                        $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
                            #              ^
                            $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
                                #              ^
                                $self->__set_eol_is_cr($ctx);
                                goto EOLX;
                            }
                            if ($c3 !~ /[^\x09\x20-\x7E]/) {
                                # ,1,"foo\n 3",,"bar"\r
                                # baz,4
                                # ^
                                $self->__set_eol_is_cr($ctx);
                                $ctx->{used}--;
                                $ctx->{has_ahead} = 1;
                                $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag}, $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:
                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;
                            $waitingForField = 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}) {
                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
                        #                     ^
                        $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
                            #                     ^
                            $self->__set_eol_is_cr($ctx);
                            goto EOLX;
                        }
                        $waitingForField = 0;
                        if ($c2 !~ /[^\x09\x20-\x7E]/) {
                            # ,1,"foo\n 3",,bar,\r
                            # baz,4
                            # ^
                            $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 = 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
                        #                    ^
                        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
                            #                     ^
                        ) {
                            $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;
                                        $waitingForField = 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};
                        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) {
        if ($seenSomething or !$ctx->{useIO}) {
            # new field
            if (!$v_ref) {
                if ($ctx->{is_bound}) {
                    $v_ref = $self->__bound_field($ctx, $fnum, 0);
                } else {
                    $value = '';
                    $v_ref = \$value;
                }
                $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} = "\015";
    $ctx->{eol_is_cr} = 1;
    $ctx->{eol_len} = 1;
    %{$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) = @_;
    $self->{_ERROR_POS} = $pos;
    $self->{_ERROR_FLD} = $ctx->{fld_idx};
    $self->{_ERROR_INPUT} = $ctx->{tmp} if $ctx->{tmp};
    $self->SetDiag($error);
    return;
}

sub __is_whitespace {
    my ($self, $ctx, $c) = @_;
    return unless defined $c;
    return (
        (!defined $ctx->{sep} or $c ne $ctx->{sep}) &&
        (!defined $ctx->{quo} or $c ne $ctx->{quo}) &&
        (!defined $ctx->{escape_char} or $c ne $ctx->{escape_char}) &&
        ($c eq " " or $c eq "\t")
    );
}

sub __push_value { # AV_PUSH (part of)
    my ($self, $ctx, $v_ref, $fields, $fflags, $flag, $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) = @_;

    $last_error = $self->_sv_diag($error);
    $self->{_ERROR_DIAG} = $last_error;
    if ($error == 0) {
        $self->{_ERROR_POS} = 0;
        $self->{_ERROR_FLD} = 0;
        $self->{_ERROR_INPUT} = undef;
        $ctx->{has_error_input} = 0;
    }
    if ($error == 2012) { # EOF
        $self->{_EOF} = 1;
    }
    if ($ctx->{auto_diag}) {
        $self->error_diag;
    }
    return $last_error;
}

sub SetDiag {
    my ($self, $error, $errstr) = @_;
    my $res;
    if (ref $self) {
        my $ctx = $self->_setup_ctx;
        $res = $self->_set_diag($ctx, $error);

    } else {
        $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__