1 |
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; |