Tests for Qpsmtpd::DB::Redis

t/qpsmtpd-db-redis.t

@@ -0,0 +1,179 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use lib 'lib';    # test lib/Qpsmtpd (vs site_perl)
+use lib 't';
+
+use_ok('Qpsmtpd::DB::Redis');
+
+my $db;
+eval 'use Redis; Redis->new';
+if ( $@ ) {
+    warn "Could not connect to redis to test; using mock redis";
+    $db = bless { name => 'testing', redis => FakeRedis->new }, 'Qpsmtpd::DB::Redis';
+}
+else {
+    Redis->new->flushall;
+    $db = Qpsmtpd::DB::Redis->new( name => 'testing' );
+
+    __new();
+
+}
+
+__index();
+__redis();
+__get();
+__set();
+__delete();
+__get_keys();
+__size();
+__flush();
+
+done_testing();
+
+sub __new {
+    is( ref $db->{redis}, 'MyRedis', 'Redis object populated' );
+    my $redis = $db->{redis};
+    $redis->select(0);
+    is( $redis->get('___smtpd_reserved___'), 1, 'DB properly initialized' );
+    is( join( '|', $redis->keys('*') ), '___smtpd_reserved___',
+        'Nothing else has happened to DB yet' );
+}
+
+sub __redis {
+    $db->{redis}->flushall;
+    $db->{redis}->select(0);
+    delete $db->{index};
+    my $redis = $db->redis;
+    is( $redis->selected, 1, 'redis() selects the correct index' );
+}
+
+sub __index {
+    my $redis = $db->{redis};
+    $redis->flushall;
+    is( stores($db),  '',          'stores unpopulated initially' );
+    is( $db->{index}, undef,       'index cache unpopulated initially' );
+    is( $db->index,   1,           'get first index given an empty db' );
+    is( stores($db), 'testing=1',  'stores populated correctly for index=1' );
+    is( $db->{index}, 1,           'index is cached' );
+    $db->{index} = 999;
+    is( $db->index,   999,         'index cache is honored' );
+    delete $db->{index};
+    $redis->flushall;
+    $redis->select(0);
+    $redis->hset( 'smtpd_stores', testing => 99 );
+    is( $db->index,   99,          'redis zero table is honored' );
+    delete $db->{index};
+    $redis->flushall;
+    $redis->select(1);
+    $redis->set( bugus => 1 );
+    is( $db->index,   2,           'index() skips already-populated db' );
+    is( stores($db),  'testing=2', 'stores populated correclty for index=2' );
+    delete $db->{index};
+    $redis->flushall;
+    $redis->select(0);
+    $redis->hset( 'smtpd_stores', foo => 1 );
+    $redis->hset( 'smtpd_stores', bar => 2 );
+    is( $db->index,   3,           'index() skips already-earmarked db' );
+}
+
+sub stores {
+    my $redis = $db->{redis};
+    $redis->select(0);
+    my %store = $redis->hgetall('smtpd_stores');
+    return join ';', map { "$_=$store{$_}" } keys %store;
+}
+
+sub __get {
+    my $redis = $db->redis;
+    $redis->flushdb;
+    $redis->set( moo => 'oooo' );
+    is( $db->get('moo'), 'oooo', 'get() retrieves key' );
+}
+
+sub __set {
+    my $redis = $db->redis;
+    $redis->flushdb;
+    $db->set( mee => 'ow' );
+    is( $redis->get('mee'), 'ow', 'set() stores key' );
+}
+
+sub __delete {
+    my $redis = $db->redis;
+    $redis->flushdb;
+    $redis->set( oink  => 1 );
+    $redis->set( quack => 1 );
+    $db->delete('quack');
+    is( join( '|', $redis->keys('*') ), 'oink', 'delete() removes key' );
+}
+
+sub __get_keys {
+    my $redis = $db->redis;
+    $redis->flushdb;
+    $redis->set( asdf   => 1 );
+    $redis->set( qwerty => 1 );
+    is( join( '|', sort $db->get_keys ), 'asdf|qwerty',
+        'get_keys() lists all keys in the db' );
+}
+
+sub __size {
+    my $redis = $db->redis;
+    $redis->flushdb;
+    $redis->set( baz  => 1 );
+    $redis->set( blah => 1 );
+    is( $db->size, 2, 'size() shows key count for db' );
+}
+
+sub __flush {
+    $db->redis->flushall;
+    my $redis = $db->redis;
+    $redis->flushdb;
+    $redis->set( bogus => 1 );
+    is( join( '|', $redis->keys('*') ), 'bogus', 'redis db populated' );
+    $db->flush;
+    is( join( '|', $redis->keys('*') ), '', 'flush() empties db' );
+}
+
+package FakeRedis;
+sub new {
+    my $class = shift;
+    return bless {@_}, $class;
+}
+
+sub flushall { delete $_[0]->{fakestore} }
+sub selected { $_[0]->{selected}         }
+sub select   { $_[0]->{selected} = $_[1] }
+sub dbsize   { scalar keys %{ $_[0]->fakestore }   }
+sub get      { $_[0]->fakestore->{ $_[1] }         }
+sub set      { $_[0]->fakestore->{ $_[1] } = $_[2] }
+sub del      { delete $_[0]->fakestore->{ $_[1] }  }
+
+sub hgetall  {
+    my ( $self, $h ) = @_;
+    return %{ $self->fakestore->{ $h } || {} };
+}
+
+sub hset {
+    my ( $self, $h, $key, $value ) = @_;
+    $self->fakestore->{ $h }{ $key } = $value;
+}
+
+sub keys {
+    my ( $self, $pattern ) = @_;
+    die "invalid pattern '$pattern': Mock Redis only understands '*'"
+        if $pattern ne '*';
+    return keys %{ $self->fakestore };
+}
+
+sub flushdb {
+    my ( $self ) = @_;
+    delete $self->{fakestore}{ $self->selected };
+}
+
+sub fakestore {
+    my ( $self ) = @_;
+    return $self->{fakestore}{ $self->selected } ||= {};
+}
+