File Coverage

blib/lib/Text/CSV_XS.pm

Criterion	Covered	Total	%
statement	885	894	99.1
branch	687	730	94.1
condition	368	425	86.3
subroutine	85	85	100.0
pod	66	66	100.0
total	2091	2200	95.0

package Text::CSV_XS;

# Copyright (c) 2007-2023 H.Merijn Brand.  All rights reserved.
# Copyright (c) 1998-2001 Jochen Wiedmann. All rights reserved.
# Copyright (c) 1997 Alan Citterman.       All rights reserved.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

# HISTORY
#
# 0.24 -
#    H.Merijn Brand ([e-mail])
# 0.10 - 0.23
#    Jochen Wiedmann
# Based on (the original) Text::CSV by:
#    Alan Citterman

require 5.006001;

use strict;
use warnings;

require Exporter;
use XSLoader;
use Carp;

use vars qw( $VERSION @ISA @EXPORT_OK %EXPORT_TAGS );
$VERSION = "1.50";
@ISA     = qw( Exporter );
XSLoader::load ("Text::CSV_XS", $VERSION);

sub PV { 0 } sub CSV_TYPE_PV { PV }
sub IV { 1 } sub CSV_TYPE_IV { IV }
sub NV { 2 } sub CSV_TYPE_NV { NV }

sub CSV_FLAGS_IS_QUOTED		{ 0x0001 }
sub CSV_FLAGS_IS_BINARY		{ 0x0002 }
sub CSV_FLAGS_ERROR_IN_FIELD	{ 0x0004 }
sub CSV_FLAGS_IS_MISSING	{ 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}});

if ($] < 5.008002) {
    no warnings "redefine";
    *utf8::decode = sub {};
    }

# version
#
#   class/object method expecting no arguments and returning the version
#   number of Text::CSV.  there are no side-effects.

sub version {
    return $VERSION;
    } # version

# new
#
#   class/object method expecting no arguments and returning a reference to
#   a newly created Text::CSV object.

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'			=> "",
    '_RECNO'			=> 0,
    '_STATUS'			=> undef,
    '_FIELDS'			=> undef,
    '_FFLAGS'			=> undef,
    '_STRING'			=> undef,
    '_ERROR_INPUT'		=> undef,
    '_COLUMN_NAMES'		=> undef,
    '_BOUND_COLUMNS'		=> undef,
    '_AHEAD'			=> undef,
    '_FORMULA_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_err = Text::CSV_XS->SetDiag (0);
my $ebcdic       = ord ("A") == 0xC1;	# Faster than $Config{'ebcdic'}
my @internal_kh;

# NOT a method: is also used before bless
sub _unhealthy_whitespace {
    my ($self, $aw) = @_;
    $aw or return 0; # no checks needed without allow_whitespace

    my $quo = $self->{'quote'};
    defined $quo && length ($quo) or $quo = $self->{'quote_char'};
    my $esc = $self->{'escape_char'};

    defined $quo && $quo =~ m/^[ \t]/ and return 1002;
    defined $esc && $esc =~ m/^[ \t]/ and return 1002;

    return 0;
    } # _unhealty_whitespace

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'});
    } # _check_sanity

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

sub new {
    $last_new_err = Text::CSV_XS->SetDiag (1000,
	"usage: my \$csv = Text::CSV_XS->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_err = Text::CSV_XS->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_err = Text::CSV_XS->SetDiag ($ec);
	$attr{'auto_diag'} and error_diag ();
	return;
	}
    if (defined $self->{'callbacks'} && ref $self->{'callbacks'} ne "HASH") {
	carp ("The 'callbacks' attribute is set but is not a hash: ignored\n");
	$self->{'callbacks'} = undef;
	}

    $last_new_err = Text::CSV_XS->SetDiag (0);
    defined $\ && !exists $attr{'eol'} and $self->{'eol'} = $\;
    bless $self, $class;
    defined $self->{'types'} and $self->types ($self->{'types'});
    defined $attr_formula  and $self->{'formula'} = _supported_formula ($self, $attr_formula);
    $self;
    } # new

# 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,
    );

# 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);
    } # _set_attr_C

# 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);
    } # _set_attr_X

# A number
sub _set_attr_N {
    my ($self, $name, $val) = @_;
    $self->{$name} = $val;
    $self->_cache_set ($_cache_id{$name}, 0 + $val);
    } # _set_attr_N

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

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

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

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

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

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

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

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

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

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

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;
    } # _SetDiagInfo

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_XS";
	croak ($self->_SetDiagInfo (1500, "formula-handling '$f' is not supported"));
	};
    } # _supported_formula

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'})];
    } # always_quote
sub formula_handling {
    my $self = shift;
    $self->formula (@_);
    } # formula_handling

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

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

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

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

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

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

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

# status
#
#   object method returning the success or failure of the most recent
#   combine () or parse ().  there are no side-effects.

sub status {
    my $self = shift;
    return $self->{'_STATUS'};
    } # status

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

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

# error_diag
#
#   If (and only if) an error occurred, this function returns a code that
#   indicates the reason of failure

