view release on metacpan or  search on metacpan

t/aggregate.t  view on Meta::CPAN

#!/usr/bin/perl
use strict;
use warnings;

# t/aggregate.t — Tests for Database::Join::aggregate()
# Exercises both 'array' and 'sqlite' backends against the same fixture,
# validates error conditions, and confirms the two backends agree (§10.3).

use Test::Most;
use Test::Exception;
use Test::Warn;

use_ok('Database::Join');

# ---------------------------------------------------------------------------
# Inline MinimalDA stub — same pattern as t/function.t
# ---------------------------------------------------------------------------
{
	package MinimalDA;
	use parent -norequire, 'Database::Abstraction';
	sub new {
		my ($class, %args) = @_;
		return bless {
			_cols   => $args{cols}   // [],
			_rows   => $args{rows}   // [],
			_schema => $args{schema} // {},
			id      => $args{id}     // $args{cols}[0],
		}, $class;
	}
	sub columns { return $_[0]->{_cols} }
	sub schema  { return $_[0]->{_schema} }
	sub updated { return undef }
	sub selectall_arrayref {
		my ($self, $criteria) = @_;
		$criteria //= {};
		my @result;
		ROW: for my $row (@{ $self->{_rows} }) {
			for my $col (keys %{$criteria}) {
				my $want = $criteria->{$col};
				my $got  = $row->{$col};
				if (ref($want) eq 'HASH') {
					for my $op (keys %{$want}) {
						my $v = $want->{$op};
						if    ($op eq '=')  { next ROW unless defined $got && $got eq $v }
						elsif ($op eq '!=') { next ROW if     defined $got && $got eq $v }
						elsif ($op eq '>')  { next ROW unless defined $got && $got > $v  }
						elsif ($op eq '<')  { next ROW unless defined $got && $got < $v  }
						elsif ($op eq '>=') { next ROW unless defined $got && $got >= $v }
						elsif ($op eq '<=') { next ROW unless defined $got && $got <= $v }
					}
				} elsif (!defined $want) {
					next ROW if defined $got;
				} else {
					next ROW unless defined $got && $got eq $want;
				}
			}
			push @result, { %{$row} };
		}
		return \@result;
	}
	sub count { scalar @{ $_[0]->{_rows} } }
}

# ---------------------------------------------------------------------------
# §10.1 Fixture:
#   Source A: id, name, tier, region
#   Source B: id, score, region   (collision_prefix => {1=>'b'})
#   Join: left, join_column => 'id'
#   k4 absent from B; k5 absent from A (outer) or present (left with k4 only missing)
# ---------------------------------------------------------------------------
my @rows_a = (
	{ id => 'k1', name => 'Alice', tier => 'gold',   region => 'East' },
	{ id => 'k2', name => 'Bob',   tier => 'silver',  region => 'West' },
	{ id => 'k3', name => 'Carol', tier => 'bronze',  region => 'East' },
	{ id => 'k4', name => 'Dave',  tier => 'gold',    region => 'West' },
	{ id => 'k5', name => 'Eve',   tier => 'silver',  region => 'East' },
);

my @rows_b = (
	{ id => 'k1', score => 95, region => 'North' },
	{ id => 'k2', score => 72, region => 'South' },
	{ id => 'k3', score => 88, region => 'North' },
	{ id => 'k5', score => 61, region => 'South' },
	# k4 intentionally absent
);

sub make_join {
	my (%opts) = @_;
	my $jt = delete $opts{join_type} // 'left';
	my $be = delete $opts{backend}   // 'sqlite';
	my $da = MinimalDA->new(cols => [qw(id name tier region)], rows => \@rows_a, id => 'id');
	my $db = MinimalDA->new(cols => [qw(id score region)],     rows => \@rows_b, id => 'id');