File Coverage

blib/lib/Redis/Key.pm

Criterion	Covered	Total	%
statement	15	74	20.2
branch	0	20	0.0
condition	0	8	0.0
subroutine	5	17	29.4
pod	0	6	0.0
total	20	125	16.0

package Redis::Key;

use strict;
use warnings;
use Carp;
our $VERSION = '0.03';

use Redis;

# key:     you should not pass any args
# pass:    do not change args
# invalid: the command cannot use with Redis::Key
our %command_type = (
    del                => 'key',

    auth               => 'pass',
    bgrewriteaof       => 'pass',
    bgsave             => 'pass',
    config             => 'pass',
    dbsize             => 'pass',
    discard            => 'pass',
    exec               => 'pass',
    info               => 'pass',
    lastsave           => 'pass',
    ping               => 'pass',
    save               => 'pass',
    multi              => 'pass',
    wait_all_responses => 'pass',
    wait_one_responses => 'pass',

    flushall           => 'invalid',
    flushdb            => 'invalid',
    quit               => 'invalid',
    select             => 'invalid',
    shutdown           => 'invalid',
    slaveof            => 'invalid',
);

our %wrappers = (
);

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

    $self->{redis} = $args{redis} || Redis->new(%args);
    $self->{key} = $args{key};
    $self->{need_bind} = $args{need_bind};
    return $self;
}

sub redis { shift->{redis} }
sub key { shift->{key} }

sub keys {
    my $self = shift;
    my $key = $self->{key};
    if($self->{need_bind}) {
        $key =~ s!{\w+}!*!g;
        my $redis = $self->{redis};
        return $redis->keys($key);
    } else {
        return wantarray ? ($key) : 1;
    }
}

sub scan {
    my ($self, $iter, @args) = @_;
    my $key = $self->{key};
    if($self->{need_bind}) {
        $key =~ s!{\w+}!*!g;
        my $redis = $self->{redis};
        return $redis->scan($iter, @args, MATCH => $key);
    } else {
        return (0, [$key]);
    }
}

sub bind {
    my $self = shift;
    my $key = $self->{key};
    my %hash = @_;

    $key =~ s!{(\w+)}!
        $hash{$1} // croak("$1 is not passed to $key");
    !eg;

    return __PACKAGE__->new(
        redis     => $self->{redis},
        key       => $key,
        need_bind => 0,
    );
}

sub DESTROY { }

our $AUTOLOAD;
sub AUTOLOAD {
    my $command = $AUTOLOAD;
    $command =~ s/.*://;

    my $type = $command_type{$command} || 'normal';
    my $method;

    if($type eq 'normal') {
        $method = sub {
            my $self = shift;
            my $redis = $self->{redis};
            my $key = $self->{key};

            if($self->{need_bind}) {
                croak "$key needs bind";
            }

            $redis->$command($key, @_);
        };
    } elsif($type eq 'key') {
        $method = sub {
            my $self = shift;
            my $redis = $self->{redis};
            my $key = $self->{key};

            if($self->{need_bind}) {
                croak "$key needs bind";
            }
            if(@_) {
                croak "too many args for $command";
            }

            $redis->$command($key);
        };
    } elsif($type eq 'pass') {
        $method = sub {
            my $self = shift;
            my $redis = $self->{redis};
            $redis->$command(@_);
        };
    } elsif($type eq 'invalid') {
        $method = sub {
            croak "$command connot use with Redis::Key";
        };
    }

  # Save this method for future calls
  no strict 'refs';
  *$AUTOLOAD = $method;

  goto $method;
}

1;
__END__