<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">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-&gt;new;
	$name .= ':' if $name;
	$self-&gt;{name} = $name || '';
	bless $self =&gt; $class;
}

sub STORE {
	my ($self,$key,$value) = @_;
	$self-&gt;set( $self-&gt;{name} . $key, $value );
}

sub FETCH {
	my ($self,$key) = @_;
	$self-&gt;get( $self-&gt;{name} . $key );
}

sub FIRSTKEY {
	my $self = shift;
	$self-&gt;{keys} = [ $self-&gt;keys( $self-&gt;{name} . '*' ) ];
	$self-&gt;NEXTKEY;
} 

sub NEXTKEY {
	my $self = shift;
	my $key = shift @{ $self-&gt;{keys} } || return;
	my $name = $self-&gt;{name};
	$key =~ s{^$name}{} || warn "can't strip $name from $key";
	return $key;
}

sub EXISTS {
	my ($self,$key) = @_;
	$self-&gt;exists( $self-&gt;{name} . $key );
}

sub DELETE {
	my ($self,$key) = @_;
	$self-&gt;del( $self-&gt;{name} . $key );
}

sub CLEAR {
	my ($self) = @_;
	$self-&gt;del( $_ ) foreach ( $self-&gt;keys( $self-&gt;{name} . '*' ) );
	$self-&gt;{keys} = [];
}

1;
</pre></body></html>