From 5865a7df1443ffc1b82a03eb4d08f0a8a7fe3fff Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Tue, 28 Nov 2000 11:16:57 +0000 Subject: [PATCH] [ID 20001128.002] what's the point of example code if it is buggy? Message-Id: p4raw-id: //depot/perl@7904 --- pod/perlipc.pod | 32 ++++++++++++++++++++++++++++---- 1 file changed, 28 insertions(+), 4 deletions(-) diff --git a/pod/perlipc.pod b/pod/perlipc.pod index 758f303..a1df3e4 100644 --- a/pod/perlipc.pod +++ b/pod/perlipc.pod @@ -660,14 +660,14 @@ instead. BEGIN { $ENV{PATH} = '/usr/ucb:/bin' } use Socket; use Carp; - $EOL = "\015\012"; + my $EOL = "\015\012"; sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } my $port = shift || 2345; my $proto = getprotobyname('tcp'); - ($port) = $port =~ /^(\d+)$/ || die "invalid port"; + ($port) = $port =~ /^(\d+)$/ or die "invalid port"; socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, @@ -703,7 +703,7 @@ go back to service a new client. BEGIN { $ENV{PATH} = '/usr/ucb:/bin' } use Socket; use Carp; - $EOL = "\015\012"; + my $EOL = "\015\012"; sub spawn; # forward declaration sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } @@ -711,7 +711,7 @@ go back to service a new client. my $port = shift || 2345; my $proto = getprotobyname('tcp'); - ($port) = $port =~ /^(\d+)$/ || die "invalid port"; + ($port) = $port =~ /^(\d+)$/ or die "invalid port"; socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, @@ -865,6 +865,7 @@ to be on the localhost, and thus everything works right. use Carp; BEGIN { $ENV{PATH} = '/usr/ucb:/bin' } + sub spawn; # forward declaration sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } my $NAME = '/tmp/catsock'; @@ -901,6 +902,29 @@ to be on the localhost, and thus everything works right. }; } + sub spawn { + my $coderef = shift; + + unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') { + confess "usage: spawn CODEREF"; + } + + my $pid; + if (!defined($pid = fork)) { + logmsg "cannot fork: $!"; + return; + } elsif ($pid) { + logmsg "begat $pid"; + return; # I'm the parent + } + # else I'm the child -- go spawn + + open(STDIN, "<&Client") || die "can't dup client to stdin"; + open(STDOUT, ">&Client") || die "can't dup client to stdout"; + ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr"; + exit &$coderef(); + } + As you see, it's remarkably similar to the Internet domain TCP server, so much so, in fact, that we've omitted several duplicate functions--spawn(), logmsg(), ctime(), and REAPER()--which are exactly the same as in the -- 2.7.4