home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 2 / RISC_DISC_2.iso / pd_share / utilities / cli / perl / !Perl / Manual / perlipc < prev    next >
Encoding:
Text File  |  1995-04-18  |  5.2 KB  |  197 lines
  1. <!-- $RCSfile$$Revision$$Date$ -->
  2. <!-- $Log$ -->
  3. <HTML>
  4. <TITLE> PERLIPC </TITLE>
  5. <h2>NAME</h2>
  6. perlipc - Perl interprocess communication
  7. <p><h2>DESCRIPTION</h2>
  8. The IPC facilities of Perl are built on the Berkeley socket mechanism.
  9. If you don't have sockets, you can ignore this section.  The calls have
  10. the same names as the corresponding system calls, but the arguments
  11. tend to differ, for two reasons.  First, Perl file handles work
  12. differently than C file descriptors.  Second, Perl already knows the
  13. length of its strings, so you don't need to pass that information.
  14. <p><h3>Client/Server Communication</h3>
  15. Here's a sample TCP client.
  16. <p><pre>
  17.         ($them,$port) = @ARGV;
  18.         $port = 2345 unless $port;
  19.         $them = 'localhost' unless $them;
  20. </pre>
  21. <pre>
  22.         $SIG{'INT'} = 'dokill';
  23.         sub dokill { kill 9,$child if $child; }
  24. </pre>
  25. <pre>
  26.         use Socket;
  27. </pre>
  28. <pre>
  29.         $sockaddr = 'S n a4 x8';
  30.         chop($hostname = `hostname`);
  31. </pre>
  32. <pre>
  33.         ($name, $aliases, $proto) = getprotobyname('tcp');
  34.         ($name, $aliases, $port) = getservbyname($port, 'tcp')
  35.         unless $port =~ /^\d+$/;
  36.         ($name, $aliases, $type, $len, $thisaddr) =
  37.                     gethostbyname($hostname);
  38.         ($name, $aliases, $type, $len, $thataddr) = gethostbyname($them);
  39. </pre>
  40. <pre>
  41.         $this = pack($sockaddr, &AF_INET, 0, $thisaddr);
  42.         $that = pack($sockaddr, &AF_INET, $port, $thataddr);
  43. </pre>
  44. <pre>
  45.         socket(S, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
  46.         bind(S, $this) || die "bind: $!";
  47.         connect(S, $that) || die "connect: $!";
  48. </pre>
  49. <pre>
  50.         select(S); $| = 1; select(stdout);
  51. </pre>
  52. <pre>
  53.         if ($child = fork) {
  54.         while (<>) {
  55.             print S;
  56.         }
  57.         sleep 3;
  58.         do dokill();
  59.         }
  60.         else {
  61.         while (<S>) {
  62.             print;
  63.         }
  64.         }
  65. </pre>
  66. And here's a server:
  67. <p><pre>
  68.         ($port) = @ARGV;
  69.         $port = 2345 unless $port;
  70. </pre>
  71. <pre>
  72.         use Socket;
  73. </pre>
  74. <pre>
  75.         $sockaddr = 'S n a4 x8';
  76. </pre>
  77. <pre>
  78.         ($name, $aliases, $proto) = getprotobyname('tcp');
  79.         ($name, $aliases, $port) = getservbyname($port, 'tcp')
  80.         unless $port =~ /^\d+$/;
  81. </pre>
  82. <pre>
  83.         $this = pack($sockaddr, &AF_INET, $port, "\0\0\0\0");
  84. </pre>
  85. <pre>
  86.         select(NS); $| = 1; select(stdout);
  87. </pre>
  88. <pre>
  89.         socket(S, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
  90.         bind(S, $this) || die "bind: $!";
  91.         listen(S, 5) || die "connect: $!";
  92. </pre>
  93. <pre>
  94.         select(S); $| = 1; select(stdout);
  95. </pre>
  96. <pre>
  97.         for (;;) {
  98.         print "Listening again\n";
  99.         ($addr = accept(NS,S)) || die $!;
  100.         print "accept ok\n";
  101. </pre>
  102. <pre>
  103.         ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
  104.         @inetaddr = unpack('C4',$inetaddr);
  105.         print "$af $port @inetaddr\n";
  106. </pre>
  107. <pre>
  108.         while (<NS>) {
  109.             print;
  110.             print NS;
  111.         }
  112.         }
  113. </pre>
  114. <h3>SysV IPC</h3>
  115. Here's a small example showing shared memory usage:
  116. <p><pre>
  117.         $IPC_PRIVATE = 0;
  118.         $IPC_RMID = 0;
  119.         $size = 2000;
  120.         $key = shmget($IPC_PRIVATE, $size , 0777 );
  121.         die if !defined($key);
  122. </pre>
  123. <pre>
  124.         $message = "Message #1";
  125.         shmwrite($key, $message, 0, 60 ) || die "$!";
  126.         shmread($key,$buff,0,60) || die "$!";
  127. </pre>
  128. <pre>
  129.         print $buff,"\n";
  130. </pre>
  131. <pre>
  132.         print "deleting $key\n";
  133.         shmctl($key ,$IPC_RMID, 0) || die "$!";
  134. </pre>
  135. Here's an example of a semaphore:
  136. <p><pre>
  137.         $IPC_KEY = 1234;
  138.         $IPC_RMID = 0;
  139.         $IPC_CREATE = 0001000;
  140.         $key = semget($IPC_KEY, $nsems , 0666 | $IPC_CREATE );
  141.         die if !defined($key);
  142.         print "$key\n";
  143. </pre>
  144. Put this code in a separate file to be run in more that one process
  145. Call the file <I>take</I>:
  146. <p><pre>
  147.         # create a semaphore
  148. </pre>
  149. <pre>
  150.         $IPC_KEY = 1234;
  151.         $key = semget($IPC_KEY,  0 , 0 );
  152.         die if !defined($key);
  153. </pre>
  154. <pre>
  155.         $semnum = 0;
  156.         $semflag = 0;
  157. </pre>
  158. <pre>
  159.         # 'take' semaphore
  160.         # wait for semaphore to be zero
  161.         $semop = 0;
  162.         $opstring1 = pack("sss", $semnum, $semop, $semflag);
  163. </pre>
  164. <pre>
  165.         # Increment the semaphore count
  166.         $semop = 1;
  167.         $opstring2 = pack("sss", $semnum, $semop,  $semflag);
  168.         $opstring = $opstring1 . $opstring2;
  169. </pre>
  170. <pre>
  171.         semop($key,$opstring) || die "$!";
  172. </pre>
  173. Put this code in a separate file to be run in more that one process
  174. Call this file <I>give</I>:
  175. <p><pre>
  176.         #'give' the semaphore
  177.         # run this in the original process and you will see
  178.         # that the second process continues
  179. </pre>
  180. <pre>
  181.         $IPC_KEY = 1234;
  182.         $key = semget($IPC_KEY, 0, 0);
  183.         die if !defined($key);
  184. </pre>
  185. <pre>
  186.         $semnum = 0;
  187.         $semflag = 0;
  188. </pre>
  189. <pre>
  190.         # Decrement the semaphore count
  191.         $semop = -1;
  192.         $opstring = pack("sss", $semnum, $semop, $semflag);
  193. </pre>
  194. <pre>
  195.         semop($key,$opstring) || die "$!";
  196. </pre>
  197.