view release on metacpan or  search on metacpan

t/transaction.t  view on Meta::CPAN

	# Phase 7 can verify it is forwarded from the user@host path component.
	my $captured_sftp_user;

	{
		no strict 'refs';
		no warnings 'redefine';
		*{'Net::SFTP::Foreign::new'} = sub {
			my ($class, $host, %opts) = @_;
			return undef unless defined $host && $host eq 'mockhost';
			$captured_sftp_user = $opts{user};
			return bless { _stub_host => $host }, $class;
		};
		*{'Net::SFTP::Foreign::error'} = sub { '' };
		*{'Net::SFTP::Foreign::get'}   = sub {
			my ($self, $remote, $local) = @_;
			# Serve the CSV body for both the .csv and .log filenames so we
			# can test that _sniff_data_ext renames the .log to .csv correctly.
			return unless $remote =~ m{remote_sales\.(?:csv|log)$};
			open(my $fh, '>', $local) or return;
			print {$fh} $CSV_BODY;
			close $fh;
		};
	}

	# Phase 1: path-traversal attempt outside the /../ prefix is rejected.
	$t->get_ok('/open?path=/' . url_escape('.') . '/../../etc/passwd')
	  ->status_is(404, 'Phase 1: path-traversal outside /../ notation rejected');

	# Phase 2: remote path whose file is not found on the mock host gives 404.
	$t->get_ok('/open?path=' . url_escape('/../mockhost/tmp/file.php'))
	  ->status_is(404, 'Phase 2: file not found on remote host gives 404');

	# Phase 3: well-formed remote path with standard .csv extension opens correctly.
	my $remote_path = '/../mockhost/tmp/remote_sales.csv';
	$t->get_ok('/open?path=' . url_escape($remote_path))
	  ->status_is(200, 'Phase 3: /../hostname/dir/file.csv returns 200')
	  ->content_like(qr/Widget/, 'Phase 3: first data row visible')
	  ->content_like(qr/Gadget/, 'Phase 3: second data row visible')
	  ->content_like(qr/product/i, 'Phase 3: column header "product" present');

	# Phase 4: spec-based access via _open_spec (used by join, combine, graph).
	$t->get_ok('/api/columns?spec=' . url_escape('path:' . $remote_path))
	  ->status_is(200, 'Phase 4: columns API resolves remote path spec')
	  ->json_has('/columns', 'Phase 4: columns key present in JSON response');

	# Phase 5: idempotency -- second request returns same columns.
	$t->get_ok('/api/columns?spec=' . url_escape('path:' . $remote_path))
	  ->status_is(200, 'Phase 5: second columns request is idempotent')
	  ->json_has('/columns', 'Phase 5: columns key still present');

	# Phase 6: non-standard extension (.log) -- _sniff_data_ext renames to .csv.
	# The stub serves the same CSV body for .log; DataSource must detect the
	# comma-separated content and open it correctly without a "Can't find a
	# file" error.
	my $log_path = '/../mockhost/tmp/remote_sales.log';
	$t->get_ok('/open?path=' . url_escape($log_path))
	  ->status_is(200, 'Phase 6: non-standard .log extension opens via content sniffing')
	  ->content_like(qr/Widget/, 'Phase 6: first data row visible after sniff rename')
	  ->content_like(qr/product/i, 'Phase 6: column header present after sniff rename');

	# Phase 7: user@hostname syntax passes credentials to Net::SFTP::Foreign.
	# DataSource splits "testuser@mockhost" into user="testuser", host="mockhost"
	# and forwards user => $user to Net::SFTP::Foreign->new.
	$captured_sftp_user = undef;
	my $user_path = '/../testuser@mockhost/tmp/remote_sales.csv';
	$t->get_ok('/open?path=' . url_escape($user_path))
	  ->status_is(200, 'Phase 7: user@hostname syntax opens correctly')
	  ->content_like(qr/Widget/, 'Phase 7: data visible with user@hostname path');
	is($captured_sftp_user, 'testuser',
		'Phase 7: username extracted from user@hostname and forwarded to Net::SFTP::Foreign');

	# Tear down: restore original Net::SFTP::Foreign methods.
	{
		no strict 'refs';
		no warnings 'redefine';
		*{'Net::SFTP::Foreign::new'}   = $orig_new   if $orig_new;
		*{'Net::SFTP::Foreign::error'} = $orig_error if $orig_error;
		*{'Net::SFTP::Foreign::get'}   = $orig_get   if $orig_get;
	}
};

subtest 'Transaction 40 -- Bar chart lifecycle' => sub {
	plan tests => 37;

	my $dir = tempdir(CLEANUP => 1);
	my $csv = Mojo::File->new($dir)->child('bardata.csv')->to_string;
	Mojo::File->new($csv)->spurt(
		"tester,result,score\n"
		. "Alice,pass,95\n"
		. "Bob,fail,42\n"
		. "Alice,pass,88\n"
		. "Carol,pass,76\n"
		. "Bob,pass,61\n"
	);

	my $base = '/bar?l=' . url_escape("path:$csv");

	# Phase 1: count mode (no val param) -- count rows per category.
	$t->get_ok($base . '&cat=tester')
	  ->status_is(200, 'Phase 1: /bar count mode returns 200');
	$t->content_like(qr/id="bar_chart"/,  'Phase 1: bar_chart SVG element present');
	$t->content_like(qr/Count by tester/, 'Phase 1: title reflects count mode');

	# Phase 2: value mode -- sum score per tester.
	$t->get_ok($base . '&cat=tester&val=score')
	  ->status_is(200, 'Phase 2: /bar value mode returns 200');
	$t->content_like(qr/id="bar_chart"/,  'Phase 2: bar_chart SVG element present');
	$t->content_like(qr/score by tester/, 'Phase 2: title reflects value mode');

	# Phase 3: missing required cat param returns 400.
	$t->get_ok('/bar?l=' . url_escape("path:$csv"))
	  ->status_is(400, 'Phase 3: missing cat param returns 400');

	# Phase 4: non-existent column returns 400.
	$t->get_ok($base . '&cat=no_such_col')
	  ->status_is(400, 'Phase 4: non-existent cat column returns 400');

	# Phase 5: horizontal orientation.
	$t->get_ok($base . '&cat=tester&orient=h')
	  ->status_is(200, 'Phase 5: horizontal orientation returns 200');
	$t->content_like(qr/id="bar_chart"/, 'Phase 5: bar chart SVG present in horizontal mode');