view release on metacpan or  search on metacpan

t/05-cli-smoke.t  view on Meta::CPAN

like( $complete_top, qr/^doctor$/m, 'dashboard complete suggests doctor for top-level completion' );
my $complete_top_alias = _run("$perl -I'$lib' '$dashboard' complete 1 d2 do");
like( $complete_top_alias, qr/^docker$/m, 'dashboard complete suggests docker for the d2 alias as well' );
like( $complete_top_alias, qr/^doctor$/m, 'dashboard complete suggests doctor for the d2 alias as well' );
my $complete_sub = _run("$perl -I'$lib' '$dashboard' complete 2 dashboard docker co");
is( $complete_sub, "compose\n", 'dashboard complete suggests docker subcommands' );
my $completion_skill_root = File::Spec->catdir( $ENV{HOME}, '.developer-dashboard', 'skills', 'completion-skill', 'cli' );
make_path($completion_skill_root);
my $completion_skill_command = File::Spec->catfile( $completion_skill_root, 'run-test' );
open my $completion_skill_fh, '>', $completion_skill_command or die "Unable to write $completion_skill_command: $!";
print {$completion_skill_fh} "#!/usr/bin/env perl\nuse strict;\nuse warnings;\nprint qq{completion\\n};\n";
close $completion_skill_fh;
chmod 0755, $completion_skill_command or die "Unable to chmod $completion_skill_command: $!";
my $complete_skill = _run("$perl -I'$lib' '$dashboard' complete 1 dashboard completion-s");
like( $complete_skill, qr/^completion-skill\.run-test$/m, 'dashboard complete suggests installed dotted skill commands' );

