view release on metacpan or  search on metacpan

t/distinct-mandatory.t  view on Meta::CPAN

use strict;
use warnings;

use Test::More;
use Test::Exception;

BEGIN {
	eval { require DBD::SQLite; require Database::Abstraction };
	plan skip_all => 'DBD::SQLite and Database::Abstraction required' if $@;
	plan tests => 45;
}

use lib 't/lib';
use DBI;
use File::Temp qw(tempdir);
use Database::Join;

# ---------------------------------------------------------------------------
# Inline minimal DAs (no file fixtures needed)
# ---------------------------------------------------------------------------

package MinimalDA;
use parent -norequire, 'Database::Abstraction';
sub new {
	my ($class, %args) = @_;
	return bless { _cols => $args{cols}, _rows => $args{rows} }, $class;
}
sub columns { return $_[0]->{_cols} }
sub schema  { return {} }
sub updated { return undef }
sub set_logger { return $_[0] }
sub selectall_arrayref {
	my ($self, $crit) = @_;
	$crit //= {};
	my @rows = @{ $self->{_rows} };
	for my $col (keys %{$crit}) {
		my $val = $crit->{$col};
		if (!ref $val) {
			@rows = grep { defined $_->{$col} && $_->{$col} eq $val } @rows;
		} elsif (ref $val eq 'HASH') {
			for my $op (keys %{$val}) {
				my $v = $val->{$op};
				if    ($op eq '=')  { @rows = grep { defined $_->{$col} && $_->{$col} eq  $v } @rows }
				elsif ($op eq '!=') { @rows = grep { defined $_->{$col} && $_->{$col} ne  $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 }
			}
		}
	}
	return \@rows;
}

package main;

# ---------------------------------------------------------------------------
# Fixtures
#
#   left:   entry | region | tier
#     r1     West   gold
#     r2     East   silver
#     r3     West   silver
#     r4     East   gold
#     r5     West   bronze
#
#   right:  entry | score
#     r1      90
#     r2      70
#     r3      85
#     r4      60
#     r5      50
# ---------------------------------------------------------------------------

my $left = MinimalDA->new(
	cols => [qw(entry region tier)],
	rows => [
		{ entry => 'r1', region => 'West', tier => 'gold'   },
		{ entry => 'r2', region => 'East', tier => 'silver' },
		{ entry => 'r3', region => 'West', tier => 'silver' },
		{ entry => 'r4', region => 'East', tier => 'gold'   },
		{ entry => 'r5', region => 'West', tier => 'bronze' },
	],
);

my $right = MinimalDA->new(
	cols => [qw(entry score)],
	rows => [
		{ entry => 'r1', score => 90 },
		{ entry => 'r2', score => 70 },