File Coverage

blib/lib/POSIX/RT/SharedMem.pm

Criterion	Covered	Total	%
statement	21	37	56.7
branch	0	22	0.0
condition	0	3	0.0
subroutine	7	8	87.5
pod			n/a
total	28	70	40.0

package POSIX::RT::SharedMem;
$POSIX::RT::SharedMem::VERSION = '0.10';
use strict;
use warnings;

use Exporter 5.57 'import';
use XSLoader;
use Carp qw/croak/;
use Fcntl qw/O_RDONLY O_WRONLY O_RDWR O_CREAT/;

use File::Map 'map_handle';

our @EXPORT_OK = qw/shared_open shared_unlink/;

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

my $default_perms = oct '600';

my %flag_for = (
	'<'  => O_RDONLY,
	'+<' => O_RDWR,
	'>'  => O_WRONLY | O_CREAT,
	'+>' => O_RDWR | O_CREAT,
);

sub shared_open {    ## no critic (Subroutines::RequireArgUnpacking)
	my (undef, $name, $mode, %other) = @_;

	my %options = (
		perms  => $default_perms,
		offset => 0,
		flags  => 0,
		%other,
	);
	croak 'Not enough arguments for shared_open' if @_ < 2;
	$mode = '<' if not defined $mode;
	croak 'No such mode' if not defined $flag_for{$mode};
	croak 'Size must be given in creating mode' if $flag_for{$mode} & O_CREAT and $options{size} == 0;

	my $fh = _shm_open($name, $flag_for{$mode} | $options{flags}, $options{perms});
	$options{after_open}->($fh, \%options) if defined $options{after_open};

	$options{size} = -s $fh if not defined $options{size};
	croak 'Can\'t map empty file' if $options{size} == 0;    # Should never happen
	truncate $fh, $options{size} if $options{size} > -s $fh;

	$options{before_mapping}->($fh, \%options) if defined $options{before_mapping};
	map_handle $_[0], $fh, $mode, $options{offset}, $options{size};

	return $fh if defined wantarray;

	close $fh or croak "Could not close shared filehandle: $!";
	return;
}

1;    # End of POSIX::RT::SharedMem

#ABSTRACT: Create/open or unlink POSIX shared memory objects in Perl

__END__