view release on metacpan or  search on metacpan

lib/Developer/Dashboard/SkillDispatcher.pm  view on Meta::CPAN

    }

    for my $item ( @{$right} ) {
        if ( ref($item) eq 'HASH' ) {
            my $identity = $item->{$field};
            if ( defined $identity && $identity ne '' ) {
                if ( exists $positions{$identity} ) {
                    $combined[ $positions{$identity} ] = $item;
                    next;
                }
                $positions{$identity} = scalar @combined;
            }
        }
        push @combined, $item;
    }

    return \@combined;
}

# _defined_or_default($value, $default)
# Supplies a default scalar only when the candidate value is undef.
# Input: candidate scalar and fallback scalar.
# Output: original scalar when defined, otherwise the fallback scalar.
sub _defined_or_default {
    my ( $self, $value, $default ) = @_;
    return defined $value ? $value : $default;
}

# get_skill_config($skill_name)
# Reads and returns a skill's configuration.
# Input: skill repo name.
# Output: hash ref with config or empty hash.
sub get_skill_config {
    my ( $self, $skill_name ) = @_;
    
    return {} if !$skill_name;

    my @skill_layers = $self->_skill_layers($skill_name);
    return {} if !@skill_layers;

    my $merged = {};
    for my $skill_path (@skill_layers) {
        my $config_file = File::Spec->catfile( $skill_path, 'config', 'config.json' );
        next if !-f $config_file;

        open( my $fh, '<', $config_file ) or return {};
        my $json_text = do { local $/; <$fh> };
        close($fh);

        my $config = eval { decode_json($json_text) } || {};
        return {} if ref($config) ne 'HASH';
        $merged = $self->_merge_skill_hashes( $merged, $config );
    }

    return $merged;
}

# config_fragment($skill_name)
# Wraps one installed skill config under its underscored runtime key for merged config use.
# Input: skill repo name.
# Output: hash ref containing one underscored skill key and its decoded config.
sub config_fragment {
    my ( $self, $skill_name ) = @_;
    return {} if !$skill_name;
    my $config = $self->get_skill_config($skill_name);
    return {} if ref($config) ne 'HASH' || !%{$config};
    return { '_' . $skill_name => $config };
}

# get_skill_path($skill_name)
# Returns the path to an installed skill.
# Input: skill repo name.
# Output: skill path string or undef.
sub get_skill_path {
    my ( $self, $skill_name ) = @_;
    
    return if !$skill_name;
    return $self->{manager}->get_skill_path($skill_name);
}

# command_path($skill_name, $command)
# Resolves one executable command within the isolated skill CLI tree.
# Input: skill repo name and command name.
# Output: executable file path string or undef.
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;

lib/Developer/Dashboard/SkillDispatcher.pm  view on Meta::CPAN

# resolve_ajax_route_path($path)
# Resolves one canonical or alias custom ajax route path across installed skills.
# Input: absolute request path string.
# Output: normalized route spec hash reference or undef when no custom ajax route matches.
sub resolve_ajax_route_path {
    my ( $self, $path ) = @_;
    my $spec = $self->resolve_custom_route_path($path);
    return if !$spec || ( $spec->{kind} || '' ) ne 'ajax';
    return $spec;
}

# _skill_routes_for($skill_name, $kind)
# Loads and merges config/routes.json metadata for one layered skill and route kind.
# Input: skill repository name string and route kind string.
# Output: hash reference keyed by relative route target with normalized route specs.
sub _skill_routes_for {
    my ( $self, $skill_name, $kind ) = @_;
    return {} if !$skill_name || !$kind;
    my %routes;
    my %claimed_paths;

    for my $skill_path ( $self->_skill_lookup_roots($skill_name) ) {
        my $routes_file = File::Spec->catfile( $skill_path, 'config', 'routes.json' );
        next if !-f $routes_file;
        my $payload = $self->_load_skill_routes_file($routes_file);
        my $kind_routes = $payload->{$kind} || {};
        for my $target ( sort keys %{$kind_routes} ) {
            next if exists $routes{$target};
            my $spec = $self->_normalize_skill_route_spec(
                kind       => $kind,
                skill_name => $skill_name,
                target     => $target,
                routes_file => $routes_file,
                spec       => $kind_routes->{$target},
            );
            for my $route_path ( $spec->{path}, @{ $spec->{aliases} || [] } ) {
                next if !defined $route_path || $route_path eq '';
                die "Duplicate $kind route path '$route_path' in skill '$skill_name'"
                  if $claimed_paths{$route_path}++;
            }
            $routes{$target} = $spec;
        }
    }

    return \%routes;
}

