#!/usr/bin/perl 
# vim: ts=2 sw=2 filetype=perl expandtab

# Scott Beck reported that tied STDERR breaks POE::Wheel::Run.  He
# suggested untying STDOUT and STDERR in the child process.  This test
# makes sure the bad behavior does not come back.

use strict;

# Skip these tests if fork() is unavailable.
BEGIN {
  my $error;
  if ($^O eq "MacOS") {
    $error = "$^O does not support fork";
  }
  elsif ($^O eq "MSWin32") {
    eval "use Win32::Console";
    if ($@) {
      $error = "Win32::Console is required on $^O.";
    }
    elsif ($] < 5.010000) {
      $error = "$^O ver. $] doesn't fork/exec properly. Consider upgrading.";
    }
  }
  if ($error) {
    print "1..0 # Skip $error\n";
    exit();
  }
}

sub DEBUG () { 0 }

use Test::More tests => 1;

sub POE::Kernel::ASSERT_DEFAULT () { 1 }

BEGIN {
  package POE::Kernel;
  use constant TRACE_DEFAULT => exists($INC{'Devel/Cover.pm'});
}

use POE qw/Wheel::Run Session/;

tie *STDERR, 'Test::Tie::Handle';
POE::Session->create(
  inline_states => {
    _start => sub {
      my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];

      $_[KERNEL]->sig( 'CHLD', 'sigchld' );
      $_[KERNEL]->refcount_increment( $session->ID, "teapot" );
      DEBUG and diag( "Installing CHLD signal Handler" );
      my $wheel = POE::Wheel::Run->new(
        Program     => [ $^X, '-e', 'warn "OK"' ],
        StderrEvent => 'stderr'
      );
      $heap->{wheel} = $wheel;
      $heap->{pid} = $wheel->PID;
      $kernel->delay(shutdown => 3);
      $heap->{got_stderr} = 0;
    },
    stderr => sub {
      delete $_[HEAP]->{wheel};
      $_[HEAP]->{got_stderr}++;
      $_[KERNEL]->delay(shutdown => undef);
    },
    shutdown => sub {
      delete $_[HEAP]->{wheel};
    },
    sigchld => sub {
      DEBUG and diag( "Got SIGCHLD for PID $_[ARG1]" );
      if ($_[ARG1] == $_[HEAP]->{pid}) {
        DEBUG and diag( "PID Matches, removing CHLD handler" );
        $_[KERNEL]->sig( 'CHLD' );
        $_[KERNEL]->refcount_decrement( $_[SESSION]->ID, "teapot" );
      }
    },
    _stop => sub {
      ok($_[HEAP]->{got_stderr}, "should receive STDERR even when tied");
    },
  },
);

$poe_kernel->run;

BEGIN {
  package Test::Tie::Handle;
  use Tie::Handle;
  use vars qw(@ISA);
  @ISA = 'Tie::Handle';
  use Symbol qw(gensym);

  sub TIEHANDLE {
    my $class = shift;
    my $fh    = gensym();
    bless $fh, $class;
    $fh->OPEN(@_) if (@_);
    return $fh;
  }

  sub EOF     { eof($_[0]) }
  sub TELL    { tell($_[0]) }
  sub FILENO  { fileno($_[0]) }
  sub SEEK    { seek($_[0],$_[1],$_[2]) }
  sub CLOSE   { close($_[0]) }
  sub BINMODE { binmode($_[0]) }

  sub OPEN {
    $_[0]->CLOSE if defined($_[0]->FILENO);
    open(@_);
  }

  sub READ     { read($_[0],$_[1],$_[2]) }
  sub READLINE { my $fh = $_[0]; <$fh> }
  sub GETC     { getc($_[0]) }

  my $out;
  sub WRITE {
    my $fh = $_[0];
    $out .= substr($_[1],0,$_[2]);
  }
}