view release on metacpan or  search on metacpan

t/transaction.t  view on Meta::CPAN

	$t->post_ok('/upload',
		{ 'Content-Type' => 'multipart/form-data' },
		form => { file => { content => $csv_a, filename => 'cache_a.csv' } },
	)->status_is(200);
	my $res_a = decode_json($t->tx->res->body);
	ok defined $res_a->{path}, 'Phase 1a: first upload returned a path';

	$t->post_ok('/upload',
		{ 'Content-Type' => 'multipart/form-data' },
		form => { file => { content => $csv_b, filename => 'cache_b.csv' } },
	)->status_is(200);
	my $res_b = decode_json($t->tx->res->body);
	ok defined $res_b->{path}, 'Phase 1b: second upload returned a path';

	# Phase 2: first clear — must recover exactly the two Phase 1 uploads.
	$t->post_ok('/uploads/clear')->status_is(200);
	my $clear1 = decode_json($t->tx->res->body);
	ok defined $clear1->{freed}, 'Phase 2: response contains "freed"';
	ok defined $clear1->{count}, 'Phase 2: response contains "count"';
	is $clear1->{count}, 2,
		'Phase 2: exactly two files freed (one per upload)';
	cmp_ok $clear1->{freed}, '>', 0,
		'Phase 2: freed bytes > 0 after clearing non-empty cache';

	# Phase 3: second clear — cache empty, both values must be zero.
	$t->post_ok('/uploads/clear')->status_is(200);
	my $clear2 = decode_json($t->tx->res->body);
	is $clear2->{freed}, 0, 'Phase 3: idempotent clear returns freed=0';
	is $clear2->{count}, 0, 'Phase 3: idempotent clear returns count=0';
};

# ======================================================================
# TRANSACTION 17: Per-request CGI::Info/CGI::Lingua detection regression
#
# Verifies that platform/language detection does not break page rendering
# when unusual User-Agent or Accept-Language values are present, and that
# the server gracefully falls back to the configured defaults when no
# matching template directory exists for the detected value.
#
#   Phase 1  Mobile UA + no mobile/ templates  -> 200, falls back to web/en
#   Phase 2  Desktop UA                        -> 200, normal web/en render
#   Phase 3  Accept-Language: fr (no fr/ dir)  -> 200, falls back to en
#   Phase 4  Accept-Language: en               -> 200, en render
#   Phase 5  Accept-Language absent            -> 200, en render (early return)
# ======================================================================

subtest 'Transaction 17: Per-request CGI::Info/CGI::Lingua detection regression' => sub {
	SKIP: {
		skip 'data/sales.csv not found', 1 unless -f $SALES_CSV;

		Readonly my $MOBILE_UA  => 'Mozilla/5.0 (iPhone; CPU iPhone OS 17_0 like Mac OS X) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/17.0 Mobile/15E148 Safari/604.1';
		Readonly my $DESKTOP_UA => 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/125.0.0.0 Safari/537.36';

		# Phase 1: mobile UA — no templates/mobile/ dir, so falls back to web/en.
		$t->get_ok('/view/sales',
			{ 'User-Agent' => $MOBILE_UA })->status_is(200,
				'Phase 1: mobile UA returns 200 (falls back to web/en templates)');
		$t->content_like(qr/sales|product|region/,
			'Phase 1: data table rendered despite mobile UA');

		# Phase 2: standard desktop UA — normal web/en render.
		$t->get_ok('/view/sales',
			{ 'User-Agent' => $DESKTOP_UA })->status_is(200,
				'Phase 2: desktop UA returns 200');
		$t->content_like(qr/sales|product|region/,
			'Phase 2: data table rendered with desktop UA');

		# Phase 3: Accept-Language: fr — no templates/web/fr/, falls back to en.
		$t->get_ok('/view/sales',
			{ 'Accept-Language' => 'fr-FR,fr;q=0.9,en;q=0.8' })->status_is(200,
				'Phase 3: fr Accept-Language returns 200 (falls back to en)');
		$t->content_like(qr/sales|product|region/,
			'Phase 3: data table rendered with fr Accept-Language (en fallback)');

		# Phase 4: Accept-Language: en — standard path, no fallback needed.
		$t->get_ok('/view/sales',
			{ 'Accept-Language' => 'en-US,en;q=0.9' })->status_is(200,
				'Phase 4: en Accept-Language returns 200');

		# Phase 5: No Accept-Language header at all — early return to default.
		my $tx = $t->ua->build_tx(GET => '/view/sales');
		$tx->req->headers->remove('Accept-Language');
		$t->request_ok($tx)->status_is(200,
			'Phase 5: absent Accept-Language returns 200 (early return in _resolve_language)');
		$t->content_like(qr/sales|product|region/,
			'Phase 5: data table rendered when Accept-Language header is absent');
	}
};

subtest 'Transaction 18: Mixed-case upload filename opens correctly' => sub {
	# Regression test covering two bugs found when opening a real bank CSV:
	#
	# Bug 1 (case): controller lowercased the filename stem to "accounthistory",
	#   but the file on disk is "AccountHistory.csv" — not found on case-sensitive
	#   Linux.  Fix: preserve original case when opening by absolute path.
	#
	# Bug 2 (id column): the CSV header had "Account Number,Post Date,Check,..."
	#   where the first safe-identifier column ("Check") is always empty.
	#   Database::Abstraction uses empty_is_undef => 1, so every row had
	#   undef in the id column and was filtered out — only rows where "Check"
	#   actually had a value (written cheques) survived.  Fix: _detect_file_info
	#   now reads the first data row and picks the first safe column that has a
	#   non-empty value there ("Description" in the bank-export case).

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

	# Reproduce bug 2: first safe-identifier column ("ref") is always empty;
	# second safe column ("description") is always populated.
	my $csv_path = "$dir/AccountHistory.csv";
	Mojo::File->new($csv_path)->spurt(
		"Account Number,ref,description,amount\n" .
		"XX1234,,Coffee shop,4.50\n" .
		"XX1234,,Supermarket,23.10\n" .
		"XX1234,,Online transfer,100.00\n"
	);

	my $encoded = url_escape($csv_path);

	$t->get_ok("/open?path=$encoded")
		->status_is(200, 'Phase 1: /open succeeds for mixed-case filename with spaced first column')
		->content_like(qr/AccountHistory|description/i,
			'Phase 2: page mentions table or a column name')
		->content_like(qr/Coffee shop/,
			'Phase 3: first row rendered (ref-is-empty row not filtered out)')
		->content_like(qr/Supermarket/,
			'Phase 4: second row rendered')