view release on metacpan or  search on metacpan

t/domain.t  view on Meta::CPAN

#!/usr/bin/perl

# Domain tests for Database::Join using Equivalence Partitioning (EP) and
# Boundary Value Analysis (BVA).  Each parameter's valid and invalid partitions
# are tested with representative values; exact boundary edges are exercised
# wherever a numerical range, array size, or string length applies.

use strict;
use warnings;

use Test::Most tests => 202;
use Readonly;
use Scalar::Util qw(blessed);
use File::Spec;

use_ok('Database::Join');

# ---------------------------------------------------------------------------
# Inline test double: configurable in-memory Database::Abstraction subclass.
# Supports equality filtering and operator hashrefs (>, <, >=, <=, !=).
# ---------------------------------------------------------------------------
{
	package DomainDA;
	use parent -norequire, 'Database::Abstraction';

	Readonly::Scalar my $UPDATED => '2026-01-01';

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

	sub columns { return $_[0]->{cols} }
	sub schema  { return $_[0]->{schema} }
	sub updated { return $_[0]->{updated} }

	sub selectall_arrayref {
		my ($self, $criteria) = @_;
		$criteria //= {};
		my @results;
		ROW: for my $row (@{ $self->{rows} }) {
			for my $col (keys %{$criteria}) {
				my $val = $criteria->{$col};
				if (ref $val eq 'HASH') {
					for my $op (keys %{$val}) {
						my $rhs = $val->{$op};
						if    ($op eq '>')  { next ROW unless defined $row->{$col} && $row->{$col} >  $rhs }
						elsif ($op eq '<')  { next ROW unless defined $row->{$col} && $row->{$col} <  $rhs }
						elsif ($op eq '>=') { next ROW unless defined $row->{$col} && $row->{$col} >= $rhs }
						elsif ($op eq '<=') { next ROW unless defined $row->{$col} && $row->{$col} <= $rhs }
						elsif ($op eq '!=') { next ROW unless defined $row->{$col} && $row->{$col} != $rhs }
					}
				} elsif (!defined $val) {
					next ROW if defined $row->{$col};
				} else {
					next ROW unless defined $row->{$col} && $row->{$col} eq $val;
				}
			}
			push @results, { %{$row} };
		}
		return \@results;
	}

	sub DESTROY {}
}

# ---------------------------------------------------------------------------
# Wrong-class sentinel: blessed but not a Database::Abstraction subclass.
# ---------------------------------------------------------------------------
{
	package WrongClass;
	sub new { return bless {}, shift }
}

# ---------------------------------------------------------------------------
# DomainCountDA: subclass of DomainDA that defines count() directly in its
# own package stash.  Required for the 'auto' threshold probe in _sqlite_join,
# which checks `defined &{"${pkg}::count"}` and rejects inherited methods.
# Without this, the probe cannot obtain a row count and falls back to the
# array path regardless of max_array_rows, defeating threshold domain tests.
# ---------------------------------------------------------------------------
{
	package DomainCountDA;
	use parent -norequire, 'DomainDA';
	# count() is defined here (not inherited) so the auto-threshold check finds it.
	sub count { return scalar @{ $_[0]->{rows} } }
}

# ---------------------------------------------------------------------------
# Constants — no magic strings in test bodies.
# ---------------------------------------------------------------------------

Readonly::Scalar my $JC => 'entry';

Readonly::Scalar my $LONG_COLNAME => 'x' x 255;	# 255-char boundary for join_column length