X-Git-Url: http://git.rot13.org/?p=perl-Redis.git;a=blobdiff_plain;f=lib%2FRedis.pm;h=36416c435e665d09b060d439937509fadcc9db38;hp=31d7eb03696be340c356e76cc5613f0708a3367f;hb=3957dcfecc1628ff65b686a2444765c4ebeef05b;hpb=0530ee25184daf62214ddb3b281cb806aff7f9db diff --git a/lib/Redis.pm b/lib/Redis.pm index 31d7eb0..36416c4 100644 --- a/lib/Redis.pm +++ b/lib/Redis.pm @@ -9,7 +9,7 @@ use Carp qw/confess/; =head1 NAME -Redis - The great new Redis! +Redis - perl binding for Redis database =cut @@ -20,19 +20,21 @@ our $VERSION = '0.01'; 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'; @@ -51,20 +53,22 @@ sub new { $self; } -sub _sock_result { +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 { +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; - read($sock, $v, $len) || die $!; - warn "## bulk v: ",dump($v); + if ( $len > 0 ) { + read($sock, $v, $len) || die $!; + warn "## bulk v: ",dump($v) if $debug; + } my $crlf; read($sock, $crlf, 2); # skip cr/lf return $v; @@ -72,45 +76,65 @@ sub _sock_read_bulk { 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(); + __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"; confess dump($ok) unless $ok eq "+OK\r\n"; } sub _sock_send { my $self = shift; - warn "## _sock_send ",dump( @_ ); + warn "## _sock_send ",dump( @_ ) if $debug; print $sock join(' ',@_) . "\r\n"; - _sock_result(); + __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; - print $sock join(' ',@_) . ' ' . length($value) . "\r\n$value\r\n"; + $value = '' unless defined $value; # FIXME errr? nil? + print $sock join(' ',@_) . ' ' . length($value) . "\r\n$value\r\n" } sub _sock_send_bulk { + my $self = shift; __sock_send_bulk_raw( @_ ); __sock_ok(); } sub _sock_send_bulk_number { + my $self = shift; __sock_send_bulk_raw( @_ ); - my $v = _sock_result(); + my $v = __sock_result(); confess $v unless $v =~ m{^\-?\d+$}; return $v; } @@ -162,7 +186,18 @@ sub set { sub get { my $self = shift; - $self->_sock_result_bulk('GET', @_); + $self->_sock_result_bulk('GET',@_); +} + +=head2 mget + + my @values = $r->get( 'foo', 'bar', 'baz' ); + +=cut + +sub mget { + my $self = shift; + $self->_sock_result_bulk_list('MGET',@_); } =head2 incr @@ -234,7 +269,9 @@ sub type { sub keys { my ( $self, $glob ) = @_; - return split(/\s/, $self->_sock_result_bulk( 'KEYS', $glob )); + my $keys = $self->_sock_result_bulk( 'KEYS', $glob ); + return split(/\s/, $keys) if $keys; + return () if wantarray; } =head2 randomkey @@ -272,6 +309,8 @@ sub dbsize { =head1 Commands operating on lists +See also L for tie interface. + =head2 rpush $r->rpush( $key, $value ); @@ -313,18 +352,7 @@ sub llen { 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 @@ -362,7 +390,7 @@ sub lset { =head2 lrem - $r->lrem( $key, $count, $value ); + my $modified_count = $r->lrem( $key, $count, $value ); =cut @@ -371,6 +399,143 @@ sub lrem { $self->_sock_send_bulk_number( 'LREM', $key, $count, $value ); } +=head2 lpop + + my $value = $r->lpop( $key ); + +=cut + +sub lpop { + my ( $self, $key ) = @_; + $self->_sock_result_bulk( 'LPOP', $key ); +} + +=head2 rpop + + my $value = $r->rpop( $key ); + +=cut + +sub rpop { + my ( $self, $key ) = @_; + $self->_sock_result_bulk( 'RPOP', $key ); +} + +=head1 Commands operating on sets + +=head2 sadd + + $r->sadd( $key, $member ); + +=cut + +sub sadd { + my ( $self, $key, $member ) = @_; + $self->_sock_send_bulk_number( 'SADD', $key, $member ); +} + +=head2 srem + + $r->srem( $key, $member ); + +=cut + +sub srem { + my ( $self, $key, $member ) = @_; + $self->_sock_send_bulk_number( 'SREM', $key, $member ); +} + +=head2 scard + + my $elements = $r->scard( $key ); + +=cut + +sub scard { + my ( $self, $key ) = @_; + $self->_sock_send( 'SCARD', $key ); +} + +=head2 sismember + + $r->sismember( $key, $member ); + +=cut + +sub sismember { + my ( $self, $key, $member ) = @_; + $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 Multiple databases handling commands + +=head2 select + + $r->select( $dbindex ); # 0 for new clients + +=cut + +sub select { + my ($self,$dbindex) = @_; + confess dump($dbindex) . 'not number' unless $dbindex =~ m{^\d+$}; + $self->_sock_send_ok( 'SELECT', $dbindex ); +} + +=head2 move + + $r->move( $key, $dbindex ); + +=cut + +sub move { + my ( $self, $key, $dbindex ) = @_; + $self->_sock_send( 'MOVE', $key, $dbindex ); +} + +=head2 flushdb + + $r->flushdb; + +=cut + +sub flushdb { + my $self = shift; + $self->_sock_send_ok('FLUSHDB'); +} + +=head2 flushall + + $r->flushall; + +=cut + +sub flushall { + my $self = shift; + $self->_sock_send_ok('flushall'); +} + =head1 AUTHOR Dobrica Pavlinusic, C<< >>