Developer-Dashboard
view release on metacpan or search on metacpan
lib/Developer/Dashboard/SkillDispatcher.pm view on Meta::CPAN
sub command_path {
my ( $self, $skill_name, $command ) = @_;
return if !$skill_name || !$command;
my $command_spec = $self->_command_spec( $skill_name, $command );
return $command_spec ? $command_spec->{cmd_path} : undef;
}
# command_spec($skill_name, $command)
# Resolves one dotted skill command and returns the internal command
# specification used for dispatch.
# Input: skill repo name and command name.
# Output: hash reference containing cmd_path, skill_path, skill_layers, and
# command_name, or undef when the command cannot be resolved.
sub command_spec {
my ( $self, $skill_name, $command ) = @_;
return if !$skill_name || !$command;
return $self->_command_spec( $skill_name, $command );
}
# command_hook_paths($skill_name, $command)
# Enumerates the skill-local hook files that would execute before one resolved
# skill command across every participating skill layer.
# Input: skill repo name and command name.
# Output: ordered list of absolute hook file paths.
sub command_hook_paths {
my ( $self, $skill_name, $command ) = @_;
return () if !$skill_name || !$command;
my $command_spec = $self->_command_spec( $skill_name, $command );
return () if !$command_spec;
my @hooks;
my $resolved_command = $command_spec->{command_name} || '';
return () if $resolved_command eq '';
for my $layer_path ( @{ $command_spec->{skill_layers} || [] } ) {
my $hooks_dir = File::Spec->catdir( $layer_path, 'cli', "$resolved_command.d" );
next if !-d $hooks_dir;
opendir( my $dh, $hooks_dir ) or die "Unable to read $hooks_dir: $!";
for my $entry ( sort grep { $_ ne '.' && $_ ne '..' } readdir($dh) ) {
my $hook_path = File::Spec->catfile( $hooks_dir, $entry );
next unless is_runnable_file($hook_path);
push @hooks, $hook_path;
}
closedir($dh);
}
return @hooks;
}
# route_response(%args)
# Serves isolated skill browser routes and the older /skill bookmark namespace.
# Input: skill name, route path, and optional web app for rendering.
# Output: array reference HTTP response.
sub route_response {
my ( $self, %args ) = @_;
my $skill_name = $args{skill_name} || '';
my $route = defined $args{route} ? $args{route} : '';
my @skill_layers = $self->_skill_layers($skill_name);
return [ 404, 'text/plain; charset=utf-8', "Skill '$skill_name' not found\n" ] if !@skill_layers;
my @parts = grep { defined && $_ ne '' } split m{/+}, $route;
my @dashboards_roots = map { File::Spec->catdir( $_, 'dashboards' ) } @skill_layers;
return [ 404, 'text/plain; charset=utf-8', "Skill '$skill_name' does not provide dashboards\n" ]
if !grep { -d $_ } @dashboards_roots;
if ( @parts && $parts[0] eq 'bookmarks' ) {
if ( @parts == 1 ) {
my @items = $self->_skill_bookmark_entries($skill_name);
return [ 404, 'text/plain; charset=utf-8', "Skill '$skill_name' does not provide dashboards\n" ] if !@items;
return [ 200, 'application/json; charset=utf-8', encode_json( { skill => $skill_name, bookmarks => \@items } ) ];
}
my $legacy_id = join '/', @parts[ 1 .. $#parts ];
return $self->_skill_page_response(
%args,
skill_name => $skill_name,
route_id => $legacy_id,
);
}
my $route_id = @parts ? join( '/', @parts ) : 'index';
return $self->_skill_page_response(
%args,
skill_name => $skill_name,
route_id => $route_id,
);
}
# skill_nav_pages($skill_name)
# Loads the skill-local nav/*.tt or bookmark pages used by /app/<skill> routes.
# Input: skill repo name.
# Output: array ref of prepared page documents before runtime state is applied.
sub skill_nav_pages {
my ( $self, $skill_name ) = @_;
return [] if !$skill_name;
my %route_ids = $self->_skill_nav_route_ids($skill_name);
return [] if !%route_ids;
my @pages;
for my $entry ( sort keys %route_ids ) {
push @pages, $self->_load_skill_page(
skill_name => $skill_name,
route_id => $route_ids{$entry},
);
}
return \@pages;
}
# all_skill_nav_pages()
# Loads nav bookmark pages from every installed skill in deterministic skill order.
# Input: none.
# Output: array ref of prepared page documents before runtime state is applied.
sub all_skill_nav_pages {
my ($self) = @_;
my @pages;
for my $skill_name ( $self->_all_installed_skill_names ) {
push @pages, @{ $self->skill_nav_pages($skill_name) || [] };
}
return \@pages;
}
lib/Developer/Dashboard/SkillDispatcher.pm view on Meta::CPAN
}
die( $@ || "Unable to parse skill bookmark '$route_id'" ) if !$page;
$page->{id} = $skill_name . ( $route_id eq 'index' ? '' : '/' . $route_id );
$page->{meta}{source_kind} = 'skill';
$page->{meta}{skill_name} = $skill_name;
$page->{meta}{skill_route_id} = $route_id;
$page->{meta}{skill_path} = $skill_path;
$page->{meta}{raw_instruction} = $instruction;
return $page;
}
# _skill_env(%args)
# Builds the isolated environment passed to skill hooks and commands.
# Input: skill name, skill path, and command name.
# Output: hash of environment variables.
sub _skill_env {
my ( $self, %args ) = @_;
my $skill_path = $args{skill_path} || die 'Missing skill path';
my $local_root = File::Spec->catdir( $skill_path, 'perl5' );
my $shared_root = File::Spec->catdir( $self->{manager}{paths}->home, 'perl5' );
my @perl5lib_extra;
for my $shared_lib (
File::Spec->catdir( $shared_root, 'lib', 'perl5' ),
File::Spec->catdir( $shared_root, 'lib', 'perl5', $Config::Config{archname} || '' ),
) {
push @perl5lib_extra, $shared_lib if defined $shared_lib && $shared_lib ne '' && -d $shared_lib;
}
for my $layer_path ( reverse @{ $args{skill_layers} || [] } ) {
for my $local_lib (
File::Spec->catdir( $layer_path, 'perl5', 'lib', 'perl5' ),
File::Spec->catdir( $layer_path, 'perl5', 'lib', 'perl5', $Config::Config{archname} || '' ),
) {
push @perl5lib_extra, $local_lib if defined $local_lib && $local_lib ne '' && -d $local_lib;
}
}
return (
DEVELOPER_DASHBOARD_SKILL_NAME => $args{skill_name},
DEVELOPER_DASHBOARD_SKILL_ROOT => $skill_path,
DEVELOPER_DASHBOARD_SKILL_COMMAND => $args{command},
DEVELOPER_DASHBOARD_SKILL_CLI_ROOT => File::Spec->catdir( $skill_path, 'cli' ),
DEVELOPER_DASHBOARD_SKILL_CONFIG_ROOT => File::Spec->catdir( $skill_path, 'config' ),
DEVELOPER_DASHBOARD_SKILL_DOCKER_ROOT => File::Spec->catdir( $skill_path, 'config', 'docker' ),
DEVELOPER_DASHBOARD_SKILL_STATE_ROOT => File::Spec->catdir( $skill_path, 'state' ),
DEVELOPER_DASHBOARD_SKILL_LOGS_ROOT => File::Spec->catdir( $skill_path, 'logs' ),
DEVELOPER_DASHBOARD_SKILL_LOCAL_ROOT => $local_root,
%{ Developer::Dashboard::PerlEnv->dashboard_child_env(
extra => \@perl5lib_extra,
) },
);
}
# _skill_layers($skill_name)
# Returns the participating installed roots for one skill in inheritance order.
# Input: skill repository name string and optional include_disabled flag.
# Output: ordered list of skill root directory path strings from home to leaf.
sub _skill_layers {
my ( $self, $skill_name, %args ) = @_;
return () if !$skill_name;
my @segments = grep { defined && $_ ne '' } split m{/+}, $skill_name;
return () if !@segments;
my $root_skill = shift @segments;
my $paths = $self->{manager}{paths};
my @layers = $paths->can('skill_layers')
? $paths->skill_layers( $root_skill, %args )
: do {
my $skill_path = $self->{manager}->get_skill_path( $root_skill, %args ) or return ();
($skill_path);
};
return @layers if !@segments;
for my $nested_skill (@segments) {
my @next_layers;
for my $skill_path (@layers) {
my $nested_path = $self->_nested_skill_path( $skill_path, [$nested_skill] );
next if !-d $nested_path;
my $disabled = -f File::Spec->catfile( $nested_path, '.disabled' ) ? 1 : 0;
next if !$args{include_disabled} && $disabled;
push @next_layers, $nested_path;
}
return () if !@next_layers;
@layers = @next_layers;
}
return @layers;
}
# _skill_lookup_roots($skill_name)
# Returns the participating installed roots for one skill in effective lookup order.
# Input: skill repository name string and optional include_disabled flag.
# Output: ordered list of skill root directory path strings from leaf to home.
sub _skill_lookup_roots {
my ( $self, $skill_name, %args ) = @_;
return reverse $self->_skill_layers( $skill_name, %args );
}
# resolve_route_segments($segments)
# Resolves the longest installed skill-prefix from one slash-delimited route tail.
# Input: array reference of path segments and optional include_disabled flag.
# Output: hash reference containing skill_name, route_segments, and skill_layers, or undef.
sub resolve_route_segments {
my ( $self, $segments, %args ) = @_;
my @segments = grep { defined && $_ ne '' } @{ $segments || [] };
return if !@segments;
my $best;
for my $prefix_length ( 1 .. scalar @segments ) {
my $candidate_skill = join '/', @segments[ 0 .. $prefix_length - 1 ];
my @skill_layers = $self->_skill_layers( $candidate_skill, %args );
next if !@skill_layers;
$best = {
skill_name => $candidate_skill,
route_segments => [ @segments[ $prefix_length .. $#segments ] ],
skill_layers => \@skill_layers,
};
}
return $best;
}
# _command_spec($skill_name, $command)
# Resolves one runnable skill command across every participating skill layer,
lib/Developer/Dashboard/SkillDispatcher.pm view on Meta::CPAN
skill_layers => \@provider_layers,
command_name => $command_root_spec->{command_name},
};
}
}
return;
}
# _command_root_specs(\@segments)
# Builds candidate nested-skill command roots from the dotted command tail.
# Input: array reference of dotted command segments.
# Output: ordered list of hash references with nested_segments and command_name.
sub _command_root_specs {
my ( $self, $segments ) = @_;
my @segments = @{ $segments || [] };
return () if !@segments;
my @specs = (
{
nested_segments => [],
command_name => join( '.', @segments ),
},
);
for my $split_index ( 1 .. $#segments ) {
push @specs, {
nested_segments => [ @segments[ 0 .. $split_index - 1 ] ],
command_name => join( '.', @segments[ $split_index .. $#segments ] ),
};
}
return @specs;
}
# _nested_skill_path($skill_path, \@nested_segments)
# Resolves one nested installed-skill tree where each dotted skill segment lives
# beneath its own repeated skills/<repo> directory pair.
# Input: installed skill root path string and array reference of nested skill names.
# Output: absolute nested skill root path string.
sub _nested_skill_path {
my ( $self, $skill_path, $nested_segments ) = @_;
my @segments = @{ $nested_segments || [] };
return $skill_path if !@segments;
my @parts = ($skill_path);
for my $segment (@segments) {
push @parts, 'skills', $segment;
}
return File::Spec->catdir(@parts);
}
# _page_location($skill_name, $route_id)
# Resolves one skill dashboard file across every participating skill layer.
# Input: skill repository name string and route id string such as index or nav/foo.tt.
# Output: file path string and the skill layer root that provided it.
sub _page_location {
my ( $self, $skill_name, $route_id ) = @_;
return if !$skill_name || !$route_id;
for my $skill_path ( $self->_skill_lookup_roots($skill_name) ) {
my $file = File::Spec->catfile( $skill_path, 'dashboards', split m{/+}, $route_id );
return ( $file, $skill_path ) if -f $file;
}
return;
}
# skill_route_spec($kind, $skill_name, $target)
# Resolves one custom config/routes.json route definition for a skill route kind.
# Input: route kind string, skill repository name string, and relative route target path.
# Output: normalized route spec hash reference or undef when no custom route exists.
sub skill_route_spec {
my ( $self, $kind, $skill_name, $target ) = @_;
return if !$kind || !$skill_name || !$target;
my $routes = $self->_skill_routes_for( $skill_name, $kind );
return $routes->{$target};
}
# skill_ajax_route_spec($skill_name, $ajax_file)
# Resolves one custom config/routes.json ajax route definition for a skill.
# Input: skill repository name string and relative ajax file path.
# Output: normalized route spec hash reference or undef when no custom route exists.
sub skill_ajax_route_spec {
my ( $self, $skill_name, $ajax_file ) = @_;
return $self->skill_route_spec( 'ajax', $skill_name, $ajax_file );
}
# resolve_custom_route_path($path)
# Resolves one canonical or alias custom route path across installed skills and route kinds.
# Input: absolute request path string.
# Output: normalized route spec hash reference or undef when no custom route matches.
sub resolve_custom_route_path {
my ( $self, $path ) = @_;
return if !defined $path || $path eq '';
for my $spec ( reverse $self->_runtime_custom_route_specs ) {
return $spec if ( $spec->{path} || '' ) eq $path;
my $aliases = $spec->{aliases};
$aliases = [] if ref($aliases) ne 'ARRAY';
return $spec if grep { $_ eq $path } @{$aliases};
}
for my $skill_name ( $self->_all_installed_skill_names ) {
for my $kind (qw(app ajax js css others)) {
my $routes = $self->_skill_routes_for( $skill_name, $kind );
for my $target ( sort keys %{$routes} ) {
my $spec = $routes->{$target};
return $spec if ( $spec->{path} || '' ) eq $path;
my $aliases = $spec->{aliases};
$aliases = [] if ref($aliases) ne 'ARRAY';
return $spec if grep { $_ eq $path } @{$aliases};
}
}
}
return;
}
# _runtime_custom_route_specs()
# Loads runtime-level config/routes.json custom route metadata across every
# participating DD-OOP-LAYER config root.
# Input: none.
# Output: ordered list of normalized route specs from home to deepest layer.
sub _runtime_custom_route_specs {
my ($self) = @_;
lib/Developer/Dashboard/SkillDispatcher.pm view on Meta::CPAN
}
return \%expanded;
}
# _normalize_skill_route_spec(%args)
# Validates and normalizes one config/routes.json route entry.
# Input: kind, skill_name, target, routes_file, and raw spec hash reference.
# Output: normalized route spec hash reference.
sub _normalize_skill_route_spec {
my ( $self, %args ) = @_;
my $kind = $args{kind} || die 'Missing kind';
my $skill_name = $args{skill_name};
my $target = $args{target} || die 'Missing target';
my $routes_file = $args{routes_file} || die 'Missing routes_file';
my $spec = $args{spec};
die "$routes_file $kind entry '$target' must be a JSON object" if ref($spec) ne 'HASH';
die "$routes_file $kind entry '$target' path is required"
if !defined $spec->{path} || $spec->{path} eq '';
die "$routes_file $kind entry '$target' path must start with /"
if $spec->{path} !~ m{\A/};
my $aliases = $spec->{aliases};
$aliases = [] if !defined $aliases;
die "$routes_file $kind entry '$target' aliases must be an array"
if ref($aliases) ne 'ARRAY';
my @aliases = grep { defined $_ && $_ ne '' } @{$aliases};
for my $alias (@aliases) {
die "$routes_file $kind entry '$target' aliases must start with /"
if $alias !~ m{\A/};
}
if ( exists $spec->{type} ) {
die "$routes_file $kind entry '$target' type must be a scalar"
if ref( $spec->{type} );
die "$routes_file $kind entry '$target' type must not be empty"
if !defined $spec->{type} || $spec->{type} eq '';
die "$routes_file app entry '$target' must not declare type"
if $kind eq 'app';
}
my $normalized = {
aliases => \@aliases,
kind => $kind,
path => $spec->{path},
source_file => $routes_file,
target => $target,
type => $spec->{type},
};
$normalized->{skill_name} = $skill_name if defined $skill_name && $skill_name ne '';
$normalized->{ajax_file} = $target if $kind eq 'ajax';
$normalized->{route_id} = $target if $kind eq 'app';
$normalized->{file} = $target if $kind ne 'ajax' && $kind ne 'app';
return $normalized;
}
# skill_ajax_file_path($skill_name, $ajax_file)
# Resolves one layered skill-local dashboards/ajax file in deepest-first order.
# Input: skill repository name string and relative ajax file path.
# Output: absolute file path string or undef when missing.
sub skill_ajax_file_path {
my ( $self, $skill_name, $ajax_file ) = @_;
return if !$skill_name || !$ajax_file;
for my $skill_path ( $self->_skill_lookup_roots($skill_name) ) {
my $file = File::Spec->catfile( $skill_path, 'dashboards', 'ajax', split m{/+}, $ajax_file );
return $file if -f $file;
}
return;
}
# skill_static_file_path($skill_name, $type, $file)
# Resolves one layered skill-local dashboards/public asset in deepest-first order.
# Input: skill repository name string, static asset type, and relative file path.
# Output: absolute file path string or undef when missing.
sub skill_static_file_path {
my ( $self, $skill_name, $type, $file ) = @_;
return if !$skill_name || !$type || !$file;
for my $skill_path ( $self->_skill_lookup_roots($skill_name) ) {
my $candidate = File::Spec->catfile( $skill_path, 'dashboards', 'public', $type, split m{/+}, $file );
return $candidate if -f $candidate;
}
return;
}
# _skill_bookmark_entries($skill_name)
# Enumerates non-nav bookmark files contributed by one layered skill with deepest
# duplicates overriding shallower layers.
# Input: skill repository name string.
# Output: sorted list of bookmark entry names.
sub _skill_bookmark_entries {
my ( $self, $skill_name ) = @_;
return () if !$skill_name;
my %entries;
for my $skill_path ( $self->_skill_lookup_roots($skill_name) ) {
my $dashboards_root = File::Spec->catdir( $skill_path, 'dashboards' );
next if !-d $dashboards_root;
opendir( my $dh, $dashboards_root ) or die "Unable to read $dashboards_root: $!";
for my $entry (
grep {
$_ ne '.'
&& $_ ne '..'
&& $_ ne 'nav'
&& $_ ne 'routes.json'
&& -f File::Spec->catfile( $dashboards_root, $_ )
} readdir($dh)
)
{
$entries{$entry} ||= 1;
}
closedir($dh);
}
return sort keys %entries;
}
# _skill_nav_route_ids($skill_name)
# Enumerates nav/*.tt routes contributed by one layered skill with deepest
# duplicates overriding shallower layers.
# Input: skill repository name string.
# Output: hash of nav filenames to route ids.
sub _skill_nav_route_ids {
my ( $self, $skill_name ) = @_;
return () if !$skill_name;
my %routes;
for my $skill_path ( $self->_skill_lookup_roots($skill_name) ) {
my $nav_root = File::Spec->catdir( $skill_path, 'dashboards', 'nav' );
next if !-d $nav_root;
for my $entry ( $self->_relative_files($nav_root) ) {
$routes{$entry} ||= 'nav/' . $entry;
}
}
return %routes;
}
# _all_installed_skill_names()
# Enumerates every enabled installed skill name, including nested skills/<repo>
# trees, in deterministic order for shared nav rendering and similar global
# skill discovery paths.
# Input: none.
# Output: ordered list of slash-delimited installed skill names.
( run in 0.656 second using v1.01-cache-2.11-cpan-71847e10f99 )