--- lib/Redis.pm 2009/03/21 21:53:15 4 +++ lib/Redis.pm 2009/03/22 09:46:14 19 @@ -5,6 +5,7 @@ use IO::Socket::INET; use Data::Dump qw/dump/; +use Carp qw/confess/; =head1 NAME @@ -50,6 +51,37 @@ $self; } +sub _sock_result { + my $result = <$sock>; + warn "# result: ",dump( $result ); + $result =~ s{\r\n$}{} || warn "can't find cr/lf"; + return $result; +} + +sub _sock_result_bulk { + my $len = <$sock>; + warn "# len: ",dump($len); + return undef if $len eq "nil\r\n"; + my $v; + read($sock, $v, $len) || die $!; + warn "# v: ",dump($v); + my $crlf; + read($sock, $crlf, 2); # skip cr/lf + return $v; +} + +sub _sock_ok { + my $ok = <$sock>; + confess dump($ok) unless $ok eq "+OK\r\n"; +} + +sub _sock_send_bulk { + my ( $self, $command, $key, $value ) = @_; + print $sock "$command $key " . length($value) . "\r\n$value\r\n"; + _sock_ok(); +} + + =head1 Connection Handling =head2 quit @@ -80,15 +112,13 @@ =head2 set - $r->set( foo => 'bar' ); + $r->set( foo => 'bar', $new ); =cut sub set { - my ( $self, $k, $v ) = @_; - print $sock "SET $k " . length($v) . "\r\n$v\r\n"; - my $ok = <$sock>; - die dump($ok) unless $ok eq "+OK\r\n"; + my ( $self, $key, $value, $new ) = @_; + $self->_sock_send_bulk( "SET" . ( $new ? 'NX' : '' ), $key, $value ); } =head2 get @@ -100,18 +130,154 @@ sub get { my ( $self, $k ) = @_; print $sock "GET $k\r\n"; - my $len = <$sock>; -# warn "# len: ",dump($len); - return undef if $len eq "nil\r\n"; - my $v; - read($sock, $v, $len) || die $!; -# warn "# v: ",dump($v); - my $crlf; - read($sock, $crlf, 2); # skip cr/lf - return $v; + _sock_result_bulk(); +} + +=head2 incr + + $r->incr('counter'); + $r->incr('tripplets', 3); + +=cut + + + +sub incr { + my ( $self, $key, $value ) = @_; + if ( defined $value ) { + print $sock "INCRBY $key $value\r\n"; + } else { + print $sock "INCR $key\r\n"; + } + _sock_result(); +} + +=head2 decr + + $r->decr('counter'); + $r->decr('tripplets', 3); + +=cut + +sub decr { + my ( $self, $key, $value ) = @_; + if ( defined $value ) { + print $sock "DECRBY $key $value\r\n"; + } else { + print $sock "DECR $key\r\n"; + } + _sock_result(); +} + +=head2 exists + + $r->exists( 'key' ) && print "got key!"; + +=cut + +sub exists { + my ( $self, $key ) = @_; + print $sock "EXISTS $key\r\n"; + _sock_result(); +} + +=head2 del + + $r->del( 'key' ) || warn "key doesn't exist"; + +=cut + +sub del { + my ( $self, $key ) = @_; + print $sock "DEL $key\r\n"; + _sock_result(); +} + +=head2 type + + $r->type( 'key' ); # = string + +=cut + +sub type { + my ( $self, $key ) = @_; + print $sock "TYPE $key\r\n"; + _sock_result(); +} + +=head1 Commands operating on the key space + +=head2 keys + + my @keys = $r->keys( '*glob_pattern*' ); + +=cut + +sub keys { + my ( $self, $glob ) = @_; + print $sock "KEYS $glob\r\n"; + return split(/\s/, _sock_result_bulk()); +} + +=head2 randomkey + + my $key = $r->randomkey; + +=cut + +sub randomkey { + my ( $self ) = @_; + print $sock "RANDOMKEY\r\n"; + _sock_result(); } +=head2 rename + my $ok = $r->rename( 'old-key', 'new-key', $new ); + +=cut + +sub rename { + my ( $self, $old, $new, $nx ) = @_; + print $sock "RENAME" . ( $nx ? 'NX' : '' ) . " $old $new\r\n"; + _sock_ok(); +} + +=head2 dbsize + + my $nr_keys = $r->dbsize; + +=cut + +sub dbsize { + my ( $self ) = @_; + print $sock "DBSIZE\r\n"; + _sock_result(); +} + +=head1 Commands operating on lists + +=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); +} =head1 AUTHOR