view release on metacpan or  search on metacpan

t/redis.t  view on Meta::CPAN

			_data         => $opts{_data}  // {},
			_select_calls => 0,
			_auth_calls   => 0,
			_quit_calls   => 0,
		}, $class;
	}

	sub auth   { my $self = shift; $self->{_auth_calls}++;  return 'OK' }
	sub quit   { my $self = shift; $self->{_quit_calls}++;  return 'OK' }
	sub select { my ($self, $idx) = @_; $self->{_select_calls}++; return 'OK' }

	sub keys {
		my ($self, $pattern) = @_;
		my $table = $self->{_table};
		(my $prefix = $pattern) =~ s/\*\z//;
		return grep { /\A\Q$prefix\E/ }
			map { "${table}:$_" } sort CORE::keys %{ $self->{_data} };
	}

	sub hgetall {
		my ($self, $key) = @_;
		my $table = $self->{_table};
		(my $entry = $key) =~ s/\A\Q${table}\E://;
		my $row = $self->{_data}{$entry} or return ();
		return %{$row};
	}
}

# Determine which Redis class DA's _open() will actually use
my $REDIS_CLASS = defined $INC{'Redis/Fast.pm'} ? 'Redis::Fast' : 'Redis';

# Helper: return a fresh MockRedis and a mock_scoped guard
sub _mock_redis {
	my (%opts) = @_;
	my $mock = MockRedis->new(
		_table => $opts{table} // 'dj_rA',
		_data  => $opts{data}  // \%REDIS_FIXTURE,
	);
	my $guard = mock_scoped($REDIS_CLASS, new => sub { $mock });
	return ($mock, $guard);
}

# ---------------------------------------------------------------------------
# InlineDA — minimal blessed stub for the non-Redis side of the join.
# Must implement columns(), selectall_arrayref(), schema(), updated(),
# set_logger() to satisfy Database::Join's component contract.
# ---------------------------------------------------------------------------
{
	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;
	}
}

# Build a fresh InlineDA with the standard fixture columns
sub _inline_da {
	return InlineDA->new(
		cols => [qw(entry tier region)],
		rows => [@INLINE_ROWS],
	);
}

# ---------------------------------------------------------------------------
# Section 1 — constructor
# ---------------------------------------------------------------------------
subtest 'R1: Database::Join accepts a Redis-backed DA' => sub {
	plan tests => 1;
	my ($mock, $guard) = _mock_redis();
	my $redis_da = Database::dj_rA->new(database => $REDIS_URL);
	lives_ok {
		Database::Join->new(
			databases    => [$redis_da, _inline_da()],
			join_column  => 'entry',
		);
	} 'new() with Redis DA lives';
};

# ---------------------------------------------------------------------------
# Section 2 — columns() and schema()
# ---------------------------------------------------------------------------
subtest 'R2: columns() returns merged columns from both DAs' => sub {
	plan tests => 3;
	my ($mock, $guard) = _mock_redis();
	my $redis_da = Database::dj_rA->new(database => $REDIS_URL);
	$redis_da->count();    # trigger Redis _open() while guard is active
	my $join = Database::Join->new(
		databases   => [$redis_da, _inline_da()],
		join_column => 'entry',
	);
	my $cols = $join->columns();
	returns_is($cols, { type => 'arrayref' }, 'columns() returns arrayref');
	my %col_set = map { $_ => 1 } @{$cols};
	ok($col_set{name},   'columns() includes Redis column name');
	ok($col_set{tier},   'columns() includes InlineDA column tier');
};

# ---------------------------------------------------------------------------
# Section 3 — count()
# ---------------------------------------------------------------------------
subtest 'R3: count() == 4 for left join (primary is Redis, 4 Redis rows)' => sub {