Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:
$connections{$user_name}{client} = $client; and then runnig it through a loop foreach $key (keys %connections) { print $connections{$key}{client} "info to be displayed"; }
#!/usr/bin/perl # preforker - server who forks first use IO::Socket; use Symbol; use POSIX; # establish SERVER socket, bind and listen. $server = IO::Socket::INET->new(LocalPort => 6969, Type => SOCK_STREAM, Proto => 'tcp', Reuse => 1, Listen => 10 ) or die "making socket: $@\n"; # global variables $PREFORK = 5; # number of children to maintain $MAX_CLIENTS_PER_CHILD = 5; # number of clients each child sho +uld process %children = (); # keys are current child process I +Ds $children = 0; # current number of children ############# %connections = (); #current connections ############# sub REAPER { # takes care of dead children $SIG{CHLD} = \&REAPER; my $pid = wait; $children --; delete $children{$pid}; } sub HUNTSMAN { # signal handler for SIGINT local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children kill 'INT' => keys %children; exit; # clean up with dignity } # Fork off our children. for (1 .. $PREFORK) { make_new_child(); } # Install signal handlers. $SIG{CHLD} = \&REAPER; $SIG{INT} = \&HUNTSMAN; # And maintain the population. while (1) { sleep; # wait for a signal (i.e., child's + death) for ($i = $children; $i < $PREFORK; $i++) { make_new_child(); # top up the child pool } } sub make_new_child { my $pid; my $sigset; # block signal for fork $sigset = POSIX::SigSet->new(SIGINT); sigprocmask(SIG_BLOCK, $sigset) or die "Can't block SIGINT for fork: $!\n"; die "fork: $!" unless defined ($pid = fork); if ($pid) { # Parent records the child's birth and returns. sigprocmask(SIG_UNBLOCK, $sigset) or die "Can't unblock SIGINT for fork: $!\n"; $children{$pid} = 1; $children++; return; } else { # Child can *not* return from this subroutine. $SIG{INT} = 'DEFAULT'; # make SIGINT kill us as it did be +fore # unblock signals sigprocmask(SIG_UNBLOCK, $sigset) or die "Can't unblock SIGINT for fork: $!\n"; # handle connections until we've reached $MAX_CLIENTS_PER_CHIL +D for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { $client = $server->accept() or last; # do something with the connection ################## My Code #################### print $client "What is your name: "; $user_name = <$client>; $connections{$user_name}{client} = $client; foreach $key (keys %connections) { Send($connections{$key}{client}, "test from $key"); } } ################## End My Code #################### # tidy up gracefully and finish # this exit is VERY important, otherwise the child will become # a producer of more and more children, forking yourself into # process death. exit; } }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: forking server
by chromatic (Archbishop) on Oct 12, 2000 at 23:05 UTC | |
|
Re: forking server
by bliz (Acolyte) on Oct 12, 2000 at 22:56 UTC | |
by Anonymous Monk on Oct 12, 2000 at 23:03 UTC | |
by bliz (Acolyte) on Oct 12, 2000 at 23:07 UTC | |
|
RE: forking server
by AgentM (Curate) on Oct 13, 2000 at 00:23 UTC | |
by geektron (Curate) on Oct 13, 2000 at 03:14 UTC | |
by AgentM (Curate) on Oct 13, 2000 at 05:07 UTC | |
|
Re: forking server
by Anonymous Monk on Oct 12, 2000 at 22:34 UTC | |
|
Re: forking server
by Anonymous Monk on Aug 03, 2006 at 17:07 UTC |