use IO::Select ();
use IO::Socket ();
use Net::Server::SIG qw(register_sig check_sigs);
use POSIX ();
print "Usage: $0 SIGNAME SAFE|UNSAFE
(SIGNAME is a standard signal - default is USR1)
(SAFE will use Net::Server::SIG, UNSAFE uses \$SIG{} - default is SAFE)
If the child isn't saying anything, the test is invalid.
If the child dies, look for a core file.
";
my $SIG = shift() || 'USR1';
my $safe = shift() || 'SAFE';
$safe = uc($safe) eq 'UNSAFE' ? undef : 1;
my $x = 0;
my %hash = ();
pipe(READ,WRITE);
READ->autoflush(1);
WRITE->autoflush(1);
STDOUT->autoflush(1);
my $pid = fork();
die "Couldn't fork [$!]" unless defined $pid;
$SIG{CHLD} = sub {
print "P ($$): Child died (\$?=$?)\n"
while (waitpid(-1, POSIX::WNOHANG()) > 0);
};
if( $pid ){
sleep(2);
for(1..4){
my $pid2 = fork();
unless( defined $pid2 ){
kill 9, $pid;
die "Couldn't fork [$!]";
}
unless( $pid2 ){
$SIG{CHLD} = 'DEFAULT';
last;
}
}
print "P ($$): Starting up!\n";
my $n = 50000;
while (1){
last unless kill $SIG, $pid;
unless( ++$x % $n ){
print "P ($$): $x SIG_$SIG\'s sent.\n";
print WRITE "$n\n";
}
}
}else{
print "C ($$): Starting up!\n";
my $select = IO::Select->new();
$select->add(\*READ);
my $subroutine = sub {
$hash{foo} = "abcde"x10000;
$hash{bar} ++;
delete $hash{baz};
delete $hash{bar};
};
if( $safe ){
print "C ($$): Using SAFE signal handler.\n";
register_sig($SIG => $subroutine);
}else{
print "C ($$): Using UNSAFE signal handler.\n";
$SIG{$SIG} = $subroutine;
}
my $total = 0;
while ( 1 ){
my @fh = $select->can_read(10);
my $key;
my $val;
next if &check_sigs() && ! @fh;
delete $hash{foo};
$hash{bar} = 0;
$hash{baz} = "abcde"x100000;
next unless @fh;
my $line = <READ>;
chomp($line);
$total += $line;
print "C ($$): P said \"$line\"\n";
unless( ++$x % 5 ){
print "C ($$): $x lines read. $total SIG's received\n";
}
}
print "Child is done\n";
}