File Coverage

blib/lib/Data/Section/Seekable/Reader.pm

Criterion	Covered	Total	%
statement	52	52	100.0
branch	15	16	93.7
condition	2	2	100.0
subroutine	8	8	100.0
pod	4	4	100.0
total	81	82	98.7

package Data::Section::Seekable::Reader;

use 5.010001;
use strict;
use warnings;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2023-01-20'; # DATE
our $DIST = 'Data-Section-Seekable'; # DIST
our $VERSION = '0.091'; # VERSION

sub new {
    no strict 'refs'; ## no critic: TestingAndDebugging::ProhibitNoStrict

    my $class = shift;

    my $caller = caller;
    my $self = bless {@_}, $class;

    $self->{handle} //= \*{"$caller\::DATA"};

    {
        my $fh = $self->{handle};

# BEGIN_BLOCK: read_dss_toc

        my $header_line;
        my $header_found;
        while (1) {
            my $header_line = <$fh>;
            defined($header_line)
                or die "Unexpected end of data section while reading header line";
            chomp($header_line);
            if ($header_line eq 'Data::Section::Seekable v1') {
                $header_found++;
                last;
            }
        }
        die "Can't find header 'Data::Section::Seekable v1'"
            unless $header_found;

        my %toc;
        my $i = 0;
        while (1) {
            $i++;
            my $toc_line = <$fh>;
            defined($toc_line)
                or die "Unexpected end of data section while reading TOC line #$i";
            chomp($toc_line);
            $toc_line =~ /\S/ or last;
            $toc_line =~ /^([^,]+),(\d+),(\d+)(?:,(.*))?$/
                or die "Invalid TOC line #$i in data section: $toc_line";
            $toc{$1} = [$2, $3, $4];
        }
        my $pos = tell $fh;
        $toc{$_}[0] += $pos for keys %toc;

# END_BLOCK: read_dss_toc

        $self->{_toc} = \%toc;
    }

    $self;
}

sub parts {
    my $self = shift;
    sort keys %{$self->{_toc}};
}

sub read_part {
    my ($self, $name) = @_;

    defined($self->{_toc}{$name})
        or die "Unknown part '$name'";

    seek $self->{handle}, $self->{_toc}{$name}[0], 0;
    read $self->{handle}, my($content), $self->{_toc}{$name}[1];

    $content;
}

sub read_extra {
    my ($self, $name) = @_;

    defined($self->{_toc}{$name})
        or die "Unknown part '$name'";

    $self->{_toc}{$name}[2];
}

1;
# ABSTRACT: Read parts from data section

__END__