#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 205;
use POE;
use POE::Session::Hachi;
pass( "Before Create" );
POE::Session::Hachi->create(
package_states => [
main => [ qw(_start go chld _stop) ],
],
heap => {
pids => {},
child => 0,
},
);
sub _start {
pass( "Start" );
$POE::KERNEL->sig( 'CHLD', 'chld' );
$POE::KERNEL->yield( 'go' );
}
sub go {
my $pids = $POE::HEAP->{pids};
for my $count (1..100) {
my $return = int( rand( 100 ) );
my $fork = fork();
if ($fork) {
pass( "Parent ($$)!" );
if (exists( $pids->{$fork} )) {
fail( "Child PID already used" );
}
else {
$pids->{$fork} = $return;
}
}
elsif (defined( $fork )) {
$POE::HEAP->{child} = 1;
sleep( 2 );
exit( $return );
}
else {
fail( "Fork Failed!" );
}
}
$POE::HEAP->{done} = 1;
}
sub chld {
my $package = shift;
my $pid = $_[1];
my $return = $_[2] >> 8;
my $pids = $POE::HEAP->{pids};
if(exists( $pids->{$pid} )) {
if($pids->{$pid} == $return) {
pass( "Yay!" );
}
else {
fail( "PID Return value was unexpected" );
}
delete( $pids->{$pid} );
}
else {
fail( "Signal received for pid that was not forked" );
}
if (keys( %$pids ) == 0 and $POE::HEAP->{done}) {
$POE::KERNEL->sig( 'CHLD' );
}
$POE::KERNEL->sig_handled();
}
sub _stop {
if ($POE::HEAP->{child}) {
# This is stranger for interaction than you can imagine, try it some time.
# fail( "This should not get called by a child." );
}
else {
pass( "This should be called in the parent." );
}
}
pass( "Before Run" );
POE::Kernel->run();
pass( "After Run" );
# vim: filetype=perl