pod/perlipc.pod

   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