view release on metacpan or  search on metacpan

t/function.t  view on Meta::CPAN

# Subtest: _i18n -- message lookup with and without sprintf args
#
# _i18n does not use $self internally (it only reads %MESSAGES, which is
# lexically scoped to the Dashboard package), so we call it as a direct
# function with a dummy $self to avoid OO dispatch via the generic
# Mojolicious::Controller base returned by build_controller.
# ---------------------------------------------------------------------------

Readonly my $DASH => 'Database::BI::Controller::Dashboard';

subtest 'Dashboard::_i18n -- known key returns formatted string' => sub {
	# Direct package call bypasses OO dispatch (Sub::Private stash cleanup
	# does not affect direct calls resolved at compile time in test mode).
	my $msg = "${DASH}"->can('_i18n')
		? $DASH->can('_i18n')->(undef, 'error_table_invalid', 'bad!table')
		: do { Database::BI::Controller::Dashboard::_i18n(undef, 'error_table_invalid', 'bad!table') };
	like $msg, qr/bad!table/, '_i18n interpolates sprintf arg';
	unlike $msg, qr/Internal error/, '_i18n does not trigger fallback for known key';
};

subtest 'Dashboard::_i18n -- unknown key returns fallback' => sub {
	my $msg = Database::BI::Controller::Dashboard::_i18n(undef, 'totally_nonexistent_key_xyz');
	like $msg, qr/Internal error.*totally_nonexistent_key_xyz/,
		'_i18n returns descriptive fallback for unknown key';
};

# ---------------------------------------------------------------------------
# Subtest: _resolve_language -- Accept-Language parsing
#
# Build a controller with a custom transaction so we can set the
# Accept-Language header.  Called as a direct package function because
# build_controller returns Mojolicious::Controller (the base class), not
# our Dashboard subclass, and :Private OO dispatch would fail in production.
# ---------------------------------------------------------------------------
subtest 'Dashboard::_resolve_language -- uses config default when no header' => sub {
	my $tx = $t->ua->build_tx(GET => '/');
	$tx->req->headers->remove('Accept-Language');
	my $c = $t->app->build_controller($tx);
	my $lang = Database::BI::Controller::Dashboard::_resolve_language($c, 'web', 'en');
	is $lang, 'en', 'falls back to config default when Accept-Language absent';
};

subtest 'Dashboard::_resolve_language -- valid header parsed, falls back when no templates' => sub {
	my $tx = $t->ua->build_tx(GET => '/');
	# 'fr' has no template directory in this installation; should fall back to 'en'.
	$tx->req->headers->header('Accept-Language' => 'fr-FR,fr;q=0.9,en;q=0.8');
	my $c    = $t->app->build_controller($tx);
	my $lang = Database::BI::Controller::Dashboard::_resolve_language($c, 'web', 'en');
	ok $lang eq 'fr' || $lang eq 'en',
		"resolved language is 'fr' or 'en' (fallback when no fr templates)";
};

subtest 'Dashboard::_resolve_language -- garbage header falls back to default' => sub {
	my $tx = $t->ua->build_tx(GET => '/');
	$tx->req->headers->header('Accept-Language' => ';;; junk ;;;');
	my $c    = $t->app->build_controller($tx);
	my $lang = Database::BI::Controller::Dashboard::_resolve_language($c, 'web', 'en');
	is $lang, 'en', 'garbage Accept-Language header falls back to default';
};

subtest 'Dashboard::_detect_platform -- desktop UA -> web' => sub {
	my $platform = Database::BI::Controller::Dashboard::_detect_platform(
		'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36', 'web');
	is $platform, 'web', 'desktop UA maps to web platform';
};

subtest 'Dashboard::_detect_platform -- mobile UA -> mobile' => sub {
	my $platform = Database::BI::Controller::Dashboard::_detect_platform(
		'Mozilla/5.0 (iPhone; CPU iPhone OS 17_0 like Mac OS X) AppleWebKit/605.1.15', 'web');
	is $platform, 'mobile', 'iPhone UA maps to mobile platform';
};

subtest 'Dashboard::_detect_platform -- empty UA -> fallback' => sub {
	my $platform = Database::BI::Controller::Dashboard::_detect_platform('', 'web');
	is $platform, 'web', 'empty UA returns fallback';
};

# ---------------------------------------------------------------------------
# Subtest: _spec_to_url -- spec-to-URL mapping
#
# _spec_to_url uses only url_escape() and regex matches on $spec, not $self,
# so it is safe to call as a package function with undef.
# ---------------------------------------------------------------------------
subtest 'Dashboard::_spec_to_url -- table spec' => sub {
	is Database::BI::Controller::Dashboard::_spec_to_url(undef, 'table:sales'),
		'/view/sales',
		'table: spec maps to /view/<name>';
};

subtest 'Dashboard::_spec_to_url -- path spec' => sub {
	my $url = Database::BI::Controller::Dashboard::_spec_to_url(undef, 'path:/tmp/data.csv');
	like $url, qr{^/open\?path=},  'path: spec maps to /open?path=...';
	like $url, qr{%2F|/},          'path is URL-encoded in spec-to-url output';
};

subtest 'Dashboard::_spec_to_url -- url spec' => sub {
	my $url = Database::BI::Controller::Dashboard::_spec_to_url(
		undef, 'url:http://example.com/data.html');
	like $url, qr{^/import\?url=}, 'url: spec maps to /import?url=...';
};

subtest 'Dashboard::_spec_to_url -- unknown spec falls back to /' => sub {
	is Database::BI::Controller::Dashboard::_spec_to_url(undef, 'garbage'),
		'/',
		'unrecognised spec falls back to /';
};

# ---------------------------------------------------------------------------
# Subtest: _write_sqlite_db -- produces a valid SQLite binary
# ---------------------------------------------------------------------------
subtest 'Dashboard::_write_sqlite_db -- creates valid SQLite blob' => sub {
	SKIP: {
		eval { require DBI; DBI->install_driver('SQLite') }
			or skip 'DBD::SQLite not available', 3;

		# _write_sqlite_db uses $self only for tempdir (via File::Temp) and DBI.
		# Pass undef -- the helper does not invoke any Mojo controller methods.
		my $records = [{ name => 'Alice', score => '95' }];
		my $columns = [qw(name score)];

		my $blob = eval {
			Database::BI::Controller::Dashboard::_write_sqlite_db(undef, $records, $columns)
		};
		is $@, '', '_write_sqlite_db does not throw';