view release on metacpan or  search on metacpan

t/data-flow.t  view on Meta::CPAN

#      `my $db = $self->{_dbs}[$db_idx]` was computed unconditionally but is
#      only used in the non-join-map/filters branch.  Fixed by moving the
#      assignment into the else branch.
#
#   2. D~ in _joined_query (annotated):
#      $had_criteria[0] is written for every database, but the key-set
#      resolution loop starts at i=1; when n==1, $had_criteria[0] is a
#      permanent dead store.
#
#   3. Filter reference aliasing (annotated):
#      $self->{_filters} stores the caller's hashref directly.  External
#      mutation after construction silently changes query behaviour.
#
# All component databases are inline stubs (no SQLite, no disk I/O).
# ---------------------------------------------------------------------------

use Test::Most;
use Readonly;
use Scalar::Util qw(blessed refaddr weaken);

BEGIN {
	eval { require Database::Abstraction };
	plan skip_all => 'Database::Abstraction required' if $@;
	plan tests => 40;
	use_ok('Database::Join');
}

# ---------------------------------------------------------------------------
# Constants
# ---------------------------------------------------------------------------
Readonly::Scalar my $JC      => 'entry';
Readonly::Scalar my $K_A     => 'a1';
Readonly::Scalar my $K_B     => 'a2';
Readonly::Scalar my $K_C     => 'a3';   # secondary-only in some tests

# ---------------------------------------------------------------------------
# DFRecordingDA: records every criteria hashref passed to selectall_arrayref
# so DU tests can assert exactly what each database received.
# The `refaddr` of the received hashref is recorded alongside the hashref
# itself, enabling reference-identity checks separate from value checks.
# ---------------------------------------------------------------------------
## no critic (Modules::ProhibitMultiplePackages)
{
	package DFRecordingDA;
	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,
			_received => [],   # [ { hashref => ..., refaddr => ... }, ... ]
		}, $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) = @_;
		push @{ $self->{_received} }, {
			hashref => $criteria,
			refaddr => Scalar::Util::refaddr($criteria),
		};
		# Simple equality filter (no operator hashrefs needed for DU tests)
		my @rows = @{ $self->{_rows} };
		for my $col (keys %{ $criteria // {} }) {
			my $v = $criteria->{$col};
			@rows = grep {
				defined $_->{$col} && defined $v && $_->{$col} eq $v
			} @rows if defined $v;
		}
		return \@rows;
	}

	sub received       { return $_[0]->{_received} }
	sub clear_received { $_[0]->{_received} = []; return $_[0] }
	sub DESTROY {}
}

# ---------------------------------------------------------------------------
# DFMinimalDA: lightweight stub without recording, for tests that only need
# data back and don't inspect the criteria sent to the DA.
# ---------------------------------------------------------------------------
{
	package DFMinimalDA;
	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 { return $_[0]->{_rows} }   # always returns all rows
	sub DESTROY {}
}

# ---------------------------------------------------------------------------
# Helpers
# ---------------------------------------------------------------------------
sub _two_db_join {
	my (%opts) = @_;
	my $prim = DFMinimalDA->new(
		cols => ['entry', 'name'],
		rows => [
			{ entry => $K_A, name => 'Alpha' },
			{ entry => $K_B, name => 'Beta'  },
		],
	);
	my $sec = DFMinimalDA->new(
		cols => ['entry', 'score'],
		rows => [
			{ entry => $K_A, score => 10 },
			{ entry => $K_B, score => 20 },
		],
	);
	my $j = Database::Join->new(
		databases   => [$prim, $sec],
		join_column => $JC,
		%opts,
	);
	return ($j, $prim, $sec);
}

# ===========================================================================
# Section 1: Memoization cache lifecycle (DU for _col_cache and _schema_cache)
# ===========================================================================

subtest 'columns(): memoized — second call returns same arrayref' => sub {
	# D: cache written on first call; U: cache read on second call; K: object destruction.
	my ($j) = _two_db_join();
	my $r1 = $j->columns();
	my $r2 = $j->columns();
	is refaddr($r1), refaddr($r2),
		'repeated columns() calls return the same cached arrayref';
};

subtest 'schema(): memoized — second call returns same hashref' => sub {
	my ($j) = _two_db_join();
	my $s1 = $j->schema();
	my $s2 = $j->schema();
	is refaddr($s1), refaddr($s2),
		'repeated schema() calls return the same cached hashref';
};

subtest 'remove_column: kills _col_cache (next call re-derives)' => sub {
	# D: col_cache written during first columns() call
	# K: col_cache killed by remove_column
	# D: col_cache re-derived on next columns() call
	# If the cache were NOT killed, the new arrayref would be the same ref as before.
	my ($j) = _two_db_join();
	my $r_before = $j->columns();

t/data-flow.t  view on Meta::CPAN

};

