view release on metacpan or  search on metacpan

t/redis_live.t  view on Meta::CPAN

# Connect -- skip if unreachable
# ---------------------------------------------------------------------------
my $redis;
my $connect_err;
eval {
	$redis = $REDIS_CLASS->new(
		server      => "${REDIS_HOST}:${REDIS_PORT}",
		reconnect   => 0,
		cnx_timeout => 5,
	);
	$redis->auth($REDIS_PASS) if defined $REDIS_PASS && length $REDIS_PASS;
};
$connect_err = "$@" if $@;

plan skip_all => "Cannot connect to Redis at $SERVER_URL: $connect_err"
	if $connect_err;

# ---------------------------------------------------------------------------
# PID-unique table prefix to avoid collisions on shared servers
# ---------------------------------------------------------------------------
Readonly my $PREFIX => sprintf 'bilive_%d', $$;
Readonly my $TABLE  => "${PREFIX}_players";

# ---------------------------------------------------------------------------
# Fixture data
# ---------------------------------------------------------------------------
my %REDIS_FIXTURE = (
	row1 => { name => 'Alice', score => '10' },
	row2 => { name => 'Bob',   score => '20' },
	row3 => { name => 'Carol', score => '30' },
	row4 => { name => 'Dave',  score => '40' },
);

for my $entry (keys %REDIS_FIXTURE) {
	$redis->del("${TABLE}:${entry}");
	$redis->hset("${TABLE}:${entry}", %{ $REDIS_FIXTURE{$entry} });
}

# ---------------------------------------------------------------------------
# InlineDA -- minimal stub for join right-side
# ---------------------------------------------------------------------------
my @INLINE_ROWS = (
	{ entry => 'row1', tier => 'gold',   region => 'east'  },
	{ entry => 'row2', tier => 'silver', region => 'west'  },
	{ entry => 'row3', tier => 'bronze', region => 'north' },
);

{
	package InlineDA;

	sub new {
		my ($class, %args) = @_;
		return bless {
			_cols => $args{cols} // [],
			_rows => $args{rows} // [],
		}, $class;
	}

	sub columns { return $_[0]->{_cols} }
	sub schema  { return {} }
	sub updated { return 1 }
	sub set_logger { return $_[0] }

	sub selectall_arrayref {
		my ($self, $criteria) = @_;
		my @rows = @{ $self->{_rows} };
		for my $col (CORE::keys %{ $criteria // {} }) {
			my $val = $criteria->{$col};
			next if ref $val;
			@rows = grep { defined $_->{$col} && $_->{$col} eq $val } @rows;
		}
		return \@rows;
	}
}

sub _inline_da {
	return InlineDA->new(
		cols => [qw(entry tier region)],
		rows => [@INLINE_ROWS],
	);
}

# ---------------------------------------------------------------------------
# Clean up all test keys from Redis when done
# ---------------------------------------------------------------------------
END {
	if ($redis) {
		eval { $redis->del($_) for $redis->keys("${TABLE}:*") };
	}
}

# Load the BI app
use Test::Mojo;
my $t = Test::Mojo->new('Database::BI');
require Database::BI::Model::DataSource;
require Database::BI::Controller::Dashboard;

# ---------------------------------------------------------------------------
plan tests => 14;
# ---------------------------------------------------------------------------

sub _redis_src {
	return Database::BI::Model::DataSource->new(table => $TABLE, redis => $SERVER_URL);
}

sub _join {
	my (%extra) = @_;
	eval { require Database::Join }
		or die 'Database::Join required';
	return Database::Join->new(
		databases   => [_redis_src(), _inline_da()],
		join_column => 'entry',
		%extra,
	);
}

# ---------------------------------------------------------------------------
# Section 1 -- connection
# ---------------------------------------------------------------------------
subtest 'L1: DataSource->new(redis=>) connects successfully' => sub {
	plan tests => 2;