view release on metacpan or  search on metacpan

lib/IPC/SRLock.pm  view on Meta::CPAN

package IPC::SRLock;

use 5.010001;
use namespace::autoclean;
use version; our $VERSION = qv( sprintf '0.31.%d', q$Rev: 1 $ =~ /\d+/gmx );

use File::DataClass::Types qw( HashRef LoadableClass NonEmptySimpleStr Object );
use IPC::SRLock::Utils     qw( merge_attributes );
use Moo;

my $_build__implementation = sub {
   return $_[ 0 ]->_implementation_class->new( $_[ 0 ]->_implementation_attr );
};

my $_build__implementation_class = sub {
   my $self = shift; my $type = $self->type; my $class;

   if ('+' eq substr $type, 0, 1) { $class = substr $type, 1 }
   else { $class = __PACKAGE__.'::'.(ucfirst $type) }

   return $class;
};

# Public attributes
has 'type' => is => 'ro', isa => NonEmptySimpleStr, default => 'fcntl';

# Private attributes
has '_implementation'       => is => 'lazy', isa => Object,
   handles                  => [ qw( get_table list reset set ) ],
   builder                  => $_build__implementation;

has '_implementation_attr'  => is => 'ro',   isa => HashRef, required => 1;

has '_implementation_class' => is => 'lazy', isa => LoadableClass,
   builder                  => $_build__implementation_class;

# Construction
around 'BUILDARGS' => sub {
   my ($orig, $self, @args) = @_; my $attr = $orig->( $self, @args );

   my $builder = $attr->{builder};
   my $conf    = $builder && $builder->can( 'config' ) ? $builder->config : 0;

   $conf and $conf->can( 'lock_attributes' )
         and merge_attributes $attr, $conf->lock_attributes,
                           [ keys %{ $conf->lock_attributes } ];

   $attr->{name} //= lc join '_', split m{ :: }mx, __PACKAGE__, -1;

   my $type = delete $attr->{type}; $attr = { _implementation_attr => $attr };

   $type and $type !~ m{ \A ([a-zA-Z0-9\:\+]+) \z }mx
         and die "Type ${type} tainted";
   $type and $attr->{type} = $1;

   return $attr;
};

sub BUILD {
   my $self = shift; $self->_implementation; return;
}

1;

__END__

=pod

=encoding utf-8

=begin html

<a href="https://travis-ci.org/pjfl/p5-ipc-srlock"><img src="https://travis-ci.org/pjfl/p5-ipc-srlock.svg?branch=master" alt="Travis CI Badge"></a>
<a href="https://roxsoft.co.uk/coverage/report/ipc-srlock/latest"><img src="https://roxsoft.co.uk/coverage/badge/ipc-srlock/latest" alt="Coverage Badge"></a>
<a href="http://badge.fury.io/pl/IPC-SRLock"><img src="https://badge.fury.io/pl/IPC-SRLock.svg" alt="CPAN Badge"></a>
<a href="http://cpants.cpanauthors.org/dist/IPC-SRLock"><img src="http://cpants.cpanauthors.org/dist/IPC-SRLock.png" alt="Kwalitee Badge"></a>

=end html

=head1 Name

IPC::SRLock - Set / reset locking semantics to single thread processes

=head1 Version

This documents version v0.31.$Rev: 1 $ of L<IPC::SRLock>

=head1 Synopsis

   use IPC::SRLock;

   my $config   = { tempdir => 'path_to_tmp_directory', type => 'fcntl' };