Due to a lack of "reading the docs" :-), I made
shared mem segments with Inline::C. But sgifford pointed out today that Perl has an interface to it, as shown in "perldoc perlfunc". So here is a pure perl version of shared memory segments. Of course this is just a proof of concept snippet, designed to be a simple as possible. ( But I'm working on multi-robot-object control program using it :-) ).
So start the init script and pass the shmid as ARGV[0] to the listener.
####### shmem-init.pl ############################
#!/usr/bin/perl
use warnings;
use strict;
use IPC::SysV qw(IPC_STAT IPC_PRIVATE IPC_CREAT IPC_EXCL S_IRUSR S_IWU
+SR IPC_RMID);
# see "perldoc perlfunc /shmget" and "perldoc perlipc /SysV"
# big difference from c is attach and detach is automatic in Perl
# it attaches to read or write, then detaches
my $go = 1;
$SIG{INT} = sub{ $go = 0;
&close_m(); #close up the shared mem
exit;
};
my $segment_hbytes = 0x640; # hex bytes, a multiple of 4k
my ($segment_id, $segment_size) = &init_m($segment_hbytes);
print "shmid-> $segment_id\tsize-> $segment_size\n";
my $i = 'a';
while($go){
&write_m($i);
$i++;
#select(undef,undef,undef,.001);
last if ! $go;
}
exit;
#################################################################
sub init_m(){
my $segment_hbytes = shift;
# Allocate a shared memory segment.
my $segment_id = shmget (IPC_PRIVATE, $segment_hbytes,
IPC_CREAT | IPC_EXCL | S_IRUSR | S_IWUSR);
# Verify the segment's size.
my $shmbuffer = '';
shmctl ($segment_id, IPC_STAT, $shmbuffer);
my @mdata = unpack("i*",$shmbuffer); #not sure if that is right unp
+ack? works :-)
return($segment_id, $mdata[9] );
}
sub write_m() {
# Write a string to the shared memory segment.
my $message = shift;
shmwrite($segment_id, $message, 0, $segment_size) || die "$!";
#the 0, $segment_size can be broke up into substrings like 0,60
# or 61,195, etc
return 0;
}
sub close_m(){
# Deallocate the shared memory segment.
shmctl ($segment_id, IPC_RMID, 0);
return 0;
}
__END__
#########################################################
#########################################################
########## shmem-listener.pl #########################
#!/usr/bin/perl
use warnings;
use strict;
use IPC::SysV qw(IPC_STAT);
#see "perldoc perlfunc /shmget" and "perldoc perlipc /SysV"
my $go = 1;
my $segment_id = $ARGV[0] + 0; # make sure it's integer
$SIG{INT} = sub{ $go = 0; exit;};
my $segment_size = &size_m($segment_id);
print "segment_size = $segment_size\n";
while($go){
my $readm = &read_m();
print "$readm\n";
last if ! $go;
#select(undef,undef,undef,.001);
}
#############################################################
sub size_m(){
my $segment_id = shift;
my $shmbuffer = '';
shmctl ($segment_id, IPC_STAT, $shmbuffer);
my @mdata = unpack("i*",$shmbuffer); #not sure if that is right unp
+ack? works :-)
print "segment size: ", $mdata[9], "\n";
return($mdata[9]);
}
#################################################################3
sub read_m(){
my $buff;
#the $buff is paaded with nulls \0 to fill it out
shmread($segment_id, $buff, 0, $segment_size) || die "$!";
# the buffer of shmread is zero-character end-padded.
#substr($buff, index($buff, "\0")) = '';
return ($buff);
}
__END__