File Coverage

blib/lib/IPC/Semaphore/Set.pm

Criterion	Covered	Total	%
statement	57	61	93.4
branch	18	24	75.0
condition	5	7	71.4
subroutine	13	15	86.6
pod	8	8	100.0
total	101	115	87.8

package IPC::Semaphore::Set;
use strict;
use warnings;

use 5.008;
use Digest::CRC qw(crc8);
use IPC::SysV qw(IPC_PRIVATE IPC_CREAT IPC_NOWAIT S_IRUSR S_IWUSR);
use IPC::Semaphore;
use IPC::Semaphore::Set::Resource;

our $VERSION = 1.04;

############
## Public ##
############

sub new
{
	my $class = shift;
	my $args  = ref($_[0]) ? $_[0] : {@_};
	# set some sane defaults: we want at least one resource (semaphore in the set),
	# and for each semaphore we want it to have a value of at least one, and
	# when working on the semaphore by default we want to use IPC_CREAT to create
	# the semaphore if it didn't already exist, and S_IRUSR & S_IWUSR to give the
	# semaphore read and write permissions for the current perl user which you could
	# see by getting and viewing the results of the perl function getlogin()
	$args->{_resources} = delete($args->{resources}) || 1;
	$args->{_value}     = delete($args->{value})     || 1;
	$args->{_flags}     = delete($args->{flags})     || S_IRUSR | S_IWUSR | IPC_CREAT;
	# determine if we're using a key_name, key, or private semaphore set
	my $self = bless($args, $class);
	if (my $key = $self->{key}) {
		if ($key =~ m/[^0-9]/) {
			die "key [$key] was not numeric";
		}
		$self->{_pre_exist} = semget($key, 0, IPC_NOWAIT);
		$self->{_key}       = $key;
		$self->{_semaphore} = IPC::Semaphore->new($key, $self->{_resources}, $self->{_flags});
	} elsif (my $key_name = $self->{key_name}) {
		$self->{_key_name}  = $key_name;
		$self->{_key}       = crc8($key_name);
		$self->{_pre_exist} = semget($self->{_key}, 0, IPC_NOWAIT);
		$self->{_semaphore} = IPC::Semaphore->new($self->key, $self->{_resources}, $self->{_flags});
	} else {
		$self->{_semaphore} = IPC::Semaphore->new(IPC_PRIVATE, $self->{_resources}, $self->{_flags});
	}
	# bail out if we didn't get an IPC::Semaphore
	if (ref($self->semaphore) ne 'IPC::Semaphore') {
		die 'could not get a semaphore with ' . $self->key . ": $!";
	}
	# if we created this semaphore, allow use of 'available' but if we didn't, don't clobber what
	# the semaphore resources were already set to
	if (!$self->{_pre_exist}) {
		$self->semaphore->setall(($self->{_value}) x $self->{_resources});
	}
	return $self;
}

sub resource
{
	my $self = shift;
	my $args = ref($_[0]) ? $_[0] : {@_};
	# default to 0, the first resource in the set
	$args->{number} = $args->{number} ? $args->{number} : 0;
	if (!$self->{resources}{$args->{number}}) {
		$args->{key}       = $self->key ? $self->key : IPC_PRIVATE;
		$args->{semaphore} = $self->semaphore;
		$self->{resources}{$args->{number}} = IPC::Semaphore::Set::Resource->new($args);
	}
	return $self->{resources}{$args->{number}};
}

sub resources
{
	my $self  = shift;
	my $total = () = $self->semaphore->getall;
	my @resources;
	for (0..($total - 1)) {
		push(@resources, $self->resource(number => $_));
	}
	return wantarray ? @resources : \@resources;
}

############
## Helper ##
############

sub id        {return shift->sem->id}
sub key       {return shift->{_key}}
sub keyName   {return shift->{_key_name}}
sub remove    {return shift->semaphore->remove ? 1 : 0}
sub semaphore {return shift->{_semaphore}}

1;

__END__