File Coverage

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

Criterion	Covered	Total	%
statement	34	39	87.1
branch	4	10	40.0
condition			n/a
subroutine	10	10	100.0
pod	1	1	100.0
total	49	60	81.6

package Crypt::Random::Source::Base::Proc;
# ABSTRACT: Base class for helper processes (e.g. C)

our $VERSION = '0.11';

use Moo;

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

use Capture::Tiny 0.08 qw(capture);
use File::Spec;
use IO::File 1.14;
use Types::Standard qw(Str);
use namespace::clean;

use 5.008;

has command => ( is => "rw", required => 1 );
has search_path => ( is => 'rw', isa => Str, lazy => 1, builder => 1);

# This is a scalar so that people can customize it (which they would
# particularly need to do on Windows).
our $TAINT_PATH =
    '/usr/local/bin:/usr/bin:/bin:/usr/local/sbin:/usr/sbin:/sbin';

sub _build_search_path {
    # In taint mode it's not safe to use $ENV{PATH}.
    if (${^TAINT}) {
        return $TAINT_PATH;
    }
    return $ENV{PATH};
}

sub open_handle {
    my $self = shift;

    my $cmd = $self->command;
    my @cmd = ref $cmd ? @$cmd : $cmd;
    my $retval;
    local $ENV{PATH} = $self->search_path;
    my ($stdout, $stderr) = capture { $retval = system(@cmd) };
    chomp($stderr);
    if ($retval) {
        my $err = join(' ', @cmd) . ": $! ($?)";
        if ($stderr) {
            $err .= "\n$stderr";
        }
        die $err;
    }
    warn $stderr if $stderr;

    my $fh = IO::File->new(\$stdout, '<');

    return $fh;
}

1;

=pod

=encoding UTF-8

=head1 NAME

Crypt::Random::Source::Base::Proc - Base class for helper processes (e.g. C)

=head1 VERSION

version 0.11

=head1 SYNOPSIS

    use Moose;

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

    has '+command' => ( default => ... );

=head1 DESCRIPTION

This is a base class for using command line utilities which output random data
on STDOUT as L objects.

=head1 ATTRIBUTES

=head2 command

An array reference or string that is the command to run.

=head1 METHODS

=head2 open_handle

Opens a pipe for reading using C.

=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__