Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

SysV shared memory --pure perl

by zentara (Archbishop)
on Feb 07, 2005 at 22:12 UTC ( #428839=snippet: print w/ replies, xml ) Need Help??

Description: 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__

Comment on SysV shared memory --pure perl
Download Code
Re: SysV shared memory --pure perl
by MF (Scribe) on Jul 12, 2006 at 15:39 UTC
    The unpack doesn't work for me. $segment_size is returned with a huge negative value (causing it to die with a "bad adress" error). $shmbuffer seemds to be in order, but I haven't been able to fix this yet. Any ideas?
    I'm desperate for easy shared memory operation, and this snippet is pretty close to the results of my own attempts, but it yields the same error. Maybe it's a Solaris problem for me. I'll test it on other machines.
      I just tested this again on linux with Perl 5.8.8 and it works. I don't know what to tell you, except try different unpack modes. Maybe its a 64-bit vs. 32-bit or endian problem?

      I'm not really a human, but I play one on earth. Cogito ergo sum a bum
      I have been using Storable's freeze and thaw instead of pack and unpack for random data formats. Works fine so far.
Re: SysV shared memory --pure perl
by Anonymous Monk on Feb 20, 2012 at 20:50 UTC
    Its because struct ipc_perm in Solaris is 44 bytes (or 11 4-byte integers), so use $mdata11 to access the size.

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://428839]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (9)
As of 2014-09-22 21:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (202 votes), past polls