3 perlipc - Perl interprocess communication
7 The IPC facilities of Perl are built on the Berkeley socket mechanism.
8 If you don't have sockets, you can ignore this section. The calls have
9 the same names as the corresponding system calls, but the arguments
10 tend to differ, for two reasons. First, Perl file handles work
11 differently than C file descriptors. Second, Perl already knows the
12 length of its strings, so you don't need to pass that information.
14 =head2 Client/Server Communication
16 Here's a sample TCP client.
18 ($them,$port) = @ARGV;
19 $port = 2345 unless $port;
20 $them = 'localhost' unless $them;
22 $SIG{'INT'} = 'dokill';
23 sub dokill { kill 9,$child if $child; }
27 $sockaddr = 'S n a4 x8';
28 chop($hostname = `hostname`);
30 ($name, $aliases, $proto) = getprotobyname('tcp');
31 ($name, $aliases, $port) = getservbyname($port, 'tcp')
32 unless $port =~ /^\d+$/;
33 ($name, $aliases, $type, $len, $thisaddr) =
34 gethostbyname($hostname);
35 ($name, $aliases, $type, $len, $thataddr) = gethostbyname($them);
37 $this = pack($sockaddr, AF_INET, 0, $thisaddr);
38 $that = pack($sockaddr, AF_INET, $port, $thataddr);
40 socket(S, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
41 bind(S, $this) || die "bind: $!";
42 connect(S, $that) || die "connect: $!";
44 select(S); $| = 1; select(stdout);
62 $port = 2345 unless $port;
66 $sockaddr = 'S n a4 x8';
68 ($name, $aliases, $proto) = getprotobyname('tcp');
69 ($name, $aliases, $port) = getservbyname($port, 'tcp')
70 unless $port =~ /^\d+$/;
72 $this = pack($sockaddr, AF_INET, $port, "\0\0\0\0");
74 select(NS); $| = 1; select(stdout);
76 socket(S, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
77 bind(S, $this) || die "bind: $!";
78 listen(S, 5) || die "connect: $!";
80 select(S); $| = 1; select(stdout);
83 print "Listening again\n";
84 ($addr = accept(NS,S)) || die $!;
87 ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
88 @inetaddr = unpack('C4',$inetaddr);
89 print "$af $port @inetaddr\n";
99 Here's a small example showing shared memory usage:
104 $key = shmget($IPC_PRIVATE, $size , 0777 );
105 die if !defined($key);
107 $message = "Message #1";
108 shmwrite($key, $message, 0, 60 ) || die "$!";
109 shmread($key,$buff,0,60) || die "$!";
113 print "deleting $key\n";
114 shmctl($key ,$IPC_RMID, 0) || die "$!";
116 Here's an example of a semaphore:
120 $IPC_CREATE = 0001000;
121 $key = semget($IPC_KEY, $nsems , 0666 | $IPC_CREATE );
122 die if !defined($key);
125 Put this code in a separate file to be run in more that one process
126 Call the file F<take>:
131 $key = semget($IPC_KEY, 0 , 0 );
132 die if !defined($key);
138 # wait for semaphore to be zero
140 $opstring1 = pack("sss", $semnum, $semop, $semflag);
142 # Increment the semaphore count
144 $opstring2 = pack("sss", $semnum, $semop, $semflag);
145 $opstring = $opstring1 . $opstring2;
147 semop($key,$opstring) || die "$!";
149 Put this code in a separate file to be run in more that one process
150 Call this file F<give>:
152 #'give' the semaphore
153 # run this in the original process and you will see
154 # that the second process continues
157 $key = semget($IPC_KEY, 0, 0);
158 die if !defined($key);
163 # Decrement the semaphore count
165 $opstring = pack("sss", $semnum, $semop, $semflag);
167 semop($key,$opstring) || die "$!";