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
}
{
local $ENV{DD_TEST_DDFILE_FAIL} = 1;
my $fail_repo = File::Spec->catdir( $test_repos, 'fail-dd-skill' );
make_path($fail_repo);
_write_file( File::Spec->catfile( $fail_repo, 'ddfile' ), "shared-skill\n" );
like(
$manager->_install_skill_dependencies($fail_repo)->{error},
qr/Failed to install dependent skills for/,
'install reports ddfile dependency installation failures',
);
}
{
local $ENV{DD_TEST_NPM_FAIL} = 1;
my $fail_repo = File::Spec->catdir( $test_repos, 'fail-npm-skill' );
make_path($fail_repo);
_write_file(
File::Spec->catfile( $fail_repo, 'package.json' ),
qq|{"name":"fail-npm","version":"0.01.0","dependencies":{"fail-npm-runtime":"^9.9.9"}}\n|
);
like(
$manager->_install_skill_dependencies($fail_repo)->{error},
qr/Failed to install skill Node dependencies/,
'install reports package.json dependency installation failures',
);
}
{
my $missing_home = File::Spec->catdir( $test_repos, 'missing-npm-home' );
my $fail_repo = File::Spec->catdir( $test_repos, 'fail-npm-chdir-skill' );
make_path($fail_repo);
_write_file(
File::Spec->catfile( $fail_repo, 'package.json' ),
qq|{"name":"fail-npm-chdir","version":"0.01.0","dependencies":{"fail-npm-runtime":"^9.9.9"}}\n|
);
my $cwd = getcwd();
my $broken_paths = Developer::Dashboard::PathRegistry->new( home => $missing_home );
my $broken_manager = Developer::Dashboard::SkillManager->new( paths => $broken_paths );
my $error = eval { $broken_manager->_install_skill_package_json($fail_repo); 1 } ? '' : $@;
like(
$error,
qr/Unable to chdir to \Q$missing_home\E for package\.json dependency install/,
'_install_skill_package_json surfaces a HOME chdir failure before npm runs',
);
is(
getcwd(),
$cwd,
'_install_skill_package_json restores the original cwd after a HOME chdir failure',
);
}
{
my $capture_fail_repo = File::Spec->catdir( $test_repos, 'capture-fail-npm-skill' );
make_path($capture_fail_repo);
_write_file(
File::Spec->catfile( $capture_fail_repo, 'package.json' ),
qq|{"name":"capture-fail-npm","version":"1.0.0","dependencies":{"capture-fail-runtime":"^1.0.0"}}\n|
);
my $cwd = getcwd();
my $error;
{
no warnings 'redefine';
local *Developer::Dashboard::SkillManager::_run_streaming_command = sub {
die "synthetic npm streaming failure\n";
};
$error = eval { $manager->_install_skill_package_json($capture_fail_repo); 1 } ? '' : $@;
}
like(
$error,
qr/synthetic npm streaming failure/,
'_install_skill_package_json surfaces streaming failures from the staged npm install workspace',
);
is(
getcwd(),
$cwd,
'_install_skill_package_json restores the original cwd after a staged npm capture failure',
);
}
{
my $installed_dep = File::Spec->catdir( $skill_paths->skills_root, 'shared-skill' );
make_path($installed_dep);
my $skip_repo = File::Spec->catdir( $test_repos, 'skip-dd-skill' );
make_path($skip_repo);
_write_file( File::Spec->catfile( $skip_repo, 'ddfile' ), "shared-skill\nfresh-skill\n" );
unlink $dashboard_log;
my $skip_install = $manager->_install_skill_dependencies($skip_repo);
ok( !$skip_install->{error}, '_install_skill_dependencies skips already-installed ddfile dependencies without looping' ) or diag $skip_install->{error};
open my $dashboard_log_fh, '<', $dashboard_log or die "Unable to read $dashboard_log: $!";
my @dashboard_steps = grep { defined && $_ ne '' } map { chomp; $_ } <$dashboard_log_fh>;
close $dashboard_log_fh;
is_deeply( \@dashboard_steps, ['skills install fresh-skill'], '_install_skill_dependencies skips installed skills and only installs missing ddfile dependencies' );
}
{
my $stacked_repo = File::Spec->catdir( $test_repos, 'stacked-dd-skill' );
make_path($stacked_repo);
_write_file( File::Spec->catfile( $stacked_repo, 'ddfile' ), "stacked-skill\nfresh-skill\n" );
open my $dashboard_script_fh, '<', File::Spec->catfile( $fake_bin, 'dashboard' ) or die "Unable to read fake dashboard script: $!";
my $original_dashboard_script = do { local $/; <$dashboard_script_fh> };
close $dashboard_script_fh;
_write_file(
File::Spec->catfile( $fake_bin, 'dashboard' ),
<<"SH",
#!/bin/sh
printf '%s\\n' "\$*" >> "$dashboard_log"
printf 'DDFILE:%s\\n' "\$*" >> "$dependency_log"
printf 'installed:%s\\n' "\$3"
printf 'warning:%s\\n' "\$3" >&2
if [ "\$DD_TEST_DDFILE_FAIL" = "1" ]; then
exit 1
fi
exit 0
SH
0755,
);
unlink $dashboard_log;
local $ENV{DEVELOPER_DASHBOARD_INSTALL_STACK} = 'stacked-skill';
my $stacked_install = $manager->_install_skill_ddfile($stacked_repo);
ok( !$stacked_install->{error}, '_install_skill_ddfile skips dependencies already present in the install stack' ) or diag $stacked_install->{error};
is( $stacked_install->{stdout}, "installed:fresh-skill\n", '_install_skill_ddfile returns captured stdout when a dependent install emits output' );
is( $stacked_install->{stderr}, "warning:fresh-skill\n", '_install_skill_ddfile returns captured stderr when a dependent install emits warnings' );
open my $stacked_dashboard_log_fh, '<', $dashboard_log or die "Unable to read $dashboard_log after stacked ddfile install: $!";
my @stacked_dashboard_steps = grep { defined && $_ ne '' } map { chomp; $_ } <$stacked_dashboard_log_fh>;
close $stacked_dashboard_log_fh;
is_deeply( \@stacked_dashboard_steps, ['skills install fresh-skill'], '_install_skill_ddfile only invokes dashboard install for dependencies missing from the current install stack' );
_write_file( File::Spec->catfile( $fake_bin, 'dashboard' ), $original_dashboard_script, 0755 );
}
t/21-refactor-coverage.t view on Meta::CPAN
'owner/registered-uninstall-skill',
q{},
),
);
ok( !$manager->install($install_source)->{error}, 'registered-uninstall-skill installs cleanly before uninstalling it' );
ok( !$manager->uninstall('registered-uninstall-skill')->{error}, 'uninstall succeeds for a skill registered in the root ddfile' );
is(
_read_file($root_ddfile),
join( "\n", '# dashboard skills', $keep_source, q{} ),
'uninstall removes matching root ddfile entries while preserving unrelated sources and comments',
);
}
{
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',
t/21-refactor-coverage.t view on Meta::CPAN
undef,
'_skill_env_version returns undef when the .env file has no VERSION assignment',
);
}
{
my $label_root = tempdir( CLEANUP => 1 );
is(
$manager->_dependency_progress_label(
'install_aptfile',
$label_root,
result => { error => "apt exploded\nwith details" },
),
'Install aptfile dependencies (error: apt exploded with details)',
'_dependency_progress_label still surfaces dependency errors when the manifest file is absent',
);
}
{
my $manifest_progress_home = tempdir( CLEANUP => 1 );
my $manifest_progress_paths = Developer::Dashboard::PathRegistry->new( home => $manifest_progress_home );
my @manifest_progress_events;
my $manifest_progress_manager = Developer::Dashboard::SkillManager->new(
paths => $manifest_progress_paths,
progress => sub {
my ($event) = @_;
push @manifest_progress_events, { %{$event} };
},
);
my $manifest_dir = tempdir( CLEANUP => 1 );
my $broken_dependency = File::Spec->catdir( $manifest_dir, 'broken-dependency' );
make_path($broken_dependency);
my $manifest_path = File::Spec->catfile( $manifest_dir, 'ddfile' );
_write_file( $manifest_path, "$broken_dependency\n" );
my @operations;
my $manifest_failure = $manifest_progress_manager->_install_manifest_file(
$manifest_path,
manifest_name => 'ddfile',
skills_root => File::Spec->catdir( $manifest_progress_paths->home_runtime_root, 'skills' ),
operations => \@operations,
progress => 1,
);
ok( $manifest_failure->{error}, '_install_manifest_file returns an explicit error when one manifest source fails' );
like(
$manifest_failure->{error},
qr/Local skill source '\Q$broken_dependency\E' is missing a \.git directory/,
'_install_manifest_file forwards the underlying manifest install failure',
);
is_deeply( \@operations, [], '_install_manifest_file records no completed operations when the first source fails' );
is_deeply(
[ map { $_->{status} } @manifest_progress_events ],
[ 'running', 'failed' ],
'_install_manifest_file emits running and failed progress events for a broken source',
);
}
{
my $default_fail_skill = _create_skill_repo( $test_repos, 'make-default-fail', with_cpanfile => 0 );
_write_file( File::Spec->catfile( $default_fail_skill, 'Makefile' ), "install:\n\t\@true\n" );
my $default_make_failure;
{
no warnings 'redefine';
local *Developer::Dashboard::SkillManager::_run_streaming_command = sub {
my ( undef, %args ) = @_;
my $target = @{ $args{command} } > 1 ? join( ' ', @{ $args{command} }[ 1 .. $#{ $args{command} } ] ) : 'default';
return {
stdout => '',
stderr => "synthetic make failure for $target\n",
exit => 1,
};
};
$default_make_failure = $manager->_install_skill_makefile($default_fail_skill);
}
ok( $default_make_failure->{error}, '_install_skill_makefile returns an explicit error when the default make target fails' );
like(
$default_make_failure->{error},
qr/^Failed to run skill Makefile target 'default' for \Q$default_fail_skill\E: /,
'_install_skill_makefile names the failing default target in its error message',
);
}
{
my $install_target_make_failure;
{
no warnings 'redefine';
local *Developer::Dashboard::SkillManager::_run_streaming_command = sub {
my ( undef, %args ) = @_;
my $target = @{ $args{command} } > 1 ? join( ' ', @{ $args{command} }[ 1 .. $#{ $args{command} } ] ) : 'default';
return {
stdout => '',
stderr => $target eq 'install' ? "synthetic make failure for $target\n" : '',
exit => $target eq 'install' ? 1 : 0,
};
};
$install_target_make_failure = $manager->_install_skill_makefile($dep_skill_root);
}
ok( $install_target_make_failure->{error}, '_install_skill_makefile returns an explicit error when a named target fails' );
like(
$install_target_make_failure->{error},
qr/^Failed to run skill Makefile target 'install' for \Q$dep_skill_root\E: /,
'_install_skill_makefile names the failing non-default target in its error message',
);
}
done_testing();
__END__
=head1 NAME
21-refactor-coverage.t - direct coverage closure for helper packaging and skills
=head1 DESCRIPTION
This test closes direct branch coverage for the private helper packaging,
query parsing, runtime result, path registry, and isolated skill modules.
=for comment FULL-POD-DOC START
=head1 PURPOSE
This test is the executable regression contract for the hard-to-hit branches that keep library coverage honest. Read it when you need to understand the real fixture setup, assertions, and failure modes for this slice of the repository instead of gues...
=head1 WHY IT EXISTS
It exists because the hard-to-hit branches that keep library coverage honest has enough moving parts that a code-only review can miss real regressions. Keeping those expectations in a dedicated test file makes the TDD loop, coverage loop, and release...
=head1 WHEN TO USE
Use this file when changing the hard-to-hit branches that keep library coverage honest, when a focused CI failure points here, or when you want a faster regression loop than running the entire suite.
=head1 HOW TO USE
Run it directly with C<prove -lv t/21-refactor-coverage.t> while iterating, then keep it green under C<prove -lr t> and the coverage runs before release.
=head1 WHAT USES IT
Developers during TDD, the full C<prove -lr t> suite, the coverage gates, and the release verification loop all rely on this file to keep this behavior from drifting.
=head1 EXAMPLES
Example 1:
prove -lv t/21-refactor-coverage.t
Run the focused regression test by itself while you are changing the behavior it owns.
( run in 0.451 second using v1.01-cache-2.11-cpan-6aa56a78535 )