File Coverage

blib/lib/Net/SSH/Any/Test/Isolated.pm

Criterion	Covered	Total	%
statement	93	122	76.2
branch	11	24	45.8
condition	6	14	42.8
subroutine	21	29	72.4
pod	0	3	0.0
total	131	192	68.2

package Net::SSH::Any::Test::Isolated;

use strict;
use warnings;
use feature qw(say);
use Carp;
use Scalar::Util ();
use Data::Dumper;
use IPC::Open2 qw(open2);

our $debug;

use parent qw(Net::SSH::Any::Test::Isolated::_Base);
use Net::SSH::Any::URI;


sub _default_logger {
    my ($fh, $text) = @_;
    print {$fh} $text;
}

sub _diag_logger {
    require Test::More;
    Test::More::diag($_[1]);
}

sub new {
    my ($class, %opts) = @_;
    my $self = $class->SUPER::_new('client');

    my $logger_fh = delete $opts{logger_fh} // \*STDERR;
    open my $logger_fh_dup, '>>&', $logger_fh;
    $self->{logger_fh} = $logger_fh_dup;
    my $logger = delete $opts{logger} // \&_default_logger;
    unless (ref $logger) {
        if ($logger eq 'diag') {
            $logger = \&_diag_logger;
        }
        else {
            croak "Bad logger argument '$logger'";
        }
    }
    $self->{logger} = $logger;
    $self->{perl} = $opts{local_perl_cmd} // $^X // 'perl';
    $self->_bootstrap;
    $self->_start(%opts);

    $self;
}

sub _log {
    my $self = shift;
    $self->{logger}->($self->{logger_fh}, @_);
}

sub _bootstrap {
    my $self = shift;
    $self->_check_state('new');
    my $perl = $self->{perl} or return;
    $self->{pid} = open2($self->{in}, $self->{out}, $^X);

    my $old = select($self->{out});
    $| = 1;
    select $old;

    my $inc = Data::Dumper::Dumper([grep defined && !ref, @INC]);
    my $debug_as_str = ($debug ? -1 : 'undef');

    my $code = <

use lib \@{$inc};

use strict;
use warnings;

\$Net::SSH::Any::Test::Isolated::debug = $debug_as_str;

use Net::SSH::Any::Test::Isolated::_Slave;
Net::SSH::Any::Test::Isolated::_Slave->run;

__END__