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 )