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 );
48 $self->{debug} ||= $ENV{REDIS_DEBUG};
49 $self->{encoding} ||= 'utf8'; ## default to lax utf8
51 $self->{server} ||= $ENV{REDIS_SERVER} || '127.0.0.1:6379';
52 $self->{sock} = IO::Socket::INET->new(
53 PeerAddr => $self->{server},
55 ) || confess("Could not connect to Redis server at $self->{server}: $!");
57 return bless($self, $class);
60 # we don't want DESTROY to fallback into AUTOLOAD
66 my $sock = $self->{sock} || confess("Not connected to any server");
67 my $enc = $self->{encoding};
68 my $deb = $self->{debug};
70 my $command = $AUTOLOAD;
73 $self->__send_command($command, @_);
75 if ( $command eq 'quit' ) {
76 close( $sock ) || confess("Can't close socket: $!");
80 my $result = <$sock> || confess("Can't read socket: $!");
81 my $type = substr($result,0,1);
82 $result = substr($result,1,-2);
84 $result = decode($enc, $result) if $enc;
85 warn "[RECV] '$type$result'" if $deb;
87 if ( $command eq 'info' ) {
89 foreach my $l ( split(/\r\n/, $self->__read_bulk($result) ) ) {
90 my ($n,$v) = split(/:/, $l, 2);
94 } elsif ( $command eq 'keys' ) {
95 return $self->__read_multi_bulk($result)
97 my $keys = $self->__read_bulk($result);
98 return split(/\s/, $keys) if $keys;
102 if ( $type eq '-' ) {
103 confess "[$command] $result";
104 } elsif ( $type eq '+' ) {
106 } elsif ( $type eq '$' ) {
107 return $self->__read_bulk($result);
108 } elsif ( $type eq '*' ) {
109 return $self->__read_multi_bulk($result);
110 } elsif ( $type eq ':' ) {
111 return $result; # FIXME check if int?
113 confess "unknown type: $type", $self->__read_line();
118 ### Socket operations
123 my $enc = $self->{encoding};
124 my $deb = $self->{debug};
126 warn "[SEND] $cmd ", Dumper([@_]) if $deb;
128 ## Encode command using multi-bulk format
129 my $n_elems = scalar(@_) + 1;
130 my $buf = "\*$n_elems\r\n";
131 for my $elem ($cmd, @_) {
132 my $bin = $enc ? encode($enc, $elem) : $elem;
133 $buf .= defined($bin) ? '$' . length($bin) . "\r\n$bin\r\n" : "\$-1\r\n";
136 ## Send command, take care for partial writes
137 warn "[SEND RAW] $buf" if $deb;
138 my $sock = $self->{sock} || confess("Not connected to any server");
140 my $len = syswrite $sock, $buf, length $buf;
141 confess("Could not write to Redis server: $!")
143 substr $buf, 0, $len, "";
150 my ($self,$len) = @_;
153 my $enc = $self->{encoding};
156 read($self->{sock}, $v, $len) || confess("Could not read from sock: $!");
157 $v = decode($enc, $v) if $enc;
160 read($self->{sock}, $crlf, 2); # skip cr/lf
162 warn "[PARSE] read_bulk ".Dumper($v) if $self->{debug};
166 sub __read_multi_bulk {
167 my ($self,$size) = @_;
168 return if $size <= 0;
170 my $sock = $self->{sock};
171 my $deb = $self->{debug};
172 my $enc = $self->{encoding};
175 my $v = $self->__read_bulk( substr(<$sock>,1,-2) );
176 $v = decode($enc, $v) if $enc;
177 warn " [PARSE] read_multi_bulk ($size) ".Dumper($v) if $deb;
181 warn "[PARSE] multi_bulk ".Dumper( \@list ) if $deb;
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 Since Redis knows nothing about encoding, we are forcing utf-8 flag on all data received from Redis.
378 This change is introduced in 1.2001 version.
380 This allows us to round-trip utf-8 encoded characters correctly, but might be problem if you push
381 binary junk into Redis and expect to get it back without utf-8 flag turned on.
385 Dobrica Pavlinusic, C<< <dpavlin at rot13.org> >>
389 Please report any bugs or feature requests to C<bug-redis at rt.cpan.org>, or through
390 the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Redis>. I will be notified, and then you'll
391 automatically be notified of progress on your bug as I make changes.
398 You can find documentation for this module with the perldoc command.
405 You can also look for information at:
409 =item * RT: CPAN's request tracker
411 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Redis>
413 =item * AnnoCPAN: Annotated CPAN documentation
415 L<http://annocpan.org/dist/Redis>
419 L<http://cpanratings.perl.org/d/Redis>
423 L<http://search.cpan.org/dist/Redis>
428 =head1 ACKNOWLEDGEMENTS
431 =head1 COPYRIGHT & LICENSE
433 Copyright 2009-2010 Dobrica Pavlinusic, all rights reserved.
435 This program is free software; you can redistribute it and/or modify it
436 under the same terms as Perl itself.