File: IPC_Run.pm

package info (click to toggle)
libnet-cli-interact-perl 2.142720-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 420 kB
  • ctags: 127
  • sloc: perl: 1,907; makefile: 2
file content (85 lines) | stat: -rw-r--r-- 1,805 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
package Net::CLI::Interact::Transport::Wrapper::IPC_Run;
{
  $Net::CLI::Interact::Transport::Wrapper::IPC_Run::VERSION = '2.142720';
}

use Moo;
use Sub::Quote;
use MooX::Types::MooseLike::Base qw(ScalarRef InstanceOf);

extends 'Net::CLI::Interact::Transport::Wrapper::Base';

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

use IPC::Run ();

has '_in' => (
    is => 'rw',
    isa => ScalarRef,
    default => sub { \eval "''" },
);

# writer for the _in slot
sub put { ${ (shift)->_in } .= join '', @_ }

has '_out' => (
    is => 'ro',
    isa => ScalarRef,
    default => sub { \eval "''" },
);

sub buffer {
    my $self = shift;
    return ${ $self->_out } if scalar(@_) == 0;
    return ${ $self->_out } = shift;
}

# clearer for the _out slot
has '_err' => (
    is => 'ro',
    isa => ScalarRef,
    default => sub { \eval "''" },
);

has '_timeout_obj' => (
    is => 'lazy',
    isa => InstanceOf['IPC::Run::Timer'],
);

sub _build__timeout_obj { return IPC::Run::timeout((shift)->timeout) }

has '+timeout' => (
    trigger => quote_sub(q{(shift)->_timeout_obj->start(shift) if scalar @_ > 1}),
);

has '+wrapper' => (
    isa => InstanceOf['IPC::Run'],
    handles => ['pump'],
);

around '_build_wrapper' => sub {
    my ($orig, $self) = (shift, shift);

    $self->logger->log('transport', 'notice', 'booting IPC::Run harness for', $self->app);
    $self->$orig(@_);

    return IPC::Run::harness(
        [$self->app, $self->runtime_options],
            $self->_in,
            $self->_out,
            $self->_err,
            $self->_timeout_obj,
    );
};

before 'disconnect' => sub {
    my $self = shift;
    $self->wrapper->kill_kill(grace => 1);
};

1;