mirror of
https://codeberg.org/redict/redict.git
synced 2025-01-23 16:48:27 -05:00
71 lines
1.1 KiB
Perl
71 lines
1.1 KiB
Perl
package Redis::Hash;
|
|
|
|
use strict;
|
|
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', 'prefix';
|
|
|
|
=cut
|
|
|
|
# mandatory methods
|
|
sub TIEHASH {
|
|
my ($class,$name) = @_;
|
|
my $self = Redis->new;
|
|
$name .= ':' if $name;
|
|
$self->{name} = $name || '';
|
|
bless $self => $class;
|
|
}
|
|
|
|
sub STORE {
|
|
my ($self,$key,$value) = @_;
|
|
$self->set( $self->{name} . $key, $value );
|
|
}
|
|
|
|
sub FETCH {
|
|
my ($self,$key) = @_;
|
|
$self->get( $self->{name} . $key );
|
|
}
|
|
|
|
sub FIRSTKEY {
|
|
my $self = shift;
|
|
$self->{keys} = [ $self->keys( $self->{name} . '*' ) ];
|
|
$self->NEXTKEY;
|
|
}
|
|
|
|
sub NEXTKEY {
|
|
my $self = shift;
|
|
my $key = shift @{ $self->{keys} } || return;
|
|
my $name = $self->{name};
|
|
$key =~ s{^$name}{} || warn "can't strip $name from $key";
|
|
return $key;
|
|
}
|
|
|
|
sub EXISTS {
|
|
my ($self,$key) = @_;
|
|
$self->exists( $self->{name} . $key );
|
|
}
|
|
|
|
sub DELETE {
|
|
my ($self,$key) = @_;
|
|
$self->del( $self->{name} . $key );
|
|
}
|
|
|
|
sub CLEAR {
|
|
my ($self) = @_;
|
|
$self->del( $_ ) foreach ( $self->keys( $self->{name} . '*' ) );
|
|
$self->{keys} = [];
|
|
}
|
|
|
|
1;
|