File Coverage

blib/lib/CHI/Driver/Redis.pm

Criterion	Covered	Total	%
statement	71	71	100.0
branch	8	10	80.0
condition			n/a
subroutine	12	12	100.0
pod	0	8	0.0
total	91	101	90.1

package CHI::Driver::Redis;

use Moo;
use Redis;
use URI::Escape qw(uri_escape uri_unescape);

extends 'CHI::Driver';

our $VERSION = '0.10';

has 'redis' => (
    is   => 'ro',
    lazy => 1,
    builder => '_build_redis',
);

has 'redis_options' => (
    is => 'rw',
    default => sub { {} },
);

has 'redis_class' => (
    is => 'ro',
    default => 'Redis',
);

has 'prefix'=> (
    is => 'ro',
    default => '',
);

sub BUILD {
    my ($self, $params) = @_;
    foreach my $param (qw/redis redis_class redis_options prefix/) {
        if (exists $params->{$param}) {
            delete $params->{$param};
        }
    }
    my %options = (
        server => '127.0.0.1:6379',
        encoding => undef,
        %{ $self->redis_options() },
        %{ $self->non_common_constructor_params($params) },
    );
    $self->redis_options(\%options);
}

sub _build_redis {
    my ($self) = @_;
    return $self->redis_class()->new(%{ $self->redis_options() });
}

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

    my $eskey = uri_escape($key);
    my $realkey = $self->prefix . $self->namespace . '||' . $eskey;
    my $val = $self->redis->get($realkey);
    return $val;
}

sub fetch_multi_hashref {
    my ($self, $keys) = @_;

    return unless scalar(@{ $keys });

    my $ns = $self->prefix . $self->namespace;

    my @keys;
    foreach my $k (@$keys) {
        my $esk = uri_escape($k);
        my $key = $ns . '||' . $esk;
        push @keys, $key;
    }

    my @vals = $self->redis->mget(@keys);

    my $count = 0;
    my %resp;
    foreach my $k (@$keys) {
        $resp{$k} = $vals[$count];
        $count++;
    }

    return \%resp;
}

sub get_keys {
    my ($self) = @_;

    my @keys = $self->redis->smembers($self->prefix . $self->namespace);

    my @unesckeys = ();

    foreach my $k (@keys) {
        # Getting an empty key here for some reason...
        next unless defined $k;
        push(@unesckeys, uri_unescape($k));
    }
    return @unesckeys;
}

sub get_namespaces {
    my ($self) = @_;

    return $self->redis->smembers($self->prefix . 'chinamespaces');
}

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

    return unless defined($key);

    my $ns = $self->prefix . $self->namespace;

    my $skey = uri_escape($key);

    $self->redis->srem($ns, $skey);
    $self->redis->del($ns . '||' . $skey);
}

sub store {
    my ($self, $key, $data, $expires_in) = @_;

    my $ns = $self->prefix . $self->namespace;

    my $skey = uri_escape($key);
    my $realkey = $ns . '||' . $skey;

    $self->redis->sadd($self->prefix . 'chinamespaces', $self->namespace);
    $self->redis->sadd($ns, $skey);
    $self->redis->set($realkey, $data);

    if (defined($expires_in)) {
        $self->redis->expire($realkey, $expires_in);
    }
}

sub clear {
    my ($self) = @_;

    my $ns = $self->prefix . $self->namespace;
    my @keys = $self->redis->smembers($ns);

    foreach my $k (@keys) {
        $self->redis->srem($ns, $k);
        $self->redis->del($ns . '||' . $k);
    }
}

1;

__END__