view release on metacpan or  search on metacpan

lib/IPC/Shareable/SharedMem.pm  view on Meta::CPAN

package IPC::Shareable::SharedMem;

use warnings;
use strict;

use Carp qw(carp croak confess);
use IPC::SysV qw(IPC_RMID);

our $VERSION = '1.13';

use constant DEBUGGING => ($ENV{SHM_DEBUG} or 0);

my $default_size = 1024;

sub default_size {
    my $class = shift;
    $default_size = shift if @_;
    return $default_size;
}

sub new {
    my($class, $key, $size, $flags, $type) = @_;

    defined $key or do {
        confess "usage: IPC::SharedMem->new(KEY, [ SIZE,  [ FLAGS ] ])";
    };

    $size  ||= $default_size;
    $flags ||= 0;

    my $id = shmget($key, $size, $flags);

    defined $id or do {
        if ($! =~ /File exists/){
            croak "\nERROR: IPC::Shareable::SharedMem: shmget $key: $!\n\n" .
                  "Are you using exclusive, but trying to create multiple " .
                  "instances?\n\n";
        }
        return undef;
    };

    my $sh = {
        _id    => $id,
        _key   => $key,
        _size  => $size,
        _flags => $flags,
        _type  => $type,
    };

    return bless $sh => $class;
}
sub id {
    my $self = shift;

    $self->{_id} = shift if @_;
    return $self->{_id};
}
sub key {
    my $self = shift;

    $self->{_key} = shift if @_;
    return $self->{_key};
}
sub flags {
    my $self = shift;

    $self->{_flags} = shift if @_;
    return $self->{_flags};
}
sub size {
    my $self = shift;

    $self->{_size} = shift if @_;
    return $self->{_size};
}
sub type {
    my $self = shift;

    $self->{_type} = shift if @_;
    return $self->{_type};
}
sub shmwrite {
    my($self, $data) = @_;
    return shmwrite($self->{_id}, $data, 0, $self->{_size});
}
sub shmread {
    my $self = shift;

    my $data = '';
    shmread($self->{_id}, $data, 0, $self->{_size}) or return;
    return $data;
}
sub remove {
    my $to_remove = shift;

    my $id;

    if (ref $to_remove eq __PACKAGE__){
        $id = $to_remove->{_id};
    }

    my $arg = 0;

    my $ret = shmctl($id, IPC_RMID, $arg);
    return $ret;
}

1;

=head1 NAME