caleb-brown/redict
1
0
Fork 0
mirror of https://codeberg.org/redict/redict.git synced 2025-01-22 16:18:28 -05:00
Code Issues Actions Packages Projects Releases Wiki Activity

New file dump format, perl client library added

Browse Source
This commit is contained in:
antirez 2009-03-25 16:47:22 +01:00
parent 7b45bfb2a4
commit f78fd11b71
17 changed files with 1129 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
TODO
View File

@ -7,3 +7,6 @@
- maxclients directive
- check 'server.dirty' everywere
- replication automated tests
- a command, or an external tool, to perform the MD5SUM of the whole dataset, so that if the dataset between two servers is identical, so will be the MD5SUM
* Include Lua and Perl bindings

17
client-libraries/README
View File

@ -9,9 +9,9 @@ code or recent bugfixes read more.
How to get the lastest versions of client libraries source code
---------------------------------------------------------------
Note that while the PHP and Python versions are the most uptodate available
libraries, the Ruby and Erlang libraries have their own sites so you may want
to grab this libraries from their main sites:
Note that while the pure PHP, Tcl and Python libraries are the most uptodate
available libraries, all the other libraries have their own repositories where
it's possible to grab the most recent version:
Ruby lib source code:
http://github.com/ezmobius/redis-rb/tree/master
@ -19,10 +19,11 @@ http://github.com/ezmobius/redis-rb/tree/master
Erlang lib source code:
http://bitbucket.org/adroll/erldis/
For the languages with development code in the Redis SVN, check this urls for unstable versions of the libs:
Perl lib source code:
(web) http://svn.rot13.org/index.cgi/Redis
(svn) svn://svn.rot13.org/Redis/
Python lib source code:
http://code.google.com/p/redis/source/browse/#svn/trunk/client-libraries/python
Redis-php PHP C module:
http://code.google.com/p/phpredis/
PHP lib source code:
http://code.google.com/p/redis/source/browse/#svn/trunk/client-libraries/php
For all the rest check the Redis tarball or Git repository.

8
client-libraries/perl/Changes Normal file
View File

@ -0,0 +1,8 @@
Revision history for Redis
0.01 Sun Mar 22 19:02:17 CET 2009
First version, tracking git://github.com/antirez/redis
0.08 Tue Mar 24 22:38:59 CET 2009
This version supports new protocol introduced in beta 8
Version bump to be in-sync with Redis version

8
client-libraries/perl/MANIFEST Normal file
View File

@ -0,0 +1,8 @@
Changes
MANIFEST
Makefile.PL
README
lib/Redis.pm
t/00-load.t
t/pod-coverage.t
t/pod.t

19
client-libraries/perl/Makefile.PL Normal file
View File

@ -0,0 +1,19 @@
use strict;
use warnings;
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'Redis',
AUTHOR => 'Dobrica Pavlinusic <dpavlin@rot13.org>',
VERSION_FROM => 'lib/Redis.pm',
ABSTRACT_FROM => 'lib/Redis.pm',
PL_FILES => {},
PREREQ_PM => {
'Test::More' => 0,
'IO::Socket::INET' => 0,
'Data::Dump' => 0,
'Carp' => 0,
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'Redis-*' },
);

43
client-libraries/perl/README Normal file
View File

@ -0,0 +1,43 @@
Redis
Perl binding for Redis database which is in-memory hash store with
support for scalars, arrays and sets and disk persistence.
INSTALLATION
To install this module, run the following commands:
perl Makefile.PL
make
make test
make install
SUPPORT AND DOCUMENTATION
After installing, you can find documentation for this module with the
perldoc command.
perldoc Redis
You can also look for information at:
RT, CPAN's request tracker
http://rt.cpan.org/NoAuth/Bugs.html?Dist=Redis
AnnoCPAN, Annotated CPAN documentation
http://annocpan.org/dist/Redis
CPAN Ratings
http://cpanratings.perl.org/d/Redis
Search CPAN
http://search.cpan.org/dist/Redis
COPYRIGHT AND LICENCE
Copyright (C) 2009 Dobrica Pavlinusic
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

422
client-libraries/perl/lib/Redis.pm Normal file
View File

