view release on metacpan or  search on metacpan

t/redis.t  view on Meta::CPAN

	sub new {
		my ($class, %opts) = @_;
		return bless {
			_table => $opts{_table} // $TABLE,
			_data  => $opts{_data}  // {},
		}, $class;
	}

	sub auth   { 'OK' }
	sub quit   { 'OK' }
	sub select { 'OK' }

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

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

# Determine which Redis class Database::Abstraction will try to instantiate.
my $REDIS_CLASS = defined $INC{'Redis/Fast.pm'} ? 'Redis::Fast' : 'Redis';

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

# ---------------------------------------------------------------------------
# InlineDA -- minimal DataSource-compatible stub for the right side of joins
# ---------------------------------------------------------------------------
{
	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],
	);
}

# ---------------------------------------------------------------------------
plan tests => 13;
# ---------------------------------------------------------------------------

# ---------------------------------------------------------------------------
# Section 1 -- DataSource construction
# ---------------------------------------------------------------------------
subtest 'R1: DataSource->new(redis=>) constructs without error' => sub {
	plan tests => 2;
	my ($mock, $guard) = _mock_redis();
	my $src;
	lives_ok {
		$src = Database::BI::Model::DataSource->new(
			table => $TABLE,
			redis => $REDIS_URL,
		);
	} 'DataSource->new with redis=> lives';
	ok(defined $src, 'returns a defined DataSource object');
};

subtest 'R2: DataSource->new rejects a non-redis:// URL' => sub {
	plan tests => 1;
	throws_ok {
		Database::BI::Model::DataSource->new(table => $TABLE, redis => 'http://localhost:6379')
	} qr/redis:\/\//i, 'croaks when URL does not begin with redis://';
};

subtest 'R3: DataSource->new with redis=> requires a table name' => sub {
	plan tests => 1;
	throws_ok {
		Database::BI::Model::DataSource->new(redis => $REDIS_URL)
	} qr/table/i, 'croaks when table name is absent';
};

# ---------------------------------------------------------------------------
# Section 2 -- data access
# ---------------------------------------------------------------------------
subtest 'R4: fetch_all returns all rows from the Redis store' => sub {
	plan tests => 2;