This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
This is my patch patch.1n for perl5.001.
[perl5.git] / pod / perlipc.pod
CommitLineData
a0d0e21e
LW
1=head1 NAME
2
3perlipc - Perl interprocess communication
4
5=head1 DESCRIPTION
6
7The IPC facilities of Perl are built on the Berkeley socket mechanism.
8If you don't have sockets, you can ignore this section. The calls have
9the same names as the corresponding system calls, but the arguments
10tend to differ, for two reasons. First, Perl file handles work
11differently than C file descriptors. Second, Perl already knows the
12length of its strings, so you don't need to pass that information.
13
14=head2 Client/Server Communication
15
16Here's a sample TCP client.
17
18 ($them,$port) = @ARGV;
19 $port = 2345 unless $port;
20 $them = 'localhost' unless $them;
21
22 $SIG{'INT'} = 'dokill';
23 sub dokill { kill 9,$child if $child; }
24
25 use Socket;
26
27 $sockaddr = 'S n a4 x8';
28 chop($hostname = `hostname`);
29
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);
36
748a9306
LW
37 $this = pack($sockaddr, AF_INET, 0, $thisaddr);
38 $that = pack($sockaddr, AF_INET, $port, $thataddr);
a0d0e21e 39
748a9306 40 socket(S, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
a0d0e21e
LW
41 bind(S, $this) || die "bind: $!";
42 connect(S, $that) || die "connect: $!";
43
44 select(S); $| = 1; select(stdout);
45
46 if ($child = fork) {
47 while (<>) {
48 print S;
49 }
50 sleep 3;
51 do dokill();
52 }
53 else {
54 while (<S>) {
55 print;
56 }
57 }
58
59And here's a server:
60
61 ($port) = @ARGV;
62 $port = 2345 unless $port;
63
64 use Socket;
65
66 $sockaddr = 'S n a4 x8';
67
68 ($name, $aliases, $proto) = getprotobyname('tcp');
69 ($name, $aliases, $port) = getservbyname($port, 'tcp')
70 unless $port =~ /^\d+$/;
71
748a9306 72 $this = pack($sockaddr, AF_INET, $port, "\0\0\0\0");
a0d0e21e
LW
73
74 select(NS); $| = 1; select(stdout);
75
748a9306 76 socket(S, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
a0d0e21e
LW
77 bind(S, $this) || die "bind: $!";
78 listen(S, 5) || die "connect: $!";
79
80 select(S); $| = 1; select(stdout);
81
82 for (;;) {
83 print "Listening again\n";
84 ($addr = accept(NS,S)) || die $!;
85 print "accept ok\n";
86
87 ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
88 @inetaddr = unpack('C4',$inetaddr);
89 print "$af $port @inetaddr\n";
90
91 while (<NS>) {
92 print;
93 print NS;
94 }
95 }
96
97=head2 SysV IPC
98
99Here's a small example showing shared memory usage:
100
101 $IPC_PRIVATE = 0;
102 $IPC_RMID = 0;
103 $size = 2000;
104 $key = shmget($IPC_PRIVATE, $size , 0777 );
105 die if !defined($key);
106
107 $message = "Message #1";
108 shmwrite($key, $message, 0, 60 ) || die "$!";
109 shmread($key,$buff,0,60) || die "$!";
110
111 print $buff,"\n";
112
113 print "deleting $key\n";
114 shmctl($key ,$IPC_RMID, 0) || die "$!";
115
116Here's an example of a semaphore:
117
118 $IPC_KEY = 1234;
119 $IPC_RMID = 0;
120 $IPC_CREATE = 0001000;
121 $key = semget($IPC_KEY, $nsems , 0666 | $IPC_CREATE );
122 die if !defined($key);
123 print "$key\n";
124
125Put this code in a separate file to be run in more that one process
126Call the file F<take>:
127
128 # create a semaphore
129
130 $IPC_KEY = 1234;
131 $key = semget($IPC_KEY, 0 , 0 );
132 die if !defined($key);
133
134 $semnum = 0;
135 $semflag = 0;
136
137 # 'take' semaphore
138 # wait for semaphore to be zero
139 $semop = 0;
140 $opstring1 = pack("sss", $semnum, $semop, $semflag);
141
142 # Increment the semaphore count
143 $semop = 1;
144 $opstring2 = pack("sss", $semnum, $semop, $semflag);
145 $opstring = $opstring1 . $opstring2;
146
147 semop($key,$opstring) || die "$!";
148
149Put this code in a separate file to be run in more that one process
150Call this file F<give>:
151
152 #'give' the semaphore
153 # run this in the original process and you will see
154 # that the second process continues
155
156 $IPC_KEY = 1234;
157 $key = semget($IPC_KEY, 0, 0);
158 die if !defined($key);
159
160 $semnum = 0;
161 $semflag = 0;
162
163 # Decrement the semaphore count
164 $semop = -1;
165 $opstring = pack("sss", $semnum, $semop, $semflag);
166
167 semop($key,$opstring) || die "$!";
168