qpsmtpd/t/qpsmtpd-db-redis.t

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 } ||= {};
}