#####################################################
#####################################################
########### shmem-sem-init ##########################

#!/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 S_IRWXU);
use IPC::Semaphore;

my $IPC_KEY = 1234;
#create 2 semaphores identified by $IPC_KEY, max is 4 digits  
my $sem = new IPC::Semaphore($IPC_KEY, 2, S_IRWXU | IPC_CREAT);

#won't work with 8 digit shmids, unless split it on 2 semaphores 
$sem->setall( (0000) x 2);
my @sem = $sem->getall;
print "sem0->@sem\n";

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 ($shval1,$shval2) = $segment_id =~ /(\d{4})(\d{4})/;
$sem->setval(0, $shval1 );
$sem->setval(1, $shval2 );

@sem = $sem->getall;
print "sem1->@sem\n";

my $i = 'a';
while($go){
          &write_m($i);
          $i++;
          select(undef,undef,undef,.01);
          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); 
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 "$!";
   return 0;
  }

sub close_m(){
 # Deallocate the shared memory segment. 
  shmctl ($segment_id, IPC_RMID, 0);
  $sem->remove;
  return 0;
}

__END__

#####################################################
#####################################################
###########shmem-sem-listener########################
#!/usr/bin/perl
use warnings;
use strict;
use IPC::SysV qw(IPC_STAT);
use IPC::Semaphore;

#see "perldoc perlfunc /shmget" and "perldoc perlipc /SysV"  

my $IPC_KEY = 1234;   #key to be shared for apps to connect 
my $sem = new IPC::Semaphore($IPC_KEY, 2, 0);
print "sem->$sem\n";

my $go = 1;
#get shmid from semaphore 0 and 1 
my $segment_id1 = $sem->getval(0); #first 4 digits 
my $segment_id2 = $sem->getval(1); #last 4 digits 
#hack for segment_id2 being 0000 or 0530, which Perl converts to 0 or 
+530 
my $padded = '0' x ( 4 - length( $segment_id2 ) ) . $segment_id2;
my $segment_id = $segment_id1.$padded;

$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";
select(undef,undef,undef,.01);
last if ! $go;
}
############################################################# 

sub size_m(){
  my $segment_id = shift;
  my $shmbuffer = '';
  shmctl ($segment_id, IPC_STAT, $shmbuffer);
  my @mdata = unpack("i*",$shmbuffer);  
  print "segment size: ", $mdata[9], "\n";
  return($mdata[9]);
}

#################################################################3 

sub read_m(){
   my $buff;
   shmread($segment_id, $buff, 0, $segment_size) || die "$!";
   return ($buff);
}
[download]