SysV IPC
While System V IPC isn't so widely used as sockets, it still has some interesting uses. You
can't, however, effectively use SysV IPC or Berkeley mmap() to have shared memory so as to
share a variable amongst several processes. That's because Perl would reallocate your string
when you weren't wanting it to.
Here's a small example showing shared memory usage.
use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRWXU);
$size = 2000;
$id = shmget(IPC_PRIVATE, $size, S_IRWXU) || die "$!";
print "shm key $id\n";
$message = "Message #1";
shmwrite($id, $message, 0, 60) || die "$!";
print "wrote: '$message'\n";
shmread($id, $buff, 0, 60) || die "$!";
print "read : '$buff'\n";
# the buffer of shmread is zero-character end-padded.
substr($buff, index($buff, "\0")) = '';
print "un" unless $buff eq $message;
print "swell\n";
print "deleting shm $id\n";
shmctl($id, IPC_RMID, 0) || die "$!";
|
|
Here's an example of a semaphore:
use IPC::SysV qw(IPC_CREAT);
$IPC_KEY = 1234;
$id = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!";
print "shm key $id\n";
|
|
Put this code in a separate file to be run in more than one process. Call the file take:
# create a semaphore
$IPC_KEY = 1234;
$id = semget($IPC_KEY, 0 , 0 );
die if !defined($id);
$semnum = 0;
$semflag = 0;
# 'take' semaphore
# wait for semaphore to be zero
$semop = 0;
$opstring1 = pack("s!s!s!", $semnum, $semop, $semflag);
# Increment the semaphore count
$semop = 1;
$opstring2 = pack("s!s!s!", $semnum, $semop, $semflag);
$opstring = $opstring1 . $opstring2;
semop($id,$opstring) || die "$!";
|
|
Put this code in a separate file to be run in more than one process. Call this file give:
# 'give' the semaphore
# run this in the original process and you will see
# that the second process continues
$IPC_KEY = 1234;
$id = semget($IPC_KEY, 0, 0);
die if !defined($id);
$semnum = 0;
$semflag = 0;
# Decrement the semaphore count
$semop = -1;
$opstring = pack("s!s!s!", $semnum, $semop, $semflag);
semop($id,$opstring) || die "$!";
|
|
The SysV IPC code above was written long ago, and it's definitely clunky looking. For a
more modern look, see the IPC::SysV module which is included with Perl starting from Perl
5.005.
A small example demonstrating SysV message queues:
use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRWXU);
my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRWXU);
my $sent = "message";
my $type = 1234;
my $rcvd;
my $type_rcvd;
if (defined $id) {
if (msgsnd($id, pack("l! a*", $type_sent, $sent), 0)) {
if (msgrcv($id, $rcvd, 60, 0, 0)) {
($type_rcvd, $rcvd) = unpack("l! a*", $rcvd);
if ($rcvd eq $sent) {
print "okay\n";
} else {
print "not okay\n";
}
} else {
die "# msgrcv failed\n";
}
} else {
die "# msgsnd failed\n";
}
msgctl($id, IPC_RMID, 0) || die "# msgctl failed: $!\n";
} else {
die "# msgget failed\n";
}
|
|
|
|
