File Coverage

blib/lib/Redis/ScriptCache.pm

Criterion	Covered	Total	%
statement	18	69	26.0
branch	0	22	0.0
condition	0	5	0.0
subroutine	6	14	42.8
pod	7	7	100.0
total	31	117	26.5

package Redis::ScriptCache;
use strict;
use warnings;

our $VERSION = '0.04';

use File::Basename;
use File::Spec qw(
    catdir
    splitdir
);
use Carp;

use Class::XSAccessor {
    getters => [qw(
        redis_conn
        script_dir
        _script_cache
    )],
};

sub new {
    my $class = shift;
    my $self = bless { @_ }, $class;

    # initialize the cache
    $self->{_script_cache} = {};
    # redis_conn is compulsory
    $self->redis_conn
        or croak('Need Redis connection');
    # canonicalize script_dir
    $self->_set_script_dir;

    return $self;
}

sub _set_script_dir {
    my( $self, $script_dir ) = @_;
    my $script_dir_to_set = $script_dir // $self->script_dir // undef;
    $self->{script_dir} = File::Spec->catdir( File::Spec->splitdir( $script_dir_to_set ) )
        if $script_dir_to_set;
    return $self;
}

sub register_all_scripts {
    my $self = shift;
    my %args = @_;

    $self->_set_script_dir( $args{script_dir} )
        if $args{script_dir};

    if ( $self->script_dir ) {
        for my $file (glob($self->script_dir . '/*.lua')) {
            $self->register_file(basename($file));
        }
        return $self->scripts;
    } else {
        croak('No script_dir specified');
    }
}

sub register_script {
    my ($self, $script_name, $script) = @_;
    my $script_ref = ref($script) ? $script : \$script;
    return $script_name
        if exists $self->{_script_cache}->{$script_name};

    my $sha;
    eval {
        $sha = $self->redis_conn->script_load($$script_ref);
        1;
    } or do {
        croak("redis script_load failed: $@");
    };
    $self->{_script_cache}->{$script_name} = $sha;

    return $script_name;
}

sub run_script {
    my ($self, $script_name, $args) = @_;

    my $conn = $self->redis_conn;
    my $sha = $self->_script_cache->{$script_name};

    croak("Unknown script $script_name") if !$sha;

    return $conn->evalsha($sha, ($args ? (@$args) : (0)));
}

sub register_file {
    my ($self, $path_to_file) = @_;
    open my $fh, '<', File::Spec->catdir( $self->script_dir, $path_to_file )
        or croak "error opening $path_to_file: $!";

    my $script_name = basename( $path_to_file );
    $script_name =~ s/\.lua$//;
    my $script = do { local $/; <$fh> };
    return $self->register_script($script_name, $script);
}

sub scripts {
    my ($self) = @_;
    return keys %{ $self->_script_cache };
}

sub flush_all_scripts {
    my ($self) = @_;
    eval {
        $self->redis_conn->script_flush();
        1;
    } or do {
        croak "redis script_flush failed: $@";
    };
    $self->{_script_cache} = {};
    return $self;
}

1;

__END__