<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Redis::List;

use strict;
use warnings;

use base qw/Redis Tie::Array/;

=head1 NAME

Redis::List - tie perl arrays into Redis lists

=head1 SYNOPSYS

  tie @a, 'Redis::List', 'name';

=cut

# mandatory methods
sub TIEARRAY {
	my ($class,$name) = @_;
	my $self = $class-&gt;new;
	$self-&gt;{name} = $name;
	bless $self =&gt; $class;
}

sub FETCH {
	my ($self,$index) = @_;
	$self-&gt;lindex( $self-&gt;{name}, $index );
}

sub FETCHSIZE {
	my ($self) = @_;
	$self-&gt;llen( $self-&gt;{name} );
} 

sub STORE {
	my ($self,$index,$value) = @_;
	$self-&gt;lset( $self-&gt;{name}, $index, $value );
}

sub STORESIZE {
	my ($self,$count) = @_;
	$self-&gt;ltrim( $self-&gt;{name}, 0, $count );
#		if $count &gt; $self-&gt;FETCHSIZE;
}

sub CLEAR {
	my ($self) = @_;
	$self-&gt;del( $self-&gt;{name} );
}

sub PUSH {
	my $self = shift;
	$self-&gt;rpush( $self-&gt;{name}, $_ ) foreach @_;
}

sub SHIFT {
	my $self = shift;
	$self-&gt;lpop( $self-&gt;{name} );
}

sub UNSHIFT {
	my $self = shift;
	$self-&gt;lpush( $self-&gt;{name}, $_ ) foreach @_;
}

sub SPLICE {
	my $self = shift;
	my $offset = shift;
	my $length = shift;
	$self-&gt;lrange( $self-&gt;{name}, $offset, $length );
	# FIXME rest of @_ ?
}

sub EXTEND {
	my ($self,$count) = @_;
	$self-&gt;rpush( $self-&gt;{name}, '' ) foreach ( $self-&gt;FETCHSIZE .. ( $count - 1 ) );
} 

sub DESTROY {
	my $self = shift;
	$self-&gt;quit;
}

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