home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl501m.zip / pod / perlipc.pod < prev    next >
Text File  |  1995-03-16  |  4KB  |  169 lines
  1. =head1 NAME
  2.  
  3. perlipc - Perl interprocess communication
  4.  
  5. =head1 DESCRIPTION
  6.  
  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.
  13.  
  14. =head2 Client/Server Communication
  15.  
  16. Here'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.  
  37.     $this = pack($sockaddr, AF_INET, 0, $thisaddr);
  38.     $that = pack($sockaddr, AF_INET, $port, $thataddr);
  39.  
  40.     socket(S, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
  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.  
  59. And 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.  
  72.     $this = pack($sockaddr, AF_INET, $port, "\0\0\0\0");
  73.  
  74.     select(NS); $| = 1; select(stdout);
  75.  
  76.     socket(S, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
  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.  
  99. Here'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.  
  116. Here'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.  
  125. Put this code in a separate file to be run in more that one process
  126. Call 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.  
  149. Put this code in a separate file to be run in more that one process
  150. Call 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.  
  169.