http://qs321.pair.com?node_id=340608

fxmakers has asked for the wisdom of the Perl Monks concerning the following question:

Hi!

I'm not sure to understand how waitpid works, as my script always dies returning "No children at test.pl lineXX".
I'm connecting to some servers using a multisocket and vec/select and forking some subs at the same time.
These childs exit with a $result I'd like to store.

Code follows:
use strict; use POSIX ":sys_wait_h"; use IO::Socket::INET; $SIG{'CHLD'} = \&reaper; sub reaper { my $child; while (($child = waitpid(-1, &WNOHANG)) > 0) { my $exit = $? >> 8; print STDOUT "$child returned $exit\n"; } $SIG{'CHLD'} = \&reaper; } my %socklist = (); my $bit = ''; my $socket = &open_socket("tcp", "irc.creatixnet.com", 6667, 3); sub open_socket { my ($proto, $host, $port, $timeout) = (shift, shift, shift, shift); my $socket = IO::Socket::INET->new( Proto => $proto, PeerAddr => $host, PeerPort => $port, Timeout => $timeout ); if (!$socket) { return(0); } return($socket); } if (!$socket) { die("can't connect"); } &add_socket($socket, "IRC"); sub add_socket { my ($socket, $type) = (shift, shift); $socket->autoflush(1); $socklist{$socket}{'sock'} = $socket; $socklist{$socket}{'type'} = $type; $socklist{$socket}{'fileno'} = $socket->fileno(); vec($bit, $socklist{$socket}{'fileno'}, 1) = 1; return(0); } print $socket "USER zxf sdf sdf sdf\n"; print $socket "NICK sdxfsdfg\n"; print $socket "JOIN #fx\n"; sub new_child { my $result = 0; my $pid; if ($pid = fork()) { print STDOUT"new child $pid\n"; return($pid); } elsif (defined($pid)) { print STDOUT "child code here\n"; sleep(2); $result = 2; exit($result); } } my $child = &new_child(); print STDOUT "got a new child: $child\n"; sub loop_socket { my $rin = $bit; $rin =~ /[^\0]/ || next; my $idx = select($rin, undef, undef, 1); my $buffer = ""; $idx || next; $idx > 0 || die($!); my %list = %socklist; while ($idx && (my ($socket, $value) = each(%list))) { $socket = $value->{'sock'}; if (vec($rin, $value->{'fileno'}, 1)) { $buffer = <$socket>; print + STDOUT "IRC: $buffer"; } } return(0); } for (;;) { &loop_socket(); } 1;


Please give me a hand, I'd really appreciate it :)

Replies are listed 'Best First'.
Re: fork/reaper
by blue_cowdawg (Monsignor) on Mar 29, 2004 at 15:26 UTC

        I'm not sure to understand how waitpid works, as my script always dies returning "No children at test.pl lineXX".

    IIRC by the time your handler is called your child has already died.


    Peter L. Berghold -- Unix Professional
    Peter at Berghold dot Net
       Dog trainer, dog agility exhibitor, brewer of fine Belgian style ales. Happiness is a warm, tired, contented dog curled up at your side and a good Belgian ale in your chalice.
      Any idea on how to get children's exit $result before he dies?

      UPDATED: ok I think I got it
      Added &reaper into the infinite loop and deleted $SIG{CHLD}
      Seems to work now.
      (I'd like to know if this is the good way)

            Any idea on how to get children's exit $result before he dies?

        You probably should keep a SIGCHLD handler around just to catch that signal to avoid zombies.


        Peter L. Berghold -- Unix Professional
        Peter at Berghold dot Net
           Dog trainer, dog agility exhibitor, brewer of fine Belgian style ales. Happiness is a warm, tired, contented dog curled up at your side and a good Belgian ale in your chalice.