sub error_diag {
    my $self = shift;
    my @diag = (0 + $last_new_err, $last_new_err, 0, 0, 0);

    # Docs state to NEVER use UNIVERSAL::isa, because it will *never* call an
    # overridden isa method in any class. Well, that is exacly what I want here
    if ($self && ref $self and # Not a class method or direct call
	 UNIVERSAL::isa ($self, __PACKAGE__) && exists $self->{'_ERROR_DIAG'}) {
	$diag[0] = 0 + $self->{'_ERROR_DIAG'};
	$diag[1] =     $self->{'_ERROR_DIAG'};
	$diag[2] = 1 + $self->{'_ERROR_POS'} if exists $self->{'_ERROR_POS'};
	$diag[3] =     $self->{'_RECNO'};
	$diag[4] =     $self->{'_ERROR_FLD'} if exists $self->{'_ERROR_FLD'};

	$diag[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_XS 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'} && $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];
    } # error_diag

sub record_number {
    my $self = shift;
    return $self->{'_RECNO'};
    } # record_number

# string
#
#   object method returning the result of the most recent combine () or the
#   input to the most recent parse (), whichever is more recent.  there are
#   no side-effects.

sub string {
    my $self = shift;
    return ref $self->{'_STRING'} ? ${$self->{'_STRING'}} : undef;
    } # string

# fields
#
#   object method returning the result of the most recent parse () or the
#   input to the most recent combine (), whichever is more recent.  there
#   are no side-effects.

sub fields {
    my $self = shift;
    return ref $self->{'_FIELDS'} ? @{$self->{'_FIELDS'}} : undef;
    } # fields

# meta_info
#
#   object method returning the result of the most recent parse () or the
#   input to the most recent combine (), whichever is more recent.  there
#   are no side-effects. meta_info () returns (if available)  some of the
#   field's properties

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

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

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

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

# combine
#
#  Object method returning success or failure. The given arguments are
#  combined into a single comma-separated value. Failure can be the
#  result of no arguments or an argument containing an invalid character.
#  side-effects include:
#      setting status ()
#      setting fields ()
#      setting string ()
#      setting error_input ()

sub combine {
    my $self = shift;
    my $str  = "";
    $self->{'_FIELDS'} = \@_;
    $self->{'_STATUS'} = (@_ > 0) && $self->Combine (\$str, \@_, 0);
    $self->{'_STRING'} = \$str;
    $self->{'_STATUS'};
    } # combine

# parse
#
#  Object method returning success or failure. The given argument is
#  expected to be a valid comma-separated value. Failure can be the
#  result of no arguments or an argument containing an invalid sequence
#  of characters. Side-effects include:
#      setting status ()
#      setting fields ()
#      setting meta_info ()
#      setting string ()
#      setting error_input ()

sub parse {
    my ($self, $str) = @_;

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

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

sub column_names {
    my ($self, @keys) = @_;
    @keys or
	return defined $self->{'_COLUMN_NAMES'} ? @{$self->{'_COLUMN_NAMES'}} : ();

    @keys == 1 && ! defined $keys[0] and
	return $self->{'_COLUMN_NAMES'} = undef;

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

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

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

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

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

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

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

    # Reset any previous leftovers
    $self->{'_RECNO'}		= 0;
    $self->{'_AHEAD'}		= undef;
    $self->{'_COLUMN_NAMES'}	= undef if $args{'set_column_names'};
    $self->{'_BOUND_COLUMNS'}	= undef if $args{'set_column_names'};

    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;
    } # header

sub bind_columns {
    my ($self, @refs) = @_;
    @refs or
	return defined $self->{'_BOUND_COLUMNS'} ? @{$self->{'_BOUND_COLUMNS'}} : undef;

    if (@refs == 1 && ! defined $refs[0]) {
	$self->{'_COLUMN_NAMES'} = undef;
	return $self->{'_BOUND_COLUMNS'} = undef;
	}

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

    join "", map { ref $_ eq "SCALAR" ? "" : "*" } @refs and
	croak ($self->SetDiag (3004));

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

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

sub getline_hr_all {
    my ($self, @args) = @_;
    $self->{'_COLUMN_NAMES'} or croak ($self->SetDiag (3002));
    my @cn = @{$self->{'_COLUMN_NAMES'}};
    [ map { my %h; @h{@cn} = @{$_}; \%h } @{$self->getline_all (@args)} ];
    } # getline_hr_all

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;
    } # say

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 () ]);
    } # print_hr

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;
    } # fragment

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_XS->new (\%attr)
	or croak ($last_new_err);
    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,
	};
    } # _csv_attr

sub csv {
    @_ && ref $_[0] eq __PACKAGE__ 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_d'} and $harg{'detect_bom'}         = $c->{'hd_b'};
	defined  $c->{'hd_m'} and $harg{'munge_column_names'} = $hdrs ? "none" : $c->{'hd_m'};
	defined  $c->{'hd_c'} and $harg{'set_column_names'}   = $hdrs ? 0      : $c->{'hd_c'};
	@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) {
	    if ($hdrs eq "skip") {
		$csv->getline ($fh); # discard;
		}
	    elsif ($hdrs eq "auto") {
		my $h = $csv->getline ($fh) or return;
		$hdrs = [ map {      $hdr{$_} || $_ } @{$h} ];
		}
	    elsif ($hdrs eq "lc") {
		my $h = $csv->getline ($fh) or return;
		$hdrs = [ map { lc ($hdr{$_} || $_) } @{$h} ];
		}
	    elsif ($hdrs eq "uc") {
		my $h = $csv->getline ($fh) or return;
		$hdrs = [ map { uc ($hdr{$_} || $_) } @{$h} ];
		}
	    }
	elsif (ref $hdrs eq "CODE") {
	    my $h  = $csv->getline ($fh) or return;
	    my $cr = $hdrs;
	    $hdrs  = [ map {  $cr->($hdr{$_} || $_) } @{$h} ];
	    }
	$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_XS->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;
    } # csv

1;

__END__