File Coverage

blib/lib/SysV/SharedMem.pm

Criterion	Covered	Total	%
statement	32	32	100.0
branch	5	8	62.5
condition	3	6	50.0
subroutine	9	9	100.0
pod	1	1	100.0
total	50	56	89.2

package SysV::SharedMem;
{
  $SysV::SharedMem::VERSION = '0.010';
}

use 5.008;
use strict;
use warnings FATAL => 'all';

use Carp qw/croak/;
use IPC::SysV qw/ftok IPC_PRIVATE IPC_CREAT SHM_RDONLY/;
use Sub::Exporter::Progressive -setup => { exports => [qw/shared_open shared_remove shared_stat shared_chmod shared_chown shared_detach shared_identifier/] };

use XSLoader;

XSLoader::load(__PACKAGE__, __PACKAGE__->VERSION);

my %get_flags_for = (
	'<'  => 0,
	'+<' => 0,
	'>'  => 0 | IPC_CREAT,
	'+>' => 0 | IPC_CREAT,
);

my %at_flags_for = (
	'<'  => SHM_RDONLY,
	'+<' => 0,
	'>'  => 0,
	'+>' => 0,
);

## no critic (RequireArgUnpacking)

sub _get_key {
	my ($filename, $mode, %options) = @_;
	return $options{key} if defined $options{key};
	return ftok($filename, $options{proj_id}) || croak "Invalid filename for shared memory segment: $!" if defined $filename;
	return IPC_PRIVATE;
}

sub shared_open {
	my (undef, $filename, $mode, %other) = @_;
	my %options = (
		offset  => 0,
		proj_id => 1,
		perms   => oct 600,
		size    => 0,
		%other,
	);
	$mode = '<' if not defined $mode;
	croak 'No such mode' if not exists $at_flags_for{$mode};
	my $id = $options{id} || do {
		my $key = _get_key($filename, $mode, %options);
		croak 'Zero length specified for shared memory segment' if $options{size} == 0 && ($get_flags_for{$mode} & IPC_CREAT || $key == IPC_PRIVATE);
		shmget $key, $options{size}, $get_flags_for{$mode} | $options{perms} or croak "Can't open shared memory object: $!";
	};

	_shmat($_[0], $id, @options{qw/offset size/}, $at_flags_for{$mode});
	return;
}

1;    # End of SysV::SharedMem

# ABSTRACT: SysV Shared memory made easy

__END__