want to get the die error message from a command executed via open in Perl

Question

I am trying to fork out a cmd like below

my $h = IO::Handle->new;
$self->{-handle} = $h;

die "IO::Handle->new failed." unless defined $h;
$self->{-pid} = open $h, $self->{-command} . ' 2>&1 |';
$self->fileevent($h, 'readable' => [\&_read_cmd_op, $self]);

sub _read_cmd_op{
    my $h = $self->{-handle};
    if ( sysread $h, $_, 4096 ) {
        my $t = $self->Subwidget('text');
        $t->insert('end', $_);
        $t->yview('end');
    } else {
        $self->{-finish} = 1;
    }
}

Now the problem is that the '$self{-command}' is invoking another perl script which if dies I want to know.

Note that the $self{-pid} still exists even if cmd dies.

The above code is in a Perl/TK app, where the $self->{-command} o/p in captured in a text widget.

Somehow i don't get the die message even in the test widget. I see it on stdout.

2 questions

1. How can i get the cmd op/error in the text widget?

2. How can i know that the command fired via IO::Handle died?

Answer 1

$self->{-pid} is just the pid of the forked process, not some magic object which goes away if the command exits.

I cannot reproduce the problem not getting the die() message. If the snippet above is called with 'perl -e "die 123"', then "123" appears in the text widget (at least on a Unix system).

For getting the exit code you can use something like the following.

} else {
    $mw->fileevent($h, 'readable', '');
    my $pid = waitpid($self->{-pid},0);
    warn "pid $pid finished";
    warn "retcode is " . ($? >> 8);
    $self->{-finish} = 1;
}

The fileevent call with the empty callback stops further selects on this filehandle. With the waitpid call you wait for the termination of the child process. Once this happens, the exit code is available in the $? variable, like after a normal system() call. So for a non-zero exit code you know that the command died or exited with a false value.