| Subject: | POE::Wheel::Run fails to redirect piped STDOUT/STDERR |
When using POE::Wheel::ReadLine, it is convenient to replace
STDOUT/STDERR with pipes which call $readline->put() so that you don't
have to change any code in your program which writes to these handles.
However, when running a program via exec (i.e. not a coderef) with
POE::Wheel::Run under these conditions, no stdout/stderr will be
delivered from the child process. From looking at Run.pm, it should be
redirecting STDIN/STDOUT/STDERR in the child in every scenario (see
_redirect_child_stdio_sanely()), though.
Attached is a test case which demonstrates the problem.
| Subject: | foo.pl |
#!/usr/bin/env perl
use strict;
use warnings;
use POE;
use POE::Wheel::ReadLine;
use POE::Wheel::Run;
use POE::Wheel::ReadWrite;
use Symbol 'gensym';
use Test::More tests => 4;
POE::Session->create(
package_states => [
(__PACKAGE__) => [
qw(
_start
run_child
got_output
got_child_output
got_child_stderr
got_child_signal
setup_readline
got_user_input
pipe_error
close_pipes
)
],
],
);
$poe_kernel->run;
sub _start {
my ($kernel, $heap) = @_[KERNEL, HEAP];
diag("Running coderef child without ReadLine");
$kernel->yield('run_child', sub { sleep 1; print "foo\n" });
}
sub run_child {
my ($kernel, $heap, $program) = @_[KERNEL, HEAP, ARG0];
my $child = POE::Wheel::Run->new(
Program => $program,
StdoutEvent => 'got_child_output',
StderrEvent => 'got_child_stderr',
);
$kernel->sig_child($child->PID(), 'got_child_signal');
$heap->{child} = $child;
}
sub got_child_output {
my ($heap, $line) = @_[HEAP, ARG0];
my $err = $heap->{orig_stderr} // \*STDERR;
print $err "!!! $line\n";
$heap->{got_foo} = 1 if $line =~ /foo/;
}
sub got_child_stderr {
my ($heap, $line) = @_[HEAP, ARG0];
my $err = $heap->{orig_stderr};
print $err "### $line\n";
}
sub got_child_signal {
my ($kernel, $heap) = @_[KERNEL, HEAP];
ok($heap->{got_foo}, "Got output from child before it died");
delete $heap->{child};
delete $heap->{got_foo};
$heap->{children_done}++;
if ($heap->{children_done} == 1) {
diag("Running exec child without ReadLine");
$kernel->yield('run_child', [$^X, '-e', 'sleep 1; print "foo\n"']);
}
elsif ($heap->{children_done} == 2) {
diag("Running coderef child with ReadLine and STDOUT/STDERR as pipes");
$kernel->yield('setup_readline');
$kernel->yield('run_child', sub { sleep 1; print "foo\n" });
}
elsif ($heap->{children_done} == 3) {
diag("Running exec child with ReadLine and STDOUT/STDERR as pipes");
$kernel->yield('setup_readline');
$kernel->yield('run_child', [$^X, '-e', 'sleep 1; print "foo\n"']);
}
elsif ($heap->{children_done} == 4) {
$kernel->yield('close_pipes');
}
}
sub setup_readline {
my ($kernel, $heap) = @_[KERNEL, HEAP];
$heap->{console} = POE::Wheel::ReadLine->new(
InputEvent => 'got_user_input',
PutMode => 'immediate',
);
open my $orig_stderr, '>&', STDERR or die "Can't dup STDERR: $!";
$heap->{orig_stderr} = $orig_stderr;
open my $orig_stdout, '>&', STDOUT or die "Can't dup STDOUT: $!";
$heap->{orig_stdout} = $orig_stdout;
my ($read_stderr, $read_stdout) = (gensym(), gensym());
pipe $read_stdout, STDOUT or do {
open STDOUT, '>&=', 1;
die "Can't pipe STDOUT: $!";
};
pipe $read_stderr, STDERR or do {
open STDERR, '>&=', '2';
die "Can't pipe STDERR: $!";
};
STDOUT->autoflush(1);
STDERR->autoflush(1);
$heap->{stderr_reader} = POE::Wheel::ReadWrite->new(
Handle => $read_stderr,
InputEvent => 'got_output',
ErrorEvent => 'pipe_error',
);
$heap->{stdout_reader} = POE::Wheel::ReadWrite->new(
Handle => $read_stdout,
InputEvent => 'got_output',
ErrorEvent => 'pipe_error',
);
$heap->{console}->get('');
return;
}
sub pipe_error {
my ($heap) = $_[HEAP];
$heap->{closed_pipe}++;
if ($heap->{closed_pipe} == 2) {
delete $heap->{stderr_reader};
delete $heap->{stdout_reader};
delete $heap->{console};
my $orig_stderr = delete $heap->{orig_stderr};
open STDERR, '>&', $orig_stderr;
STDERR->autoflush(1);
my $orig_stdout = delete $heap->{orig_stdout};
open STDOUT, '>&', $orig_stdout;
STDOUT->autoflush(1);
}
return;
}
sub got_output {
my ($heap, $line) = @_[OBJECT, ARG0];
my $err = $heap->{orig_stderr};
print $err "??? $line\n";
$heap->{console}->put($line);
}
sub got_user_input {
my ($heap, $line, $ex) = @_[HEAP, ARG0, ARG1];
die if defined $ex && $ex eq 'interrupt';
}
sub close_pipes {
close STDOUT;
close STDERR;
}