File Coverage

blib/lib/IPC/Mmap/Share.pm

Criterion	Covered	Total	%
statement	30	76	39.4
branch	5	66	7.5
condition	1	3	33.3
subroutine	10	19	52.6
pod	5	10	50.0
total	51	174	29.3

package IPC::Mmap::Share;

use warnings;
use strict;
use Carp;
use Data::Dumper;
use IPC::Mmap;
use Storable qw(freeze thaw);

use base qw(Exporter);

BEGIN {
	our $VERSION     = 0.03;
}

my $DEBUG = 0;

sub new {
	my $self =  shift(@_) or croak "Error!..I do not even know who I am!..";
	my $class = ref($self) || $self;
	my $size = shift(@_) or croak "Incorrect call to new";
	open(my $FILE,"<","/dev/zero") || die $!;
	my $mmap = create_mmap($size);
	return bless { mmap => $mmap , size => $size },$class;
}

sub create_mmap {
	my $size = shift(@_) or die "Internal error!..Size was not passed to create_mmap";
	open(my $FILE,"<","/dev/zero") || croak $!;
	my $mmap = IPC::Mmap->new($FILE, $size, PROT_READ|PROT_WRITE, MAP_SHARED|MAP_ANONYMOUS) or croak $!;
	return $mmap;
}

sub set_mmap {
	my $self = shift(@_) or croak "Error...set_mmap is a method call";
	my $mmap = shift(@_) or croak "Error...incorrect call to set_mmap...expected an argument";
	$self->{mmap} = $mmap;
}

sub get_mmap {
	my $self = shift(@_) or croak "Error...get_mmap is a method call";
	return $self->{mmap};
}

sub get_size {
	my $self = shift(@_) or croak "Error...get_size is a method call";
	return $self->{size};
}

sub set {
	my $self = shift(@_);
	my $var =  shift(@_) or croak "Error...You passed no argument or undef to set method";

	my $var_ref = \$var; #saying $var=\$var would create a circular reference, caution!!

	my $serialized = freeze($var_ref) or croak "Internal error...freeze failed...";

	#check that the structure fits the mmaped area...
	croak "Error...you cannot store a structure that is bigger than the size you have allocated in new. Please go back and try an allocation size of at least ".length($serialized)."\n" if (length($serialized) > $self->get_size);

	$DEBUG&&print STDERR "Size is ",length($serialized),"\n";
	my $mmap = $self->get_mmap();
	my $size = $self->get_size();
	$mmap->lock() || croak "Internal error...lock failed";
	$mmap->write($serialized,0,$size) || croak "Internal error...write failed";
	$mmap->unlock() || croak "Internal error...unlock failed";
}


sub get {
	my $self = shift(@_);
	my $mmap = $self->get_mmap();
	my $size = $self->get_size();
	my $unserialized;
	$mmap->lock() || croak "Internal error...lock failed";
	$mmap->read($unserialized,0,$size) ||  croak "Internal error...read failed";
	$mmap->unlock() || croak "Internal error...unlock failed";
	my $var_ref = thaw($unserialized) or croak "Error...Unfreezing returned an undefined value...";
	return ${$var_ref};
}

sub lock {
	my $self = shift(@_) or croak "I could not shift the reference to my self";
	my $mmap = $self->get_mmap() or croak "Failed to retrieve mmap object";
	$mmap->lock() || croak "Internal error...lock failed";
	$self->{locked} = 1;
}


sub unlock {
	my $self = shift(@_) or croak "I could not shift the reference to my self";
	my $mmap = $self->get_mmap() or croak "Failed to retrieve mmap object";
	$mmap->unlock() || croak "Internal error...lock failed";
	$self->{locked} = 0;
}

sub is_locked {
	my $self = shift(@_) or croak "I could not shift the reference to my self";
	return 1 if ($self->{locked} == 1);
	return;
}

sub DESTROY {
	my $self = shift(@_) or croak "I could not shift the reference to my self";
	my $mmap = $self->get_mmap() or croak "Failed to retrieve mmap object";
	if ($self->is_locked) {
		$mmap->unlock() || croak "Internal error...unlock failed";
	}
	return;
}

1;

__END__