view release on metacpan or  search on metacpan

lib/Cache/Isolator.pm  view on Meta::CPAN

package Cache::Isolator;

use strict;
use warnings;
use Carp;
use Try::Tiny;
use Time::HiRes;
use List::Util qw/shuffle/;
use Class::Accessor::Lite (
    ro  => [ qw(cache interval timeout concurrency trial early_expires_ratio expires_before) ],
);

our $VERSION = '0.02';

sub new {
    my $class = shift;
    my %args = (
        interval => 0.01,
        timeout => 10,
        trial => 0,
        concurrency => 1,
        early_expires_ratio => 0,
        expires_before => 10,
        @_
    );

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

    bless \%args, $class;
}

sub get_or_set {
    my ($self, $key, $cb, $expires ) = @_;

    my $value;
    my $try = 0;

    TRYLOOP: while  ( 1 ) {
        $value = $self->get($key);
        last TRYLOOP if $value;

        $try++;
        my @lockkeys = map { $key .":lock:". $_ } shuffle 1..$self->concurrency;
        foreach my $lockkey ( @lockkeys ) {
            my $locked = $self->cache->add($lockkey, 1, $self->timeout ); #lock
            if ( $locked ) {
                try {
                    $value = $self->get($key);
                    return 1 if $value;
                    $value = $cb->();
                    $self->set( $key, $value, $expires );
                }
                catch {
                    die $_;
                }
                finally {
                    $self->cache->delete( $lockkey ); #lock
                };
                last TRYLOOP;
            }
        }