File Coverage

blib/lib/Crypt/Random/Source/Base/Handle.pm

Criterion	Covered	Total	%
statement	43	46	93.4
branch	9	12	75.0
condition	11	18	61.1
subroutine	14	16	87.5
pod	5	7	71.4
total	82	99	82.8

package Crypt::Random::Source::Base::Handle;
# ABSTRACT: L based random data sources

our $VERSION = '0.11';

use Moo;
use Types::Standard qw(Bool);

use Errno;

use Carp qw(croak);
use IO::Handle;
use namespace::clean;

extends qw(Crypt::Random::Source::Base);

has allow_under_read => (
    isa => Bool,
    is  => "rw",
    default => 0,
);

has reread_attempts => (
    is => "rw",
    default => 1,
);

has handle => (
    is => "rw",
    lazy => 1,
    builder => 1,
    predicate  => "has_handle",
    clearer    => "clear_handle",
);

sub blocking { shift->handle->blocking(@_) }
sub read { shift->handle->read(@_) }
sub opened { shift->handle->opened(@_) }

sub DEMOLISH {
    my $self = shift;
    $self->close;
}

sub _build_handle {
    my ( $self, @args ) = @_;
    $self->open_handle;
}

sub open_handle {
    die "open_handle is an abstract method";
}

sub get {
    my ( $self, $n, @args ) = @_;

    croak "How many bytes would you like to read?" unless $n;

    return $self->_read($self->handle, $n, @args);
}

sub _read {
    my ( $self, $handle, $n, @args) = @_;

    my $buf;
    my $got = $self->read($buf, $n);

    if ( defined($got) && $got == $n || $!{EWOULDBLOCK} || $!{EAGAIN} ) {
        return $buf;
    } else {
        croak "read error: $!" unless defined $got;
        return $self->_read_too_short($buf, $got, $n, @args);
    }
}

sub _read_too_short {
    my ( $self, $buf, $got, $req, %args ) = @_;

    if ( $self->allow_under_read ) {
        return $buf;
    } else {
        if ( ($self->reread_attempts || 0) >= ($args{reread_attempt} || 0) ) {
            croak "Source failed to read enough bytes (requested $req, got $got)";
        } else {
            return $buf . $self->_read( $req - $got, reread_attempt => 1 + ( $args{reread_attempt} || 0 ) );
        }
    }
}

sub close {
    my $self = shift;

        # During global destruction, $self->handle can be undef already,
        # so we need to also check if it is defined.
    if ( $self->has_handle and $self->handle ) {
        $self->handle->close; # or die "close: $!"; # open "-|" returns exit status on close
        $self->clear_handle;
    }
}

1;

=pod

=encoding UTF-8

=head1 NAME

Crypt::Random::Source::Base::Handle - L based random data sources

=head1 VERSION

version 0.11

=head1 SYNOPSIS

    use Moose;
    extends qw(Crypt::Random::Source::Base::Handle);

    sub open_handle {
        # invoked as needed
    }


    # this class can also be used directly
    Crypt::Random::Source::Base::Handle->new( handle => $file_handle );


    # it supports some standard methods:

    $p->blocking(0);

    $p->read( my $buf, $n ); # no error handling here

=head1 DESCRIPTION

This is a concrete base class for all L based random data sources.

It implements error handling

=head1 ATTRIBUTES

=head2 handle

An L or file handle to read from.

=head2 blocking

This is actually handled by C, and is documented in L.

=head2 allow_under_read

Whether or not under reading is considered an error.

Defaults to false.

=head2 reread_attempts

The number of attempts to make at rereading if the handle did not provide
enough bytes on the first attempt.

Defaults to 1.

Only used if C is enabled.

=head1 METHODS

=head2 get

See L.

When C or C are set to a true value this method may
return fewer bytes than requested.

=head2 read

This delegates directly to C.

It B provide the same validation as C would have, so no checking
for underreads is done.

=head2 close

Close the handle and clear it.

=head2 _read

C<< $self->handle->read >> but with additional error checking and different
calling conventions.

=head2 _read_too_short

Called by C<_read> when not enough data was read from the handle. Normally it
will either die with an error or attempt to reread. When C is
true it will just return the partial buffer.

=head2 open_handle

Abstract method, should return an L to use.

=head1 SUPPORT

Bugs may be submitted through L
(or L).

=head1 AUTHOR

יובל קוג'מן (Yuval Kogman)

=head1 COPYRIGHT AND LICENCE

This software is copyright (c) 2008 by Yuval Kogman.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut

__END__