AnyEvent-Proc

 view release on metacpan or  search on metacpan

lib/AnyEvent/Proc.pm  view on Meta::CPAN

            err => $rERR,
            map { ( "$_" => $_->A ) } @xhs,
        },
        pid       => $pid,
        listeners => {
            exit       => delete $options{on_exit},
            ttl_exceed => delete $options{on_ttl_exceed},
        },
        eol     => "\n",
        cv      => $cv,
        alive   => 1,
        waiter  => $waiter,
        waiters => {
            in  => [],
            out => [],
            err => [],
            map { ( "$_" => [] ) } @xhs
        },
        reapers => [],
      } => ref $class
      || $class;

lib/AnyEvent/Proc.pm  view on Meta::CPAN

    {
        my $eol = quotemeta $self->_eol;
        $self->{reol} = delete $options{reol} || qr{$eol};
    }

    if ( $options{ttl} ) {
        $self->{timer} = AnyEvent->timer(
            after => delete $options{ttl},
            cb    => sub {
                return unless $self->alive;
                $self->kill;
                $self->_emit('ttl_exceed');
            }
        );
    }

    my $kill = sub { $self->end };

    if ( $options{timeout} ) {
        $wIN->timeout( $options{timeout} );

lib/AnyEvent/Proc.pm  view on Meta::CPAN

    if ( $options{outstr} ) {
        my $sref = delete $options{outstr};
        $$sref = '';
        $self->pipe( out => $sref );
    }

    $waiter->begin;
    $cv->cb(
        sub {
            $self->{status} = shift->recv;
            $self->{alive}  = 0;
            undef $self->{timer};
            $waiter->end;
            $self->_emit( exit => $self->{status} );
        }
    );

    if ( keys %options ) {
        AE::log note => "unknown left-over option(s): " . join ', ' =>
          keys %options;
    }

lib/AnyEvent/Proc.pm  view on Meta::CPAN

}

sub fire_and_kill {
    my $self   = shift;
    my $cb     = ( ref $_[-1] eq 'CODE' ? pop : undef );
    my $time   = pop;
    my $signal = uc( pop || 'TERM' );
    my $w      = AnyEvent->timer(
        after => $time,
        cb    => sub {
            return unless $self->alive;
            $self->kill;
        }
    );
    $self->fire($signal);
    if ($cb) {
        return $self->wait(
            sub {
                undef $w;
                $cb->(@_);
            }
        );
    }
    else {
        my $exit = $self->wait;
        undef $w;
        return $exit;
    }
}

sub alive {
    my $self = shift;
    return 0 unless $self->{alive};
    $self->fire(0) ? 1 : 0;
}

sub wait {
    my ( $self, $cb ) = @_;

    my $next = sub {
        my $cv = shift;
        $cv->recv;
        waitpid $self->{pid} => 0;

lib/AnyEvent/Proc.pm  view on Meta::CPAN

	$proc->fire('kill')

=head2 fire_and_kill([$signal, ]$time[, $callback])

Fires specified signal C<$signal> (or I<TERM> if omitted) and after C<$time> seconds kills the subprocess.

See L</wait> for the meaning of the callback parameter and return value.

Without calllback, this is a synchronous call. After this call, the subprocess can be considered to be dead. Returns the exit code of the subprocess.

=head2 alive()

Check whether is subprocess is still alive. Returns I<1> or I<0>

In fact, the method equals to

	$proc->fire(0)

=head2 wait([$callback])

Waits for the subprocess to be finished call the callback with the exit code. Returns a condvar.

Without callback, this is a synchronous call directly returning the exit code.

t/000-simple.t  view on Meta::CPAN

    delete @ENV{qw{ LANG LANGUAGE }};
    $ENV{LC_ALL} = 'C';
}

plan tests => 5;

SKIP: {
    my ($bin) = Env::Path->PATH->Whence('xxxxcat');
    skip "test, reason: executable 'cat' not available", 5 unless $bin;
    my $proc = AnyEvent::Proc->new( bin => $bin, ttl => 5 );
    ok $proc->alive(), 'proc is alive';
    $proc->writeln($$);
    ok $proc->alive(), 'proc is still alive (1)';
    is $proc->readline() => $$, 'readline returns my pid';
    ok $proc->alive(), 'proc is still alive (2)';
    $proc->fire();
    is $proc->wait() => 0, 'wait ok, status is 0';
}

done_testing;