readline_pipes_child.t

#!/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_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 { 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',
    );
    $kernel->sig_child($child->PID(), 'got_child_signal');
    $heap->{child} = $child;
}

sub got_child_output {
    my ($heap, $line) = @_[HEAP, ARG0];
    $heap->{got_foo} = 1 if $line =~ /foo/;
}

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', '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 { print "foo\n" });
    }
    elsif ($heap->{children_done} == 3) {
        diag("Running exec child with ReadLine and STDOUT/STDERR as pipes");
        $kernel->yield('run_child', [$^X, '-e', '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;
    }
    return;
}

sub got_output {
    my ($heap, $line) = @_[OBJECT, ARG0];
    $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;
}

###################################


$ prove -vl t/90_regression/readline_pipes_child.t 
t/90_regression/readline_pipes_child.t .. 
1..4
# Running coderef child without ReadLine
ok 1 - Got output from child before it died
# Running exec child without ReadLine
ok 2 - Got output from child before it died
# Running coderef child with ReadLine and STDOUT/STDERR as pipes
ok 3 - Got output from child before it died
                                           # Running exec child with ReadLine and STDOUT/STDERR as pipes
                                                                                                        not ok 4 - Got output from child before it died

                                        #   Failed test 'Got output from child before it died'
                                                                                              #   at t/90_regression/readline_pipes_child.t line 54.
                                     # Looks like you failed 1 test of 4.
Dubious, test returned 1 (wstat 256, 0x100)
Failed 1/4 subtests 

Test Summary Report
-------------------
t/90_regression/readline_pipes_child.t (Wstat: 256 Tests: 4 Failed: 1)
  Failed test:  4
  Non-zero exit status: 1
Files=1, Tests=4,  0 wallclock secs ( 0.02 usr  0.01 sys +  0.12 cusr  0.01 csys =  0.16 CPU)
Result: FAIL