Developer-Dashboard
view release on metacpan or search on metacpan
t/05-cli-smoke.t view on Meta::CPAN
last if ( $status->{last_success} || 0 ) && $first_stdout =~ /^\d+\.\d+\n$/;
sleep 0.25;
}
like( $first_stdout, qr/^\d+\.\d+\n$/, 'dashboard serve starts configured interval collectors so collector output begins changing without a separate restart' );
my $restart_json = json_decode( _run_in_home( $serve_home, "$perl -I'$lib' '$dashboard' restart -o json --host 127.0.0.1 --port $serve_port" ) );
ok( $restart_json->{web_pid}, 'dashboard restart still returns a managed web pid in the collector lifecycle smoke test' );
ok( kill( 0, $restart_json->{web_pid} ), 'dashboard restart reports a live managed web pid in the collector lifecycle smoke test' );
my $serve_ua = LWP::UserAgent->new( timeout => 5 );
my $serve_health_response;
for ( 1 .. _startup_probe_attempts() ) {
$serve_health_response = $serve_ua->get("http://127.0.0.1:$serve_port/");
last if $serve_health_response->code;
sleep 0.25;
}
ok( $serve_health_response && $serve_health_response->code, 'dashboard restart leaves the collector lifecycle web listener reachable on the restarted port' );
my $second_stdout = '';
for ( 1 .. 160 ) {
my $output = json_decode( _run_in_home( $serve_home, "$perl -I'$lib' '$dashboard' collector output tick.collector" ) );
$second_stdout = $output->{stdout} || '';
last if $second_stdout =~ /^\d+\.\d+\n$/ && $second_stdout ne $first_stdout;
sleep 0.25;
}
unlike( $second_stdout, qr/^\Q$first_stdout\E$/, 'dashboard restart restarts collector loops and refreshes collector output after the serve-started run' );
my $serve_stop = json_decode( _run_in_home( $serve_home, "$perl -I'$lib' '$dashboard' stop -o json" ) );
ok( ref( $serve_stop->{collectors} ) eq 'ARRAY', 'dashboard stop still returns the collector stop list after serve/restart lifecycle control' );
my $serve_stop_response = $serve_ua->get("http://127.0.0.1:$serve_port/");
ok( !$serve_stop_response->is_success, 'dashboard stop actually tears down the restarted collector lifecycle web listener' );
}
if ( !$UNDER_COVER ) {
my $readonly_home = tempdir( CLEANUP => 1 );
local $ENV{HOME} = $readonly_home;
local $ENV{DEVELOPER_DASHBOARD_BOOKMARKS};
local $ENV{DEVELOPER_DASHBOARD_CONFIGS};
local $ENV{DEVELOPER_DASHBOARD_CHECKERS};
my $readonly_init = _run_in_home( $readonly_home, "$perl -I'$lib' '$dashboard' init" );
like( $readonly_init, qr/runtime_root/, 'isolated no-editor smoke home initializes a runtime' );
my $readonly_source = _run_in_home( $readonly_home, "$perl -I'$lib' '$dashboard' page new readonly 'Read Only'" );
my $readonly_source_file = File::Spec->catfile( $readonly_home, 'readonly.page' );
open my $readonly_source_fh, '>:raw', $readonly_source_file or die "Unable to write $readonly_source_file: $!";
print {$readonly_source_fh} $readonly_source;
close $readonly_source_fh;
_run_in_home( $readonly_home, "$perl -I'$lib' '$dashboard' page save readonly < '$readonly_source_file'" );
my $readonly_port = _find_free_port();
my $readonly_serve = json_decode( _run_in_home( $readonly_home, "$perl -I'$lib' '$dashboard' serve --host 127.0.0.1 --port $readonly_port --no-endit" ) );
ok( $readonly_serve->{pid}, 'dashboard serve --no-endit starts the managed web service' );
my $readonly_ua = LWP::UserAgent->new( timeout => 5 );
my $readonly_ready_response;
for ( 1 .. 240 ) {
$readonly_ready_response = $readonly_ua->get("http://127.0.0.1:$readonly_port/system/status");
last if $readonly_ready_response->is_success;
sleep 0.25;
}
ok( $readonly_ready_response && $readonly_ready_response->is_success, 'no-editor live server exposes the system status route before route assertions begin' );
my $render_response;
for ( 1 .. 240 ) {
$render_response = $readonly_ua->get("http://127.0.0.1:$readonly_port/app/readonly");
last if $render_response->is_success;
sleep 0.25;
}
ok( $render_response && $render_response->is_success, 'no-editor live server serves saved page render routes' );
my $render_body = decode( 'UTF-8', $render_response->decoded_content );
unlike( $render_body, qr/id="share-url"/, 'no-editor live server hides the share link from render views' );
unlike( $render_body, qr/id="view-source-url"/, 'no-editor live server hides the view-source link from render views' );
unlike( $render_body, qr/id="play-url"/, 'no-editor live server hides the play link from render views' );
my $edit_response;
for ( 1 .. 240 ) {
$edit_response = $readonly_ua->get("http://127.0.0.1:$readonly_port/app/readonly/edit");
last if $edit_response->code == 403;
sleep 0.25;
}
is( $edit_response->code, 403, 'no-editor live server blocks direct bookmark editor routes' );
my $edit_post_response;
for ( 1 .. 240 ) {
$edit_post_response = $readonly_ua->post(
"http://127.0.0.1:$readonly_port/app/readonly/edit",
{ instruction => "TITLE: Changed\n:--------------------------------------------------------------------------------:\nBOOKMARK: readonly\n:--------------------------------------------------------------------------------:\nHTML: changed\n"...
);
last if $edit_post_response->code == 403;
sleep 0.25;
}
is( $edit_post_response->code, 403, 'no-editor live server blocks bookmark editor post saves' );
my $readonly_config_file = File::Spec->catfile( $readonly_home, '.developer-dashboard', 'config', 'config.json' );
open my $readonly_config_fh, '<', $readonly_config_file or die "Unable to read $readonly_config_file: $!";
my $readonly_config = do { local $/; <$readonly_config_fh> };
close $readonly_config_fh;
like( $readonly_config, qr/"web"\s*:\s*\{[\s\S]*"no_editor"\s*:\s*1/s, 'dashboard serve --no-endit persists no_editor in config' );
my $readonly_restart = json_decode( _run_in_home( $readonly_home, "$perl -I'$lib' '$dashboard' restart -o json --host 127.0.0.1 --port $readonly_port" ) );
ok( $readonly_restart->{web_pid}, 'dashboard restart keeps managing the no-editor web service' );
for ( 1 .. _startup_probe_attempts() ) {
my $ready_response = $readonly_ua->get("http://127.0.0.1:$readonly_port/app/readonly");
last if $ready_response->is_success;
sleep 0.25;
}
my $source_response = $readonly_ua->get("http://127.0.0.1:$readonly_port/app/readonly/source");
is( $source_response->code, 403, 'dashboard restart preserves the saved no-editor source block' );
my $readonly_stop = json_decode( _run_in_home( $readonly_home, "$perl -I'$lib' '$dashboard' stop -o json" ) );
ok( ref( $readonly_stop->{collectors} ) eq 'ARRAY', 'dashboard stop still works after a no-editor lifecycle run' );
}
if ( !$UNDER_COVER ) {
my $noind_home = tempdir( CLEANUP => 1 );
local $ENV{HOME} = $noind_home;
local $ENV{DEVELOPER_DASHBOARD_BOOKMARKS};
local $ENV{DEVELOPER_DASHBOARD_CONFIGS};
local $ENV{DEVELOPER_DASHBOARD_CHECKERS};
my $noind_init = _run_in_home( $noind_home, "$perl -I'$lib' '$dashboard' init" );
like( $noind_init, qr/runtime_root/, 'isolated no-indicators smoke home initializes a runtime' );
my $noind_source = _run_in_home( $noind_home, "$perl -I'$lib' '$dashboard' page new noind 'No Indicators'" );
my $noind_source_file = File::Spec->catfile( $noind_home, 'noind.page' );
open my $noind_source_fh, '>:raw', $noind_source_file or die "Unable to write $noind_source_file: $!";
print {$noind_source_fh} $noind_source;
close $noind_source_fh;
_run_in_home( $noind_home, "$perl -I'$lib' '$dashboard' page save noind < '$noind_source_file'" );
my $noind_port = _find_free_port();
my $noind_serve = json_decode( _run_in_home( $noind_home, "$perl -I'$lib' '$dashboard' serve --host 127.0.0.1 --port $noind_port --no-indicator" ) );
ok( $noind_serve->{pid}, 'dashboard serve --no-indicator starts the managed web service' );
my $noind_ua = LWP::UserAgent->new( timeout => 5 );
my $noind_ready_response;
for ( 1 .. 240 ) {
$noind_ready_response = $noind_ua->get("http://127.0.0.1:$noind_port/system/status");
last if $noind_ready_response->is_success;
sleep 0.25;
}
ok( $noind_ready_response && $noind_ready_response->is_success, 'no-indicators live server exposes the system status route before route assertions begin' );
my $noind_render_response;
for ( 1 .. 240 ) {
$noind_render_response = $noind_ua->get("http://127.0.0.1:$noind_port/app/noind");
last if $noind_render_response->is_success;
sleep 0.25;
}
ok( $noind_render_response && $noind_render_response->is_success, 'no-indicators live server serves saved page render routes' );
my $noind_render_body = decode( 'UTF-8', $noind_render_response->decoded_content );
unlike( $noind_render_body, qr/id="status-on-top"/, 'no-indicators live server hides the top-right indicator strip' );
unlike( $noind_render_body, qr/id="status-datetime"/, 'no-indicators live server hides the top-right date-time marker' );
unlike( $noind_render_body, qr/id="status-server"/, 'no-indicators live server hides the top-right server marker' );
unlike( $noind_render_body, qr/class="user-name-and-icon"/, 'no-indicators live server hides the top-right user marker' );
my $noind_status_response;
for ( 1 .. 240 ) {
$noind_status_response = $noind_ua->get("http://127.0.0.1:$noind_port/system/status");
last if $noind_status_response->code == 200;
sleep 0.25;
}
is( $noind_status_response->code, 200, 'no-indicators live server keeps the status endpoint available' );
like( decode( 'UTF-8', $noind_status_response->decoded_content ), qr/"array"\s*:/, 'no-indicators live server still exposes status payload data' );
my $noind_ps1 = _run_in_home( $noind_home, "$perl -I'$lib' '$dashboard' ps1 --jobs 0" );
like( $noind_ps1, qr/\S/, 'no-indicators mode does not blank the terminal prompt output' );
my $noind_config_file = File::Spec->catfile( $noind_home, '.developer-dashboard', 'config', 'config.json' );
open my $noind_config_fh, '<', $noind_config_file or die "Unable to read $noind_config_file: $!";
my $noind_config = do { local $/; <$noind_config_fh> };
close $noind_config_fh;
like( $noind_config, qr/"web"\s*:\s*\{[\s\S]*"no_indicators"\s*:\s*1/s, 'dashboard serve --no-indicator persists no_indicators in config' );
my $noind_restart = json_decode( _run_in_home( $noind_home, "$perl -I'$lib' '$dashboard' restart -o json --host 127.0.0.1 --port $noind_port" ) );
ok( $noind_restart->{web_pid}, 'dashboard restart keeps managing the no-indicators web service' );
my $post_restart_render;
for ( 1 .. 240 ) {
$post_restart_render = $noind_ua->get("http://127.0.0.1:$noind_port/app/noind");
last if $post_restart_render->is_success;
sleep 0.25;
}
ok( $post_restart_render && $post_restart_render->is_success, 'no-indicators live server remains reachable after restart' );
my $post_restart_body = decode( 'UTF-8', $post_restart_render->decoded_content );
unlike( $post_restart_body, qr/id="status-on-top"/, 'dashboard restart preserves the no-indicators top-right strip removal' );
my $noind_stop = json_decode( _run_in_home( $noind_home, "$perl -I'$lib' '$dashboard' stop -o json" ) );
ok( ref( $noind_stop->{collectors} ) eq 'ARRAY', 'dashboard stop still works after a no-indicators lifecycle run' );
}
{
my $collector_log_home = tempdir( CLEANUP => 1 );
local $ENV{HOME} = $collector_log_home;
local $ENV{DEVELOPER_DASHBOARD_BOOKMARKS};
local $ENV{DEVELOPER_DASHBOARD_CONFIGS};
local $ENV{DEVELOPER_DASHBOARD_CHECKERS};
my $collector_init = _run_in_home( $collector_log_home, "$perl -I'$lib' '$dashboard' init" );
like( $collector_init, qr/runtime_root/, 'isolated collector-log smoke home initializes a runtime' );
my $collector_config_file = File::Spec->catfile( $collector_log_home, '.developer-dashboard', 'config', 'config.json' );
open my $collector_config_fh, '>:raw', $collector_config_file or die "Unable to write $collector_config_file: $!";
my $collector_config_json = json_encode(
{
collectors => [
{
name => 'cli.collector',
command => q{printf 'cli stdout\n'; printf 'cli stderr\n' >&2},
cwd => 'home',
},
{
name => 'pending.collector',
command => q{printf 'pending\n'},
cwd => 'home',
},
{
name => 'templated.collector',
command => q{printf '{"a":123}'},
cwd => 'home',
indicator => {
name => 'templated.indicator',
label => 'Templated',
icon => '[% a %]',
},
},
{
name => 'housekeeper',
interval => 30,
indicator => {
icon => 'HK',
},
},
{
name => 'rotating.collector',
command => q{printf 'rotate\n'},
cwd => 'home',
rotation => {
lines => 4,
},
},
],
}
);
$collector_config_json = encode( 'UTF-8', $collector_config_json ) if utf8::is_utf8($collector_config_json);
print {$collector_config_fh} $collector_config_json;
close $collector_config_fh;
my $collector_run = json_decode( _run_in_home( $collector_log_home, "$perl -I'$lib' '$dashboard' collector run cli.collector" ) );
t/05-cli-smoke.t view on Meta::CPAN
open my $fake_ticket_tmux_fh, '>', $fake_ticket_tmux or die "Unable to write $fake_ticket_tmux: $!";
print {$fake_ticket_tmux_fh} <<"SH";
#!/bin/sh
printf '%s\\n' "\$*" >> '$fake_ticket_log'
if [ "\$1" = "has-session" ]; then
if [ "\$3" = "DD-NEW" ]; then
exit 1
fi
exit 0
fi
if [ "\$1" = "show-options" ] && [ "\$3" = "status-format[0]" ]; then
printf '%s\n' '#[default]DEFAULT-ROW'
exit 0
fi
exit 0
SH
close $fake_ticket_tmux_fh;
chmod 0755, $fake_ticket_tmux or die "Unable to chmod $fake_ticket_tmux: $!";
my $ticket_output = _run("PATH='$fake_ticket_bin':\"\$PATH\" $perl -I'$lib' '$dashboard' workspace DD-NEW");
is( $ticket_output, '', 'dashboard workspace stays quiet on success while tmux handles the terminal attach' );
open my $fake_ticket_log_fh, '<', $fake_ticket_log or die "Unable to read $fake_ticket_log: $!";
my $fake_ticket_log_text = do { local $/; <$fake_ticket_log_fh> };
close $fake_ticket_log_fh;
like( $fake_ticket_log_text, qr/^has-session -t DD-NEW$/m, 'dashboard workspace checks whether the requested tmux session already exists' );
like( $fake_ticket_log_text, qr/^new-session -d .* -s DD-NEW -n Code1$/m, 'dashboard workspace creates a new tmux session when the workspace session is missing' );
like( $fake_ticket_log_text, qr/^show-options -gqv \@dd_ticket_status_default$/m, 'dashboard workspace checks whether tmux already recorded the default bottom-row status' );
like( $fake_ticket_log_text, qr/^show-options -gqv status-format\[0\]$/m, 'dashboard workspace snapshots the current global tmux bottom-row status before replacing it with the indicator row' );
like( $fake_ticket_log_text, qr/^set-option -gq status-position bottom$/m, 'dashboard workspace keeps the tmux status block anchored at the bottom' );
like( $fake_ticket_log_text, qr/^set-option -gq status 2$/m, 'dashboard workspace enables a two-line tmux status block for dashboard-managed workspace sessions' );
like( $fake_ticket_log_text, qr/^set-option -gq status-interval 15$/m, 'dashboard workspace refreshes the tmux status block automatically for dashboard-managed workspace sessions without hot-looping' );
like( $fake_ticket_log_text, qr/^set-option -gq status-format\[0\] #\('.*dashboard' ps1 --mode tmux-status-top --width #\{client_width\}\)$/m, 'dashboard workspace configures the first tmux status row to render dashboard indicators through the explic...
like( $fake_ticket_log_text, qr/^set-option -gq status-format\[1\] /m, 'dashboard workspace restores the normal tmux bottom-row status beneath the indicator strip' );
like( $fake_ticket_log_text, qr/^set-option -guq status-format\[2\]$/m, 'dashboard workspace clears any stale third tmux status row after configuring the workspace status block' );
like( $fake_ticket_log_text, qr/^attach-session -t DD-NEW$/m, 'dashboard workspace attaches to the requested tmux session' );
like( $fake_ticket_log_text, qr/WORKSPACE_REF=DD-NEW/, 'dashboard workspace seeds WORKSPACE_REF into new tmux sessions' );
like( $fake_ticket_log_text, qr/TICKET_REF=DD-NEW/, 'dashboard workspace keeps TICKET_REF seeded for compatibility with older tmux sessions' );
like( $fake_ticket_log_text, qr/DEVELOPER_DASHBOARD_TMUX_STATUS=1/, 'dashboard workspace seeds the tmux-status session flag into new tmux sessions so only dashboard-managed workspace sessions move indicators into the tmux status line' );
unlink $fake_ticket_log or die "Unable to unlink $fake_ticket_log: $!";
my $runtime_ticket_output = _run("PATH='$fake_ticket_bin':\"\$PATH\" $perl -I'$lib' '$runtime_workspace' DD-EXISTING");
is( $runtime_ticket_output, '', 'private runtime workspace helper stays quiet on success' );
open my $runtime_ticket_log_fh, '<', $fake_ticket_log or die "Unable to read $fake_ticket_log: $!";
my $runtime_ticket_log_text = do { local $/; <$runtime_ticket_log_fh> };
close $runtime_ticket_log_fh;
like( $runtime_ticket_log_text, qr/^has-session -t DD-EXISTING$/m, 'private runtime workspace helper checks the requested session' );
unlike( $runtime_ticket_log_text, qr/^new-session /m, 'private runtime workspace helper skips session creation when tmux reports it already exists' );
like( $runtime_ticket_log_text, qr/^set-option -gq status-format\[0\] #\('.*dashboard' ps1 --mode tmux-status-top --width #\{client_width\}\)$/m, 'private runtime workspace helper also reapplies the indicator tmux status row for existing workspace se...
like( $runtime_ticket_log_text, qr/^attach-session -t DD-EXISTING$/m, 'private runtime workspace helper attaches to existing sessions' );
my $json_value = _run(qq{printf '{"alpha":{"beta":2}}' | $perl -I'$lib' '$dashboard' jq alpha.beta});
is( $json_value, "2\n", 'jq extracts scalar JSON values' );
my $json_file = File::Spec->catfile( $open_root, 'sample.json' );
open my $json_fh, '>', $json_file or die "Unable to write $json_file: $!";
print {$json_fh} qq|{"alpha":{"beta":2}}|;
close $json_fh;
my $json_root = _run("$perl -I'$lib' '$dashboard' jq '\$d' '$json_file'");
is_deeply( json_decode($json_root), { alpha => { beta => 2 } }, 'jq accepts file then root query with order-independent args' );
my $json_root_stdin = _run("cat '$json_file' | $perl -I'$lib' '$dashboard' jq '\$d'");
is( $json_root_stdin, $json_root, 'jq returns the same whole-document result from stdin and file input' );
my $json_keys = _run(qq{printf '{"foo":[1,2,3,4],"bar":[4,5,6]}' | $perl -I'$lib' '$dashboard' jq 'sort keys %\$d'});
is_deeply( json_decode($json_keys), [ 'bar', 'foo' ], 'jq evaluates Perl expressions against decoded stdin data through $d' );
my $json_keys_file = _run("$perl -I'$lib' '$dashboard' jq '$json_file' 'sort' 'keys' '%\$d'");
is_deeply( json_decode($json_keys_file), ['alpha'], 'jq rejoins split expression argv pieces when the file path comes first' );
my $json_direct = _run(qq{printf '{"alpha":{"beta":2}}' | $perl -I'$lib' '$runtime_jq' alpha.beta});
is( $json_direct, $json_value, 'private runtime jq matches dashboard jq output' );
my $yaml_value = _run(qq{printf 'alpha:\\n beta: 3\\n' | $perl -I'$lib' '$dashboard' yq alpha.beta});
is( $yaml_value, "3\n", 'yq extracts scalar YAML values' );
my $yaml_file = File::Spec->catfile( $open_root, 'sample.yaml' );
open my $yaml_fh, '>', $yaml_file or die "Unable to write $yaml_file: $!";
print {$yaml_fh} "alpha:\n beta: 3\n";
close $yaml_fh;
my $yaml_root = _run("$perl -I'$lib' '$dashboard' yq '$yaml_file' '\$d'");
is_deeply( json_decode($yaml_root), { alpha => { beta => '3' } }, 'yq accepts file then root query with order-independent args' );
my $yaml_root_stdin = _run("cat '$yaml_file' | $perl -I'$lib' '$dashboard' yq '\$d'");
is( $yaml_root_stdin, $yaml_root, 'yq returns the same whole-document result from stdin and file input' );
my $yaml_keys = _run(qq{printf 'foo:\\n - 1\\nbar:\\n - 2\\n' | $perl -I'$lib' '$dashboard' yq 'sort keys %\$d'});
is_deeply( json_decode($yaml_keys), [ 'bar', 'foo' ], 'yq evaluates Perl expressions against decoded YAML data through $d' );
my $yaml_direct = _run(qq{printf 'alpha:\\n beta: 3\\n' | $perl -I'$lib' '$runtime_yq' alpha.beta});
is( $yaml_direct, $yaml_value, 'private runtime yq matches dashboard yq output' );
my $jq_hook_root = File::Spec->catdir( $ENV{HOME}, '.developer-dashboard', 'cli', 'jq.d' );
make_path($jq_hook_root);
my $jq_hook_one = File::Spec->catfile( $jq_hook_root, '00-first.pl' );
open my $jq_hook_one_fh, '>', $jq_hook_one or die "Unable to write $jq_hook_one: $!";
print {$jq_hook_one_fh} <<'PL';
#!/usr/bin/env perl
print "hook-one\n";
warn "hook-one-err\n";
PL
close $jq_hook_one_fh;
chmod 0755, $jq_hook_one or die "Unable to chmod $jq_hook_one: $!";
my $jq_hook_two = File::Spec->catfile( $jq_hook_root, '01-second.pl' );
my $jq_hook_result = File::Spec->catfile( $ENV{HOME}, 'jq-hook-result.txt' );
open my $jq_hook_two_fh, '>', $jq_hook_two or die "Unable to write $jq_hook_two: $!";
print {$jq_hook_two_fh} <<"PL";
#!/usr/bin/env perl
use strict;
use warnings;
use lib '$repo/lib';
use Developer::Dashboard::Runtime::Result;
open my \$fh, '>', '$jq_hook_result' or die \$!;
print {\$fh} Developer::Dashboard::Runtime::Result::stdout('00-first.pl');
close \$fh;
print "hook-two\n";
warn "hook-two-err\n";
PL
close $jq_hook_two_fh;
chmod 0755, $jq_hook_two or die "Unable to chmod $jq_hook_two: $!";
my $jq_hook_skipped = File::Spec->catfile( $jq_hook_root, 'data.file' );
open my $jq_hook_skipped_fh, '>', $jq_hook_skipped or die "Unable to write $jq_hook_skipped: $!";
print {$jq_hook_skipped_fh} "skip\n";
close $jq_hook_skipped_fh;
chmod 0600, $jq_hook_skipped or die "Unable to chmod $jq_hook_skipped: $!";
my ( $jq_hooked_stdout, $jq_hooked_stderr, $jq_hooked_exit ) = capture {
system 'sh', '-c', qq{printf '{"alpha":{"beta":2}}' | $perl -I'$lib' '$dashboard' jq alpha.beta};
return $? >> 8;
};
is( $jq_hooked_exit, 0, 'dashboard jq succeeds when command hook files exist' );
like( $jq_hooked_stdout, qr/^hook-one\n/s, 'dashboard jq streams hook stdout before the main command output' );
like( $jq_hooked_stdout, qr/hook-two\n2\n\z/s, 'dashboard jq keeps the main command output after streamed hook stdout' );
like( $jq_hooked_stderr, qr/hook-one-err\n/, 'dashboard jq streams hook stderr live' );
like( $jq_hooked_stderr, qr/hook-two-err\n/, 'dashboard jq keeps later hook stderr visible' );
my $jq_which = _run("$perl -I'$lib' '$dashboard' which jq");
like( $jq_which, qr/^COMMAND \Q$runtime_jq\E$/m, 'dashboard which jq reports the staged built-in helper path' );
like( $jq_which, qr/^HOOK \Q$jq_hook_one\E$/m, 'dashboard which jq lists the first participating hook file' );
like( $jq_which, qr/^HOOK \Q$jq_hook_two\E$/m, 'dashboard which jq lists the later participating hook file' );
my $which_editor_log = File::Spec->catfile( $ENV{HOME}, 'which-editor.log' );
my $which_editor = File::Spec->catfile( $ENV{HOME}, 'fake-editor' );
open my $which_editor_fh, '>', $which_editor or die "Unable to write $which_editor: $!";
print {$which_editor_fh} <<"SH";
#!/bin/sh
printf '%s\\n' "\$@" > '$which_editor_log'
SH
close $which_editor_fh;
chmod 0755, $which_editor or die "Unable to chmod $which_editor: $!";
my ( $jq_which_edit_stdout, $jq_which_edit_stderr, $jq_which_edit_exit ) = capture {
local $ENV{EDITOR} = $which_editor;
t/05-cli-smoke.t view on Meta::CPAN
close $stop_second_fh;
chmod 0755, $stop_second or die "Unable to chmod $stop_second: $!";
my $stop_third = File::Spec->catfile( $stop_hook_root, '02-never.pl' );
open my $stop_third_fh, '>', $stop_third or die "Unable to write $stop_third: $!";
print {$stop_third_fh} <<"PL";
#!/usr/bin/env perl
use strict;
use warnings;
open my \$fh, '>', '$stop_sentinel' or die \$!;
print {\$fh} "ran\\n";
close \$fh;
print "third-hook\\n";
PL
close $stop_third_fh;
chmod 0755, $stop_third or die "Unable to chmod $stop_third: $!";
my ( $stop_stdout, $stop_stderr, $stop_exit ) = capture {
system 'sh', '-c', "$perl -I'$lib' '$dashboard' hook-stop-check";
return $? >> 8;
};
is( $stop_exit, 0, 'dashboard returns to the main command after a hook emits the explicit stop marker' );
like( $stop_stdout, qr/^ABC\n/s, 'dashboard still streams stdout from hooks that ran before the stop marker' );
like( $stop_stdout, qr/stop-hook\n/s, 'dashboard still streams stdout from the hook that requested stop' );
unlike( $stop_stdout, qr/third-hook\n/s, 'dashboard skips later hook scripts after a stop marker appears on stderr' );
like( $stop_stderr, qr/\[\[STOP\]\] stop requested by 01-stop\.pl/, 'dashboard keeps the explicit stop marker visible on stderr' );
ok( !-e $stop_sentinel, 'dashboard does not execute later hook files once the stop marker is seen' );
open my $stop_probe_fh, '<', $stop_probe or die "Unable to read $stop_probe: $!";
my $stop_previous = json_decode( do { local $/; <$stop_probe_fh> } );
close $stop_probe_fh;
like( $stop_previous->{file}, qr/\Qhook-stop-check.d\E.*\Q00-first.pl\E\z/, 'Runtime::Result last_result exposes the previous hook file path inside the next hook' );
is( $stop_previous->{exit}, 0, 'Runtime::Result last_result exposes the previous hook exit code inside the next hook' );
is( $stop_previous->{STDOUT}, "ABC\n", 'Runtime::Result last_result exposes the previous hook stdout inside the next hook' );
is( $stop_previous->{STDERR}, '', 'Runtime::Result last_result exposes the previous hook stderr inside the next hook' );
my ($stop_result_json) = $stop_stdout =~ /__DD_RESULT_BEGIN__\n([\s\S]*?)\n__DD_RESULT_END__/;
ok( defined $stop_result_json && $stop_result_json ne '', 'main command receives RESULT after hook-stop execution' );
my $stop_result_data = json_decode($stop_result_json);
ok( exists $stop_result_data->{'00-first.pl'}, 'main command RESULT keeps the first hook entry' );
ok( exists $stop_result_data->{'01-stop.pl'}, 'main command RESULT keeps the stopping hook entry' );
ok( !exists $stop_result_data->{'02-never.pl'}, 'main command RESULT skips hooks after the explicit stop marker' );
my ($stop_last_json) = $stop_stdout =~ /__DD_LAST_RESULT_BEGIN__\n([\s\S]*?)\n__DD_LAST_RESULT_END__/;
ok( defined $stop_last_json && $stop_last_json ne '', 'main command receives LAST_RESULT after hook-stop execution' );
my $stop_last_data = json_decode($stop_last_json);
like( $stop_last_data->{file}, qr/\Qhook-stop-check.d\E.*\Q01-stop.pl\E\z/, 'main command LAST_RESULT points at the stopping hook file' );
is( $stop_last_data->{exit}, 0, 'main command LAST_RESULT keeps the stopping hook exit code' );
is( $stop_last_data->{STDOUT}, "stop-hook\n", 'main command LAST_RESULT keeps the stopping hook stdout' );
like( $stop_last_data->{STDERR}, qr/\[\[STOP\]\] stop requested by 01-stop\.pl/, 'main command LAST_RESULT keeps the stopping hook stderr' );
is( _run("$perl -I'$lib' '$dashboard' version"), "$expected_version\n", 'dashboard version prints the installed dashboard version' );
my $toml_value = _run(qq{printf '[alpha]\\nbeta = 4\\n' | $perl -I'$lib' '$dashboard' tomq alpha.beta});
is( $toml_value, "4\n", 'tomq extracts scalar TOML values' );
my $toml_file = File::Spec->catfile( $open_root, 'sample.toml' );
open my $toml_fh, '>', $toml_file or die "Unable to write $toml_file: $!";
print {$toml_fh} "[alpha]\nbeta = 4\n";
close $toml_fh;
my $toml_root = _run("$perl -I'$lib' '$dashboard' tomq '\$d' '$toml_file'");
is_deeply( json_decode($toml_root), { alpha => { beta => 4 } }, 'tomq accepts file then root query with order-independent args' );
my $toml_root_stdin = _run("cat '$toml_file' | $perl -I'$lib' '$dashboard' tomq '\$d'");
is( $toml_root_stdin, $toml_root, 'tomq returns the same whole-document result from stdin and file input' );
my $toml_keys = _run(qq{printf '[foo]\\na = 1\\n[bar]\\nb = 2\\n' | $perl -I'$lib' '$dashboard' tomq 'sort keys %\$d'});
is_deeply( json_decode($toml_keys), [ 'bar', 'foo' ], 'tomq evaluates Perl expressions against decoded TOML data through $d' );
my $toml_bool = _run(qq{printf 'enabled = true\\ndisabled = false\\n' | $perl -I'$lib' '$dashboard' tomq '\$d'});
is_deeply( json_decode($toml_bool), { disabled => 0, enabled => 1 }, 'tomq returns plain Perl scalar booleans instead of TOML backend objects' );
my $toml_direct = _run(qq{printf '[alpha]\\nbeta = 4\\n' | $perl -I'$lib' '$runtime_tomq' alpha.beta});
is( $toml_direct, $toml_value, 'private runtime tomq matches dashboard tomq output' );
my $props_value = _run(qq{printf 'alpha.beta=5\\nname = demo\\n' | $perl -I'$lib' '$dashboard' propq alpha.beta});
is( $props_value, "5\n", 'propq extracts scalar Java properties values' );
my $props_file = File::Spec->catfile( $open_root, 'sample.properties' );
open my $props_fh, '>', $props_file or die "Unable to write $props_file: $!";
print {$props_fh} "alpha.beta=5\nname = demo\n";
close $props_fh;
my $props_root = _run("$perl -I'$lib' '$dashboard' propq '$props_file' '\$d'");
is_deeply( json_decode($props_root), { 'alpha.beta' => '5', name => 'demo' }, 'propq accepts file then root query with order-independent args' );
my $props_root_stdin = _run("cat '$props_file' | $perl -I'$lib' '$dashboard' propq '\$d'");
is( $props_root_stdin, $props_root, 'propq returns the same whole-document result from stdin and file input' );
my $props_keys = _run(qq{printf 'foo=1\\nbar=2\\n' | $perl -I'$lib' '$dashboard' propq 'sort keys %\$d'});
is_deeply( json_decode($props_keys), [ 'bar', 'foo' ], 'propq evaluates Perl expressions against decoded properties data through $d' );
my $props_direct = _run(qq{printf 'alpha.beta=5\\nname = demo\\n' | $perl -I'$lib' '$runtime_propq' alpha.beta});
is( $props_direct, $props_value, 'private runtime propq matches dashboard propq output' );
my $ini_value = _run(qq{printf '[alpha]\\nbeta=6\\n' | $perl -I'$lib' '$dashboard' iniq alpha.beta});
is( $ini_value, "6\n", 'iniq extracts scalar INI values' );
my $ini_keys = _run(qq{printf '[foo]\\na=1\\n[bar]\\nb=2\\n' | $perl -I'$lib' '$dashboard' iniq 'sort keys %\$d'});
is_deeply( json_decode($ini_keys), [ '_global', 'bar', 'foo' ], 'iniq evaluates Perl expressions against decoded INI data through $d' );
my $ini_direct = _run(qq{printf '[alpha]\\nbeta=6\\n' | $perl -I'$lib' '$runtime_iniq' alpha.beta});
is( $ini_direct, $ini_value, 'private runtime iniq matches dashboard iniq output' );
my $csv_value = _run(qq{printf 'alpha,beta\\n7,8\\n' | $perl -I'$lib' '$dashboard' csvq 1.1});
is( $csv_value, "8\n", 'csvq extracts scalar CSV values by row and column index' );
my $csv_expression = _run(qq{printf 'alpha,beta\\n7,8\\n' | $perl -I'$lib' '$dashboard' csvq 'join q(-), map { \$d->[1][\$_] } 0 .. \$#{ \$d->[1] }'});
is( $csv_expression, "7-8\n", 'csvq evaluates Perl expressions against decoded CSV row arrays through $d' );
my $csv_direct = _run(qq{printf 'alpha,beta\\n7,8\\n' | $perl -I'$lib' '$runtime_csvq' 1.1});
is( $csv_direct, $csv_value, 'private runtime csvq matches dashboard csvq output' );
my $xml_file = File::Spec->catfile( $open_root, 'sample.xml' );
open my $xml_fh, '>', $xml_file or die "Unable to write $xml_file: $!";
print {$xml_fh} '<root><value>demo</value><item id="1">x</item><item id="2">y</item></root>';
close $xml_fh;
my $xml_value = _run(qq{printf '<root><value>demo</value><item id="1">x</item><item id="2">y</item></root>' | $perl -I'$lib' '$dashboard' xmlq root.value});
is( $xml_value, "demo\n", 'xmlq extracts scalar XML values from the decoded XML tree' );
my $xml_root = _run("$perl -I'$lib' '$dashboard' xmlq '\$d' '$xml_file'");
is_deeply(
json_decode($xml_root),
{
root => {
value => 'demo',
item => [
{ _attributes => { id => '1' }, _text => 'x' },
{ _attributes => { id => '2' }, _text => 'y' },
],
},
},
'xmlq returns the decoded XML tree for the whole-document selector',
);
my $xml_root_stdin = _run("cat '$xml_file' | $perl -I'$lib' '$dashboard' xmlq '\$d'");
is( $xml_root_stdin, $xml_root, 'xmlq returns the same decoded whole-document result from stdin and file input' );
my $xml_expression = _run(qq{printf '<root><value>demo</value><item id="1">x</item><item id="2">y</item></root>' | $perl -I'$lib' '$dashboard' xmlq 'join q(,), map { \$_->{_attributes}{id} } \@{ \$d->{root}{item} }'});
is( $xml_expression, "1,2\n", 'xmlq evaluates Perl expressions against decoded XML data through $d' );
my $xml_direct = _run(qq{printf '<root><value>demo</value><item id="1">x</item><item id="2">y</item></root>' | $perl -I'$lib' '$runtime_xmlq' root.value});
is( $xml_direct, $xml_value, 'private runtime xmlq matches dashboard xmlq output' );
my $cli_root = File::Spec->catdir( $ENV{HOME}, '.developer-dashboard', 'cli' );
make_path($cli_root);
my $ext = File::Spec->catfile( $cli_root, 'foobar' );
open my $ext_fh, '>', $ext or die "Unable to write $ext: $!";
print {$ext_fh} <<'SH';
#!/bin/sh
input="$(cat)"
printf 'argv:%s|stdin:%s\n' "$*" "$input"
SH
close $ext_fh;
chmod 0755, $ext or die "Unable to chmod $ext: $!";
my ( $ext_stdout, $ext_stderr, $ext_exit ) = capture {
open my $pipe, '|-', $perl, '-I' . $lib, $dashboard, 'foobar', 'one', 'two'
or die "Unable to exec dashboard extension: $!";
print {$pipe} "hello-extension";
close $pipe or die "dashboard extension failed: $!";
return $? >> 8;
};
is( $ext_exit, 0, 'user CLI extension exits successfully' );
is( $ext_stderr, '', 'user CLI extension keeps stderr clean' );
like( $ext_stdout, qr/^argv:one two\|stdin:hello-extension$/m, 'user CLI extension receives argv and stdin passthrough' );
SKIP: {
skip 'go command not available for direct CLI source-command smoke test', 3 if !_command_available('go');
my $go_extension = File::Spec->catfile( $cli_root, 'hi.go' );
open my $go_extension_fh, '>', $go_extension or die "Unable to write $go_extension: $!";
print {$go_extension_fh} <<'GO';
package main
import "fmt"
func main() {
fmt.Println("Hello, World!")
}
GO
close $go_extension_fh;
chmod 0755, $go_extension or die "Unable to chmod $go_extension: $!";
my ( $go_stdout, $go_stderr, $go_exit ) = capture {
system $perl, '-I' . $lib, $dashboard, 'hi';
return $? >> 8;
};
is( $go_exit, 0, 'dashboard resolves cli/<command>.go as a direct custom command' );
is( $go_stderr, '', 'dashboard direct Go custom command keeps stderr clean' );
is( $go_stdout, "Hello, World!\n", 'dashboard direct Go custom command runs through go run' );
}
SKIP: {
skip 'a usable javac and java runtime are required for direct CLI source-command smoke test', 3
if !_command_usable('javac', '-version') || !_command_usable('java', '-version');
my $java_extension = File::Spec->catfile( $cli_root, 'foo.java' );
open my $java_extension_fh, '>', $java_extension or die "Unable to write $java_extension: $!";
print {$java_extension_fh} <<'JAVA';
public class HelloWorld {
public static void main(String[] args) {
System.out.println("Hello, World!");
}
}
JAVA
( run in 0.467 second using v1.01-cache-2.11-cpan-600a1bdf6e4 )