Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

SysV shared memory --pure perl

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

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__

Replies are listed 'Best First'.
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 have been using Storable's freeze and thaw instead of pack and unpack for random data formats. Works fine so far.
      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
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.

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others contemplating the Monastery: (5)
As of 2024-03-29 14:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found