lib/Redis/List.pm

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->new;
        $self->{name} = $name;
        bless $self => $class;
}

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

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

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

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

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

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

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

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

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

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

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

1;
1	dpavlin	29	package Redis::List;
2
3			use strict;
4			use warnings;
5
6			use base qw/Redis Tie::Array/;
7
8			=head1 NAME
9
10			Redis::List - tie perl arrays into Redis lists
11
12			=head1 SYNOPSYS
13
14			tie @a, 'Redis::List', 'name';
15
16			=cut
17
18			# mandatory methods
19			sub TIEARRAY {
20			my ($class,$name) = @_;
21			my $self = $class->new;
22			$self->{name} = $name;
23			bless $self => $class;
24			}
25
26			sub FETCH {
27			my ($self,$index) = @_;
28			$self->lindex( $self->{name}, $index );
29			}
30
31			sub FETCHSIZE {
32			my ($self) = @_;
33			$self->llen( $self->{name} );
34			}
35
36			sub STORE {
37			my ($self,$index,$value) = @_;
38			$self->lset( $self->{name}, $index, $value );
39			}
40
41			sub STORESIZE {
42			my ($self,$count) = @_;
43			$self->ltrim( $self->{name}, 0, $count );
44			# if $count > $self->FETCHSIZE;
45			}
46
47			sub CLEAR {
48			my ($self) = @_;
49			$self->del( $self->{name} );
50			}
51
52			sub PUSH {
53			my $self = shift;
54			$self->rpush( $self->{name}, $_ ) foreach @_;
55			}
56
57			sub SHIFT {
58			my $self = shift;
59			$self->lpop( $self->{name} );
60			}
61
62			sub UNSHIFT {
63			my $self = shift;
64			$self->lpush( $self->{name}, $_ ) foreach @_;
65			}
66
67			sub SPLICE {
68			my $self = shift;
69			my $offset = shift;
70			my $length = shift;
71			$self->lrange( $self->{name}, $offset, $length );
72			# FIXME rest of @_ ?
73			}
74
75			sub EXTEND {
76			my ($self,$count) = @_;
77			$self->rpush( $self->{name}, '' ) foreach ( $self->FETCHSIZE .. ( $count - 1 ) );
78			}
79
80			sub DESTROY {
81			my $self = shift;
82			$self->quit;
83			}
84
85			1;