#######  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__
[download]