File Coverage

blib/lib/IO/Framed/Read.pm

Criterion	Covered	Total	%
statement	51	55	92.7
branch	18	24	75.0
condition	4	6	66.6
subroutine	10	11	90.9
pod	0	5	0.0
total	83	101	82.1

package IO::Framed::Read;

use strict;
use warnings;

use IO::Framed::X ();

sub new {
    my ( $class, $in_fh, $initial_buffer ) = @_;

    if ( !defined $initial_buffer ) {
        $initial_buffer = q<>;
    }

    my $self = {
        _in_fh         => $in_fh,
        _read_buffer   => $initial_buffer,
        _bytes_to_read => 0,
    };

    return bless $self, $class;
}

sub get_read_fh { return $_[0]->{'_in_fh'} }

#----------------------------------------------------------------------
# IO subclass interface

sub allow_empty_read {
    my ($self) = @_;
    $self->{'_ALLOW_EMPTY_READ'} = 1;
    return $self;
}

sub READ {
    require IO::SigGuard;
    *READ = *IO::SigGuard::sysread;
    goto &READ;
}

#We assume here that whatever read may be incomplete at first
#will eventually be repeated so that we can complete it. e.g.:
#
#   - read 4 bytes, receive 1, cache it - return undef
#   - select()
#   - read 4 bytes again; since we already have 1 byte, only read 3
#       … and now we get the remaining 3, so return the buffer.
#
sub read {
    my ( $self, $bytes ) = @_;

    die "I refuse to read zero!" if !$bytes;

    if ( length $self->{'_read_buffer'} ) {
        if ( length($self->{'_read_buffer'}) + $self->{'_bytes_to_read'} != $bytes ) {
            my $should_be = length($self->{'_read_buffer'}) + $self->{'_bytes_to_read'};
            die "Continuation: should want “$should_be” bytes, not $bytes!";
        }
    }

    if ( $bytes > length($self->{'_read_buffer'}) ) {
        $bytes -= length($self->{'_read_buffer'});

        local $!;

        local $self->{'_return'};

        $bytes -= $self->_expand_read_buffer( $bytes );

        return q<> if $self->{'_return'};
    }

    $self->{'_bytes_to_read'} = $bytes;

    if ($bytes) {
        return undef;
    }

    return substr( $self->{'_read_buffer'}, 0, length($self->{'_read_buffer'}), q<> );
}

sub _expand_read_buffer {
    return $_[0]->can('READ')->( $_[0]->{'_in_fh'}, $_[0]->{'_read_buffer'}, $_[1], length($_[0]->{'_read_buffer'}) ) || do {
        if ($!) {
            if ( !$!{'EAGAIN'} && !$!{'EWOULDBLOCK'}) {
                die IO::Framed::X->create( 'ReadError', $! );
            }
        }
        elsif ($_[0]->{'_ALLOW_EMPTY_READ'}) {
            $_[0]->{'_return'} = 1;
            0;
        }
        else {
            die IO::Framed::X->create('EmptyRead');
        }
    };
}

sub read_until {
    my ( $self, $seq ) = @_;

    if ( $self->{'_bytes_to_read'} ) {
        die "Don’t call read_until() after an incomplete read()!";
    }

    die "Missing read-until sequence!" if !defined $seq || !length $seq;

    my $at = index( $self->{'_read_buffer'}, $seq );

    if ($at > -1) {
        return substr( $self->{'_read_buffer'}, 0, $at + length($seq), q<> );
    }

    local $self->{'_return'};

    $self->_expand_read_buffer( 65536 );

    return q<> if $self->{'_return'};

    $at = index( $self->{'_read_buffer'}, $seq );

    if ($at > -1) {
        return substr( $self->{'_read_buffer'}, 0, $at + length($seq), q<> );
    }

    return undef;
}

#----------------------------------------------------------------------

1;