my $serve_workers_port = _find_free_port();
my $serve_workers = _run("$perl -I'$lib' '$dashboard' serve workers 3 --port $serve_workers_port");
like($serve_workers, qr/"workers"\s*:\s*3/, 'dashboard serve workers persists the default worker count');
my ($serve_workers_pid) = $serve_workers =~ /"pid"\s*:\s*"?(\d+)"?/;
ok( !defined $serve_workers_pid || $serve_workers_pid =~ /^\d+$/, 'dashboard serve workers returns a numeric pid when it starts a stopped web service' );
open my $workers_config_fh, '<', $global_config_file or die "Unable to read $global_config_file: $!";
my $workers_config = do { local $/; <$workers_config_fh> };
close $workers_config_fh;
like( $workers_config, qr/"web"\s*:\s*\{\s*"workers"\s*:\s*3/s, 'dashboard serve workers stores the default worker count in config' );
if ( defined $serve_workers_pid ) {
    my $serve_workers_stop = _run("$perl -I'$lib' '$dashboard' stop -o json");
    like(
        $serve_workers_stop,
        qr/"web"\s*:\s*\{\s*"details"\s*:\s*"dashboard web service"\s*,\s*"pid"\s*:\s*(?:null|\d+)\s*,\s*"status"\s*:\s*"stopped"/s,
        'dashboard stop reports the service started by serve workers as stopped even when the managed pid has already disappeared from the final summary',
    );
}
else {
    pass('dashboard serve workers reused an already-running managed web service instead of starting a new pid');
}
if ( !$UNDER_COVER ) {
    my $live_status_port = _find_free_port();
    my $live_status_pid = fork();
    die 'Unable to fork live dashboard status probe' if !defined $live_status_pid;
    if ( !$live_status_pid ) {
        delete @ENV{qw(PERL5OPT HARNESS_PERL_SWITCHES)} if _coverage_requested();
        exec $perl, '-I' . $lib, $dashboard, 'serve', '--foreground', '--host', '127.0.0.1', '--port', $live_status_port;
        die "Unable to exec live dashboard serve: $!";
    }
    my $status_ua = LWP::UserAgent->new( timeout => 5 );
    my $status_response;
    for ( 1 .. _startup_probe_attempts() ) {
        $status_response = $status_ua->get("http://127.0.0.1:$live_status_port/system/status");
        last if $status_response->is_success;
        sleep 0.25;
    }
    ok( $status_response && $status_response->is_success, 'live foreground runtime exposes the system status endpoint' );
    like( decode( 'UTF-8', $status_response->content ), qr/"alias"\s*:\s*"🔑"/, 'live foreground runtime syncs configured collector indicator icons into system status' );
    kill 'TERM', $live_status_pid;
    waitpid( $live_status_pid, 0 );
}
my $dashboard_log_file = File::Spec->catfile( $ENV{HOME}, '.developer-dashboard', 'logs', 'dashboard.log' );
make_path( File::Spec->catdir( $ENV{HOME}, '.developer-dashboard', 'logs' ) );
open my $dashboard_log_fh, '>', $dashboard_log_file or die "Unable to write $dashboard_log_file: $!";
print {$dashboard_log_fh} "starman boot line\nDancer2 boot line\n";
close $dashboard_log_fh;
my $serve_logs = _run("$perl -I'$lib' '$dashboard' serve logs");
like($serve_logs, qr/starman boot line/, 'dashboard serve logs prints the web-service log content');
like($serve_logs, qr/Dancer2 boot line/, 'dashboard serve logs includes Dancer2-side log lines');
my $serve_logs_tail = _run("$perl -I'$lib' '$dashboard' serve logs -n 1");
is($serve_logs_tail, "Dancer2 boot line\n", 'dashboard serve logs -n prints only the requested trailing lines');
{
    require IPC::Open3;
    require Symbol;
    my $stderr_fh = Symbol::gensym();
    my $pid = IPC::Open3::open3( undef, my $stdout_fh, $stderr_fh, $perl, '-I' . $lib, $dashboard, 'serve', 'logs', '-f', '-n', '1' );
    my $first = <$stdout_fh>;
    is( $first, "Dancer2 boot line\n", 'dashboard serve logs -f -n prints the requested trailing lines before following new output' );
    open my $append_fh, '>>', $dashboard_log_file or die "Unable to append $dashboard_log_file: $!";
    print {$append_fh} "followed line\n";
    close $append_fh;
    my $followed = <$stdout_fh>;
    is( $followed, "followed line\n", 'dashboard serve logs -f streams appended log lines' );
    kill 'TERM', $pid;
    waitpid( $pid, 0 );
}
if ( !$UNDER_COVER ) {
    my $serve_home = tempdir( CLEANUP => 1 );
    local $ENV{HOME} = $serve_home;
    local $ENV{DEVELOPER_DASHBOARD_BOOKMARKS};
    local $ENV{DEVELOPER_DASHBOARD_CONFIGS};
    local $ENV{DEVELOPER_DASHBOARD_CHECKERS};
    my $serve_init = _run_in_home( $serve_home, "$perl -I'$lib' '$dashboard' init" );
    like( $serve_init, qr/runtime_root/, 'isolated lifecycle smoke home initializes a runtime for serve/restart collector checks' );
    my $serve_config_file = File::Spec->catfile( $serve_home, '.developer-dashboard', 'config', 'config.json' );
    open my $serve_config_fh, '>:raw', $serve_config_file or die "Unable to write $serve_config_file: $!";
    my $serve_config_json = json_encode(
        {
            collectors => [
                {
                    name     => 'tick.collector',
                    command  => q{perl -MTime::HiRes=time -e 'printf qq{%.6f\n}, time'},
                    cwd      => 'home',
                    interval => 1,
                },
            ],
        }
    );
    $serve_config_json = encode( 'UTF-8', $serve_config_json ) if utf8::is_utf8($serve_config_json);
    print {$serve_config_fh} $serve_config_json;
    close $serve_config_fh;
    my $serve_port = _find_free_port();
    my $serve_json = json_decode( _run_in_home( $serve_home, "$perl -I'$lib' '$dashboard' serve --host 127.0.0.1 --port $serve_port" ) );
    ok( $serve_json->{pid}, 'dashboard serve returns a managed web pid for the collector lifecycle smoke test' );
    my $first_stdout = '';
    for ( 1 .. 160 ) {
        my $output = json_decode( _run_in_home( $serve_home, "$perl -I'$lib' '$dashboard' collector output tick.collector" ) );
        $first_stdout = $output->{stdout} || '';
        last if $first_stdout =~ /^\d+\.\d+\n$/;
        my $status = json_decode( _run_in_home( $serve_home, "$perl -I'$lib' '$dashboard' collector status tick.collector" ) );
        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 );