File Coverage

blib/lib/Text/KDL/XS/Parser.pm

Criterion	Covered	Total	%
statement	39	42	92.8
branch	17	26	65.3
condition	7	13	53.8
subroutine	9	9	100.0
pod	0	2	0.0
total	72	92	78.2

package Text::KDL::XS::Parser;

use strict;
use warnings;

use Scalar::Util ();
use Carp ();

# Constructor:
#   Text::KDL::XS::Parser->new($source, %opts)
#     $source : string | filehandle | coderef returning chunks
#     %opts   : version       => 'detect'|'1'|'2'   (default: detect)
#               emit_comments => 0|1                (default: 0)
sub new {
    my ($class, $source, %opts) = @_;

    Carp::croak("Text::KDL::XS::Parser: source is required")
        unless defined $source;

    my $opts_int = _build_opt_flags(\%opts);

    if (my $reftype = ref $source) {
        return $class->_new_stream_parser($source, $opts_int)
            if $reftype eq 'CODE';

        my $reader = _make_io_reader($source);
        return $class->_new_stream_parser($reader, $opts_int)
            if $reader;

        Carp::croak("Text::KDL::XS::Parser: unsupported source ref type '$reftype'");
    }

    return $class->_new_string_parser($source, $opts_int);
}

# Returns the next event hashref, or undef at EOF. Dies on parse error.
sub next_event {
    my ($self) = @_;
    return $self->_next_event;
}

# --- internals -------------------------------------------------------------

sub _build_opt_flags {
    my ($opts) = @_;

    my $version = lc($opts->{version} // 'detect');
    my $flags
        = $version eq 'detect' ? Text::KDL::XS::_OPT_DETECT()
        : $version eq '1'      ? Text::KDL::XS::_OPT_V1()
        : $version eq '2'      ? Text::KDL::XS::_OPT_V2()
        : Carp::croak("unknown version '$version' (expected 'detect', '1', or '2')");

    $flags |= Text::KDL::XS::_OPT_EMIT_COMMENTS() if $opts->{emit_comments};
    return $flags;
}

# Wrap a filehandle / IO object as a Perl sub the XS layer can call.
sub _make_io_reader {
    my ($source) = @_;

    my $reftype = Scalar::Util::reftype($source) // '';
    return undef unless $reftype eq 'GLOB' || Scalar::Util::blessed($source);

    # Duck-type: must support sysread or read.
    my $can_sysread = $reftype eq 'GLOB' || (Scalar::Util::blessed($source)
        && ($source->can('sysread') || $source->can('read')));
    return undef unless $can_sysread;

    return sub {
        my ($want) = @_;
        my $buf = '';
        my $n;
        if ($reftype eq 'GLOB') {
            $n = sysread($source, $buf, $want);
        }
        elsif ($source->can('sysread')) {
            $n = $source->sysread($buf, $want);
        }
        else {
            $n = $source->read($buf, $want);
        }
        return defined $n && $n > 0 ? $buf : '';
    };
}

1;

__END__