view release on metacpan or  search on metacpan

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

package IPC::SRLock::Memcached;

use namespace::autoclean;

use Cache::Memcached;
use English                qw( -no_match_vars );
use File::DataClass::Types qw( ArrayRef NonEmptySimpleStr Object );
use IPC::SRLock::Utils     qw( Unspecified hash_from loop_until throw );
use Moo;

extends q(IPC::SRLock::Base);

# Public attributes
has 'lockfile' => is => 'ro', isa => NonEmptySimpleStr, default => '_lockfile';

has 'servers'  => is => 'ro', isa => ArrayRef,
   default     => sub { [ 'localhost:11211' ] };

has 'shmfile'  => is => 'ro', isa => NonEmptySimpleStr, default => '_shmfile';

# Private attributes
has '_memd'    => is => 'lazy', isa => Object, reader => 'memd',
   builder     => sub { Cache::Memcached->new
                           ( debug     => $_[ 0 ]->debug,
                             namespace => $_[ 0 ]->name,
                             servers   => $_[ 0 ]->servers ) };

# Private methods
my $_expire_lock = sub {
   my ($self, $data, $key, @fields) = @_;

   $self->log->error
      ( $self->_timeout_error
        ( $key, $fields[ 0 ], $fields[ 1 ], $fields[ 2 ] ) );

   delete $data->{ $key };
   return 0;
};

my $_unlock_share = sub {
   my $self = shift; $self->memd->delete( $self->lockfile ); return 1;
};

my $_list = sub {
   my $self = shift;

   $self->memd->add( $self->lockfile, 1, $self->patience + 30 ) or return 0;

   my $shm_content = $self->memd->get( $self->shmfile ) // {};
   my $list        = []; $self->$_unlock_share;

   for my $key (sort keys %{ $shm_content }) {
      my @fields = split m{ , }mx, $shm_content->{ $key };

      push @{ $list }, { key     => $key,
                         pid     => $fields[ 0 ],
                         stime   => $fields[ 1 ],
                         timeout => $fields[ 2 ] };
   }

   return $list;
};

my $_reset = sub {
   my ($self, $args, $now) = @_; my $key = $args->{k}; my $pid = $args->{p};

   $self->memd->add( $self->lockfile, 1, $self->patience + 30 ) or return 0;

   my $shm_content = $self->memd->get( $self->shmfile ) // {};

   my $lock; exists $shm_content->{ $key }
      and $lock = $shm_content->{ $key }
      and (split m{ , }mx, $lock)[ 0 ] != $pid
      and $self->$_unlock_share
      and throw 'Lock [_1] set by another process', [ $key ];