view release on metacpan or  search on metacpan

t/integration.t  view on Meta::CPAN

use Test::Most;
use Test::Returns;
use Test::Mockingbird;
use Test::Without::Module;
use Readonly;
use Scalar::Util qw(blessed refaddr);

BEGIN {
	eval { require DBD::SQLite; require DBI; require Database::Abstraction };
	plan skip_all => 'DBD::SQLite, DBI, and Database::Abstraction required' if $@;
	plan tests => 54;
	use_ok('Database::Join');
}

use DBI;
use File::Temp qw(tempdir);

# ---------------------------------------------------------------------------
# SQLite-backed DA stubs.  -norequire because Database::Abstraction was
# already require()d in the BEGIN block above.
#
# Class-name last-component must match the SQL filename exactly (case-sensitive).
# Using all-lowercase names to match the intcust.sql / intscore.sql filenames.
# ---------------------------------------------------------------------------
{
	package Database::intcust;
	use parent -norequire, 'Database::Abstraction';
}
{
	package Database::intscore;
	use parent -norequire, 'Database::Abstraction';
}
{
	package Database::intregion;
	use parent -norequire, 'Database::Abstraction';
}

# ---------------------------------------------------------------------------
# InMemDA: in-process stub for tests that do not need SQLite.
# Implements the subset of the Database::Abstraction API that Database::Join
# calls: columns, schema, updated, set_logger, selectall_arrayref.
# Operator hashrefs (>, <, >=, <=, !=) are supported for numeric columns.
# ---------------------------------------------------------------------------
{
	package InMemDA;
	use parent -norequire, 'Database::Abstraction';

	sub new {
		my ($class, %args) = @_;
		return bless {
			id      => $args{id}      // 'entry',
			_cols   => $args{cols}    // ['entry'],
			_rows   => $args{rows}    // [],
			_schema => $args{schema}  // {},
			_ts     => $args{updated} // 1_000_000,
		}, $class;
	}

	sub columns  { return $_[0]->{_cols} }
	sub schema   { return $_[0]->{_schema} }
	sub updated  { return $_[0]->{_ts} }
	sub set_logger { $_[0]->{_logger} = $_[1]; return $_[0] }

	sub selectall_arrayref {
		my ($self, $criteria) = @_;
		my @rows = @{ $self->{_rows} };
		for my $col (keys %{ $criteria // {} }) {
			my $val = $criteria->{$col};
			if (ref($val) eq 'HASH') {
				for my $op (keys %{$val}) {
					my $v = $val->{$op};
					if    ($op eq '>')  { @rows = grep { defined $_->{$col} && $_->{$col} >  $v } @rows }
					elsif ($op eq '<')  { @rows = grep { defined $_->{$col} && $_->{$col} <  $v } @rows }
					elsif ($op eq '>=') { @rows = grep { defined $_->{$col} && $_->{$col} >= $v } @rows }
					elsif ($op eq '<=') { @rows = grep { defined $_->{$col} && $_->{$col} <= $v } @rows }
					elsif ($op eq '!=') { @rows = grep { defined $_->{$col} && $_->{$col} != $v } @rows }
				}
			} else {
				@rows = grep { defined $_->{$col} && $_->{$col} eq $val } @rows;
			}
		}
		return \@rows;
	}

	sub DESTROY {}
}

# ---------------------------------------------------------------------------
# Fake logger: records calls so that set_logger propagation can be verified
# without triggering real logging side-effects.
# Database::Abstraction calls $logger->debug/info/warn/error at query time,
# so all four levels must exist.
# ---------------------------------------------------------------------------
{
	package IntFakeLogger;
	sub new   { return bless { _calls => [] }, shift }
	sub debug { push @{$_[0]->{_calls}}, ['debug', $_[1]] }
	sub info  { push @{$_[0]->{_calls}}, ['info',  $_[1]] }
	sub warn  { push @{$_[0]->{_calls}}, ['warn',  $_[1]] }
	sub error { push @{$_[0]->{_calls}}, ['error', $_[1]] }
}

# ---------------------------------------------------------------------------
# Constants -- no magic numbers or strings in test assertions.
# ---------------------------------------------------------------------------
Readonly::Scalar my $JC         => 'entry';
Readonly::Scalar my $ALICE_KEY  => 'c001';
Readonly::Scalar my $BOB_KEY    => 'c002';
Readonly::Scalar my $CAROL_KEY  => 'c003';
Readonly::Scalar my $ALL_CUST   => 3;   # total rows in intcust
Readonly::Scalar my $ALL_SCORED => 3;   # total rows in intscore
Readonly::Scalar my $REGIOND    => 2;   # rows in intregion (c003 absent)
Readonly::Scalar my $GOLD_COUNT => 2;   # Alice and Carol are tier=gold

# ---------------------------------------------------------------------------
# SQLite fixture setup
#
#   intcust:   entry | name  | email                | tier
#              c001  | Alice | alice@example.com    | gold
#              c002  | Bob   | bob@example.com      | silver
#              c003  | Carol | carol@example.com    | gold