Database-BI

 view release on metacpan or  search on metacpan

t/transaction.t  view on Meta::CPAN

subtest 'Transaction 6: Filter state machine' => sub {
	# ------------------------------------------------------------------
	# State S0: no filter.
	# ------------------------------------------------------------------
	$t->get_ok('/export?l=table:sales&format=csv')
		->status_is(200)
		->content_type_like(qr{text/csv});

	is count_csv_rows($t->tx->res->body), $SALES_ROWS,
		'S0 (no filter): all sales rows present';

	# ------------------------------------------------------------------
	# State S1: region = North.
	# ------------------------------------------------------------------
	$t->get_ok('/export?l=table:sales&format=csv&f=region:eq:North')
		->status_is(200);

	is count_csv_rows($t->tx->res->body), $NORTH_ROWS,
		'S1 (region=North): correct North row count';

	# ------------------------------------------------------------------
	# State S2: region = North AND amount > 1000.
	# ------------------------------------------------------------------
	$t->get_ok('/export?l=table:sales&format=csv&f=region:eq:North&f=amount:gt:1500')
		->status_is(200);

	is count_csv_rows($t->tx->res->body), $NORTH_GT1500,
		'S2 (North AND amount>1000): exactly one row';

	# ------------------------------------------------------------------
	# Back to S1: remove the amount filter (region=North only).
	# ------------------------------------------------------------------
	$t->get_ok('/export?l=table:sales&format=csv&f=region:eq:North')
		->status_is(200);

	is count_csv_rows($t->tx->res->body), $NORTH_ROWS,
		'S1 (return): removing amount filter restores North count';

	# ------------------------------------------------------------------
	# Back to S0: remove all filters.
	# ------------------------------------------------------------------
	$t->get_ok('/export?l=table:sales&format=csv')
		->status_is(200);

	is count_csv_rows($t->tx->res->body), $SALES_ROWS,
		'S0 (return): removing all filters restores full row count';

	# ------------------------------------------------------------------
	# Commutativity: S2 with reversed filter order must give the same count.
	# ------------------------------------------------------------------
	$t->get_ok('/export?l=table:sales&format=csv&f=amount:gt:1500&f=region:eq:North')
		->status_is(200);

	is count_csv_rows($t->tx->res->body), $NORTH_GT1500,
		'Commutativity: reversed filter order produces same S2 count';
};

# ======================================================================
# TRANSACTION 7: Columns API -> Join coordination
#
# The columns_api endpoint feeds the join panel UI with column names.
# This transaction verifies that:
#   Phase 1  GET /api/columns?table=sales  -> columns list
#   Phase 2  The "region" column from the API can serve as a join key
#   Phase 3  GET /join using that key -> merged result
#   Phase 4  Column count in result is correct
# ======================================================================

subtest 'Transaction 7: Columns API -> join coordination' => sub {
	# ------------------------------------------------------------------
	# Phase 1: fetch columns for the sales table.
	# ------------------------------------------------------------------
	$t->get_ok('/api/columns?table=sales')
		->status_is(200)
		->content_type_like(qr{application/json});

	my $cols_json = decode_json($t->tx->res->body);
	ok defined $cols_json->{columns}, 'Phase 1: response has "columns" key';
	my @cols = @{ $cols_json->{columns} };
	ok scalar @cols == $SALES_COLS, 'Phase 1: correct number of columns returned';

	# ------------------------------------------------------------------
	# Phase 2: verify a key column is present in the API response.
	# We will use "region" to join with a hand-crafted right table.
	# ------------------------------------------------------------------
	ok scalar(grep { $_ eq 'region' } @cols), 'Phase 2: "region" column reported by API';

	# ------------------------------------------------------------------
	# Phase 3: create a right table keyed on "region" and perform the join.
	# ------------------------------------------------------------------
	my $tmpdir     = tempdir(CLEANUP => 1);
	my $right_file = Mojo::File->new($tmpdir)->child('regionmap.csv');
	$right_file->spurt("region,zone_code\nNorth,N\nSouth,S\nEast,E\nWest,W\n");

	my $lspec = 'table:sales';
	my $rspec = 'path:' . $right_file->to_string;
	my $jspec = $rspec . '|region|region';

	$t->get_ok('/join?l=' . url_escape($lspec) . '&j=' . url_escape($jspec))
		->status_is(200);

	# ------------------------------------------------------------------
	# Phase 4: merged result has left columns + right non-key columns.
	# left = 6 (id,product,region,sales_rep,amount,sale_date)
	# right non-key = 1 (zone_code)  -> merged total = 7
	# ------------------------------------------------------------------
	my $right_extra_cols = 1;	# zone_code only (region is the join key, dropped)
	my $expected_merged  = $SALES_COLS + $right_extra_cols;

	$t->get_ok(
		'/export?format=csv' .
		'&l=' . url_escape($lspec) .
		'&j=' . url_escape($jspec)
	)->status_is(200);

	is count_csv_cols($t->tx->res->body), $expected_merged,
		'Phase 4: merged CSV has left + right non-key columns';

	# Phase 5: /api/columns accepts the unified "spec=table:name" format
	# used by the join/graph pipeline, so JS can pass l= values directly.
	$t->get_ok('/api/columns?spec=table:sales')

t/transaction.t  view on Meta::CPAN

	is count_csv_rows($t->tx->res->body), $EAST_ROWS,
		'Phase 5: exported CSV has exactly the East-region rows';
};

