Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Improve Redis::List

 * added a better synopsis;
 * fix: added the POP method;
 * improved test suite.

Signed-off-by: Pedro Melo <melo@simplicidade.org>
  • Loading branch information...
commit a765bf6dbacf78fd8431a5a3dc837bba5f8b7986 1 parent 706c589
@melo melo authored
Showing with 109 additions and 40 deletions.
  1. +1 −0  Changes
  2. +46 −25 lib/Redis/List.pm
  3. +62 −15 t/10-Redis-List.t
View
1  Changes
@@ -6,6 +6,7 @@ Revision history for Redis
* feature: support for Redis PUBLISH/SUBSCRIBE commands
* feature: automatic encoding can be turned off, use encoding => undef on new() (performance++)
* performance: substantial performance improvements, specially with large responses
+ * fix: add POP method to our List Tie interface
1.2001 Wed Mar 17 17:22:01 CET 2010
* feadure: Redis protocol 1.2 support by Jeremy Zawodny <Jeremy@Zawodny.com> CPAN RT #54841
View
71 lib/Redis/List.pm
@@ -2,7 +2,6 @@ package Redis::List;
use strict;
use warnings;
-
use base qw/Redis Tie::Array/;
=head1 NAME
@@ -11,77 +10,99 @@ Redis::List - tie perl arrays into Redis lists
=head1 SYNOPSYS
- tie @a, 'Redis::List', 'name';
+ tie @my_list, 'Redis::List', 'list_name', @Redis_new_parameters;
+
+ $value = $my_list[$index];
+ $my_list[$index] = $value;
+
+ $count = @my_list;
+
+ push @my_list, 'values';
+ $value = pop @my_list;
+ unshift @my_list, 'values';
+ $value = shift @my_list;
+
+ ## NOTE: fourth parameter of splice is *NOT* supported for now
+ @other_list = splice(@my_list, 2, 3);
+
+ @my_list = ();
+
=cut
-# mandatory methods
+
sub TIEARRAY {
- my ($class, $name) = @_;
- my $self = $class->new;
- $self->{name} = $name;
- bless $self => $class;
+ my ($class, $list, @rest) = @_;
+ my $self = $class->new(@rest);
+
+ $self->{list} = $list;
+
+ return $self;
}
sub FETCH {
my ($self, $index) = @_;
- $self->lindex($self->{name}, $index);
+ $self->lindex($self->{list}, $index);
}
sub FETCHSIZE {
my ($self) = @_;
- $self->llen($self->{name});
+ $self->llen($self->{list});
}
sub STORE {
my ($self, $index, $value) = @_;
- $self->lset($self->{name}, $index, $value);
+ $self->lset($self->{list}, $index, $value);
}
sub STORESIZE {
my ($self, $count) = @_;
- $self->ltrim($self->{name}, 0, $count);
+ $self->ltrim($self->{list}, 0, $count);
# if $count > $self->FETCHSIZE;
}
sub CLEAR {
my ($self) = @_;
- $self->del($self->{name});
+ $self->del($self->{list});
}
sub PUSH {
my $self = shift;
- $self->rpush($self->{name}, $_) foreach @_;
+ my $list = $self->{list};
+
+ $self->rpush($list, $_) for @_;
}
-sub SHIFT {
+sub POP {
my $self = shift;
- $self->lpop($self->{name});
+ $self->rpop($self->{list});
+}
+
+sub SHIFT {
+ my ($self) = @_;
+ $self->lpop($self->{list});
}
sub UNSHIFT {
my $self = shift;
- $self->lpush($self->{name}, $_) foreach @_;
+ my $list = $self->{list};
+
+ $self->lpush($list, $_) for @_;
}
sub SPLICE {
- my $self = shift;
- my $offset = shift;
- my $length = shift;
- $self->lrange($self->{name}, $offset, $length);
+ my ($self, $offset, $length) = @_;
+ $self->lrange($self->{list}, $offset, $length);
# FIXME rest of @_ ?
}
sub EXTEND {
my ($self, $count) = @_;
- $self->rpush($self->{name}, '') foreach ($self->FETCHSIZE .. ($count - 1));
+ $self->rpush($self->{list}, '') for ($self->FETCHSIZE .. ($count - 1));
}
-sub DESTROY {
- my $self = shift;
- $self->quit;
-}
+sub DESTROY { $_[0]->quit }
1;
View
77 t/10-Redis-List.t
@@ -1,28 +1,75 @@
-#!/usr/bin/perl
+#!perl
use warnings;
use strict;
+use Test::More;
+use Redis::List;
+use lib 't/tlib';
+use Test::SpawnRedisServer;
-use Test::More tests => 8;
-use lib 'lib';
+my ($guard, $srv) = redis();
-BEGIN {
- use_ok('Redis::List');
-}
+## Setup
+my @my_list;
+ok(my $redis = tie(@my_list, 'Redis::List', 'my_list', server => $srv),
+ 'tied to our test redis-server');
+ok($redis->ping, 'pinged fine');
+isa_ok($redis, 'Redis::List');
-my @a;
-ok(my $o = tie(@a, 'Redis::List', 'test-redis-list'), 'tie');
+## Direct access
+subtest 'direct access' => sub {
+ @my_list = ();
+ is_deeply(\@my_list, [], 'empty list ok');
-isa_ok($o, 'Redis::List');
+ @my_list = ('foo', 'bar', 'baz');
+ is_deeply(\@my_list, ['foo', 'bar', 'baz'], 'Set multiple values ok');
-$o->CLEAR;
+ $my_list[1] = 'BAR';
+ is_deeply(\@my_list, ['foo', 'BAR', 'baz'], 'Set single value ok');
-ok(!@a, 'empty list');
+ is($my_list[2]++, 'baz', 'get single value ok');
+ is(++$my_list[2], 'bbb', '... even with post/pre-increments');
+};
-ok(@a = ('foo', 'bar', 'baz'), '=');
-is_deeply([@a], ['foo', 'bar', 'baz']);
-ok(push(@a, 'push'), 'push');
-is_deeply([@a], ['foo', 'bar', 'baz', 'push']);
+## List functions
+subtest 'list functions' => sub {
+ my $v;
+ ok($v = shift(@my_list), 'shift ok');
+ is($v, 'foo', '... expected value');
+ is_deeply(\@my_list, ['BAR', 'bbb'], '... resulting list as expected');
+
+ ok(push(@my_list, $v), 'push ok');
+ is_deeply(
+ \@my_list,
+ ['BAR', 'bbb', 'foo'],
+ '... resulting list as expected'
+ );
+
+ ok($v = pop(@my_list), 'pop ok');
+ is($v, 'foo', '... expected value');
+ is_deeply(\@my_list, ['BAR', 'bbb'], '... resulting list as expected');
+
+ ok(unshift(@my_list, $v), 'unshift ok');
+ is_deeply(
+ \@my_list,
+ ['foo', 'BAR', 'bbb'],
+ '... resulting list as expected'
+ );
+
+ ok(my @s = splice(@my_list, 1, 2), 'splice ok');
+ is_deeply([@s], ['BAR', 'bbb'], '... resulting list as expected');
+ is_deeply(
+ \@my_list,
+ ['foo', 'BAR', 'bbb'],'... original list as expected'
+ );
+};
+
+
+## Cleanup
+@my_list = ();
+is_deeply(\@my_list, [], 'empty list ok');
+
+done_testing();
Please sign in to comment.
Something went wrong with that request. Please try again.