view release on metacpan or  search on metacpan

lib/KeyedMutex/Memcached.pm  view on Meta::CPAN

package KeyedMutex::Memcached;

use strict;
use warnings;
use Carp;
use Scope::Guard qw(scope_guard);
use Time::HiRes ();

our $VERSION = '0.05';

sub new {
    my $class = shift;
    my $args = ref $_[0] ? $_[0] : +{@_};
    $args = +{
        interval => 0.01,
        trial    => 0,
        timeout  => 30,
        prefix   => 'km',
        cache    => undef,
        %$args,
        locked => 0,
    };

    croak('cache value should be object and appeared add and delete methods.')
      unless ( $args->{cache}
        && UNIVERSAL::can( $args->{cache}, 'add' )
        && UNIVERSAL::can( $args->{cache}, 'delete' ) );

    bless $args => $class;
}

sub lock {
    my ( $self, $key, $use_raii ) = @_;

    $key = $self->{prefix} . ':' . $key if ( $self->{prefix} );
    $self->{key}    = $key;
    $self->{locked} = 0;

    my $i  = 0;
    my $rv = 0;

    while ( $self->{trial} == 0 || ++$i <= $self->{trial} ) {
        $rv = $self->{cache}->add( $key, 1, $self->{timeout} ) ? 1 : 0;
        if ($rv) {
            $self->{locked} = 1;
            last;
        }
        Time::HiRes::sleep( $self->{interval} * rand(1) );
    }

    return $rv ? ( $use_raii ? scope_guard sub { $self->release } : 1 ) : 0;
}

sub release {
    my $self = shift;
    $self->{cache}->delete( $self->{key} );
    $self->{locked} = 0;
    1;
}

1;
__END__

=head1 NAME

KeyedMutex::Memcached - An interprocess keyed mutex using memcached

=head1 SYNOPSIS

  use KeyedMutex::Memcached;

  my $key   = 'query:XXXXXX';
  my $cache = Cache::Memcached::Fast->new( ... );
  my $mutex = KeyedMutex::Memcached->new( cache => $cache );

  until ( my $value = $cache->get($key) ) {
    {
      if ( my $lock = $mutex->lock( $key, 1 ) ) {
        #locked read from DB
        $value = get_from_db($key);
        $cache->set($key, $value);
        last;
      }
    };
  }

=head1 DESCRIPTION

KeyedMutex::Memcached is an interprocess keyed mutex using memcached.