From: Dobrica Pavlinusic <dpavlin@rot13.org>
Date: Sun, 22 Mar 2009 20:04:17 +0000 (+0000)
Subject: fixed Redis::Hash keys problem,
X-Git-Tag: 0.0801~20
X-Git-Url: http://git.rot13.org/?p=perl-Redis.git;a=commitdiff_plain;h=d614f74a89501c756b5e6a240995c0aa0295573b;hp=16b05e03b2a90f65f103553d934858d974ee808d

fixed Redis::Hash keys problem,
separate prefix from key with :,
return key names without prefix

git-svn-id: svn+ssh://llin/home/dpavlin/private/svn/Redis@43 447b33ff-793d-4489-8442-9bea7d161be5
---

diff --git a/lib/Redis.pm b/lib/Redis.pm
index 6b0916d..6513752 100644
--- a/lib/Redis.pm
+++ b/lib/Redis.pm
@@ -258,7 +258,9 @@ sub type {
 
 sub keys {
 	my ( $self, $glob ) = @_;
-	return split(/\s/, $self->_sock_result_bulk( 'KEYS', $glob ));
+	my $keys = $self->_sock_result_bulk( 'KEYS', $glob );
+	return split(/\s/, $keys) if $keys;
+	return () if wantarray;
 }
 
 =head2 randomkey
diff --git a/lib/Redis/Hash.pm b/lib/Redis/Hash.pm
index 6dad3dc..e5f8f70 100644
--- a/lib/Redis/Hash.pm
+++ b/lib/Redis/Hash.pm
@@ -6,20 +6,23 @@ use warnings;
 use Tie::Hash;
 use base qw/Redis Tie::StdHash/;
 
+use Data::Dump qw/dump/;
+
 =head1 NAME
 
 Redis::Hash - tie perl hashes into Redis
 
 =head1 SYNOPSYS
 
-  tie %$name, 'Redis::Hash', 'name';
+  tie %name, 'Redis::Hash', 'prefix';
 
 =cut
 
 # mandatory methods
 sub TIEHASH {
 	my ($class,$name) = @_;
-	my $self = $class->new;
+	my $self = Redis->new;
+	$name .= ':' if $name;
 	$self->{name} = $name || '';
 	bless $self => $class;
 }
@@ -36,13 +39,16 @@ sub FETCH {
 
 sub FIRSTKEY {
 	my $self = shift;
-	$self->{keys} = [ $self->keys( $self->{name} . '*') ];
-	unshift @{ $self->{keys} };
+	$self->{keys} = [ $self->keys( $self->{name} . '*' ) ];
+	$self->NEXTKEY;
 } 
 
 sub NEXTKEY {
 	my $self = shift;
-	unshift @{ $self->{keys} };
+	my $key = shift @{ $self->{keys} } || return;
+	my $name = $self->{name};
+	$key =~ s{^$name}{} || warn "can't strip $name from $key";
+	return $key;
 }
 
 sub EXISTS {
@@ -58,6 +64,7 @@ sub DELETE {
 sub CLEAR {
 	my ($self) = @_;
 	$self->del( $_ ) foreach ( $self->keys( $self->{name} . '*' ) );
+	$self->{keys} = [];
 }
 
 1;
diff --git a/t/20-Redis-Hash.t b/t/20-Redis-Hash.t
index 4bef8a5..687b85c 100755
--- a/t/20-Redis-Hash.t
+++ b/t/20-Redis-Hash.t
@@ -11,20 +11,20 @@ BEGIN {
 	use_ok( 'Redis::Hash' );
 }
 
-my $h;
-
-ok( my $o = tie( %$h, 'Redis::Hash', 'test-redis-hash' ), 'tie' );
+ok( my $o = tie( my %h, 'Redis::Hash', 'test-redis-hash' ), 'tie' );
 
 isa_ok( $o, 'Redis::Hash' );
 
-$h = {};
+$o->CLEAR();
+
+ok( ! keys %h, 'empty' );
+
+ok( %h = ( 'foo' => 42, 'bar' => 1, 'baz' => 99 ), '=' );
 
-ok( ! %$h, 'empty' );
+is_deeply( [ keys %h ], [ 'bar', 'baz', 'foo' ], 'keys' );
 
-ok( $h = { 'foo' => 42, 'bar' => 1, 'baz' => 99 }, '=' );
+is_deeply( \%h, { bar => 1, baz => 99, foo => 42, }, 'structure' );
 
-is_deeply( $h, { bar => 1, baz => 99, foo => 42 }, 'values' );
 
-is_deeply( [ keys %$h ], [ 'bar', 'baz', 'foo' ], 'keys' );
+diag dump( \%h );
 
-diag dump( $h );