client-libraries/perl/lib/Redis/List.pm

   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;