Many-to-One pipe

I composed this ditty to demonstrate how to let one child process collect data from many client processes forked from the same parent. This was motivated by suaveant's question about speedy local IPC at Fastest way to talk to a perl daemon.

This demo program shows how the file descriptor for the write end of a pipe is duplicated on fork, allowing many processes to share it.

The select... while kill $ppid, 0; line in the client code is there just to keep the kids idle until the parent has departed. That is to avoid waiting or ignoring SIGCHLD. A persistent parent server would need to clean up after the kids.

#!/usr/bin/perl
use warnings;
use strict;

my ( $ppid, $in, $out) = $$;
pipe ( $in, $out) or die $!;

# "Daemon"
{
    local *STDIN = $in;
    local $| = 1;
    my $child;
    defined( $child = fork) or die $!;
    last if $child;
    close $out or die $!;
    print while <STDIN>;
    exit 0;
}

# Spawn some client processess
{
    local *STDOUT = $out;
    local $| = 1;
    for my $kid (1..50) {
        my $child;
        defined( $child = fork) or die $!;
        next if $child;
        close $in;
        select( undef, undef, undef, .001)
          while kill $ppid, 0;
        select( undef, undef, undef, rand(1000)/1000),
          print 'Child ', $kid,
                ' pid=', $$,
                ' message=', 0 | rand 10000,
                $/
          for 1..20;
        exit 0;
    }
}
[download]

Comment on Many-to-One pipe Download Code

Replies are listed 'Best First'.
Re: Many-to-One pipe by RMGir (Prior) on Aug 07, 2002 at 12:14 UTC
(Edit: See particle's comment; all that's missing is an '' on the locals... Removed my questions wondering why it didn't work.) Here's a version that works for me. I reduced the limits so it didn't spam quite as much :) #!/usr/bin/perl use warnings; use strict; my ( $ppid, $in, $out) = $$; pipe ( $in, $out) or die $!; # "Daemon" { #local STDIN = $in; local $\| = 1; my $child; defined( $child = fork) or die $!; last if $child; close $out or die $!; while (<$in>){ print "Parent got: $_"; } exit 0; } # Spawn some client processess { #local STDOUT = $out; select($out); local $\| = 1; for my $kid (1..10) { my $child; defined( $child = fork) or die $!; next if $child; close $in; select( undef, undef, undef, .001) while kill $ppid, 0; select( undef, undef, undef, rand(1000)/1000), print 'Child ', $kid, ' pid=', $$, ' message=', 0 \| rand 10000, $/ for 1..20; exit 0; } } [download] -- Mike (Edit:* Added 5.6.1-friendly version of code)	[reply] [d/l]
Re^2: Many-to-One pipe by particle (Vicar) on Aug 07, 2002 at 12:50 UTC
Hmmm, 5.6.1 doesn't like `local STDIN = $in;` or `local STDOUT = $out;`. that's because it's missing the sigil... `local STDIN = $in;` or `local STDOUT = $out;` Is that a 5.8 feature? I've never seen that construct before. It'd be nice to have, though! this is a standard feature (assuming the syntax is correct.) the first one will fail under 5.008 with the same errors. my correction should work fine under any recent perl. ~Particle accelerates	[reply] [d/l] [select]
Re: Many-to-One pipe by cmv (Chaplain) on Sep 12, 2014 at 15:17 UTC
++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"; [download]	[reply] [d/l] [select]