File Coverage

blib/lib/Tie/Redis/Candy/Array.pm

Criterion	Covered	Total	%
statement	15	46	32.6
branch	0	8	0.0
condition			n/a
subroutine	5	18	27.7
pod			n/a
total	20	72	27.7

# This file was part of Redis, licensed under:
#
#   The Artistic License 2.0 (GPL Compatible)
#
# Copyright (c) 2015 by Pedro Melo, Damien Krotkine.

package Tie::Redis::Candy::Array;

# ABSTRACT: tie Perl arrays to Redis lists - the candy way

use strict;
use warnings;
use Carp;
use CBOR::XS qw(encode_cbor decode_cbor);
use base 'Tie::Array';

our $VERSION = '0.004';    # VERSION

sub TIEARRAY {
    my ( $class, $redis, $listname ) = @_;

    my $self = {
        list  => $listname,
        redis => $redis,
    };

    return bless( $self, $class );
}

sub FETCH {
    my ( $self, $index ) = @_;
    my $data = $self->{redis}->lindex( $self->{list}, $index );
    return unless defined $data;
    decode_cbor($data);
}

sub FETCHSIZE {
    my ($self) = @_;
    $self->{redis}->llen( $self->{list} );
}

sub STORE {
    my ( $self, $index, $value ) = @_;
    $self->{redis}->lset( $self->{list}, $index, encode_cbor($value) );
}

sub STORESIZE {
    my ( $self, $count ) = @_;
    $self->{redis}->ltrim( $self->{list}, 0, $count );
}

sub CLEAR {
    my ($self) = @_;
    $self->{redis}->del( $self->{list} );
}

sub PUSH {
    my ( $self, @values ) = @_;
    $self->{redis}->rpush( $self->{list}, encode_cbor($_) ) for @values;
}

sub POP {
    my ($self) = @_;
    map { defined($_) ? decode_cbor($_) : undef }
      $self->{redis}->rpop( $self->{list} );
}

sub SHIFT {
    my ($self) = @_;
    map { defined($_) ? decode_cbor($_) : undef }
      $self->{redis}->lpop( $self->{list} );
}

sub UNSHIFT {
    my ( $self, @values ) = shift;
    $self->{redis}->lpush( $self->{list}, encode_cbor($_) ) for @values;
}

sub SPLICE {
    my ( $self, $offset, $length ) = @_;
    confess "cannot replace elements in list (unimplemented)" if @_ > 3;
    $self->lrange( $self->{list}, $offset, $length );
}

sub EXTEND {
    my ( $self, $count ) = @_;
    $self->{redis}->rpush( $self->{list}, '' )
      for ( $self->FETCHSIZE .. ( $count - 1 ) );
}

sub DESTROY {
}

1;

__END__