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 (file)
--- a/lib/Redis.pm
+++ b/lib/Redis.pm
@@ -258,7 +258,9 @@ sub type {
 
 sub keys {
        my ( $self, $glob ) = @_;
 
 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
 }
 
 =head2 randomkey

diff --git a/lib/Redis/Hash.pm b/lib/Redis/Hash.pm
index 6dad3dc..e5f8f70 100644 (file)
--- 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 Tie::Hash;
 use base qw/Redis Tie::StdHash/;
 

+use Data::Dump qw/dump/;
+

 =head1 NAME
 
 Redis::Hash - tie perl hashes into Redis
 
 =head1 SYNOPSYS
 
 =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) = @_;
 
 =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;
 }
        $self->{name} = $name || '';
        bless $self => $class;
 }


@@ -36,13 +39,16 @@ sub FETCH {
 
 sub FIRSTKEY {
        my $self = shift;
 
 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;
 } 
 
 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 {
 }
 
 sub EXISTS {


@@ -58,6 +64,7 @@ sub DELETE {
 sub CLEAR {
        my ($self) = @_;
        $self->del( $_ ) foreach ( $self->keys( $self->{name} . '*' ) );
 sub CLEAR {
        my ($self) = @_;
        $self->del( $_ ) foreach ( $self->keys( $self->{name} . '*' ) );

+       $self->{keys} = [];

 }
 
 1;
 }
 
 1;

diff --git a/t/20-Redis-Hash.t b/t/20-Redis-Hash.t
index 4bef8a5..687b85c 100755 (executable)
--- a/t/20-Redis-Hash.t
+++ b/t/20-Redis-Hash.t
@@ -11,20 +11,20 @@ BEGIN {
        use_ok( 'Redis::Hash' );
 }
 
        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' );
 
 
 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 );