view release on metacpan or  search on metacpan

t/unit.t  view on Meta::CPAN

	'par:three_db_correct_results' => 1,  # n > 2 databases: results same as sequential

	# schema type consistency validation (warn_schema_type_mismatch)
	'st:carp_on_mismatch'     => 1,  # carp when shared column types differ at construction
	'st:no_carp_same_type'    => 1,  # no carp when shared column types agree
	'st:join_col_exempt'      => 1,  # join column itself is not checked
	'st:prefixed_exempt'      => 1,  # collision_prefix columns are exempt
	'st:add_db_emits_carp'    => 1,  # add_database also checks the new database

	# aggregate() messages (§2.6 of Join.md)
	'agg:error_aggregate_measures_required' => 1,
	'agg:error_aggregate_measure_ref'       => 1,
	'agg:error_aggregate_fn_unknown'        => 1,
	'agg:error_aggregate_col_required'      => 1,
	'agg:error_aggregate_col_unknown'       => 1,
	'agg:error_aggregate_as_required'       => 1,
	'agg:error_aggregate_as_invalid'        => 1,
	'agg:error_aggregate_as_duplicate'      => 1,
	'agg:error_aggregate_as_collision'      => 1,
	'agg:error_aggregate_by_invalid'        => 1,
	'agg:error_aggregate_having_key'        => 1,
	'agg:error_aggregate_having_operator'   => 1,
	'agg:warn_aggregate_sort_key'           => 1,
	'agg:warn_aggregate_non_numeric'        => 1,
);

# ---------------------------------------------------------------------------
# Constants
# ---------------------------------------------------------------------------
Readonly::Scalar my $JC          => 'entry';
Readonly::Scalar my $COL_A       => 'name';
Readonly::Scalar my $COL_B       => 'score';
Readonly::Scalar my $COL_C       => 'tier';
Readonly::Scalar my $TS_OLD      => 1_000_000;
Readonly::Scalar my $TS_NEW      => 2_000_000;
Readonly::Scalar my $CP_PREFIX   => 'b';         # collision_prefix value used in cp tests
Readonly::Scalar my $COL_SHARED  => 'notes';     # the column that collides between two DBs
Readonly::Scalar my $COL_PFX     => "b.notes";   # published prefixed name of the collision

# ---------------------------------------------------------------------------
# MinimalDA: inline Database::Abstraction stub.
# Configurable at construction time; no disk I/O.
# ---------------------------------------------------------------------------
{
	package MinimalDA;
	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,
		}, $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 {}
}

# ---------------------------------------------------------------------------
# MinimalDA3: MinimalDA subclass that directly defines count() so that
# Database::Join's 'auto' backend threshold check can size datasets without
# fetching all rows (defined &{"${pkg}::count"} check in _sqlite_join).
# ---------------------------------------------------------------------------
{
	package MinimalDA3;
	use parent -norequire, 'MinimalDA';

	sub count { return scalar @{ $_[0]->{_rows} } }
}

# ---------------------------------------------------------------------------
# Helpers: build standard fixtures used across many subtests
# ---------------------------------------------------------------------------
sub _two_db_join {
	my (%opts) = @_;
	my $db_a = MinimalDA->new(
		cols   => [$JC, $COL_A, $COL_C],
		rows   => [
			{ entry => 'K1', name => 'Alice', tier => 'gold'   },
			{ entry => 'K2', name => 'Bob',   tier => 'silver' },
		],
		schema  => {
			entry => { type => 'TEXT',    nullable => 0, default => undef, pk => 1 },
			name  => { type => 'TEXT',    nullable => 1, default => undef, pk => 0 },
			tier  => { type => 'TEXT',    nullable => 1, default => undef, pk => 0 },
		},
		updated => $TS_OLD,
	);
	my $db_b = MinimalDA->new(
		cols   => [$JC, $COL_B],
		rows   => [
			{ entry => 'K1', score => 95 },
			{ entry => 'K2', score => 70 },
		],