New file dump format, perl client library added

client-libraries/perl/Changes

@@ -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

client-libraries/perl/MANIFEST

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

client-libraries/perl/Makefile.PL

@@ -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-*' },
+);

client-libraries/perl/README

@@ -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.
+

client-libraries/perl/lib/Redis.pm

@@ -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

client-libraries/perl/lib/Redis/Hash.pm

@@ -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;

client-libraries/perl/lib/Redis/List.pm

@@ -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;

client-libraries/perl/scripts/redis-benchmark.pl

@@ -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' ) },
+});

client-libraries/perl/t/00-load.t

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

client-libraries/perl/t/01-Redis.t

@@ -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' );

client-libraries/perl/t/10-Redis-List.t

@@ -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 );

client-libraries/perl/t/20-Redis-Hash.t

@@ -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 );
+

client-libraries/perl/t/pod-coverage.t

@@ -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();

client-libraries/perl/t/pod.t

@@ -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();