view release on metacpan or  search on metacpan

t/transaction.t  view on Meta::CPAN

#!/usr/bin/perl

# Transaction-flow tests for Database::Join.
# Tests walk entities through complete lifecycle phases, verify state
# consistency at every boundary, test mid-flight failure and recovery,
# and assert idempotency across repeated state transitions.

use strict;
use warnings;

use Test::Most tests => 87;
use Readonly;
use Scalar::Util qw(refaddr);
use Carp qw(croak);

use_ok('Database::Join');	# T1

# ---------------------------------------------------------------------------
# Inline component DA — configurable rows, fail-on-demand for mid-flight tests
# ---------------------------------------------------------------------------
{
	package TransactionDA;
	use parent -norequire, 'Database::Abstraction';
	use Carp qw(croak);

	sub new {
		my ($class, %args) = @_;
		return bless {
			cols    => $args{cols}    // ['entry'],
			rows    => $args{rows}    // [],
			id      => $args{id}      // 'entry',
			schema  => $args{schema}  // {},
			updated => $args{updated} // 1,
			_fail   => $args{fail}    // 0,
			_calls  => 0,
			_logger => undef,
		}, $class;
	}

	sub columns    { return $_[0]->{cols} }
	sub schema     { return $_[0]->{schema} }
	sub updated    { return $_[0]->{updated} }
	sub set_logger { $_[0]->{_logger} = $_[1]; return $_[0] }
	sub get_logger { return $_[0]->{_logger} }
	sub call_count { return $_[0]->{_calls} }
	sub set_fail   { $_[0]->{_fail} = $_[1]; return $_[0] }
	sub reset_calls { $_[0]->{_calls} = 0; return $_[0] }

	sub selectall_arrayref {
		my ($self, $criteria) = @_;
		$self->{_calls}++;
		croak 'TransactionDA: simulated mid-flight failure' if $self->{_fail};
		$criteria //= {};
		my @out;
		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 @out, { %{$row} };
		}
		return \@out;
	}

	sub DESTROY {}
}

# ---------------------------------------------------------------------------
# Inline mock logger — records calls and carries an identity string
# ---------------------------------------------------------------------------
{
	package MockLogger;
	sub new  { bless { id => $_[1] }, shift }
	sub debug {}
	sub info  {}
	sub id    { return $_[0]->{id} }
}

# ---------------------------------------------------------------------------
# Readonly constants for row fixtures and key values
# ---------------------------------------------------------------------------
Readonly::Scalar my $K1 => 'k1';
Readonly::Scalar my $K2 => 'k2';
Readonly::Scalar my $K3 => 'k3';

Readonly::Hash my %ALICE => ( entry => $K1, name => 'Alice' );
Readonly::Hash my %BOB   => ( entry => $K2, name => 'Bob'   );

Readonly::Scalar my $SCORE_HIGH => 90;