# _skill_ajax_routes_for($skill_name)
# Backward-compatible wrapper for the ajax-specific custom route map loader.
# Input: skill repository name string.
# Output: hash reference keyed by ajax file path.
sub _skill_ajax_routes_for {
    my ( $self, $skill_name ) = @_;
    return $self->_skill_routes_for( $skill_name, 'ajax' );
}

# _load_skill_routes_file($routes_file)
# Parses one config/routes.json file and validates the top-level schema.
# Input: absolute routes.json file path.
# Output: decoded hash reference.
sub _load_skill_routes_file {
    my ( $self, $routes_file ) = @_;
    open my $fh, '<', $routes_file or die "Unable to read $routes_file: $!";
    local $/;
    my $json_text = <$fh>;
    close $fh;
    my $payload = eval { decode_json($json_text) };
    die "Invalid JSON in $routes_file: $@" if $@;
    die "$routes_file must contain a JSON object" if ref($payload) ne 'HASH';
    my @non_version_keys = grep { $_ ne 'version' } keys %{$payload};
    my $has_flat_keys = grep { m{\A/} } @non_version_keys;
    my $has_typed_keys = grep { /^(?:app|ajax|js|css|others)$/ } @non_version_keys;
    die "$routes_file must not mix flat custom-path routes with typed route sections"
      if $has_flat_keys && $has_typed_keys;
    if ($has_flat_keys) {
        my @invalid = grep { $_ !~ m{\A/} } @non_version_keys;
        die "$routes_file flat routes must use absolute custom-path keys"
          if @invalid;
        return $self->_expand_flat_skill_routes_payload( $routes_file, $payload );
    }
    my @unknown = grep { $_ !~ /^(?:app|ajax|js|css|others)$/ } @non_version_keys;
    die "$routes_file contains unsupported top-level keys: @unknown"
      if @unknown;
    die "$routes_file version must be 1" if exists $payload->{version} && ( $payload->{version} || 0 ) != 1;
    for my $kind (qw(app ajax js css others)) {
        if ( exists $payload->{$kind} ) {
            die "$routes_file $kind must be a JSON object" if ref( $payload->{$kind} ) ne 'HASH';
        }
        else {
            $payload->{$kind} = {};
        }
    }
    return $payload;
}

# _expand_flat_skill_routes_payload($routes_file, $payload)
# Converts the flat custom-path config/routes.json schema into the internal typed route map.
# Input: absolute routes.json file path and decoded payload hash reference.
# Output: normalized payload hash reference with app/ajax/js/css/others maps.
sub _expand_flat_skill_routes_payload {
    my ( $self, $routes_file, $payload ) = @_;
    my %expanded = map { $_ => {} } qw(app ajax js css others);
    my %claimed_targets;
    for my $route_path ( sort grep { $_ ne 'version' } keys %{$payload} ) {
        die "$routes_file route path '$route_path' must start with /"
          if $route_path !~ m{\A/};
        my $route = $payload->{$route_path};
        my ( $to, $type );
        if ( !ref($route) ) {
            $to = $route;
        }
        elsif ( ref($route) eq 'HASH' ) {
            my @unknown = grep { $_ ne 'to' && $_ ne 'type' } keys %{$route};
            die "$routes_file route path '$route_path' contains unsupported keys: @unknown"
              if @unknown;
            $to   = $route->{to};
            $type = $route->{type};
        }
        else {
            die "$routes_file route path '$route_path' must map to a string or JSON object";
        }
        die "$routes_file route path '$route_path' must map to a non-empty route target"
          if !defined $to || ref($to) || $to eq '';
        my ( $kind, $target ) = $to =~ m{\A/(ajax|app|js|css|others)/(.*)\z};
        die "$routes_file route path '$route_path' must map to /ajax/, /app/, /js/, /css/, or /others/"
          if !$kind;
        die "$routes_file route path '$route_path' target must not be empty"
          if !defined $target || $target eq '';
        die "$routes_file route path '$route_path' type must be a scalar"
          if defined $type && ref($type);
        die "$routes_file route path '$route_path' type must not be empty"
          if defined $type && $type eq '';
        die "$routes_file route path '$route_path' does not allow type for /app targets"
          if defined $type && $kind eq 'app';
        die "$routes_file route path '$route_path' does not allow type for /js targets"
          if defined $type && $kind eq 'js';
        die "$routes_file route path '$route_path' does not allow type for /css targets"
          if defined $type && $kind eq 'css';
        die "Duplicate $kind route target '/$kind/$target' in $routes_file"
          if $claimed_targets{"$kind:$target"}++;
        $type = 'json' if !defined $type && $kind eq 'ajax';
        $expanded{$kind}{$target} = {
            path => $route_path,
            ( defined $type ? ( type => $type ) : () ),
        };
    }
    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';