13 Redis - perl binding for Redis database
17 our $VERSION = '1.2001';
22 Pure perl bindings for L<http://code.google.com/p/redis/>
24 This version supports protocol 1.2 or later of Redis available at
26 L<git://github.com/antirez/redis>
29 lists commands which are exercised in test suite, but
30 additinal commands will work correctly since protocol
31 specifies enough information to support almost all commands
32 with same peace of code with a little help of C<AUTOLOAD>.
38 my $r = Redis->new; # $ENV{REDIS_SERVER} or 127.0.0.1:6379
40 my $r = Redis->new( server => '192.168.0.1:6379', debug = 0 );
47 $self->{debug} ||= $ENV{REDIS_DEBUG};
49 $self->{sock} = IO::Socket::INET->new(
50 PeerAddr => $self->{server} || $ENV{REDIS_SERVER} || '127.0.0.1:6379',
60 rpush => 1, lpush => 1,
74 # we don't want DESTROY to fallback into AUTOLOAD
83 my $sock = $self->{sock} || die "no server connected";
85 my $command = $AUTOLOAD;
88 warn "## $command ",Dumper(@_) if $self->{debug};
92 if ( defined $bulk_command->{$command} ) {
94 $value = '' if ! defined $value;
112 warn ">> $send" if $self->{debug};
115 if ( $command eq 'quit' ) {
116 close( $sock ) || die "can't close socket: $!";
120 my $result = <$sock> || die "can't read socket: $!";
121 Encode::_utf8_on($result);
122 warn "<< $result" if $self->{debug};
123 my $type = substr($result,0,1);
124 $result = substr($result,1,-2);
126 if ( $command eq 'info' ) {
128 foreach my $l ( split(/\r\n/, $self->__read_bulk($result) ) ) {
129 my ($n,$v) = split(/:/, $l, 2);
133 } elsif ( $command eq 'keys' ) {
134 my $keys = $self->__read_bulk($result);
135 return split(/\s/, $keys) if $keys;
139 if ( $type eq '-' ) {
140 confess "[$command] $result";
141 } elsif ( $type eq '+' ) {
143 } elsif ( $type eq '$' ) {
144 return $self->__read_bulk($result);
145 } elsif ( $type eq '*' ) {
146 return $self->__read_multi_bulk($result);
147 } elsif ( $type eq ':' ) {
148 return $result; # FIXME check if int?
150 confess "unknown type: $type", $self->__read_line();
155 my ($self,$len) = @_;
156 return undef if $len < 0;
160 read($self->{sock}, $v, $len) || die $!;
161 Encode::_utf8_on($v);
162 warn "<< ",Dumper($v),$/ if $self->{debug};
165 read($self->{sock}, $crlf, 2); # skip cr/lf
169 sub __read_multi_bulk {
170 my ($self,$size) = @_;
171 return undef if $size < 0;
172 my $sock = $self->{sock};
176 my @list = ( 0 .. $size );
177 foreach ( 0 .. $size ) {
178 $list[ $_ ] = $self->__read_bulk( substr(<$sock>,1,-2) );
181 warn "## list = ", Dumper( @list ) if $self->{debug};
189 =head1 Connection Handling
197 $r->ping || die "no server?";
199 =head1 Commands operating on string values
203 $r->set( foo => 'bar' );
205 $r->setnx( foo => 42 );
209 my $value = $r->get( 'foo' );
213 my @values = $r->mget( 'foo', 'bar', 'baz' );
219 $r->incrby('tripplets', 3);
225 $r->decrby('tripplets', 3);
229 $r->exists( 'key' ) && print "got key!";
233 $r->del( 'key' ) || warn "key doesn't exist";
237 $r->type( 'key' ); # = string
239 =head1 Commands operating on the key space
243 my @keys = $r->keys( '*glob_pattern*' );
247 my $key = $r->randomkey;
251 my $ok = $r->rename( 'old-key', 'new-key', $new );
255 my $nr_keys = $r->dbsize;
257 =head1 Commands operating on lists
259 See also L<Redis::List> for tie interface.
263 $r->rpush( $key, $value );
267 $r->lpush( $key, $value );
275 my @list = $r->lrange( $key, $start, $end );
279 my $ok = $r->ltrim( $key, $start, $end );
283 $r->lindex( $key, $index );
287 $r->lset( $key, $index, $value );
291 my $modified_count = $r->lrem( $key, $count, $value );
295 my $value = $r->lpop( $key );
299 my $value = $r->rpop( $key );
301 =head1 Commands operating on sets
305 $r->sadd( $key, $member );
309 $r->srem( $key, $member );
313 my $elements = $r->scard( $key );
317 $r->sismember( $key, $member );
321 $r->sinter( $key1, $key2, ... );
325 my $ok = $r->sinterstore( $dstkey, $key1, $key2, ... );
327 =head1 Multiple databases handling commands
331 $r->select( $dbindex ); # 0 for new clients
335 $r->move( $key, $dbindex );
349 $r->sort("key BY pattern LIMIT start end GET pattern ASC|DESC ALPHA');
351 =head1 Persistence control commands
369 =head1 Remote server control commands
373 my $info_hash = $r->info;
377 Dobrica Pavlinusic, C<< <dpavlin at rot13.org> >>
381 Please report any bugs or feature requests to C<bug-redis at rt.cpan.org>, or through
382 the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Redis>. I will be notified, and then you'll
383 automatically be notified of progress on your bug as I make changes.
390 You can find documentation for this module with the perldoc command.
397 You can also look for information at:
401 =item * RT: CPAN's request tracker
403 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Redis>
405 =item * AnnoCPAN: Annotated CPAN documentation
407 L<http://annocpan.org/dist/Redis>
411 L<http://cpanratings.perl.org/d/Redis>
415 L<http://search.cpan.org/dist/Redis>
420 =head1 ACKNOWLEDGEMENTS
423 =head1 COPYRIGHT & LICENSE
425 Copyright 2009-2010 Dobrica Pavlinusic, all rights reserved.
427 This program is free software; you can redistribute it and/or modify it
428 under the same terms as Perl itself.