--- lib/Redis.pm 2009/03/21 20:20:45 1 +++ lib/Redis.pm 2009/03/22 09:22:39 17 @@ -3,14 +3,14 @@ use warnings; use strict; +use IO::Socket::INET; +use Data::Dump qw/dump/; +use Carp qw/confess/; + =head1 NAME Redis - The great new Redis! -=head1 VERSION - -Version 0.01 - =cut our $VERSION = '0.01'; @@ -18,34 +18,235 @@ =head1 SYNOPSIS -Quick summary of what the module does. - -Perhaps a little code snippet. +Pure perl bindings for L use Redis; - my $foo = Redis->new(); - ... + my $r = Redis->new(); + -=head1 EXPORT -A list of functions that can be exported. You can delete this section -if you don't export anything, such as for a purely object-oriented module. =head1 FUNCTIONS -=head2 function1 +=head2 new + +=cut + +our $sock; +my $server = '127.0.0.1:6379'; + +sub new { + my $class = shift; + my $self = {}; + bless($self, $class); + + warn "# opening socket to $server"; + + $sock ||= IO::Socket::INET->new( + PeerAddr => $server, + Proto => 'tcp', + ) || die $!; + + $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"; +} + +=head1 Connection Handling + +=head2 quit + + $r->quit; + +=cut + +sub quit { + my $self = shift; + + close( $sock ) || warn $!; +} + +=head2 ping + + $r->ping || die "no server?"; + +=cut + +sub ping { + print $sock "PING\r\n"; + my $pong = <$sock>; + 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 function1 { +sub set { + my ( $self, $k, $v, $new ) = @_; + print $sock "SET" . ( $new ? 'NX' : '' ) . " $k " . length($v) . "\r\n$v\r\n"; + _sock_ok(); } -=head2 function2 +=head2 get + + my $value = $r->get( 'foo' ); + +=cut + +sub get { + my ( $self, $k ) = @_; + print $sock "GET $k\r\n"; + _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 function2 { +sub dbsize { + my ( $self ) = @_; + print $sock "DBSIZE\r\n"; + _sock_result(); } =head1 AUTHOR