--- lib/Redis.pm 2009/03/22 17:06:34 32 +++ lib/Redis.pm 2009/03/22 18:07:46 37 @@ -9,7 +9,7 @@ =head1 NAME -Redis - The great new Redis! +Redis - perl binding for Redis database =cut @@ -20,19 +20,21 @@ Pure perl bindings for L +This version support git version of Redis available at +L + use Redis; my $r = Redis->new(); - - - =head1 FUNCTIONS =head2 new =cut +our $debug = $ENV{REDIS} || 0; + our $sock; my $server = '127.0.0.1:6379'; @@ -53,19 +55,19 @@ sub _sock_result { my $result = <$sock>; - warn "# result: ",dump( $result ); + warn "## result: ",dump( $result ) if $debug; $result =~ s{\r\n$}{} || warn "can't find cr/lf"; return $result; } sub _sock_read_bulk { my $len = <$sock>; - warn "## bulk len: ",dump($len); + warn "## bulk len: ",dump($len) if $debug; return undef if $len eq "nil\r\n"; my $v; if ( $len > 0 ) { read($sock, $v, $len) || die $!; - warn "## bulk v: ",dump($v); + warn "## bulk v: ",dump($v) if $debug; } my $crlf; read($sock, $crlf, 2); # skip cr/lf @@ -74,11 +76,28 @@ sub _sock_result_bulk { my $self = shift; - warn "## _sock_result_bulk ",dump( @_ ); + warn "## _sock_result_bulk ",dump( @_ ) if $debug; print $sock join(' ',@_) . "\r\n"; _sock_read_bulk(); } +sub _sock_result_bulk_list { + my $self = shift; + warn "## _sock_result_bulk_list ",dump( @_ ) if $debug; + + my $size = $self->_sock_send( @_ ); + confess $size unless $size > 0; + $size--; + + my @list = ( 0 .. $size ); + foreach ( 0 .. $size ) { + $list[ $_ ] = _sock_read_bulk(); + } + + warn "## list = ", dump( @list ) if $debug; + return @list; +} + sub __sock_ok { my $ok = <$sock>; return undef if $ok eq "nil\r\n"; @@ -87,21 +106,21 @@ sub _sock_send { my $self = shift; - warn "## _sock_send ",dump( @_ ); + warn "## _sock_send ",dump( @_ ) if $debug; print $sock join(' ',@_) . "\r\n"; _sock_result(); } sub _sock_send_ok { my $self = shift; - warn "## _sock_send_ok ",dump( @_ ); + warn "## _sock_send_ok ",dump( @_ ) if $debug; print $sock join(' ',@_) . "\r\n"; __sock_ok(); } sub __sock_send_bulk_raw { my $self = shift; - warn "## _sock_send_bulk ",dump( @_ ); + warn "## _sock_send_bulk ",dump( @_ ) if $debug; my $value = pop; $value = '' unless defined $value; # FIXME errr? nil? print $sock join(' ',@_) . ' ' . length($value) . "\r\n$value\r\n" @@ -276,6 +295,8 @@ =head1 Commands operating on lists +See also L for tie interface. + =head2 rpush $r->rpush( $key, $value ); @@ -317,18 +338,7 @@ sub lrange { my ( $self, $key, $start, $end ) = @_; - my $size = $self->_sock_send('LRANGE', $key, $start, $end); - - confess $size unless $size > 0; - $size--; - - my @list = ( 0 .. $size ); - foreach ( 0 .. $size ) { - $list[ $_ ] = _sock_read_bulk(); - } - - warn "## lrange $key $start $end = [$size] ", dump( @list ); - return @list; + $self->_sock_result_bulk_list('LRANGE', $key, $start, $end); } =head2 ltrim @@ -443,6 +453,28 @@ $self->_sock_send_bulk_number( 'SISMEMBER', $key, $member ); } +=head2 sinter + + $r->sinter( $key1, $key2, ... ); + +=cut + +sub sinter { + my $self = shift; + $self->_sock_result_bulk_list( 'SINTER', @_ ); +} + +=head2 sinterstore + + my $ok = $r->sinterstore( $dstkey, $key1, $key2, ... ); + +=cut + +sub sinterstore { + my $self = shift; + $self->_sock_send_ok( 'SINTERSTORE', @_ ); +} + =head1 AUTHOR Dobrica Pavlinusic, C<< >>