view release on metacpan or  search on metacpan

t/redis_live.t  view on Meta::CPAN

$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 'djlive_%d', $$;
Readonly my $TABLE  => "${PREFIX}_redis";

# ---------------------------------------------------------------------------
# Inline test subclass — class name derives the table name via ref($self)
# ---------------------------------------------------------------------------
{
	no strict 'refs';
	@{"Database::${TABLE}::ISA"} = ('Database::Abstraction');
}

# ---------------------------------------------------------------------------
# Fixture data for the Redis-backed DA
# ---------------------------------------------------------------------------
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} });
}

# ---------------------------------------------------------------------------
# Fixture data for the in-memory (non-Redis) DA
# InlineDA covers row1-row3; row4 is absent (left join fills with undef)
# ---------------------------------------------------------------------------
my @INLINE_ROWS = (
	{ entry => 'row1', tier => 'gold',   region => 'east'  },
	{ entry => 'row2', tier => 'silver', region => 'west'  },
	{ entry => 'row3', tier => 'bronze', region => 'north' },
);

# ---------------------------------------------------------------------------
# InlineDA — minimal blessed stub for the non-Redis side
# ---------------------------------------------------------------------------
{
	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}:*");
		};
	}
}

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

# Helpers
sub _redis_da {
	return "Database::${TABLE}"->new(database => $SERVER_URL);
}

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

# ---------------------------------------------------------------------------
# Section 1 — connection and type
# ---------------------------------------------------------------------------
subtest 'L1: new() with Redis-backed DA connects successfully' => sub {
	plan tests => 2;
	my $join;
	lives_ok { $join = _join() } 'new() lives';
	cmp_ok($join->count(), '>=', 1, 'count() >= 1 after connecting');
};