File Coverage

blib/lib/Cache/Redis.pm

Criterion	Covered	Total	%
statement	11	98	11.2
branch	0	34	0.0
condition	0	25	0.0
subroutine	4	20	20.0
pod	8	8	100.0
total	23	185	12.4

package Cache::Redis;
use 5.008_001;
use strict;
use warnings;

our $VERSION = '0.13';

use Module::Load;

my $_mp;
sub _mp {
    $_mp ||= Data::MessagePack->new->utf8;
}
sub _mp_serialize {
    _mp->pack(@_);
}
sub _mp_deserialize {
    _mp->unpack(@_);
}

sub _mk_serialize {
    my $code = shift;

    return sub {
        my $data = shift;

        my $flags; # for future extention
        my $store_date = [$data, $flags];
        $code->($store_date);
    };
}

sub _mk_deserialize {
    my $code = shift;

    return sub {
        my $data = shift;

        my ($org, $flags) = @{$code->($data)};
        $org;
    };
}

sub new {
    my $class = shift;

    my $args = @_ == 1 ? $_[0] : {@_};
    my $default_expires_in = delete $args->{default_expires_in} || 60*60*24 * 30;
    my $namespace          = delete $args->{namespace}          || '';
    my $nowait             = delete $args->{nowait}             || 0;
    my $redis_class        = delete $args->{redis_class}        || 'Redis';

    my $redis             = delete $args->{redis};
    my $serializer        = delete $args->{serializer};
    my $serialize_methods = delete $args->{serialize_methods};
    die '`serializer` and `serialize_methods` is exclusive option' if $serializer && $serialize_methods;
    $serializer ||= 'Storable' unless $serialize_methods;

    my ($serialize, $deserialize);
    if ($serializer) {
        if ($serializer eq 'Storable') {
            require Storable;
            $serialize_methods = [\&Storable::nfreeze, \&Storable::thaw];
        }
        elsif ($serializer eq 'JSON') {
            require JSON::XS;
            $serialize_methods = [\&JSON::XS::encode_json, \&JSON::XS::decode_json];
        }
    }

    if ($serialize_methods) {
        $serialize   = _mk_serialize   $serialize_methods->[0];
        $deserialize = _mk_deserialize $serialize_methods->[1];
    }
    elsif ($serializer eq 'MessagePack') {
        require Data::MessagePack;
        $serialize   = \&_mp_serialize;
        $deserialize = \&_mp_deserialize;
    }
    die 'Serializer is not found' if !$serialize || !$deserialize;

    unless ( $redis ) {
        load $redis_class;
        $redis = $redis_class->new(
            encoding => undef,
            %$args
        );
    }

    bless {
        default_expires_in => $default_expires_in,
        serialize          => $serialize,
        deserialize        => $deserialize,
        redis              => $redis,
        namespace          => $namespace,
        nowait             => $nowait,
    }, $class;
}

sub get {
    my ($self, $key) = @_;
    $key = $self->{namespace} . $key;

    my $data = $self->{redis}->get($key);

    defined $data ? $self->{deserialize}->($data) : $data;
}

sub get_multi {
    my ($self, @keys) = @_;
    @keys = map { $self->{namespace} . $_ } @keys;

    my @data = $self->{redis}->mget(@keys);

    my $i = 0;
    my $ret = {};
    for my $key ( @keys ) {
        if ( defined $data[$i] ) {
            $ret->{$key} = $self->{deserialize}->($data[$i]);
        }
        $i++;
    }

    $ret;
}

sub set {
    my ($self, $key, $value, $expire, $callback) = @_;

    die 'set() requires key and value arguments' if scalar(@_) < 3;

    my $response = $self->_set($key, $value, $expire, $callback);

    # return now as the callabck will be called when it's done processing
    return if ($self->{nowait});
    $self->{redis}->wait_all_responses;
    return $response;
}

sub set_multi {
    my ($self, @items) = @_;

    for my $item ( @items ) {
        $self->_set(@$item);
    }
    $self->{redis}->wait_all_responses unless $self->{nowait};
}

sub _set {
    my ($self, $key, $value, $expire, $callback) = @_;
    $key = $self->{namespace} . $key;
    $expire ||= $self->{default_expires_in};

    if ($self->{nowait} && $callback) {
      $self->{redis}->setex($key, $expire, $self->{serialize}->($value), $callback);
    }
    else {
      $self->{redis}->setex($key, $expire, $self->{serialize}->($value));
    }
}

sub get_or_set {
    my ($self, $key, $code, $expire) = @_;

    my $data = $self->get($key);
    unless (defined $data) {
        $data = $code->();
        $self->set($key, $data, $expire);
    }
    $data;
}

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

    my $data = $self->get($key);
    $key = $self->{namespace} . $key;
    $self->{redis}->del($key);

    $data;
}

sub nowait_push {
    shift->{redis}->wait_all_responses;
}

1;
__END__