@ -0,0 +1,422 @@
package Redis;
use warnings;
use strict;
use IO::Socket::INET;
use Data::Dump qw/dump/;
use Carp qw/confess/;
=head1 NAME
Redis - perl binding for Redis database
=cut
our $VERSION = '0.08';
=head1 DESCRIPTION
Pure perl bindings for L<http://code.google.com/p/redis/>
This version support git version 0.08 of Redis available at
L<git://github.com/antirez/redis>
This documentation
lists commands which are exercised in test suite, but
additinal commands will work correctly since protocol
specifies enough information to support almost all commands
with same peace of code with a little help of C<AUTOLOAD>.
=head1 FUNCTIONS
=head2 new
my $r = Redis->new;
=cut
our $debug = $ENV{REDIS} || 0;
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;
}
my $bulk_command = {
set => 1, setnx => 1,
rpush => 1, lpush => 1,
lset => 1, lrem => 1,
sadd => 1, srem => 1,
sismember => 1,
echo => 1,
};
# we don't want DESTROY to fallback into AUTOLOAD
sub DESTROY {}
our $AUTOLOAD;
sub AUTOLOAD {
my $self = shift;
my $command = $AUTOLOAD;
$command =~ s/.*://;
warn "## $command ",dump(@_) if $debug;
my $send;
if ( defined $bulk_command->{$command} ) {
my $value = pop;
$value = '' if ! defined $value;
$send
= uc($command)
. ' '
. join(' ', @_)
. ' '
. length( $value )
. "\r\n$value\r\n"
;
} else {
$send
= uc($command)
. ' '
. join(' ', @_)
. "\r\n"
;
}
warn ">> $send" if $debug;
print $sock $send;
if ( $command eq 'quit' ) {
close( $sock ) || die "can't close socket: $!";
return 1;
}
my $result = <$sock> || die "can't read socket: $!";
warn "<< $result" if $debug;
my $type = substr($result,0,1);
$result = substr($result,1,-2);
if ( $command eq 'info' ) {
my $hash;
foreach my $l ( split(/\r\n/, __sock_read_bulk($result) ) ) {
my ($n,$v) = split(/:/, $l, 2);
$hash->{$n} = $v;
}
return $hash;
} elsif ( $command eq 'keys' ) {
my $keys = __sock_read_bulk($result);
return split(/\s/, $keys) if $keys;
return;
}
if ( $type eq '-' ) {
confess $result;
} elsif ( $type eq '+' ) {
return $result;
} elsif ( $type eq '$' ) {
return __sock_read_bulk($result);
} elsif ( $type eq '*' ) {
return __sock_read_multi_bulk($result);
} elsif ( $type eq ':' ) {
return $result; # FIXME check if int?
} else {
confess "unknown type: $type", __sock_read_line();
}
}
sub __sock_read_bulk {
my $len = shift;
return undef if $len < 0;
my $v;
if ( $len > 0 ) {
read($sock, $v, $len) || die $!;
warn "<< ",dump($v),$/ if $debug;
}
my $crlf;
read($sock, $crlf, 2); # skip cr/lf
return $v;
}
sub __sock_read_multi_bulk {
my $size = shift;
return undef if $size < 0;
$size--;
my @list = ( 0 .. $size );
foreach ( 0 .. $size ) {
$list[ $_ ] = __sock_read_bulk( substr(<$sock>,1,-2) );
}
warn "## list = ", dump( @list ) if $debug;
return @list;
}
1;
__END__
=head1 Connection Handling
=head2 quit
$r->quit;
=head2 ping
$r->ping || die "no server?";
=head1 Commands operating on string values
=head2 set
$r->set( foo => 'bar' );
$r->setnx( foo => 42 );
=head2 get
my $value = $r->get( 'foo' );
=head2 mget
my @values = $r->mget( 'foo', 'bar', 'baz' );
=head2 incr
$r->incr('counter');
$r->incrby('tripplets', 3);
=head2 decr
$r->decr('counter');
$r->decrby('tripplets', 3);
=head2 exists
$r->exists( 'key' ) && print "got key!";
=head2 del
$r->del( 'key' ) || warn "key doesn't exist";
=head2 type
$r->type( 'key' ); # = string
=head1 Commands operating on the key space
=head2 keys
my @keys = $r->keys( '*glob_pattern*' );
=head2 randomkey
my $key = $r->randomkey;
=head2 rename
my $ok = $r->rename( 'old-key', 'new-key', $new );
=head2 dbsize
my $nr_keys = $r->dbsize;
=head1 Commands operating on lists
See also L<Redis::List> for tie interface.
=head2 rpush
$r->rpush( $key, $value );
=head2 lpush
$r->lpush( $key, $value );
=head2 llen
$r->llen( $key );
=head2 lrange
my @list = $r->lrange( $key, $start, $end );
=head2 ltrim
my $ok = $r->ltrim( $key, $start, $end );
=head2 lindex
$r->lindex( $key, $index );
=head2 lset
$r->lset( $key, $index, $value );
=head2 lrem
my $modified_count = $r->lrem( $key, $count, $value );
=head2 lpop
my $value = $r->lpop( $key );
=head2 rpop
my $value = $r->rpop( $key );
=head1 Commands operating on sets
=head2 sadd
$r->sadd( $key, $member );
=head2 srem
$r->srem( $key, $member );
=head2 scard
my $elements = $r->scard( $key );
=head2 sismember
$r->sismember( $key, $member );
=head2 sinter
$r->sinter( $key1, $key2, ... );
=head2 sinterstore
my $ok = $r->sinterstore( $dstkey, $key1, $key2, ... );
=head1 Multiple databases handling commands
=head2 select
$r->select( $dbindex ); # 0 for new clients
=head2 move
$r->move( $key, $dbindex );
=head2 flushdb
$r->flushdb;
=head2 flushall
$r->flushall;
=head1 Sorting
=head2 sort
$r->sort("key BY pattern LIMIT start end GET pattern ASC|DESC ALPHA');
=head1 Persistence control commands
=head2 save
$r->save;
=head2 bgsave
$r->bgsave;
=head2 lastsave
$r->lastsave;
=head2 shutdown
$r->shutdown;
=head1 Remote server control commands
=head2 info
my $info_hash = $r->info;
=head1 AUTHOR
Dobrica Pavlinusic, C<< <dpavlin at rot13.org> >>
=head1 BUGS
Please report any bugs or feature requests to C<bug-redis at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Redis>. I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Redis
perldoc Redis::List
perldoc Redis::Hash
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Redis>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/Redis>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/Redis>
=item * Search CPAN
L<http://search.cpan.org/dist/Redis>
=back
=head1 ACKNOWLEDGEMENTS
=head1 COPYRIGHT & LICENSE
Copyright 2009 Dobrica Pavlinusic, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1; # End of Redis

70
client-libraries/perl/lib/Redis/Hash.pm Normal file
View File

@ -0,0 +1,70 @@
package Redis::Hash;
use strict;
use warnings;
use Tie::Hash;
use base qw/Redis Tie::StdHash/;
use Data::Dump qw/dump/;
=head1 NAME
Redis::Hash - tie perl hashes into Redis
=head1 SYNOPSYS
tie %name, 'Redis::Hash', 'prefix';
=cut
# mandatory methods
sub TIEHASH {
my ($class,$name) = @_;
my $self = Redis->new;
$name .= ':' if $name;
$self->{name} = $name || '';
bless $self => $class;
}
sub STORE {
my ($self,$key,$value) = @_;
$self->set( $self->{name} . $key, $value );
}
sub FETCH {
my ($self,$key) = @_;
$self->get( $self->{name} . $key );
}
sub FIRSTKEY {
my $self = shift;
$self->{keys} = [ $self->keys( $self->{name} . '*' ) ];
$self->NEXTKEY;
}
sub NEXTKEY {
my $self = shift;
my $key = shift @{ $self->{keys} } || return;
my $name = $self->{name};
$key =~ s{^$name}{} || warn "can't strip $name from $key";
return $key;
}
sub EXISTS {
my ($self,$key) = @_;
$self->exists( $self->{name} . $key );
}
sub DELETE {
my ($self,$key) = @_;
$self->del( $self->{name} . $key );
}
sub CLEAR {
my ($self) = @_;
$self->del( $_ ) foreach ( $self->keys( $self->{name} . '*' ) );
$self->{keys} = [];
}
1;

85
client-libraries/perl/lib/Redis/List.pm Normal file
View File

@ -0,0 +1,85 @@
package Redis::List;
use strict;
use warnings;
use base qw/Redis Tie::Array/;
=head1 NAME
Redis::List - tie perl arrays into Redis lists
=head1 SYNOPSYS
tie @a, 'Redis::List', 'name';
=cut
# mandatory methods
sub TIEARRAY {
my ($class,$name) = @_;
my $self = $class->new;
$self->{name} = $name;
bless $self => $class;
}
sub FETCH {
my ($self,$index) = @_;
$self->lindex( $self->{name}, $index );
}
sub FETCHSIZE {
my ($self) = @_;
$self->llen( $self->{name} );
}
sub STORE {
my ($self,$index,$value) = @_;
$self->lset( $self->{name}, $index, $value );
}
sub STORESIZE {
my ($self,$count) = @_;
$self->ltrim( $self->{name}, 0, $count );
# if $count > $self->FETCHSIZE;
}
sub CLEAR {
my ($self) = @_;
$self->del( $self->{name} );
}
sub PUSH {
my $self = shift;
$self->rpush( $self->{name}, $_ ) foreach @_;
}
sub SHIFT {
my $self = shift;
$self->lpop( $self->{name} );
}
sub UNSHIFT {
my $self = shift;
$self->lpush( $self->{name}, $_ ) foreach @_;
}
sub SPLICE {
my $self = shift;
my $offset = shift;
my $length = shift;
$self->lrange( $self->{name}, $offset, $length );
# FIXME rest of @_ ?
}
sub EXTEND {
my ($self,$count) = @_;
$self->rpush( $self->{name}, '' ) foreach ( $self->FETCHSIZE .. ( $count - 1 ) );
}
sub DESTROY {
my $self = shift;
$self->quit;
}
1;

24
client-libraries/perl/scripts/redis-benchmark.pl Executable file
View File

@ -0,0 +1,24 @@
#!/usr/bin/perl
use warnings;
use strict;
use Benchmark qw/:all/;
use lib 'lib';
use Redis;
my $r = Redis->new;
my $i = 0;
timethese( 100000, {
'00_ping' => sub { $r->ping },
'10_set' => sub { $r->set( 'foo', $i++ ) },
'11_set_r' => sub { $r->set( 'bench-' . rand(), rand() ) },
'20_get' => sub { $r->get( 'foo' ) },
'21_get_r' => sub { $r->get( 'bench-' . rand() ) },
'30_incr' => sub { $r->incr( 'counter' ) },
'30_incr_r' => sub { $r->incr( 'bench-' . rand() ) },
'40_lpush' => sub { $r->lpush( 'mylist', 'bar' ) },
'40_lpush' => sub { $r->lpush( 'mylist', 'bar' ) },
'50_lpop' => sub { $r->lpop( 'mylist' ) },
});

9
client-libraries/perl/t/00-load.t Normal file
View File

@ -0,0 +1,9 @@
#!perl -T
use Test::More tests => 1;
BEGIN {
use_ok( 'Redis' );
}
diag( "Testing Redis $Redis::VERSION, Perl $], $^X" );

189
client-libraries/perl/t/01-Redis.t Executable file
View File

@ -0,0 +1,189 @@
#!/usr/bin/perl
use warnings;
use strict;
use Test::More tests => 106;
use Data::Dump qw/dump/;
use lib 'lib';
BEGIN {
use_ok( 'Redis' );
}
ok( my $o = Redis->new(), 'new' );
ok( $o->ping, 'ping' );
diag "Commands operating on string values";
ok( $o->set( foo => 'bar' ), 'set foo => bar' );
ok( ! $o->setnx( foo => 'bar' ), 'setnx foo => bar fails' );
cmp_ok( $o->get( 'foo' ), 'eq', 'bar', 'get foo = bar' );
ok( $o->set( foo => 'baz' ), 'set foo => baz' );
cmp_ok( $o->get( 'foo' ), 'eq', 'baz', 'get foo = baz' );
ok( $o->set( 'test-undef' => 42 ), 'set test-undef' );
ok( $o->set( 'test-undef' => undef ), 'set undef' );
ok( ! defined $o->get( 'test-undef' ), 'get undef' );
ok( $o->exists( 'test-undef' ), 'exists undef' );
$o->del('non-existant');
ok( ! $o->exists( 'non-existant' ), 'exists non-existant' );
ok( ! $o->get( 'non-existant' ), 'get non-existant' );
ok( $o->set('key-next' => 0), 'key-next = 0' );
my $key_next = 3;
ok( $o->set('key-left' => $key_next), 'key-left' );
is_deeply( [ $o->mget( 'foo', 'key-next', 'key-left' ) ], [ 'baz', 0, 3 ], 'mget' );
my @keys;
foreach my $id ( 0 .. $key_next ) {
my $key = 'key-' . $id;
push @keys, $key;
ok( $o->set( $key => $id ), "set $key" );
ok( $o->exists( $key ), "exists $key" );
cmp_ok( $o->get( $key ), 'eq', $id, "get $key" );
cmp_ok( $o->incr( 'key-next' ), '==', $id + 1, 'incr' );
cmp_ok( $o->decr( 'key-left' ), '==', $key_next - $id - 1, 'decr' );
}
cmp_ok( $o->get( 'key-next' ), '==', $key_next + 1, 'key-next' );
ok( $o->set('test-incrby', 0), 'test-incrby' );
ok( $o->set('test-decrby', 0), 'test-decry' );
foreach ( 1 .. 3 ) {
cmp_ok( $o->incrby('test-incrby', 3), '==', $_ * 3, 'incrby 3' );
cmp_ok( $o->decrby('test-decrby', 7), '==', -( $_ * 7 ), 'decrby 7' );
}
ok( $o->del( $_ ), "del $_" ) foreach map { "key-$_" } ( 'next', 'left' );
ok( ! $o->del('non-existing' ), 'del non-existing' );
cmp_ok( $o->type('foo'), 'eq', 'string', 'type' );
cmp_ok( $o->keys('key-*'), '==', $key_next + 1, 'key-*' );
is_deeply( [ $o->keys('key-*') ], [ @keys ], 'keys' );
ok( my $key = $o->randomkey, 'randomkey' );
ok( $o->rename( 'test-incrby', 'test-renamed' ), 'rename' );
ok( $o->exists( 'test-renamed' ), 'exists test-renamed' );
eval { $o->rename( 'test-decrby', 'test-renamed', 1 ) };
ok( $@, 'rename to existing key' );
ok( my $nr_keys = $o->dbsize, 'dbsize' );
diag "Commands operating on lists";
my $list = 'test-list';
$o->del($list) && diag "cleanup $list from last run";
ok( $o->rpush( $list => "r$_" ), 'rpush' ) foreach ( 1 .. 3 );
ok( $o->lpush( $list => "l$_" ), 'lpush' ) foreach ( 1 .. 2 );
cmp_ok( $o->type($list), 'eq', 'list', 'type' );
cmp_ok( $o->llen($list), '==', 5, 'llen' );
is_deeply( [ $o->lrange( $list, 0, 1 ) ], [ 'l2', 'l1' ], 'lrange' );
ok( $o->ltrim( $list, 1, 2 ), 'ltrim' );
cmp_ok( $o->llen($list), '==', 2, 'llen after ltrim' );
cmp_ok( $o->lindex( $list, 0 ), 'eq', 'l1', 'lindex' );
cmp_ok( $o->lindex( $list, 1 ), 'eq', 'r1', 'lindex' );
ok( $o->lset( $list, 0, 'foo' ), 'lset' );
cmp_ok( $o->lindex( $list, 0 ), 'eq', 'foo', 'verified' );
ok( $o->lrem( $list, 1, 'foo' ), 'lrem' );
cmp_ok( $o->llen( $list ), '==', 1, 'llen after lrem' );
cmp_ok( $o->lpop( $list ), 'eq', 'r1', 'lpop' );
ok( ! $o->rpop( $list ), 'rpop' );
diag "Commands operating on sets";
my $set = 'test-set';
$o->del($set);
ok( $o->sadd( $set, 'foo' ), 'sadd' );
ok( ! $o->sadd( $set, 'foo' ), 'sadd' );
cmp_ok( $o->scard( $set ), '==', 1, 'scard' );
ok( $o->sismember( $set, 'foo' ), 'sismember' );
cmp_ok( $o->type( $set ), 'eq', 'set', 'type is set' );
ok( $o->srem( $set, 'foo' ), 'srem' );
ok( ! $o->srem( $set, 'foo' ), 'srem again' );
cmp_ok( $o->scard( $set ), '==', 0, 'scard' );
$o->sadd( 'test-set1', $_ ) foreach ( 'foo', 'bar', 'baz' );
$o->sadd( 'test-set2', $_ ) foreach ( 'foo', 'baz', 'xxx' );
my $inter = [ 'baz', 'foo' ];
is_deeply( [ $o->sinter( 'test-set1', 'test-set2' ) ], $inter, 'siter' );
ok( $o->sinterstore( 'test-set-inter', 'test-set1', 'test-set2' ), 'sinterstore' );
cmp_ok( $o->scard( 'test-set-inter' ), '==', $#$inter + 1, 'cardinality of intersection' );
diag "Multiple databases handling commands";
ok( $o->select( 1 ), 'select' );
ok( $o->select( 0 ), 'select' );
ok( $o->move( 'foo', 1 ), 'move' );
ok( ! $o->exists( 'foo' ), 'gone' );
ok( $o->select( 1 ), 'select' );
ok( $o->exists( 'foo' ), 'exists' );
ok( $o->flushdb, 'flushdb' );
cmp_ok( $o->dbsize, '==', 0, 'empty' );
diag "Sorting";
ok( $o->lpush( 'test-sort', $_ ), "put $_" ) foreach ( 1 .. 4 );
cmp_ok( $o->llen( 'test-sort' ), '==', 4, 'llen' );
is_deeply( [ $o->sort( 'test-sort' ) ], [ 1,2,3,4 ], 'sort' );
is_deeply( [ $o->sort( 'test-sort DESC' ) ], [ 4,3,2,1 ], 'sort DESC' );
diag "Persistence control commands";
ok( $o->save, 'save' );
ok( $o->bgsave, 'bgsave' );
ok( $o->lastsave, 'lastsave' );
#ok( $o->shutdown, 'shutdown' );
diag "shutdown not tested";
diag "Remote server control commands";
ok( my $info = $o->info, 'info' );
diag dump( $info );
diag "Connection handling";
ok( $o->quit, 'quit' );

30
client-libraries/perl/t/10-Redis-List.t Executable file
View File

@ -0,0 +1,30 @@
#!/usr/bin/perl
use warnings;
use strict;
use Test::More tests => 8;
use lib 'lib';
use Data::Dump qw/dump/;
BEGIN {
use_ok( 'Redis::List' );
}
my @a;
ok( my $o = tie( @a, 'Redis::List', 'test-redis-list' ), 'tie' );
isa_ok( $o, 'Redis::List' );
$o->CLEAR;
ok( ! @a, 'empty list' );
ok( @a = ( 'foo', 'bar', 'baz' ), '=' );
is_deeply( [ @a ], [ 'foo', 'bar', 'baz' ] );
ok( push( @a, 'push' ), 'push' );
is_deeply( [ @a ], [ 'foo', 'bar', 'baz', 'push' ] );
#diag dump( @a );

30
client-libraries/perl/t/20-Redis-Hash.t Executable file
View File

@ -0,0 +1,30 @@
#!/usr/bin/perl
use warnings;
use strict;
use Test::More tests => 7;
use lib 'lib';
use Data::Dump qw/dump/;
BEGIN {
use_ok( 'Redis::Hash' );
}
ok( my $o = tie( my %h, 'Redis::Hash', 'test-redis-hash' ), 'tie' );
isa_ok( $o, 'Redis::Hash' );
$o->CLEAR();
ok( ! keys %h, 'empty' );
ok( %h = ( 'foo' => 42, 'bar' => 1, 'baz' => 99 ), '=' );
is_deeply( [ sort keys %h ], [ 'bar', 'baz', 'foo' ], 'keys' );
is_deeply( \%h, { bar => 1, baz => 99, foo => 42, }, 'structure' );
#diag dump( \%h );

18
client-libraries/perl/t/pod-coverage.t Normal file
View File

@ -0,0 +1,18 @@
use strict;
use warnings;
use Test::More;
# Ensure a recent version of Test::Pod::Coverage
my $min_tpc = 1.08;
eval "use Test::Pod::Coverage $min_tpc";
plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
if $@;
# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
# but older versions don't recognize some common documentation styles
my $min_pc = 0.18;
eval "use Pod::Coverage $min_pc";
plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
if $@;
all_pod_coverage_ok();

12
client-libraries/perl/t/pod.t Normal file
View File

@ -0,0 +1,12 @@
#!perl -T
use strict;
use warnings;
use Test::More;
# Ensure a recent version of Test::Pod
my $min_tp = 1.22;
eval "use Test::Pod $min_tp";
plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
all_pod_files_ok();

246
redis.c
View File

@ -46,6 +46,7 @@
#include <fcntl.h>
#include <sys/time.h>
#include <sys/resource.h>
#include <limits.h>
#include "ae.h" /* Event driven programming library */
#include "sds.h" /* Dynamic safe strings */
@ -82,9 +83,28 @@
#define REDIS_LIST 1
#define REDIS_SET 2
#define REDIS_HASH 3
/* Object types only used for dumping to disk */
#define REDIS_SELECTDB 254
#define REDIS_EOF 255
/* Defines related to the dump file format. To store 32 bits lengths for short
* keys requires a lot of space, so we check the most significant 2 bits of
* the first byte to interpreter the length:
*
* 00|000000 => if the two MSB are 00 the len is the 6 bits of this byte
* 01|000000 00000000 => 01, the len is 14 byes, 6 bits + 8 bits of next byte
* 10|000000 [32 bit integer] => if it's 01, a full 32 bit len will follow
* 11|000000 [64 bit integer] => if it's 11, a full 64 bit len will follow
*
* 64 bit lengths are not used currently. Lenghts up to 63 are stored using
* a single byte, most DB keys, and may values, will fit inside. */
#define REDIS_RDB_6BITLEN 0
#define REDIS_RDB_14BITLEN 1
#define REDIS_RDB_32BITLEN 2
#define REDIS_RDB_64BITLEN 3
#define REDIS_RDB_LENERR UINT_MAX
/* Client flags */
#define REDIS_CLOSE 1 /* This client connection should be closed ASAP */
#define REDIS_SLAVE 2 /* This client is a slave server */
@ -230,11 +250,11 @@ static void freeSetObject(robj *o);
static void decrRefCount(void *o);
static robj *createObject(int type, void *ptr);
static void freeClient(redisClient *c);
static int loadDb(char *filename);
static int rdbLoad(char *filename);
static void addReply(redisClient *c, robj *obj);
static void addReplySds(redisClient *c, sds s);
static void incrRefCount(robj *o);
static int saveDbBackground(char *filename);
static int rdbSaveBackground(char *filename);
static robj *createStringObject(char *ptr, size_t len);
static void replicationFeedSlaves(list *slaves, struct redisCommand *cmd, int dictid, robj **argv, int argc);
static int syncWithMaster(void);
@ -641,7 +661,7 @@ int serverCron(struct aeEventLoop *eventLoop, long long id, void *clientData) {
now-server.lastsave > sp->seconds) {
redisLog(REDIS_NOTICE,"%d changes in %d seconds. Saving...",
sp->changes, sp->seconds);
saveDbBackground(server.dbfilename);
rdbSaveBackground(server.dbfilename);
break;
}
}
@ -1394,12 +1414,37 @@ static void decrRefCount(void *obj) {
/*============================ DB saving/loading ============================ */
static int rdbSaveType(FILE *fp, unsigned char type) {
if (fwrite(&type,1,1,fp) == 0) return -1;
return 0;
}
static int rdbSaveLen(FILE *fp, uint32_t len) {
unsigned char buf[2];
if (len < (1<<6)) {
/* Save a 6 bit len */
buf[0] = (len&0xFF)|REDIS_RDB_6BITLEN;
if (fwrite(buf,1,1,fp) == 0) return -1;
} else if (len < (1<<14)) {
/* Save a 14 bit len */
buf[0] = ((len>>8)&0xFF)|REDIS_RDB_14BITLEN;
buf[1] = len&0xFF;
if (fwrite(buf,4,1,fp) == 0) return -1;
} else {
/* Save a 32 bit len */
buf[0] = REDIS_RDB_32BITLEN;
if (fwrite(buf,1,1,fp) == 0) return -1;
len = htonl(len);
if (fwrite(&len,4,1,fp) == 0) return -1;
}
return 0;
}
/* Save the DB on disk. Return REDIS_ERR on error, REDIS_OK on success */
static int saveDb(char *filename) {
static int rdbSave(char *filename) {
dictIterator *di = NULL;
dictEntry *de;
uint32_t len;
uint8_t type;
FILE *fp;
char tmpfile[256];
int j;
@ -1410,7 +1455,7 @@ static int saveDb(char *filename) {
redisLog(REDIS_WARNING, "Failed saving the DB: %s", strerror(errno));
return REDIS_ERR;
}
if (fwrite("REDIS0000",9,1,fp) == 0) goto werr;
if (fwrite("REDIS0001",9,1,fp) == 0) goto werr;
for (j = 0; j < server.dbnum; j++) {
dict *d = server.dict[j];
if (dictGetHashTableUsed(d) == 0) continue;
@ -1421,59 +1466,54 @@ static int saveDb(char *filename) {
}
/* Write the SELECT DB opcode */
type = REDIS_SELECTDB;
len = htonl(j);
if (fwrite(&type,1,1,fp) == 0) goto werr;
if (fwrite(&len,4,1,fp) == 0) goto werr;
if (rdbSaveType(fp,REDIS_SELECTDB) == -1) goto werr;
if (rdbSaveLen(fp,j) == -1) goto werr;
/* Iterate this DB writing every entry */
while((de = dictNext(di)) != NULL) {
robj *key = dictGetEntryKey(de);
robj *o = dictGetEntryVal(de);
type = o->type;
len = htonl(sdslen(key->ptr));
if (fwrite(&type,1,1,fp) == 0) goto werr;
if (fwrite(&len,4,1,fp) == 0) goto werr;
if (rdbSaveType(fp,o->type) == -1) goto werr;
if (rdbSaveLen(fp,sdslen(key->ptr)) == -1) goto werr;
if (fwrite(key->ptr,sdslen(key->ptr),1,fp) == 0) goto werr;
if (type == REDIS_STRING) {
if (o->type == REDIS_STRING) {
/* Save a string value */
sds sval = o->ptr;
len = htonl(sdslen(sval));
if (fwrite(&len,4,1,fp) == 0) goto werr;
if (rdbSaveLen(fp,sdslen(sval)) == -1) goto werr;
if (sdslen(sval) &&
fwrite(sval,sdslen(sval),1,fp) == 0) goto werr;
} else if (type == REDIS_LIST) {
} else if (o->type == REDIS_LIST) {
/* Save a list value */
list *list = o->ptr;
listNode *ln = list->head;
len = htonl(listLength(list));
if (fwrite(&len,4,1,fp) == 0) goto werr;
if (rdbSaveLen(fp,listLength(list)) == -1) goto werr;
while(ln) {
robj *eleobj = listNodeValue(ln);
len = htonl(sdslen(eleobj->ptr));
if (fwrite(&len,4,1,fp) == 0) goto werr;
if (sdslen(eleobj->ptr) && fwrite(eleobj->ptr,sdslen(eleobj->ptr),1,fp) == 0)
if (rdbSaveLen(fp,sdslen(eleobj->ptr)) == -1) goto werr;
if (sdslen(eleobj->ptr) &&
fwrite(eleobj->ptr,sdslen(eleobj->ptr),1,fp) == 0)
goto werr;
ln = ln->next;
}
} else if (type == REDIS_SET) {
} else if (o->type == REDIS_SET) {
/* Save a set value */
dict *set = o->ptr;
dictIterator *di = dictGetIterator(set);
dictEntry *de;
if (!set) oom("dictGetIteraotr");
len = htonl(dictGetHashTableUsed(set));
if (fwrite(&len,4,1,fp) == 0) goto werr;
if (rdbSaveLen(fp,dictGetHashTableUsed(set)) == -1) goto werr;
while((de = dictNext(di)) != NULL) {
robj *eleobj;
eleobj = dictGetEntryKey(de);
len = htonl(sdslen(eleobj->ptr));
if (fwrite(&len,4,1,fp) == 0) goto werr;
if (sdslen(eleobj->ptr) && fwrite(eleobj->ptr,sdslen(eleobj->ptr),1,fp) == 0)
if (rdbSaveLen(fp,sdslen(eleobj->ptr)) == -1) goto werr;
if (sdslen(eleobj->ptr) &&
fwrite(eleobj->ptr,sdslen(eleobj->ptr),1,fp) == 0)
goto werr;
}
dictReleaseIterator(di);
@ -1484,8 +1524,9 @@ static int saveDb(char *filename) {
dictReleaseIterator(di);
}
/* EOF opcode */
type = REDIS_EOF;
if (fwrite(&type,1,1,fp) == 0) goto werr;
if (rdbSaveType(fp,REDIS_EOF) == -1) goto werr;
/* Make sure data will not remain on the OS's output buffers */
fflush(fp);
fsync(fileno(fp));
fclose(fp);
@ -1510,14 +1551,14 @@ werr:
return REDIS_ERR;
}
static int saveDbBackground(char *filename) {
static int rdbSaveBackground(char *filename) {
pid_t childpid;
if (server.bgsaveinprogress) return REDIS_ERR;
if ((childpid = fork()) == 0) {
/* Child */
close(server.fd);
if (saveDb(filename) == REDIS_OK) {
if (rdbSave(filename) == REDIS_OK) {
exit(0);
} else {
exit(1);
@ -1531,90 +1572,109 @@ static int saveDbBackground(char *filename) {
return REDIS_OK; /* unreached */
}
static int loadType(FILE *fp) {
uint8_t type;
static int rdbLoadType(FILE *fp) {
unsigned char type;
if (fread(&type,1,1,fp) == 0) return -1;
return type;
}
static int loadDb(char *filename) {
static uint32_t rdbLoadLen(FILE *fp, int rdbver) {
unsigned char buf[2];
uint32_t len;
if (rdbver == 0) {
if (fread(&len,4,1,fp) == 0) return REDIS_RDB_LENERR;
return ntohl(len);
} else {
if (fread(buf,1,1,fp) == 0) return REDIS_RDB_LENERR;
if ((buf[0]&0xC0) == REDIS_RDB_6BITLEN) {
/* Read a 6 bit len */
return buf[0];
} else if ((buf[0]&0xC0) == REDIS_RDB_14BITLEN) {
/* Read a 14 bit len */
if (fread(buf+1,1,1,fp) == 0) return REDIS_RDB_LENERR;
return ((buf[0]&0x3F)<<8)|buf[1];
} else {
/* Read a 32 bit len */
if (fread(&len,4,1,fp) == 0) return REDIS_RDB_LENERR;
return ntohl(len);
}
}
return 0;
}
static robj *rdbLoadStringObject(FILE*fp,int rdbver) {
uint32_t len = rdbLoadLen(fp,rdbver);
sds val;
if (len == REDIS_RDB_LENERR) return NULL;
val = sdsnewlen(NULL,len);
if (len && fread(val,len,1,fp) == 0) {
sdsfree(val);
return NULL;
}
return createObject(REDIS_STRING,val);
}
static int rdbLoad(char *filename) {
FILE *fp;
char buf[REDIS_LOADBUF_LEN]; /* Try to use this buffer instead of */
char vbuf[REDIS_LOADBUF_LEN]; /* malloc() when the element is small */
char *key = NULL, *val = NULL;
uint32_t klen,vlen,dbid;
robj *keyobj = NULL;
uint32_t dbid;
int type;
int retval;
dict *d = server.dict[0];
char buf[1024];
int rdbver;
fp = fopen(filename,"r");
if (!fp) return REDIS_ERR;
if (fread(buf,9,1,fp) == 0) goto eoferr;
if (memcmp(buf,"REDIS0000",9) != 0) {
buf[9] = '\0';
if (memcmp(buf,"REDIS",5) != 0) {
fclose(fp);
redisLog(REDIS_WARNING,"Wrong signature trying to load DB from file");
return REDIS_ERR;
}
rdbver = atoi(buf+5);
if (rdbver > 1) {
fclose(fp);
redisLog(REDIS_WARNING,"Can't handle RDB format version %d",rdbver);
return REDIS_ERR;
}
while(1) {
robj *o;
/* Read type. */
if ((type = loadType(fp)) == -1) goto eoferr;
if ((type = rdbLoadType(fp)) == -1) goto eoferr;
if (type == REDIS_EOF) break;
/* Handle SELECT DB opcode as a special case */
if (type == REDIS_SELECTDB) {
if (fread(&dbid,4,1,fp) == 0) goto eoferr;
dbid = ntohl(dbid);
if ((dbid = rdbLoadLen(fp,rdbver)) == REDIS_RDB_LENERR) goto eoferr;
if (dbid >= (unsigned)server.dbnum) {
redisLog(REDIS_WARNING,"FATAL: Data file was created with a Redis server compiled to handle more than %d databases. Exiting\n", server.dbnum);
redisLog(REDIS_WARNING,"FATAL: Data file was created with a Redis server configured to handle more than %d databases. Exiting\n", server.dbnum);
exit(1);
}
d = server.dict[dbid];
continue;
}
/* Read key */
if (fread(&klen,4,1,fp) == 0) goto eoferr;
klen = ntohl(klen);
if (klen <= REDIS_LOADBUF_LEN) {
key = buf;
} else {
key = zmalloc(klen);
if (!key) oom("Loading DB from file");
}
if (fread(key,klen,1,fp) == 0) goto eoferr;
if ((keyobj = rdbLoadStringObject(fp,rdbver)) == NULL) goto eoferr;
if (type == REDIS_STRING) {
/* Read string value */
if (fread(&vlen,4,1,fp) == 0) goto eoferr;
vlen = ntohl(vlen);
if (vlen <= REDIS_LOADBUF_LEN) {
val = vbuf;
} else {
val = zmalloc(vlen);
if (!val) oom("Loading DB from file");
}
if (vlen && fread(val,vlen,1,fp) == 0) goto eoferr;
o = createObject(REDIS_STRING,sdsnewlen(val,vlen));
if ((o = rdbLoadStringObject(fp,rdbver)) == NULL) goto eoferr;
} else if (type == REDIS_LIST || type == REDIS_SET) {
/* Read list/set value */
uint32_t listlen;
if (fread(&listlen,4,1,fp) == 0) goto eoferr;
listlen = ntohl(listlen);
if ((listlen = rdbLoadLen(fp,rdbver)) == REDIS_RDB_LENERR)
goto eoferr;
o = (type == REDIS_LIST) ? createListObject() : createSetObject();
/* Load every single element of the list/set */
while(listlen--) {
robj *ele;
if (fread(&vlen,4,1,fp) == 0) goto eoferr;
vlen = ntohl(vlen);
if (vlen <= REDIS_LOADBUF_LEN) {
val = vbuf;
} else {
val = zmalloc(vlen);
if (!val) oom("Loading DB from file");
}
if (vlen && fread(val,vlen,1,fp) == 0) goto eoferr;
ele = createObject(REDIS_STRING,sdsnewlen(val,vlen));
if ((ele = rdbLoadStringObject(fp,rdbver)) == NULL) goto eoferr;
if (type == REDIS_LIST) {
if (!listAddNodeTail((list*)o->ptr,ele))
oom("listAddNodeTail");
@ -1622,30 +1682,23 @@ static int loadDb(char *filename) {
if (dictAdd((dict*)o->ptr,ele,NULL) == DICT_ERR)
oom("dictAdd");
}
/* free the temp buffer if needed */
if (val != vbuf) zfree(val);
val = NULL;
}
} else {
assert(0 != 0);
}
/* Add the new object in the hash table */
retval = dictAdd(d,createStringObject(key,klen),o);
retval = dictAdd(d,keyobj,o);
if (retval == DICT_ERR) {
redisLog(REDIS_WARNING,"Loading DB, duplicated key found! Unrecoverable error, exiting now.");
redisLog(REDIS_WARNING,"Loading DB, duplicated key (%s) found! Unrecoverable error, exiting now.", keyobj->ptr);
exit(1);
}
/* Iteration cleanup */
if (key != buf) zfree(key);
if (val != vbuf) zfree(val);
key = val = NULL;
keyobj = o = NULL;
}
fclose(fp);
return REDIS_OK;
eoferr: /* unexpected end of file is handled here with a fatal exit */
if (key != buf) zfree(key);
if (val != vbuf) zfree(val);
decrRefCount(keyobj);
redisLog(REDIS_WARNING,"Short read loading DB. Unrecoverable error, exiting now.");
exit(1);
return REDIS_ERR; /* Just to avoid warning */
@ -1894,7 +1947,7 @@ static void typeCommand(redisClient *c) {
}
static void saveCommand(redisClient *c) {
if (saveDb(server.dbfilename) == REDIS_OK) {
if (rdbSave(server.dbfilename) == REDIS_OK) {
addReply(c,shared.ok);
} else {
addReply(c,shared.err);
@ -1906,7 +1959,7 @@ static void bgsaveCommand(redisClient *c) {
addReplySds(c,sdsnew("-ERR background save already in progress\r\n"));
return;
}
if (saveDbBackground(server.dbfilename) == REDIS_OK) {
if (rdbSaveBackground(server.dbfilename) == REDIS_OK) {
addReply(c,shared.ok);
} else {
addReply(c,shared.err);
@ -1915,7 +1968,7 @@ static void bgsaveCommand(redisClient *c) {
static void shutdownCommand(redisClient *c) {
redisLog(REDIS_WARNING,"User requested shutdown, saving DB...");
if (saveDb(server.dbfilename) == REDIS_OK) {
if (rdbSave(server.dbfilename) == REDIS_OK) {
if (server.daemonize) {
unlink(server.pidfile);
}
@ -2508,13 +2561,13 @@ static void sinterstoreCommand(redisClient *c) {
static void flushdbCommand(redisClient *c) {
dictEmpty(c->dict);
addReply(c,shared.ok);
saveDb(server.dbfilename);
rdbSave(server.dbfilename);
}
static void flushallCommand(redisClient *c) {
emptyDb();
addReply(c,shared.ok);
saveDb(server.dbfilename);
rdbSave(server.dbfilename);
}
redisSortOperation *createSortOperation(int type, robj *pattern) {
@ -2923,7 +2976,8 @@ static void syncCommand(redisClient *c) {
if (c->flags & REDIS_SLAVE) return;
redisLog(REDIS_NOTICE,"Slave ask for syncronization");
if (flushClientOutput(c) == REDIS_ERR || saveDb(server.dbfilename) != REDIS_OK)
if (flushClientOutput(c) == REDIS_ERR ||
rdbSave(server.dbfilename) != REDIS_OK)
goto closeconn;
fd = open(server.dbfilename, O_RDONLY);
@ -3020,7 +3074,7 @@ static int syncWithMaster(void) {
return REDIS_ERR;
}
emptyDb();
if (loadDb(server.dbfilename) != REDIS_OK) {
if (rdbLoad(server.dbfilename) != REDIS_OK) {
redisLog(REDIS_WARNING,"Failed trying to load the MASTER synchronization DB from disk");
close(fd);
return REDIS_ERR;
@ -3079,7 +3133,7 @@ int main(int argc, char **argv) {
initServer();
if (server.daemonize) daemonize();
redisLog(REDIS_NOTICE,"Server started, Redis version " REDIS_VERSION);
if (loadDb(server.dbfilename) == REDIS_OK)
if (rdbLoad(server.dbfilename) == REDIS_OK)
redisLog(REDIS_NOTICE,"DB loaded from disk");
if (aeCreateFileEvent(server.el, server.fd, AE_READABLE,
acceptHandler, NULL, NULL) == AE_ERR) oom("creating file event");