# ======================================================================
# TRANSACTION 10: Concurrent DataSource objects do not interfere
#
# Instantiates two independent DataSource objects against different
# files and verifies that their state (table name, columns, records)
# remains isolated -- no cross-contamination from shared class-level
# state in Database::Abstraction.
# ======================================================================

subtest 'Transaction 10: Concurrent DataSource isolation' => sub {
	require Database::BI::Model::DataSource;

	my $tmpdir = tempdir(CLEANUP => 1);

	# Create two distinct CSV files with overlapping column names.
	my $alpha_file = Mojo::File->new($tmpdir)->child('alpha.csv');
	my $beta_file  = Mojo::File->new($tmpdir)->child('beta.csv');
	$alpha_file->spurt("id,value\n1,AAA\n2,BBB\n");
	$beta_file->spurt("id,value\n10,XXX\n20,YYY\n30,ZZZ\n");

	my $ds_alpha = Database::BI::Model::DataSource->new(
		directory => $tmpdir,
		table     => 'alpha',
	);
	my $ds_beta = Database::BI::Model::DataSource->new(
		directory => $tmpdir,
		table     => 'beta',
	);

	isa_ok $ds_alpha, 'Database::BI::Model::DataSource', 'alpha DataSource is correct class';
	isa_ok $ds_beta,  'Database::BI::Model::DataSource', 'beta DataSource is correct class';

	is $ds_alpha->table_name, 'alpha', 'alpha: table_name is isolated';
	is $ds_beta->table_name,  'beta',  'beta: table_name is isolated';

	my $alpha_recs = $ds_alpha->fetch_all;
	my $beta_recs  = $ds_beta->fetch_all;

	ok defined $alpha_recs, 'alpha: fetch_all returns data';
	ok defined $beta_recs,  'beta: fetch_all returns data';

	is scalar @$alpha_recs, 2,
		'alpha: 2 rows fetched (not contaminated by beta)';
	is scalar @$beta_recs, 3,
		'beta: 3 rows fetched (not contaminated by alpha)';

	# Verify alpha records do not contain beta values and vice versa.
	ok !(grep { ($_->{value} // '') =~ /^X/ } @$alpha_recs),
		'alpha: records contain no XXX values from beta';
	ok !(grep { ($_->{value} // '') =~ /^A/ } @$beta_recs),
		'beta: records contain no AAA values from alpha';
};

# ======================================================================
# TRANSACTION 11: Combine data lifecycle (cats + dogs)
#
# Verifies the /combine endpoint stacks rows from two heterogeneous files
# into a single unified view with the union of all columns.
#
# cats.csv columns: Species,Name,Color,Breed,Eye Color,Environment
# dogs.csv columns: Species,Name,Color,Breed,Eye Color,Sex,Fixed
# combined columns: Species,Name,Color,Breed,Eye Color,Environment,Sex,Fixed
#
# State invariant:
#   combined_rows  = cat_rows  + dog_rows
#   combined_cols  = union(cat_cols, dog_cols) = 8
#   cat rows have blank Sex,Fixed; dog rows have blank Environment
# ======================================================================

Readonly my $CATS_CSV	=> $t->app->home->child('data/cats.csv')->to_string;
Readonly my $DOGS_CSV	=> $t->app->home->child('data/dogs.csv')->to_string;
Readonly my $CAT_ROWS	=> 12;	# 12 data rows in cats.csv
Readonly my $DOG_ROWS	=> 12;	# 12 data rows in dogs.csv
Readonly my $CAT_COLS	=> 6;	# Species,Name,Color,Breed,Eye Color,Environment
Readonly my $DOG_COLS	=> 7;	# Species,Name,Color,Breed,Eye Color,Sex,Fixed
Readonly my $COMBINED_ROWS => $CAT_ROWS + $DOG_ROWS;
Readonly my $COMBINED_COLS => 8;	# union of cat and dog columns

subtest 'Transaction 11: combine cats + dogs lifecycle' => sub {
	SKIP: {
		skip 'data/cats.csv not found', 1 unless -f $CATS_CSV;
		skip 'data/dogs.csv not found', 1 unless -f $DOGS_CSV;

		# Phase 1: GET /combine with cats as left, dogs as right-combine source.
		my $cat_spec = 'table:cats';
		my $dog_spec = 'table:dogs';
		$t->get_ok('/combine?l=' . url_escape($cat_spec) . '&c=' . url_escape($dog_spec))
			->status_is(200)
			->content_like(qr/Species/,	'combined view contains Species column')
			->content_like(qr/Environment/,	'combined view contains Environment (cats-only column)')
			->content_like(qr/Sex/,		'combined view contains Sex (dogs-only column)')
			->content_like(qr/Fixed/,	'combined view contains Fixed (dogs-only column)');

		# Phase 2: Export the combined view as CSV and verify row and column counts.
		my $export_url = '/export?l=' . url_escape($cat_spec)
			. '&c=' . url_escape($dog_spec)
			. '&format=csv';
		$t->get_ok($export_url)->status_is(200);
		my $body = $t->tx->res->body;
		is count_csv_rows($body), $COMBINED_ROWS,
			'combined CSV has cat_rows + dog_rows rows';
		is count_csv_cols($body), $COMBINED_COLS,
			'combined CSV has 8 columns (union of cat and dog schemas)';

		# Phase 3: Filter the combined view -- only cats (Species eq Cat).
		$t->get_ok('/combine?l=' . url_escape($cat_spec)
				. '&c=' . url_escape($dog_spec)
				. '&f=Species:eq:Cat')
			->status_is(200)
			->content_like(qr/Cat/, 'filtered combined view contains Cat rows');
		my $filtered_body = $t->tx->res->body;
		# The filtered page should not show any Dog rows.
		unlike $filtered_body, qr/Rover/, 'no dog row (Rover) in cat-filtered view';

		# Phase 4: Idempotency -- combining in the same order produces the same result.
		$t->get_ok('/combine?l=' . url_escape($cat_spec) . '&c=' . url_escape($dog_spec))
			->status_is(200)

t/transaction.t  view on Meta::CPAN

	# to match the filename stem (e.g. obituaries.sql must contain a table called
	# "obituaries").  The fix probes sqlite_master and auto-selects the first
	# user table via a temporary symlink.
	SKIP: {
		eval { DBI->install_driver('SQLite') }
			or skip 'DBD::SQLite not available', 9;

		plan tests => 9;

		my $dir = tempdir(CLEANUP => 1);

		# Phase 1: create a SQLite file whose internal table name ("deceased")
		# does NOT match the filename stem ("obituaries").
		my $db_path = Mojo::File->new($dir)->child('obituaries.sql')->to_string;
		{
			my $dbh = DBI->connect("dbi:SQLite:dbname=$db_path", undef, undef,
				{ RaiseError => 1, PrintError => 0 });
			$dbh->do('CREATE TABLE deceased (name TEXT, date TEXT)');
			$dbh->do(q{INSERT INTO deceased VALUES ('Alice Smith', '2024-01-15')});
			$dbh->do(q{INSERT INTO deceased VALUES ('Bob Jones', '2024-03-22')});
			$dbh->disconnect;
		}
		ok(-f $db_path, 'Phase 1: SQLite file with mismatched table name exists');

		# Phase 2: /open must return 200 -- the old code would get
		# "no such table: obituaries" and render an error page.
		$t->get_ok('/open?path=' . url_escape($db_path))
		  ->status_is(200, 'Phase 2: /open returns 200 despite table/filename mismatch');

		# Phase 3: no error paragraph in the response.
		# Note: "Could not open file." also appears as a JS string in the drag-
		# and-drop handler on every page, so we match against the error <p> tag.
		$t->content_unlike(qr/no such table/i,
			'Phase 3: no "no such table" error rendered');
		$t->content_unlike(qr/class="error"/,
			'Phase 3: no error paragraph rendered');

		# Phase 4: data from the "deceased" table is visible in the page.
		$t->content_like(qr/Alice Smith/, 'Phase 4a: first row name visible');
		$t->content_like(qr/Bob Jones/,   'Phase 4b: second row name visible');

		# Phase 5: idempotency -- a second request hits the cached data.
		$t->get_ok('/open?path=' . url_escape($db_path))
		  ->status_is(200, 'Phase 5: second /open also succeeds (idempotent)');
	}
};

# ======================================================================
# TRANSACTION 32: Database::Join backend => 'auto' in the join pipeline
#
# Dashboard.pm passes backend => 'auto' to every Database::Join->new()
# call (added in 0.008.0).  For datasets larger than max_array_rows
# (default 10,000 combined rows) Database::Join spills to a temporary
# SQLite file; smaller datasets use the existing in-memory array path.
#
# Phase 1   Create left/right CSV fixtures in tempdir
# Phase 2   Database::Join backend => 'array' (control group)
# Phase 3   Database::Join backend => 'sqlite' (SQLite disk-spill path)
# Phase 4   Results from Phases 2 and 3 are identical (sorted by row)
# Phase 5   columns() output identical on both backends
# Phase 6   GET /join endpoint returns 200 with merged data
#           (backend => 'auto' is active via Dashboard.pm)
# Phase 7   Source-code guard: Dashboard.pm passes backend => 'auto'
#           in exactly 2 Database::Join->new() call sites
# ======================================================================

subtest 'Transaction 32 -- Database::Join backend => auto in join pipeline' => sub {
	my $has_dj = eval { require Database::Join; 1 };

	SKIP: {
		skip 'Database::Join not available', 9 unless $has_dj;

		require Database::BI::Model::DataSource;

		my $dir = tempdir(CLEANUP => 1);

		# ------------------------------------------------------------------
		# Phase 1: write the shared join fixtures to a tempdir.
		# ------------------------------------------------------------------
		my $left_file  = Mojo::File->new($dir)->child('t32left.csv');
		my $right_file = Mojo::File->new($dir)->child('t32right.csv');
		$left_file->spurt($JOIN_LEFT);
		$right_file->spurt($JOIN_RIGHT);
		ok(-f $left_file->to_string,  'Phase 1a: left CSV fixture exists');		# 1
		ok(-f $right_file->to_string, 'Phase 1b: right CSV fixture exists');	# 2

		my $make_src = sub {
			my ($table) = @_;
			Database::BI::Model::DataSource->new(directory => $dir, table => $table);
		};

		# ------------------------------------------------------------------
		# Phase 2: array backend -- control group for result identity check.
		# ------------------------------------------------------------------
		my $join_array = Database::Join->new(
			databases   => [$make_src->('t32left'), $make_src->('t32right')],
			join_column => 'item',
			backend     => 'array',
		);
		my $rows_array = $join_array->selectall_arrayref;
		ok(ref $rows_array eq 'ARRAY' && @$rows_array == $JOIN_TOTAL_ROWS,
			'Phase 2: array backend returns correct row count');			# 3

		# ------------------------------------------------------------------
		# Phase 3-5: sqlite backend -- available in Database::Join >= 0.004.0.
		# Guard with eval; if the parameter is unrecognised, skip gracefully.
		# ------------------------------------------------------------------
		my $join_sqlite = eval {
			Database::Join->new(
				databases   => [$make_src->('t32left'), $make_src->('t32right')],
				join_column => 'item',
				backend     => 'sqlite',
			)
		};
		SKIP: {
			skip 'Database::Join sqlite backend not available (need >= 0.004.0)', 3
				if $@ || !$join_sqlite;

			my $rows_sqlite = $join_sqlite->selectall_arrayref;
			ok(ref $rows_sqlite eq 'ARRAY' && @$rows_sqlite == $JOIN_TOTAL_ROWS,
				'Phase 3: sqlite backend returns correct row count');		# 4



( run in 0.626 second using v1.01-cache-2.11-cpan-16aabcbfbcb )