/[Redis.pre-github]/lib/Redis.pm

This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!

Diff of /lib/Redis.pm

Parent Directory | Revision Log | View Patch Patch

-revision 2 by dpavlin,
Sat Mar 21 21:25:52 2009 UTC
+revision 41 by dpavlin,
Sun Mar 22 18:42:21 2009 UTC
 Line 5 
 use strict;
  use IO::Socket::INET;
  use Data::Dump qw/dump/;
+ use Carp qw/confess/;
  =head1 NAME
- Redis - The great new Redis!
+ Redis - perl binding for Redis database
  =cut
-Line 19 
 our $VERSION = '0.01';
+Line 20 
 our $VERSION = '0.01';
  Pure perl bindings for L<http://code.google.com/p/redis/>
+ This version support git version of Redis available at
+ L<git://github.com/antirez/redis>
      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';
-Line 50 
 sub new {
+Line 53 
 sub new {
          $self;
  }
+ sub __sock_result {
+         my $result = <$sock>;
+         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) 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) if $debug;
+         }
+         my $crlf;
+         read($sock, $crlf, 2); # skip cr/lf
+         return $v;
+ }
+ sub _sock_result_bulk {
+         my $self = shift;
+         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";
+         confess dump($ok) unless $ok eq "+OK\r\n";
+ }
+ sub _sock_send {
+         my $self = shift;
+         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( @_ ) if $debug;
+         print $sock join(' ',@_) . "\r\n";
+         __sock_ok();
+ }
+ sub __sock_send_bulk_raw {
+         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"
+ }
+ 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();
+         confess $v unless $v =~ m{^\-?\d+$};
+         return $v;
+ }
  =head1 Connection Handling
  =head2 quit
-Line 66 
 sub quit {
+Line 155 
 sub quit {
  =head2 ping
-         $r->ping || die "no server?";
+   $r->ping || die "no server?";
  =cut
-Line 76 
 sub ping {
+Line 165 
 sub ping {
          die "ping failed, got ", dump($pong) unless $pong eq "+PONG\r\n";
  }
+ =head1 Commands operating on string values
+ =head2 set
+   $r->set( foo => 'bar', $new );
+ =cut
+ sub set {
+         my ( $self, $key, $value, $new ) = @_;
+         $self->_sock_send_bulk( "SET" . ( $new ? 'NX' : '' ), $key, $value );
+ }
+ =head2 get
+   my $value = $r->get( 'foo' );
+ =cut
+ sub get {
+         my $self = shift;
+         $self->_sock_result_bulk('GET', @_);
+ }
+ =head2 incr
+   $r->incr('counter');
+   $r->incr('tripplets', 3);
+ =cut
+ sub incr {
+         my $self = shift;
+         $self->_sock_send( 'INCR' . ( $#_ ? 'BY' : '' ), @_ );
+ }
+ =head2 decr
+   $r->decr('counter');
+   $r->decr('tripplets', 3);
+ =cut
+ sub decr {
+         my $self = shift;
+         $self->_sock_send( 'DECR' . ( $#_ ? 'BY' : '' ), @_ );
+ }
+ =head2 exists
+   $r->exists( 'key' ) && print "got key!";
+ =cut
+ sub exists {
+         my ( $self, $key ) = @_;
+         $self->_sock_send( 'EXISTS', $key );
+ }
+ =head2 del
+   $r->del( 'key' ) || warn "key doesn't exist";
+ =cut
+ sub del {
+         my ( $self, $key ) = @_;
+         $self->_sock_send( 'DEL', $key );
+ }
+ =head2 type
+   $r->type( 'key' ); # = string
+ =cut
+ sub type {
+         my ( $self, $key ) = @_;
+         $self->_sock_send( 'TYPE', $key );
+ }
+ =head1 Commands operating on the key space
+ =head2 keys
+   my @keys = $r->keys( '*glob_pattern*' );
+ =cut
+ sub keys {
+         my ( $self, $glob ) = @_;
+         return split(/\s/, $self->_sock_result_bulk( 'KEYS', $glob ));
+ }
+ =head2 randomkey
+   my $key = $r->randomkey;
+ =cut
+ sub randomkey {
+         my ( $self ) = @_;
+         $self->_sock_send( 'RANDOMKEY' );
+ }
+ =head2 rename
+   my $ok = $r->rename( 'old-key', 'new-key', $new );
+ =cut
+ sub rename {
+         my ( $self, $old, $new, $nx ) = @_;
+         $self->_sock_send_ok( 'RENAME' . ( $nx ? 'NX' : '' ), $old, $new );
+ }
+ =head2 dbsize
+   my $nr_keys = $r->dbsize;
+ =cut
+ sub dbsize {
+         my ( $self ) = @_;
+         $self->_sock_send('DBSIZE');
+ }
+ =head1 Commands operating on lists
+ See also L<Redis::List> for tie interface.
+ =head2 rpush
+   $r->rpush( $key, $value );
+ =cut
+ sub rpush {
+         my ( $self, $key, $value ) = @_;
+         $self->_sock_send_bulk('RPUSH', $key, $value);
+ }
+ =head2 lpush
+   $r->lpush( $key, $value );
+ =cut
+ sub lpush {
+         my ( $self, $key, $value ) = @_;
+         $self->_sock_send_bulk('LPUSH', $key, $value);
+ }
+ =head2 llen
+   $r->llen( $key );
+ =cut
+ sub llen {
+         my ( $self, $key ) = @_;
+         $self->_sock_send( 'LLEN', $key );
+ }
+ =head2 lrange
+   my @list = $r->lrange( $key, $start, $end );
+ =cut
+ sub lrange {
+         my ( $self, $key, $start, $end ) = @_;
+         $self->_sock_result_bulk_list('LRANGE', $key, $start, $end);
+ }
+ =head2 ltrim
+   my $ok = $r->ltrim( $key, $start, $end );
+ =cut
+ sub ltrim {
+         my ( $self, $key, $start, $end ) = @_;
+         $self->_sock_send_ok( 'LTRIM', $key, $start, $end );
+ }
+ =head2 lindex
+   $r->lindex( $key, $index );
+ =cut
+ sub lindex {
+         my ( $self, $key, $index ) = @_;
+         $self->_sock_result_bulk( 'LINDEX', $key, $index );
+ }
+ =head2 lset
+   $r->lset( $key, $index, $value );
+ =cut
+ sub lset {
+         my ( $self, $key, $index, $value ) = @_;
+         $self->_sock_send_bulk( 'LSET', $key, $index, $value );
+ }
+ =head2 lrem
+   my $modified_count = $r->lrem( $key, $count, $value );
+ =cut
+ sub lrem {
+         my ( $self, $key, $count, $value ) = @_;
+         $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<< <dpavlin at rot13.org> >>

 Legend:



Removed from v.2
 


changed lines


 
Added in v.41
 Legend:



Removed from v.2
 


changed lines


 
Added in v.41
-Removed from v.2
+Added in v.41

	ViewVC Help
Powered by ViewVC 1.1.26