view release on metacpan or  search on metacpan

t/integration.t  view on Meta::CPAN

	my $j = Database::Join->new(
		databases => [$cust, $score], join_column => $JC, join_type => 'left',
		filters   => { 1 => { score => { '>' => 60 } } },
	);
	is($j->count(), 2,
		'filter on secondary DB excludes Carol (score=55 fails score>60)');
};

subtest 'filter: two operator hashrefs on same column combine with AND semantics' => sub {
	plan tests => 1;
	# Base filter: score > 60.  Query: score < 80.  AND: 60 < score < 80.
	# Bob (70) qualifies; Alice (95) fails < 80; Carol (55) fails the base.
	my $j = Database::Join->new(
		databases => [$cust, $score], join_column => $JC, join_type => 'left',
		filters   => { 1 => { score => { '>' => 60 } } },
	);
	my $rows = $j->selectall_arrayref(score => { '<' => 80 });
	is(scalar @{$rows}, 1,
		'AND-merged operator hashrefs: only Bob (60 < 70 < 80) survives both constraints');
};

subtest 'filter: scalar query criterion replaces base operator filter for that column' => sub {
	plan tests => 1;
	# Base filter: score > 80 (excludes Bob=70, Carol=55).
	# Query: score = 70 (plain scalar).  Scalar wins, so Bob IS returned.
	my $j = Database::Join->new(
		databases => [$cust, $score], join_column => $JC, join_type => 'left',
		filters   => { 1 => { score => { '>' => 80 } } },
	);
	my $rows = $j->selectall_arrayref(score => 70);
	is(scalar @{$rows}, 1,
		'scalar query criterion replaces base filter operator (Bob score=70 returned)');
};

subtest 'filter: add_database filter option is equivalent to constructor filters' => sub {
	plan tests => 1;
	my $via_ctor = Database::Join->new(
		databases => [$cust, $score], join_column => $JC,
		filters   => { 1 => { score => { '>' => 60 } } },
	);
	my $via_add = Database::Join->new(databases => [$cust], join_column => $JC);
	$via_add->add_database($score, filter => { score => { '>' => 60 } });
	is($via_add->count(), $via_ctor->count(),
		'add_database filter option produces the same row count as constructor filters');
};

subtest 'filter: primary-database filter constrains the primary key set' => sub {
	plan tests => 1;
	# Filtering DB 0 (intcust) to tier=gold limits the key set to Alice and Carol.
	my $j = Database::Join->new(
		databases => [$cust, $score], join_column => $JC, join_type => 'left',
		filters   => { 0 => { tier => 'gold' } },
	);
	is($j->count(), $GOLD_COUNT,
		'primary-DB filter restricts key set to gold-tier customers only');
};

diag('section 5 done') if $ENV{TEST_VERBOSE};

# ===========================================================================
# SECTION 6 -- Column removal cascade (5 subtests)
#
# remove_column must propagate to columns(), schema(), result rows, and the
# routing table.  Criteria targeting a removed column are silently carp()ed
# and dropped.  The join_column itself cannot be removed.
# ===========================================================================

subtest 'remove_column: column absent from columns(), schema(), and query results' => sub {
	plan tests => 3;
	my $j = Database::Join->new(databases => [$cust, $score], join_column => $JC);
	$j->remove_column('email');
	ok(!grep({ $_ eq 'email' } @{ $j->columns() }),
		'email absent from columns() after remove_column');
	ok(!exists $j->schema()->{email},
		'email absent from schema() after remove_column');
	my $rows = $j->selectall_arrayref();
	ok(!exists $rows->[0]{email},
		'email absent from result row after remove_column');
};

subtest 'remove_column: criterion on removed column dropped with carp warning' => sub {
	plan tests => 2;
	my $j = Database::Join->new(databases => [$cust, $score], join_column => $JC);
	$j->remove_column('email');
	my @warnings;
	local $SIG{__WARN__} = sub { push @warnings, @_ };
	my $rows = $j->selectall_arrayref(email => 'alice@example.com');
	is(scalar @{$rows}, $ALL_CUST,
		'all rows returned when criterion targets a removed column');
	ok(@warnings,
		'carp warning emitted when criterion targets a removed column');
};

subtest 'remove_column: cannot remove the join_column' => sub {
	plan tests => 1;
	my $j = Database::Join->new(databases => [$cust, $score], join_column => $JC);
	throws_ok { $j->remove_column($JC) }
		qr/Cannot remove join_column/,
		'remove_column() croaks when asked to remove the join key';
};

subtest 'remove_column: chaining removes multiple columns in one expression' => sub {
	plan tests => 2;
	my $j = Database::Join->new(databases => [$cust, $score], join_column => $JC);
	$j->remove_column('email')->remove_column('age_days');
	ok(!grep({ $_ eq 'email'    } @{ $j->columns() }), 'email removed by chaining');
	ok(!grep({ $_ eq 'age_days' } @{ $j->columns() }), 'age_days removed by chaining');
};

subtest 'remove_column: idempotent and safe for non-existent column names' => sub {
	plan tests => 2;
	my $j = Database::Join->new(databases => [$cust, $score], join_column => $JC);
	lives_ok { $j->remove_column('email'); $j->remove_column('email') }
		'removing the same column twice does not croak';
	lives_ok { $j->remove_column('no_such_column') }
		'removing a non-existent column does not croak';
};

diag('section 6 done') if $ENV{TEST_VERBOSE};

# ===========================================================================