--- /dev/null
+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
--- /dev/null
+Changes
+MANIFEST
+Makefile.PL
+README
+lib/Redis.pm
+t/00-load.t
+t/pod-coverage.t
+t/pod.t
--- /dev/null
+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::Dumper' => 0,
+ 'Carp' => 0,
+ },
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+ clean => { FILES => 'Redis-*' },
+);
--- /dev/null
+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.
+
--- /dev/null
+package Redis;
+
+use warnings;
+use strict;
+
+use IO::Socket::INET;
+use Data::Dumper;
+use Carp qw/confess/;
+
+=head1 NAME
+
+Redis - perl binding for Redis database
+
+=cut
+
+our $VERSION = '0.0801';
+
+
+=head1 DESCRIPTION
+
+Pure perl bindings for L<http://code.google.com/p/redis/>
+
+This version support git version 0.08 or later 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; # $ENV{REDIS_SERVER} or 127.0.0.1:6379
+
+ my $r = Redis->new( server => '192.168.0.1:6379', debug = 0 );
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $self = {@_};
+ $self->{debug} ||= $ENV{REDIS_DEBUG};
+
+ $self->{sock} = IO::Socket::INET->new(
+ PeerAddr => $self->{server} || $ENV{REDIS_SERVER} || '127.0.0.1:6379',
+ Proto => 'tcp',
+ ) || die $!;
+
+ bless($self, $class);
+ $self;
+}
+
+my $bulk_command = {
+ set => 1, setnx => 1,
+ rpush => 1, lpush => 1,
+ lset => 1, lrem => 1,
+ sadd => 1, srem => 1,
+ sismember => 1,
+ echo => 1,
+ getset => 1,
+ smove => 1,
+ zadd => 1,
+ zrem => 1,
+ zscore => 1,
+ zincrby => 1,
+ append => 1,
+};
+
+# we don't want DESTROY to fallback into AUTOLOAD
+sub DESTROY {}
+
+our $AUTOLOAD;
+sub AUTOLOAD {
+ my $self = shift;
+
+ my $sock = $self->{sock} || die "no server connected";
+
+ my $command = $AUTOLOAD;
+ $command =~ s/.*://;
+
+ warn "## $command ",Dumper(@_) if $self->{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 $self->{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 $self->{debug};
+ my $type = substr($result,0,1);
+ $result = substr($result,1,-2);
+
+ if ( $command eq 'info' ) {
+ my $hash;
+ foreach my $l ( split(/\r\n/, $self->__read_bulk($result) ) ) {
+ my ($n,$v) = split(/:/, $l, 2);
+ $hash->{$n} = $v;
+ }
+ return $hash;
+ } elsif ( $command eq 'keys' ) {
+ my $keys = $self->__read_bulk($result);
+ return split(/\s/, $keys) if $keys;
+ return;
+ }
+
+ if ( $type eq '-' ) {
+ confess $result;
+ } elsif ( $type eq '+' ) {
+ return $result;
+ } elsif ( $type eq '$' ) {
+ return $self->__read_bulk($result);
+ } elsif ( $type eq '*' ) {
+ return $self->__read_multi_bulk($result);
+ } elsif ( $type eq ':' ) {
+ return $result; # FIXME check if int?
+ } else {
+ confess "unknown type: $type", $self->__read_line();
+ }
+}
+
+sub __read_bulk {
+ my ($self,$len) = @_;
+ return undef if $len < 0;
+
+ my $v;
+ if ( $len > 0 ) {
+ read($self->{sock}, $v, $len) || die $!;
+ warn "<< ",Dumper($v),$/ if $self->{debug};
+ }
+ my $crlf;
+ read($self->{sock}, $crlf, 2); # skip cr/lf
+ return $v;
+}
+
+sub __read_multi_bulk {
+ my ($self,$size) = @_;
+ return undef if $size < 0;
+ my $sock = $self->{sock};
+
+ $size--;
+
+ my @list = ( 0 .. $size );
+ foreach ( 0 .. $size ) {
+ $list[ $_ ] = $self->__read_bulk( substr(<$sock>,1,-2) );
+ }
+
+ warn "## list = ", Dumper( @list ) if $self->{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
--- /dev/null
+package Redis::Hash;
+
+use strict;
+use warnings;
+
+use Tie::Hash;
+use base qw/Redis Tie::StdHash/;
+
+=head1 NAME
+
+Redis::Hash - tie perl hashes into Redis
+
+=head1 SYNOPSYS
+
+ tie %name, 'Redis::Hash', 'prefix';
+
+ my $o = tie %foobar, 'Redis::Hash', 'foobar';
+ print $o->info->{used_memory}; # or any redis command
+
+=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;
--- /dev/null
+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;
--- /dev/null
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+use Benchmark qw/:all/;
+use lib 'lib';
+use Redis;
+use Redis::Hash;
+
+my $r = Redis->new;
+
+my %hash;
+tie %hash, 'Redis::Hash', 'hash';
+
+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' ) },
+ '90_h_set' => sub { $hash{ 'test' . rand() } = rand() },
+ '90_h_get' => sub { my $a = $hash{ 'test' . rand() }; },
+});
--- /dev/null
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok( 'Redis' );
+}
+
+diag( "Testing Redis $Redis::VERSION, Perl $], $^X" );
--- /dev/null
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use Test::More tests => 105;
+use Data::Dumper;
+
+use lib 'lib';
+
+BEGIN {
+ use_ok( 'Redis' );
+}
+
+ok( my $o = Redis->new(), 'new' );
+
+ok( $o->ping, 'ping' );
+
+ok( $o = Redis->new( server => 'localhost:6379' ), 'new with server' );
+
+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 = [ 'foo', 'baz' ];
+
+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' );
+isa_ok( $info, 'HASH' );
+diag Dumper( $info );
+
+diag "Connection handling";
+
+ok( $o->quit, 'quit' );
--- /dev/null
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use Test::More tests => 8;
+use lib 'lib';
+
+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' ] );
+
--- /dev/null
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use Test::More tests => 8;
+use lib 'lib';
+
+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' );
+
+ok( my $mem = $o->info->{used_memory}, 'info' );
+diag "used memory $mem";
+
--- /dev/null
+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();
--- /dev/null
+#!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();
projects / perl-Redis.git / commitdiff