++zaxo - Wonderfully useful still these many years later!
I continue to be confused by the select... while kill $ppid, 0; even with the note about it in the description. Can someone elaborate some more to help me understand better?
Here is my modified version of the original code. I ended up making it more verbose, and added additional code for the parent to manage the children.
Please feel free to comment or suggest improvements!
Thanks
-Craig
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
$::DEBUG = 1; # 0=off
my $DKID; # Daemon kid PID
my %CKIDS; # Client kids PIDs
# Make a pipe (in/out filehandles are parent's process id)...
my ($ppid, $in, $out) = $$;
pipe ($in, $out) or die $!;
print STDERR "Parent is $ppid\n";
##################
# spawn daemon kid
##################
{
local $|=1;
# Fork daemon child...
my $child;
defined($child = fork) or die $!;
# Parent & kid sort themselves out...
if($child) {
print STDERR "daemon child is $child\n" if $::DEBUG;
$DKID=$child;
last;
}
# Kid code...
print STDERR "I am Daemon child $$\n" if $::DEBUG;
close $out or die $!; # deamon kid does not write, only reads
# Daemon reads input side of pipe, forever...
while (<$in>){
#print "Daemon got: $_";
print ".";
}
exit 0;
}
###################
# spawn client kids
###################
{
select($out); local $|=1;
# Spawn 10 client kids...
for my $kid (1..10) {
# Fork kid...
my $child;
defined($child = fork) or die $!;
# Parent & kid sort themselves out...
if($child) { # Parent
$CKIDS{$child} = $kid;
next; # Parent moves on
}
# Kid code...
print STDERR "I am client child $$\n" if $::DEBUG;
close $in; # client kid does not read, only writes
# Print out messages at random times...
select(undef, undef, undef, rand(1000)/1000),
print 'Child ', $kid,
' pid=', $$,
' message=', 0 | rand 10000,
"\n"
for 1..10;
exit 0;
}
}
#############
# Manage kids
#############
print STDERR "CKIDS DUMP:\n", Dumper(\%CKIDS), "\n" if $::DEBUG;
# Watch kids until all are gone...
my $ret;
while ( ($ret = waitpid(-1, 0)) > 0 ) {
# Handle dead kid...
print STDERR "\nPARENT: Child ret=$ret status: $?\n" if $::DEBUG;
my $exit_value = $? >>8;
my $signal_num = $? & 127;
my $dumped_core = $? & 128;
print STDERR "PARENT: Child exit=$exit_value, sig=$signal_num,
core=$dumped_core\n" if $::DEBUG;
# Remove from list if client kid...
delete($CKIDS{$ret});
print STDERR "CKIDS DUMP:\n", Dumper(\%CKIDS), "\n" if $::DEBUG;
# If no more client kids, kill daemon kid...
if(scalar(keys(%CKIDS)) <= 0) {
# Will repeatadly hit this code if daemon kid doesn't die...
print STDERR "All client kids gone, killing daemon kid...\n" i
+f $::DEBUG;
kill('HUP', $DKID);
}
}
print STDERR "PARENT: All kids gone, exiting\n";
|