Developer-Dashboard
view release on metacpan or search on metacpan
t/21-refactor-coverage.t view on Meta::CPAN
{ name => 'beta', interval => 30 },
],
providers => [
{ id => 'main', title => 'Project' },
{ id => 'extra', title => 'Extra' },
],
}
) . "\n",
);
_run_or_die(qw(git add .));
_run_or_die( 'git', 'commit', '-m', 'Project layer variant' );
chdir $cwd or die "Unable to chdir back to $cwd: $!";
}
{
my $cwd = getcwd();
chdir $layered_work_root or die "Unable to chdir to $layered_work_root: $!";
my $layered_paths = Developer::Dashboard::PathRegistry->new( home => File::Spec->catdir( $ENV{HOME}, 'skills-home' ) );
my $layered_manager = Developer::Dashboard::SkillManager->new( paths => $layered_paths );
is(
$layered_paths->skills_root,
File::Spec->catdir( $layered_project_root, '.developer-dashboard', 'skills' ),
'skills_root writes to the deepest participating DD-OOP-LAYER',
);
is_deeply(
[ $layered_paths->skills_roots ],
[
File::Spec->catdir( $layered_project_root, '.developer-dashboard', 'skills' ),
File::Spec->catdir( $ENV{HOME}, 'skills-home', '.developer-dashboard', 'skills' ),
],
'skills_roots resolves layered skill roots in deepest-first lookup order',
);
ok( !$layered_manager->install( 'file://' . $shared_layer_repo )->{error}, 'layered manager installs the shared skill into the project layer without clashing with the home copy' );
is_deeply(
[ $layered_paths->skill_roots_for('shared-layer-skill') ],
[
File::Spec->catdir( $layered_project_root, '.developer-dashboard', 'skills', 'shared-layer-skill' ),
File::Spec->catdir( $ENV{HOME}, 'skills-home', '.developer-dashboard', 'skills', 'shared-layer-skill' ),
],
'skill_roots_for resolves one layered skill in deepest-first lookup order',
);
is(
$layered_manager->get_skill_path('shared-layer-skill'),
File::Spec->catdir( $layered_project_root, '.developer-dashboard', 'skills', 'shared-layer-skill' ),
'get_skill_path prefers the deepest matching layered skill',
);
is(
$layered_manager->get_skill_path('home-layer-skill'),
File::Spec->catdir( $ENV{HOME}, 'skills-home', '.developer-dashboard', 'skills', 'home-layer-skill' ),
'get_skill_path still inherits home-layer skills when no deeper override exists',
);
my $layered_dispatcher = Developer::Dashboard::SkillDispatcher->new( paths => $layered_paths );
my $layered_hooks = $layered_dispatcher->execute_hooks( 'shared-layer-skill', 'run-test' );
ok(
exists $layered_hooks->{hooks}{'00-pre.pl'},
'execute_hooks keeps the first hook basename for the first matching layered hook',
);
ok(
exists $layered_hooks->{hooks}{'run-test.d/00-pre.pl'},
'execute_hooks namespaces duplicate layered hook basenames by hook directory leaf',
);
my $layered_stream_hooks = $layered_dispatcher->_execute_hooks_streaming(
'shared-layer-skill',
'run-test',
[ $layered_manager->get_skill_path('shared-layer-skill'), File::Spec->catdir( $ENV{HOME}, 'skills-home', '.developer-dashboard', 'skills', 'shared-layer-skill' ) ],
);
ok(
exists $layered_stream_hooks->{hooks}{'run-test.d/00-pre.pl'},
'_execute_hooks_streaming namespaces duplicate layered hook basenames by hook directory leaf',
);
is_deeply(
$layered_dispatcher->get_skill_config('shared-layer-skill'),
{
skill_name => 'shared-layer-skill',
collectors => [
{ name => 'alpha', interval => 20 },
{ name => 'beta', interval => 30 },
],
providers => [
{ id => 'main', title => 'Project' },
{ id => 'extra', title => 'Extra' },
],
},
'get_skill_config merges layered collector and provider arrays by logical identity',
);
is_deeply(
[ map { File::Basename::basename($_) } $layered_paths->installed_skill_roots ],
[ 'shared-layer-skill', 'dep-skill', 'home-layer-skill', 'layout-skill' ],
'installed_skill_roots exposes the effective layered skill set once per repo name',
);
chdir $cwd or die "Unable to chdir back to $cwd: $!";
}
my $no_dep_repo = _create_skill_repo( $test_repos, 'no-dep-skill', with_cpanfile => 0 );
ok( !$manager->install( 'file://' . $no_dep_repo )->{error}, 'skill manager installs skills without a cpanfile' );
{
local $ENV{DD_TEST_CPANM_FAIL} = 1;
my $fail_repo = File::Spec->catdir( $test_repos, 'fail-dep-skill' );
make_path($fail_repo);
_write_file( File::Spec->catfile( $fail_repo, 'cpanfile' ), "requires 'JSON::XS';\n" );
like(
$manager->_install_skill_dependencies($fail_repo)->{error},
qr/Failed to install skill dependencies/,
'install reports isolated dependency installation failures',
);
}
{
local $ENV{DD_TEST_ALPINE} = 1;
my $apk_repo = File::Spec->catdir( $test_repos, 'apk-skill' );
make_path($apk_repo);
_write_file( File::Spec->catfile( $apk_repo, 'apkfile' ), "procps-dev\n" );
unlink $apk_log;
my $apk_install = $manager->_install_skill_dependencies($apk_repo);
ok( !$apk_install->{error}, '_install_skill_dependencies succeeds for apkfile-driven installs on Alpine' ) or diag $apk_install->{error};
ok( -f $apk_log, '_install_skill_dependencies records an apk invocation when the skill ships an apkfile on Alpine' );
}
{
local $ENV{DD_TEST_ALPINE} = 1;
local $ENV{DD_TEST_APK_INSTALLED} = 'procps-dev';
my $apk_repo = File::Spec->catdir( $test_repos, 'apk-skip-skill' );
make_path($apk_repo);
_write_file( File::Spec->catfile( $apk_repo, 'apkfile' ), "procps-dev\n" );
unlink $apk_log;
unlink $sudo_log;
my $skip_apk = $manager->_install_skill_dependencies($apk_repo);
ok( !$skip_apk->{error}, '_install_skill_dependencies succeeds for apkfile-driven installs on Alpine when every package is already installed' )
or diag $skip_apk->{error};
ok( !-f $apk_log, '_install_skill_dependencies skips apk add when every Alpine package is already installed' );
ok( !-f $sudo_log, '_install_skill_dependencies skips sudo when every Alpine package is already installed' );
t/21-refactor-coverage.t view on Meta::CPAN
is( scalar @{ json_decode($alias_cli_stdout)->{skills} }, 2, 'dashboard skill alias reaches the skills management command family' );
}
{
my $broken_repo = _create_skill_repo( $test_repos, 'broken-update-skill', with_cpanfile => 0 );
ok( !$manager->install( 'file://' . $broken_repo )->{error}, 'broken-update-skill installs cleanly' );
my $installed_root = $manager->get_skill_path('broken-update-skill');
_run_or_die( 'git', '-C', $installed_root, 'remote', 'set-url', 'origin', 'file:///definitely-missing-repo-path' );
like(
$manager->update('broken-update-skill')->{error},
qr/Failed to update skill:/,
'update reports git pull failures',
);
}
{
no warnings 'redefine';
local *Developer::Dashboard::SkillManager::remove_tree = sub {
my ( $path, $options ) = @_;
push @{ ${ $options->{error} } }, { $path => 'boom' };
return;
};
like(
$manager->uninstall('no-dep-skill')->{error},
qr/Failed to uninstall skill:/,
'uninstall reports remove_tree failures',
);
}
{
my $replace_target = File::Spec->catdir( $test_repos, 'failing-replace-skill' );
make_path($replace_target);
no warnings 'redefine';
local *Developer::Dashboard::SkillManager::remove_tree = sub {
my ( $path, $options ) = @_;
push @{ ${ $options->{error} } }, 'replace failed';
return;
};
is_deeply(
$manager->_remove_existing_skill_path($replace_target),
{ error => "Failed to replace existing skill at $replace_target: replace failed" },
'_remove_existing_skill_path reports remove_tree failures while replacing an installed skill',
);
}
my $dispatcher = Developer::Dashboard::SkillDispatcher->new( paths => $skill_paths );
is_deeply( $dispatcher->dispatch( '', 'run-test' ), { error => 'Missing skill name' }, 'dispatcher rejects missing skill names' );
is_deeply( $dispatcher->dispatch( 'dep-skill', '' ), { error => 'Missing command name' }, 'dispatcher rejects missing command names' );
is_deeply( $dispatcher->exec_command( '', 'run-test' ), { error => 'Missing skill name' }, 'exec_command rejects missing skill names' );
is_deeply( $dispatcher->exec_command( 'dep-skill', '' ), { error => 'Missing command name' }, 'exec_command rejects missing command names' );
{
my $missing_skill = $dispatcher->dispatch( 'missing-skill', 'run-test' );
like( $missing_skill->{error}, qr/\ASkill 'missing-skill' not found\./, 'dispatcher rejects missing skills' );
like( $missing_skill->{error}, qr/\n\nDid you mean:\n/, 'missing-skill dispatch guidance includes suggestion heading' );
}
{
my $missing_exec = $dispatcher->exec_command( 'missing-skill', 'run-test' );
like( $missing_exec->{error}, qr/\ASkill 'missing-skill' not found\./, 'exec_command rejects missing skills' );
like( $missing_exec->{error}, qr/\n\nDid you mean:\n/, 'missing-skill exec guidance includes suggestion heading' );
}
is_deeply( $dispatcher->execute_hooks( '', 'run-test' ), { hooks => {}, result_state => {} }, 'execute_hooks returns an empty result for missing skill names' );
is_deeply( $dispatcher->execute_hooks( 'dep-skill', '' ), { hooks => {}, result_state => {} }, 'execute_hooks returns an empty result for missing command names' );
is_deeply( $dispatcher->execute_hooks( 'missing-skill', 'run-test' ), { hooks => {}, result_state => {} }, 'execute_hooks returns an empty result for missing skills' );
is_deeply( $dispatcher->_execute_hooks_streaming( '', 'run-test', [] ), { hooks => {}, result_state => {} }, '_execute_hooks_streaming returns an empty payload for missing skill names' );
is_deeply( $dispatcher->_execute_hooks_streaming( 'dep-skill', '', [] ), { hooks => {}, result_state => {} }, '_execute_hooks_streaming returns an empty payload for missing command names' );
is_deeply( $dispatcher->_execute_hooks_streaming( 'dep-skill', 'run-test', [] ), { hooks => {}, result_state => {} }, '_execute_hooks_streaming returns an empty payload when no skill layers participate' );
ok( !$manager->disable('dep-skill')->{error}, 'disable succeeds for an installed skill' );
ok( !$manager->is_enabled('dep-skill'), 'is_enabled reports false once a skill is disabled' );
my @enabled_skill_roots = $skill_paths->installed_skill_roots;
my @all_skill_roots = $skill_paths->installed_skill_roots( include_disabled => 1 );
ok( !grep( { $_ eq $dep_skill_root } @enabled_skill_roots ), 'installed_skill_roots excludes disabled skills by default' );
ok( grep( { $_ eq $dep_skill_root } @all_skill_roots ), 'installed_skill_roots can still enumerate disabled skills when requested' );
is( $manager->get_skill_path('dep-skill'), undef, 'get_skill_path hides disabled skills from normal runtime lookup' );
ok( $manager->get_skill_path( 'dep-skill', include_disabled => 1 ), 'get_skill_path can still resolve disabled skills when explicitly requested' );
is_deeply(
$dispatcher->dispatch( 'dep-skill', 'run-test' ),
{
error => "Skill 'dep-skill' is disabled.\n\nEnable it with:\n dashboard skills enable dep-skill\n",
},
'dispatcher rejects disabled skills explicitly',
);
is_deeply( $dispatcher->execute_hooks( 'dep-skill', 'run-test' ), { hooks => {}, result_state => {} }, 'execute_hooks returns an empty result for disabled skills' );
is_deeply( $dispatcher->get_skill_config('dep-skill'), {}, 'get_skill_config hides disabled skill config from runtime callers' );
ok( !$manager->usage('dep-skill')->{enabled}, 'usage still works for disabled skills and reports them as disabled' );
ok( !$manager->enable('dep-skill')->{error}, 'enable restores a disabled skill' );
ok( $manager->is_enabled('dep-skill'), 'is_enabled reports true after re-enabling a skill' );
my $hookless_repo = _create_skill_repo( $test_repos, 'hookless-skill', with_hook => 0, with_cpanfile => 0 );
ok( !$manager->install( 'file://' . $hookless_repo )->{error}, 'hookless skill installs cleanly' );
is_deeply( $dispatcher->execute_hooks( 'hookless-skill', 'run-test' ), { hooks => {}, result_state => {} }, 'execute_hooks returns an empty result when no hook directory exists' );
is_deeply( $dispatcher->get_skill_config(''), {}, 'get_skill_config returns an empty hash for empty skill names' );
is_deeply( $dispatcher->get_skill_config('missing-skill'), {}, 'get_skill_config returns an empty hash for missing skills' );
is_deeply(
$dispatcher->get_skill_config('dep-skill'),
{ skill_name => 'dep-skill' },
'get_skill_config returns the decoded skill-local config payload',
);
my $invalid_config_root = $manager->get_skill_path('hookless-skill');
_write_file( File::Spec->catfile( $invalid_config_root, 'config', 'config.json' ), "{not json}\n" );
is_deeply( $dispatcher->get_skill_config('hookless-skill'), {}, 'get_skill_config falls back to an empty hash for invalid JSON config' );
is( $dispatcher->get_skill_path(''), undef, 'get_skill_path returns undef for empty skill names' );
is( $dispatcher->get_skill_path('dep-skill'), $manager->get_skill_path('dep-skill'), 'get_skill_path returns the installed skill path for valid skills' );
{
my $fallback_dispatcher = bless {
manager => bless(
{
paths => bless( {}, 'Local::NoSkillLayerPaths' ),
},
'Local::FallbackSkillManager'
),
}, 'Developer::Dashboard::SkillDispatcher';
no warnings qw(redefine once);
local *Local::FallbackSkillManager::get_skill_path = sub {
my ( $self, $skill_name ) = @_;
return '' if !$skill_name;
return '/tmp/fallback-skill-root';
};
is_deeply(
[ $fallback_dispatcher->_skill_layers('fallback-skill') ],
['/tmp/fallback-skill-root'],
'_skill_layers falls back to manager get_skill_path when the path registry does not expose layered helpers',
);
}
is( $dispatcher->command_path( '', 'run-test' ), undef, 'command_path returns undef for missing skill names' );
is( $dispatcher->command_path( 'dep-skill', '' ), undef, 'command_path returns undef for missing command names' );
is( $dispatcher->command_path( 'missing-skill', 'run-test' ), undef, 'command_path returns undef for unknown skills' );
is( $dispatcher->command_path( 'dep-skill', 'missing' ), undef, 'command_path returns undef for missing skill commands' );
t/21-refactor-coverage.t view on Meta::CPAN
);
make_path( File::Spec->catdir( $dep_skill_root, 'skills', 'foo', 'cli' ) );
_write_file(
File::Spec->catfile( $dep_skill_root, 'skills', 'foo', 'cli', 'foo' ),
"#!/usr/bin/env perl\nuse strict;\nuse warnings;\nprint qq{nested-coverage\\n};\n",
0755,
);
make_path( File::Spec->catdir( $dep_skill_root, 'skills', 'level1', 'skills', 'level2', 'cli' ) );
_write_file(
File::Spec->catfile( $dep_skill_root, 'skills', 'level1', 'skills', 'level2', 'cli', 'here' ),
"#!/usr/bin/env perl\nuse strict;\nuse warnings;\nprint qq{deep-nested-coverage\\n};\n",
0755,
);
is(
$dispatcher->command_path( 'dep-skill', 'foo.foo' ),
File::Spec->catfile( $dep_skill_root, 'skills', 'foo', 'cli', 'foo' ),
'command_path resolves nested skills/<repo>/cli commands inside one installed skill',
);
is(
$dispatcher->dispatch( 'dep-skill', 'foo.foo' )->{stdout},
"nested-coverage\n",
'dispatcher executes nested skills/<repo>/cli commands inside one installed skill',
);
is(
$dispatcher->command_path( 'dep-skill', 'level1.level2.here' ),
File::Spec->catfile( $dep_skill_root, 'skills', 'level1', 'skills', 'level2', 'cli', 'here' ),
'command_path resolves multi-level nested skills/<repo>/.../skills/<repo>/cli commands inside one installed skill',
);
is(
$dispatcher->dispatch( 'dep-skill', 'level1.level2.here' )->{stdout},
"deep-nested-coverage\n",
'dispatcher executes multi-level nested skills/<repo>/.../skills/<repo>/cli commands inside one installed skill',
);
is_deeply(
[ $dispatcher->command_hook_paths( 'dep-skill', 'run-test' ) ],
[ File::Spec->catfile( $dep_skill_root, 'cli', 'run-test.d', '00-pre.pl' ) ],
'command_hook_paths lists participating skill hook files in execution order',
);
is_deeply(
[ $dispatcher->command_hook_paths( 'dep-skill', 'level1.level2.here' ) ],
[],
'command_hook_paths returns an empty list when a nested skill command has no hook directory',
);
{
my $missing_command = $dispatcher->dispatch( 'dep-skill', 'missing' );
like( $missing_command->{error}, qr/\ACommand 'missing' not found in skill 'dep-skill'\./, 'dispatcher rejects missing commands inside installed skills' );
like( $missing_command->{error}, qr/\n\nDid you mean:\n/, 'missing skill command guidance includes suggestion heading' );
}
{
no warnings 'redefine';
local *Developer::Dashboard::SkillDispatcher::execute_hooks = sub {
return { error => 'hook failure' };
};
is_deeply(
$dispatcher->dispatch( 'dep-skill', 'run-test' ),
{ error => 'hook failure' },
'dispatcher returns hook execution errors before launching the main skill command',
);
}
{
my $streaming_dir = tempdir( CLEANUP => 1 );
my $streaming_script = File::Spec->catfile( $streaming_dir, 'stream-child.pl' );
_write_file(
$streaming_script,
<<'PERL',
#!/usr/bin/env perl
use strict;
use warnings;
$| = 1;
print "stream-out:$ENV{SKILL_COMMAND}\n";
print STDERR "stream-err\n";
exit 7;
PERL
0755,
);
my ( $stdout, $stderr, $result ) = capture {
$dispatcher->_run_child_command_streaming(
command => [ $^X, $streaming_script ],
args => [],
env => { SKILL_COMMAND => 'run-test' },
skill_layers => [$dep_skill_root],
result_state => {},
last_result => {},
stdin_mode => 'null',
);
};
is( $stdout, "stream-out:run-test\n", '_run_child_command_streaming mirrors child stdout while using null stdin for hooks' );
is( $stderr, "stream-err\n", '_run_child_command_streaming mirrors child stderr while using null stdin for hooks' );
is( $result->{stdout}, "stream-out:run-test\n", '_run_child_command_streaming captures child stdout for RESULT handoff' );
is( $result->{stderr}, "stream-err\n", '_run_child_command_streaming captures child stderr for RESULT handoff' );
is( $result->{exit_code}, 7, '_run_child_command_streaming captures the child exit code' );
}
{
my $streaming_dir = tempdir( CLEANUP => 1 );
my $streaming_script = File::Spec->catfile( $streaming_dir, 'stream-last-result.pl' );
_write_file(
$streaming_script,
<<'PERL',
#!/usr/bin/env perl
use strict;
use warnings;
print "stream-last-result\n";
exit 0;
PERL
0755,
);
local *Developer::Dashboard::Runtime::Result::set_last_result = sub {
my ( $payload ) = @_;
$main::dd_last_result_payload = $payload;
return;
};
local $main::dd_last_result_payload;
my ( $stdout, $stderr, $result ) = capture {
$dispatcher->_run_child_command_streaming(
command => [ $^X, $streaming_script ],
args => [],
env => {},
skill_layers => [$dep_skill_root],
result_state => {},
last_result => { file => '/tmp/previous-hook', exit => 0, STDOUT => "old\n", STDERR => '' },
stdin_mode => 'null',
);
};
is( $stdout, "stream-last-result\n", '_run_child_command_streaming still mirrors stdout when a prior RESULT payload exists' );
is( $stderr, '', '_run_child_command_streaming keeps stderr empty when a prior RESULT payload exists and the child emits no stderr' );
is_deeply(
$main::dd_last_result_payload,
{ file => '/tmp/previous-hook', exit => 0, STDOUT => "old\n", STDERR => '' },
'_run_child_command_streaming reloads the previous RESULT payload before launching the child',
);
is( $result->{exit_code}, 0, '_run_child_command_streaming preserves successful exit codes while restoring the previous RESULT payload' );
}
{
my $stdin_dir = tempdir( CLEANUP => 1 );
my $stdin_script = File::Spec->catfile( $stdin_dir, 'stdin-child.pl' );
_write_file(
$stdin_script,
<<'PERL',
#!/usr/bin/env perl
use strict;
use warnings;
$| = 1;
my $line = <STDIN>;
$line = '' if !defined $line;
print "stdin:$line";
exit 0;
PERL
0755,
);
my $stdin_text = File::Spec->catfile( $stdin_dir, 'stdin.txt' );
_write_file( $stdin_text, "hello-from-stdin\n" );
open my $saved_stdin, '<&', \*STDIN or die "Unable to duplicate original STDIN: $!";
open my $saved_stdout, '>&', \*STDOUT or die "Unable to duplicate original STDOUT: $!";
open my $saved_stderr, '>&', \*STDERR or die "Unable to duplicate original STDERR: $!";
my $stdout_path = File::Spec->catfile( $stdin_dir, 'stdout.txt' );
my $stderr_path = File::Spec->catfile( $stdin_dir, 'stderr.txt' );
open STDIN, '<', $stdin_text or die "Unable to open stdin fixture file: $!";
open STDOUT, '>', $stdout_path or die "Unable to redirect stdout fixture file: $!";
open STDERR, '>', $stderr_path or die "Unable to redirect stderr fixture file: $!";
my $result = $dispatcher->_run_child_command_streaming(
command => [ $^X, $stdin_script ],
args => [],
env => {},
skill_layers => [$dep_skill_root],
result_state => {},
last_result => {},
stdin_mode => 'inherit',
);
open STDIN, '<&', $saved_stdin or die "Unable to restore original STDIN: $!";
open STDOUT, '>&', $saved_stdout or die "Unable to restore original STDOUT: $!";
open STDERR, '>&', $saved_stderr or die "Unable to restore original STDERR: $!";
my $stdout = do {
open my $fh, '<', $stdout_path or die "Unable to read captured stdout fixture file: $!";
local $/;
<$fh>;
};
my $stderr = do {
open my $fh, '<', $stderr_path or die "Unable to read captured stderr fixture file: $!";
local $/;
<$fh>;
};
is( $stdout, "stdin:hello-from-stdin\n", '_run_child_command_streaming preserves interactive stdin when requested' );
is( $stderr, '', '_run_child_command_streaming keeps stderr empty when the child emits no stderr' );
is( $result->{stdout}, "stdin:hello-from-stdin\n", '_run_child_command_streaming captures inherited-stdin child stdout' );
is( $result->{stderr}, '', '_run_child_command_streaming captures an empty stderr stream when nothing is emitted' );
is( $result->{exit_code}, 0, '_run_child_command_streaming captures a successful inherited-stdin exit code' );
}
{
my $hook_dir = File::Spec->catdir( $dep_skill_root, 'cli', 'streaming-hook.d' );
make_path($hook_dir);
my $hook_script = File::Spec->catfile( $hook_dir, '00-stream.pl' );
_write_file(
$hook_script,
<<'PERL',
#!/usr/bin/env perl
use strict;
use warnings;
$| = 1;
print "hook-stream-out\n";
print STDERR "hook-stream-err\n";
exit 4;
PERL
0755,
);
my ( $stdout, $stderr, $result ) = capture {
$dispatcher->_execute_hooks_streaming( 'dep-skill', 'streaming-hook', [$dep_skill_root] );
};
is( $stdout, "hook-stream-out\n", '_execute_hooks_streaming mirrors hook stdout live' );
is( $stderr, "hook-stream-err\n", '_execute_hooks_streaming mirrors hook stderr live' );
is_deeply(
$result->{hooks}{'00-stream.pl'},
{
stdout => "hook-stream-out\n",
stderr => "hook-stream-err\n",
exit_code => 4,
},
'_execute_hooks_streaming captures hook stdout, stderr, and exit code',
);
is_deeply(
$result->{last_result},
{
file => $hook_script,
exit => 4,
STDOUT => "hook-stream-out\n",
STDERR => "hook-stream-err\n",
},
'_execute_hooks_streaming records the last streaming hook result for downstream RESULT consumers',
);
}
{
no warnings 'redefine';
local %ENV = %ENV;
my %seen;
local *Developer::Dashboard::SkillDispatcher::_execute_hooks_streaming = sub {
return {
hooks => { pre => { stdout => "hook\n", stderr => '', exit_code => 0 } },
result_state => { pre => { stdout => "hook\n", stderr => '', exit_code => 0 } },
last_result => { file => '/tmp/hook', exit => 0, STDOUT => "hook\n", STDERR => '' },
};
};
local *Developer::Dashboard::SkillDispatcher::_exec_resolved_command = sub {
my ( $self, $cmd_path, $command, $args ) = @_;
$seen{cmd_path} = $cmd_path;
$seen{command} = [ @{$command} ];
$seen{args} = [ @{$args} ];
$seen{env} = {
map { $_ => $ENV{$_} }
grep { exists $ENV{$_} }
qw(
DEVELOPER_DASHBOARD_SKILL_NAME
DEVELOPER_DASHBOARD_SKILL_ROOT
DEVELOPER_DASHBOARD_SKILL_COMMAND
DEVELOPER_DASHBOARD_SKILL_CLI_ROOT
DEVELOPER_DASHBOARD_SKILL_CONFIG_ROOT
DEVELOPER_DASHBOARD_SKILL_DOCKER_ROOT
DEVELOPER_DASHBOARD_SKILL_STATE_ROOT
DEVELOPER_DASHBOARD_SKILL_LOGS_ROOT
DEVELOPER_DASHBOARD_SKILL_LOCAL_ROOT
PERL5LIB
)
};
$seen{current} = Developer::Dashboard::Runtime::Result::current();
$seen{last} = Developer::Dashboard::Runtime::Result::last_result();
return {
success => 1,
%seen,
};
};
local *Developer::Dashboard::EnvLoader::load_runtime_layers = sub {
shift;
$seen{runtime_layers_loaded}++;
return;
};
local *Developer::Dashboard::EnvLoader::load_skill_layers = sub {
shift;
my (%args) = @_;
$seen{skill_layers} = [ @{ $args{skill_layers} || [] } ];
return;
};
my $exec_result = $dispatcher->exec_command( 'dep-skill', 'run-test', 'alpha', 'beta' );
ok( $exec_result->{success}, 'exec_command delegates to the resolved command runner after preparing the environment' );
is_same_path( $exec_result->{cmd_path}, File::Spec->catfile( $dep_skill_root, 'cli', 'run-test' ), 'exec_command resolves the final runnable command path' );
is_deeply( $exec_result->{args}, [ 'alpha', 'beta' ], 'exec_command forwards the original user arguments to the final command runner' );
is( $exec_result->{env}{DEVELOPER_DASHBOARD_SKILL_NAME}, 'dep-skill', 'exec_command exposes the skill name in the child environment' );
is( $exec_result->{env}{DEVELOPER_DASHBOARD_SKILL_COMMAND}, 'run-test', 'exec_command exposes the resolved command name in the child environment' );
is_same_path( $exec_result->{env}{DEVELOPER_DASHBOARD_SKILL_ROOT}, $dep_skill_root, 'exec_command exposes the resolved skill path in the child environment' );
is_deeply( $exec_result->{skill_layers}, [$dep_skill_root], 'exec_command loads the participating skill layers before exec' );
is( $exec_result->{runtime_layers_loaded}, 1, 'exec_command reloads runtime env layers before replacing the helper process' );
is_deeply(
$exec_result->{last},
{ file => '/tmp/hook', exit => 0, STDOUT => "hook\n", STDERR => '' },
'exec_command forwards the last hook RESULT payload into Runtime::Result',
);
}
{
no warnings 'redefine';
local *Developer::Dashboard::SkillDispatcher::_execute_hooks_streaming = sub { return { error => 'stream hook failure' } };
is_deeply(
$dispatcher->exec_command( 'dep-skill', 'run-test' ),
{ error => 'stream hook failure' },
'exec_command stops before exec when streaming hooks report an error',
);
}
{
my ( undef, undef, $exec_error ) = capture {
local *Developer::Dashboard::SkillDispatcher::_exec_replacement = sub { return 'mock exec failure'; };
$dispatcher->_exec_resolved_command( '/no/such/path', [ '/definitely/missing-skill-command' ], [] );
};
like( $exec_error->{error}, qr/\AUnable to exec \/no\/such\/path: mock exec failure/, '_exec_resolved_command reports direct exec failures clearly' );
}
{
no warnings 'redefine';
local *Developer::Dashboard::SkillDispatcher::_execute_hooks_streaming = sub {
return {
hooks => {},
result_state => {},
};
};
local *Developer::Dashboard::SkillDispatcher::_exec_resolved_command = sub {
my $last_result = Developer::Dashboard::Runtime::Result::last_result();
return {
success => 1,
last_result => $last_result,
};
};
my $exec_result = $dispatcher->exec_command( 'dep-skill', 'run-test' );
ok( $exec_result->{success}, 'exec_command still reaches the final command runner when hooks return no last_result payload' );
ok( !defined $exec_result->{last_result}, 'exec_command clears the previous RESULT payload when hooks return no last_result data' );
}
{
my ( undef, $stderr, $exec_error ) = capture {
return $dispatcher->_exec_replacement( ['/definitely/missing-skill-command'], [] );
};
like(
$stderr,
qr/Can't exec "\/definitely\/missing-skill-command": No such file or directory/,
'_exec_replacement leaves the underlying exec failure visible on stderr',
);
like(
$exec_error,
qr/No such file or directory/,
'_exec_replacement returns the system exec failure string when the replacement command cannot be executed',
);
}
{
my $arrayref = [qw(alpha beta)];
is_deeply(
$dispatcher->_arrayref_or_empty($arrayref),
$arrayref,
'_arrayref_or_empty preserves array references',
);
is_deeply(
$dispatcher->_arrayref_or_empty(undef),
[],
'_arrayref_or_empty falls back to an empty array reference',
);
my $hashref = { alpha => 1 };
is_deeply(
$dispatcher->_hashref_or_empty($hashref),
$hashref,
'_hashref_or_empty preserves hash references',
);
is_deeply(
$dispatcher->_hashref_or_empty(undef),
{},
'_hashref_or_empty falls back to an empty hash reference',
);
is(
$dispatcher->_defined_or_default( 'stdin', 'inherit' ),
'stdin',
'_defined_or_default preserves defined values',
( run in 0.704 second using v1.01-cache-2.11-cpan-39bf76dae61 )