package IPC::Shareable::SharedMem;
use strict;
use constant DEBUGGING => ($ENV{SHM_DEBUG} or 0);
use IPC::SysV qw(IPC_RMID);
my $Def_Size = 1024;
sub _trace {
require Carp;
require Data::Dumper;
my $caller = ' ' . (caller(1))[3] . " called with:\n";
my $i = -1;
my @msg = map {
++$i;
' ' . Data::Dumper->Dump( [ $_ ] => [ "\_[$i]" ]);
} @_;
Carp::carp "IPC::SharedMem debug:\n", $caller, @msg;
}
sub _debug {
require Carp;
require Data::Dumper;
local $Data::Dumper::Terse = 1;
my $caller = ' ' . (caller(1))[3] . " tells us that:\n";
my @msg = map { ' ' . Data::Dumper::Dumper($_) } @_;
Carp::carp "IPC::SharedMem debug:\n", $caller, @msg;
};
sub default_size {
_trace @_ if DEBUGGING;
my $class = shift;
$Def_Size = shift if @_;
return $Def_Size;
}
sub new {
_trace @_ if DEBUGGING;
my($class, $key, $size, $flags) = @_;
defined $key or do {
require Carp;
Carp::croak "usage: IPC::SharedMem->new(KEY, [ SIZE, [ FLAGS ] ])";
};
$size ||= $Def_Size;
$flags ||= 0;
_debug "calling shmget() on ", $key, $size, $flags if DEBUGGING;
my $id = shmget($key, $size, $flags);
defined $id or do {
require Carp;
Carp::carp "IPC::Shareable::SharedMem: shmget: $!\n";
return undef;
};
my $sh = {
_id => $id,
_size => $size,
_flags => $flags,
};
return bless $sh => $class;
}
sub id {
_trace @_ if DEBUGGING;
my $self = shift;
$self->{_id} = shift if @_;
return $self->{_id};
}
sub flags {
_trace @_ if DEBUGGING;
my $self = shift;
$self->{_flags} = shift if @_;
return $self->{_flags};
}
sub size {
_trace @_ if DEBUGGING;
my $self = shift;
$self->{_size} = shift if @_;
return $self->{_size};
}
sub shmwrite {
_trace @_ if DEBUGGING;
my($self, $data) = @_;
_debug "calling shmwrite() on ", $self->{_id}, $data,
0, $self->{_size} if DEBUGGING;
return shmwrite($self->{_id}, $data, 0, $self->{_size});
}
sub shmread {
_trace @_ if DEBUGGING;
my $self = shift;
my $data = '';
_debug "calling shread() on ", $self->{_id}, $data,
0, $self->{_size} if DEBUGGING;
shmread($self->{_id}, $data, 0, $self->{_size}) or return;
_debug "got ", $data, " from shm segment $self->{_id}" if DEBUGGING;
return $data;
}
sub remove {
_trace @_ if DEBUGGING;
my $self = shift;
my $op = shift;
my $arg = 0;
return shmctl($self->{_id}, IPC_RMID, $arg);
}
1;
=head1 NAME
IPC::Shareable::SharedMem - Object oriented interface to shared memory
=head1 SYNOPSIS
*** No public interface ***
=head1 WARNING
This module is not intended for public consumption. It is used
internally by IPC::Shareable to access shared memory. It will
probably be replaced soon by IPC::ShareLite or IPC::SharedMem (when
someone writes it).
=head1 DESCRIPTION
This module provides and object-oriented framework to access shared
memory. Its use is intended to be limited to IPC::Shareable.
Therefore I have not documented an interface.
=head1 AUTHOR
Ben Sugars (bsugars@canoe.ca)
=head1 SEE ALSO
IPC::Shareable, IPC::SharedLite