subtest 'remove_column does not affect logger reference' => sub {
	my ($j, $prim) = _two_db_join();
	my $log = bless {}, 'FourthLogger';
	$j->set_logger($log);
	$j->remove_column('score');
	is refaddr($j->{_logger}), refaddr($log),
		'join _logger ref unchanged after remove_column';
	is refaddr($prim->{logger}), refaddr($log),
		'primary DA logger ref unchanged after remove_column';
};

# ===========================================================================
# Section 8: D~ anomaly in AUTOLOAD — dead store fix verification
# ===========================================================================

subtest 'AUTOLOAD join-path: correct values returned (D~ fix does not break it)' => sub {
	# D~ fix: `my $db = $self->{_dbs}[$db_idx]` moved inside the else branch.
	# Verify the join-path branch still works correctly after the refactoring.
	# DFRecordingDA is used for the secondary because it actually applies criteria
	# (equality filter), so the base filter { score => '10' } restricts to 1 row.
	my $prim = DFMinimalDA->new(
		cols => ['entry', 'name'],
		rows => [
			{ entry => $K_A, name => 'Alpha' },
			{ entry => $K_B, name => 'Beta'  },
		],
	);
	my $sec = DFRecordingDA->new(
		cols => ['entry', 'score'],
		rows => [
			{ entry => $K_A, score => '10' },
			{ entry => $K_B, score => '20' },
		],
	);
	# Activate filters so AUTOLOAD takes the join path (not $db->$col(@_)).
	# filter score='10' on secondary: only entry $K_A survives → 1 merged row.
	my $j = Database::Join->new(
		databases   => [$prim, $sec],
		join_column => $JC,
		filters     => { 1 => { score => '10' } },
	);
	my $val = $j->name(entry => $K_A);
	is $val, 'Alpha', 'AUTOLOAD join-path returns correct scalar value';
	my @names = $j->name();
	is scalar @names, 1, 'AUTOLOAD join-path list context: filter limits to 1 row';
};

subtest 'AUTOLOAD direct-path: $db resolved correctly after D~ fix' => sub {
	# Without join_map or filters, AUTOLOAD must still resolve $db and delegate.
	# Since DFMinimalDA does not implement AUTOLOAD itself, any column shortcut
	# call would fail if the direct-delegation path were broken.
	# We verify by using a custom DA that DOES define the column as a method.
	{
		package DirectDA;
		use parent -norequire, 'Database::Abstraction';
		sub new { bless { id=>'entry', _cols=>['entry','tag'], _rows=>[], _schema=>{}, _ts=>1 }, shift }
		sub columns { return $_[0]->{_cols} }
		sub schema  { return {} }
		sub updated { return 1 }
		sub set_logger { $_[0]->{logger} = $_[1]; return $_[0] }
		sub selectall_arrayref { return $_[0]->{_rows} }
		sub tag { return 'direct-value' }   # method that AUTOLOAD will delegate to
		sub DESTROY {}
	}
	my $da = DirectDA->new();
	my $j  = Database::Join->new(databases => [$da], join_column => 'entry');
	# No join_map or filters: AUTOLOAD takes the direct path and calls $da->tag()
	my $val = $j->tag();
	is $val, 'direct-value',
		'AUTOLOAD direct-path correctly delegates to DA method after D~ fix';
};

# ===========================================================================
# Section 9: Single-DB DU — had_criteria[0] dead store (D~ annotated)
# ===========================================================================

subtest 'single-DB join: had_criteria[0] dead store does not cause runtime error' => sub {
	# D~: $had_criteria[0] is written but never read when n==1 (key-set resolution
	# loop starts at i=1, so i=0 is never processed there).
	# Verify the query path is functionally correct despite the dead store.
	my $da = DFRecordingDA->new(
		cols => ['entry', 'val'],
		rows => [
			{ entry => $K_A, val => 'x' },
			{ entry => $K_B, val => 'y' },
		],
	);
	my $j = Database::Join->new(databases => [$da], join_column => $JC);
	my $rows;
	lives_ok { $rows = $j->selectall_arrayref(entry => $K_A) }
		'single-DB join with criteria lives (no crash from dead had_criteria[0])';
	is scalar @{$rows}, 1, 'correct row count from single-DB join';
	is $rows->[0]{val}, 'x', 'correct row content';
};

subtest 'single-DB join: no-criteria query returns all rows cleanly' => sub {
	my $da = DFMinimalDA->new(
		cols => ['entry', 'x'],
		rows => [
			{ entry => $K_A, x => 1 },
			{ entry => $K_B, x => 2 },
		],
	);
	my $j    = Database::Join->new(databases => [$da], join_column => $JC);
	my $rows = $j->selectall_arrayref();
	is scalar @{$rows}, 2,
		'single-DB no-criteria query returns all rows (dead store harmless)';
};