File Coverage

blib/lib/Redis/Script.pm

Criterion	Covered	Total	%
statement	17	45	37.7
branch	0	14	0.0
condition	0	9	0.0
subroutine	6	12	50.0
pod	3	6	50.0
total	26	86	30.2

package Redis::Script;
use 5.008005;
use strict;
use warnings;
use Exporter 'import';
our @EXPORT_OK = ('redis_eval');

our $VERSION = "0.02";

use Digest::SHA qw(sha1_hex);
use Carp qw/croak/;

sub new {
    my ($class, %args) = @_;
    my $self = bless {
        use_evalsha => 1,
        %args,
    }, $class;

    return $self;
}

sub eval {
    my ($self, $redis, $keys, $args) = @_;
    if ($self->{use_evalsha}) {
        my $sha = $self->sha1;
        my $ret = eval { $redis->evalsha($sha, scalar(@$keys), @$keys, @$args) };
        if (my $err = $@) {
            croak $err if $err !~ /\[evalsha\] NOSCRIPT No matching script/i;
        } else {
            return (wantarray && ref $ret eq 'ARRAY') ? @$ret : $ret;
        }
    }

    my $ret = eval {
        $redis->eval($self->{script}, scalar(@$keys), @$keys, @$args);
    };
    if (my $err = $@) {
        croak $@;
    }

    return (wantarray && ref $ret eq 'ARRAY') ? @$ret : $ret;
}

sub exists {
    my ($self, $redis) = @_;
    return $redis->script_exists($self->sha1)->[0];
}

sub load {
    my ($self, $redis) = @_;
    my $sha = $self->sha1;
    my $redis_sha = $redis->script_load($self->{script});
    if (lc $sha ne lc $redis_sha) {
        croak "SHA is unmatch (expected $sha but redis returns $redis_sha)";
    }
    return $sha;
}

sub sha1 {
    my $self = shift;
    return $self->{sha} ||= sha1_hex($self->{script});
}

sub redis_eval {
    my ($redis, $script, $keys, $args) = @_;
    return __PACKAGE__->new(script => $script)->eval($redis, $keys, $args);
}

1;
__END__