view release on metacpan or  search on metacpan

t/unit.t  view on Meta::CPAN

	'rc:nonexistent_safe'        => 1,

	# query / execute messages
	'query:croak_unsupported'    => 1,
	'execute:croak_unsupported'  => 1,

	# AUTOLOAD states
	'al:destroy_silently'        => 1,
	'al:private_croak'           => 1,
	'al:unknown_col_croak'       => 1,
	'al:scalar_context'          => 1,
	'al:list_context'            => 1,
	'al:direct_delegate'         => 1,
	'al:full_join_join_map'      => 1,
	'al:full_join_filters'       => 1,

	# Join-type semantics
	'jt:left_primary_defines'    => 1,
	'jt:left_secondary_fills'    => 1,
	'jt:inner_shared_only'       => 1,
	'jt:outer_all_keys'          => 1,
	'jt:criteria_inner_override' => 1,

	# filters semantics
	'filt:inner_partner'         => 1,
	'filt:criteria_merge_and'    => 1,
	'filt:scalar_replaces_base'  => 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;

# ---------------------------------------------------------------------------
# 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 {}
}

# ---------------------------------------------------------------------------
# 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 },
		],
		schema  => {
			entry => { type => 'TEXT',    nullable => 0, default => undef, pk => 1 },
			score => { type => 'INTEGER', nullable => 1, default => undef, pk => 0 },
		},
		updated => $TS_NEW,
	);
	return Database::Join->new(
		databases   => [$db_a, $db_b],
		join_column => $JC,
		%opts,
	);
}