File Coverage

blib/lib/Net/CLI/Interact/Transport/Wrapper/Base.pm

Criterion	Covered	Total	%
statement	24	61	39.3
branch	0	16	0.0
condition	0	5	0.0
subroutine	8	15	53.3
pod	0	8	0.0
total	32	105	30.4

package Net::CLI::Interact::Transport::Wrapper::Base;
{ $Net::CLI::Interact::Transport::Wrapper::Base::VERSION = '2.400000' }

use Moo;
use Sub::Quote;
use MooX::Types::MooseLike::Base qw(Int RegexpRef Str Object);
use Time::HiRes qw( sleep );

with 'Net::CLI::Interact::Role::FindMatch';

{
    package # hide from pause
        Net::CLI::Interact::Transport::Wrapper::Base::Options;
    use Moo;
}

has 'use_net_telnet_connection' => (
    is => 'rw',
    isa => Int,
    default => quote_sub('0'),
);

has 'irs_re' => (
    is => 'ro',
    isa => RegexpRef,
    default => quote_sub(q{ qr/(?:\015\012|\015|\012)/ }), # first wins
);

has 'ors' => (
    is => 'rw',
    isa => Str,
    default => quote_sub(q{"\n"}),
);

has 'timeout' => (
    is => 'rw',
    isa => quote_sub(q{ die "$_[0] is not a posint!" unless $_[0] > 0 }),
    default => quote_sub('10'),
);

has 'app' => (
    is => 'lazy',
    isa => Str,
    predicate => 1,
    clearer => 1,
);

has 'stash' => (
    is => 'rw',
    isa => Str,
    default => quote_sub(q{''}),
);

has 'wrapper' => (
    is => 'lazy',
    isa => Object,
    predicate => 'connect_ready',
    clearer => 1,
);

sub _build_wrapper {
    my $self = shift;
    $self->logger->log('transport', 'notice', 'connecting with: ',
        $self->app, (join ' ', map {($_ =~ m/\s/) ? ("'". $_ ."'") : $_}
                                   $self->runtime_options));
    # this better be wrapped otherwise it'll blow up
};

sub init { (shift)->wrapper(@_) }

sub flush {
    my $self = shift;
    my $content = $self->stash . $self->buffer;
    $self->stash('');
    $self->buffer('');
    return $content;
}

sub disconnect {
    my $self = shift;
    $self->clear_wrapper;
    $self->flush;
}

sub _abc { die "not implemented." }

sub put { _abc() }
sub pump { _abc() }
sub buffer { _abc() }

sub DEMOLISH { (shift)->disconnect }

sub do_action {
    my ($self, $action) = @_;
    $self->logger->log('transport', 'info', 'callback received for', $action->type);

    if ($action->type eq 'match') {
        my $irs_re = $self->irs_re;
        my $cont = $action->continuation;

        while ($self->pump) {
            # remove control characters
            (my $buffer = $self->buffer) =~ s/[\000-\010\013\014\016-\032\034-\037]//g;
            $self->logger->log('dump', 'debug', "SEEN:\n'". $buffer. "'");

            if ($buffer =~ m/^(.*$irs_re)(.*)/s) {
                $self->stash($self->stash . $1);
                $self->buffer($2 || '');
            }

            if ($cont and $self->find_match($self->buffer, $cont->first->value)) {
                $self->logger->log('transport', 'debug', 'continuation matched');
                $self->buffer('');
                $self->put($cont->last->value);
            }
            elsif (my $hit = $self->find_match($self->buffer, $action->value)) {
                $self->logger->log('transport', 'info',
                    sprintf 'output matched %s, storing and returning', $hit);
                $action->prompt_hit($hit);
                $action->response_stash($self->stash);
                $action->response($self->buffer);
                $self->flush;
                last;
            }
            else {
                $self->logger->log('transport', 'debug', "nope, doesn't (yet) match",
                    (ref $action->value eq ref [] ? (join '|', @{$action->value})
                                                : $action->value));
            }

            sleep(0.01);
        }
    }
    if ($action->type eq 'send') {
        my $command = sprintf $action->value, @{ $action->params };
        $self->logger->log('dialogue', 'notice', 'queueing data for send: "'. $command .'"');
        $self->put( $command, ($action->no_ors ? () : $self->ors) );
    }
}

1;