Developer-Dashboard

 view release on metacpan or  search on metacpan

lib/Developer/Dashboard/Web/App.pm  view on Meta::CPAN

    return $self->_legacy_ajax_response(
        params       => \%request_params,
        remote_addr  => $args{remote_addr},
        headers      => $args{headers} || {},
    );
}

# legacy_ajax_file_response(%args)
# Executes one `/ajax/<file>` compatibility route against a saved ajax file.
# Input: ajax file name plus normalized request query, body, headers, and remote address.
# Output: response array reference.
sub legacy_ajax_file_response {
    my ( $self, %args ) = @_;
    my $ajax_file = $args{ajax_file} || '';
    my ( $params, $body_params ) = $self->_request_params(%args);
    my %request_params = ( %{$params}, %{$body_params}, file => $ajax_file );
    return _transient_url_forbidden_response() if !$self->_legacy_ajax_allowed( \%request_params );
    return $self->_legacy_ajax_response(
        params       => \%request_params,
        remote_addr  => $args{remote_addr},
        headers      => $args{headers} || {},
    );
}

# skill_ajax_file_response(%args)
# Executes one `/ajax/<skill>/<file>` route against a layered skill-local ajax file.
# Input: skill name, ajax file name, and normalized request metadata.
# Output: response array reference.
sub skill_ajax_file_response {
    my ( $self, %args ) = @_;
    my $skill_name = $args{skill_name} || '';
    my $ajax_file  = $args{ajax_file}  || '';
    return [ 400, 'text/plain; charset=utf-8', "Invalid skill name\n" ] if $skill_name eq '';
    my %params = _parse_query( $args{query} || '' );
    my %body_params = _parse_query( $args{body} || '' );
    my $saved_ajax_path = $self->_skill_ajax_file_path( $skill_name, $ajax_file );
    my %request_params = (
        %params,
        %body_params,
        file => $saved_ajax_path ne '' ? $ajax_file : join( '/', $skill_name, $ajax_file ),
    );
    if ( !exists $request_params{type} && ( $args{default_type} || '' ) ne '' ) {
        $request_params{type} = $args{default_type};
    }
    return _transient_url_forbidden_response() if !$self->_legacy_ajax_allowed( \%request_params );
    return $self->_legacy_ajax_response(
        params          => \%request_params,
        saved_ajax_path => $saved_ajax_path,
    );
}

# prefixed_ajax_file_response(%args)
# Resolves one `/ajax/...` request by preferring the longest matching skill prefix
# and falling back to the normal nested saved-ajax file path when no skill-local
# handler exists.
# Input: ajax_path plus normalized request metadata.
# Output: response array reference.
sub prefixed_ajax_file_response {
    my ( $self, %args ) = @_;
    my $ajax_path = $args{ajax_path} || '';
    my @segments = grep { defined && $_ ne '' } split m{/+}, $ajax_path;
    if ( my $spec = $self->_resolve_skill_route_spec(@segments) ) {
        my $ajax_file = join '/', @{ $spec->{route_segments} || [] };
        if ( $ajax_file ne '' ) {
            my $saved_ajax_path = $self->_skill_ajax_file_path( $spec->{skill_name}, $ajax_file );
            my $route_spec = $self->_skill_ajax_route_spec( $spec->{skill_name}, $ajax_file );
            return $self->skill_ajax_file_response(
                %args,
                default_type => $route_spec ? ( $route_spec->{type} || '' ) : '',
                skill_name   => $spec->{skill_name},
                ajax_file    => $ajax_file,
            ) if $saved_ajax_path ne '';
        }
    }
    return $self->legacy_ajax_file_response( %args, ajax_file => $ajax_path );
}

# status_response(%args)
# Executes the `/system/status` route.
# Input: normalized request arguments.
# Output: response array reference.
sub status_response {
    my ( $self, %args ) = @_;
    my $payload = $self->_page_status_payload;
    return [ 200, 'application/json; charset=utf-8', json_encode($payload) ];
}

# marked_js_response(%args)
# Serves the bundled jQuery asset used by saved bookmark pages.
# Input: normalized request arguments.
# Output: response array reference.
sub jquery_js_response {
    my ( $self, %args ) = @_;
    my $path = _bundled_public_asset_path( 'js', 'jquery-4.0.0.min.js' );
    open my $fh, '<:raw', $path or die "Unable to read $path: $!";
    local $/;
    my $content = <$fh>;
    close $fh or die "Unable to close $path: $!";
    return [ 200, 'application/javascript; charset=utf-8', $content ];
}

# _bundled_public_asset_path($type, $file)
# Resolves one bundled public asset from the repo share tree during
# development or from the installed distribution share dir after install.
# Input: asset type directory plus file name.
# Output: absolute asset path string.
sub _bundled_public_asset_path {
    my ( $type, $file ) = @_;
    die 'asset type is required' if !defined $type || $type eq '';
    die 'asset file is required' if !defined $file || $file eq '';

    my $module_source = $MODULE_SOURCE_PATH || File::Spec->rel2abs(__FILE__);
    my $module_dir    = dirname($module_source);
    my @candidates;

    for my $levels_up ( 4 .. 7 ) {
        push @candidates, File::Spec->catfile(
            File::Spec->rel2abs(
                File::Spec->catdir(
                    $module_dir,
                    ( File::Spec->updir ) x $levels_up,

lib/Developer/Dashboard/Web/App.pm  view on Meta::CPAN


    my %seen;
    for my $candidate (@candidates) {
        next if !defined $candidate || $candidate eq '' || $seen{$candidate}++;
        return $candidate if -f $candidate;
    }

    die "Unable to find bundled public asset $type/$file";
}

# marked_js_response(%args)
# Serves the built-in marked shim asset.
# Input: normalized request arguments.
# Output: response array reference.
sub marked_js_response {
    my ( $self, %args ) = @_;
    return [ 200, 'application/javascript; charset=utf-8', "window.marked=window.marked||{parse:function(s){return s||'';}};\n" ];
}

# tiff_js_response(%args)
# Serves the built-in TIFF shim asset.
# Input: normalized request arguments.
# Output: response array reference.
sub tiff_js_response {
    my ( $self, %args ) = @_;
    return [ 200, 'application/javascript; charset=utf-8', "window.Tiff=window.Tiff||function(){};\n" ];
}

# loading_image_response(%args)
# Serves the built-in loading image response.
# Input: normalized request arguments.
# Output: response array reference.
sub loading_image_response {
    my ( $self, %args ) = @_;
    return [ 200, 'image/webp', '' ];
}

# static_file_response(%args)
# Serves one static asset from the dashboard public tree.
# Input: asset type and file name.
# Output: response array reference.
sub static_file_response {
    my ( $self, %args ) = @_;
    if ( ( $args{type} || '' ) eq 'js' ) {
        my $file = $args{file} || '';
        return $self->jquery_js_response(%args) if $file eq 'jquery.js' || $file eq 'jquery-4.0.0.min.js';
    }
    return $self->_serve_static_file( $args{type}, $args{file} );
}

# prefixed_static_file_response(%args)
# Resolves one `/js/...`, `/css/...`, or `/others/...` request by preferring the
# longest matching skill prefix and falling back to the normal nested public
# asset path when no skill-local asset exists.
# Input: asset type, requested file path, and normalized request metadata.
# Output: response array reference.
sub prefixed_static_file_response {
    my ( $self, %args ) = @_;
    my $type = $args{type} || '';
    my $file = $args{file} || '';
    my @segments = grep { defined && $_ ne '' } split m{/+}, $file;
    if ( my $spec = $self->_resolve_skill_route_spec(@segments) ) {
        my $skill_file = join '/', @{ $spec->{route_segments} || [] };
        if ( $skill_file ne '' ) {
            my $resolved = $self->_skill_static_file_path( $spec->{skill_name}, $type, $skill_file );
            my $route_spec = $self->_skill_route_spec( $type, $spec->{skill_name}, $skill_file );
            return $self->skill_static_file_response(
                %args,
                default_type => $route_spec ? ( $route_spec->{type} || '' ) : '',
                skill_name => $spec->{skill_name},
                file       => $skill_file,
            ) if $resolved ne '';
        }
    }
    return $self->static_file_response( %args, type => $type, file => $file );
}

# legacy_app_response(%args)
# Executes the saved `/app/<id>` render route and follows saved URL forwards.
# Input: saved app id plus normalized request query, body, headers, and remote address.
# Output: response array reference.
sub legacy_app_response {
    my ( $self, %args ) = @_;
    my ( $params, $body_params ) = $self->_request_params(%args);
    return $self->_legacy_app_response(
        id           => $args{id},
        query_params => $params,
        body_params  => $body_params,
        remote_addr  => $args{remote_addr},
        headers      => $args{headers} || {},
    );
}

# skill_route_response(%args)
# Executes routes provided by installed skills.
# Routes are namespaced under /skill/<repo-name>/<route>
# Input: skill_name, route, query params, headers, and remote address.
# Output: response array reference.
sub skill_route_response {
    my ( $self, %args ) = @_;
    my $skill_name = $args{skill_name} || '';
    my $route = $args{route} || '';
    
    return [ 400, 'text/plain; charset=utf-8', "Invalid skill name\n" ] if !$skill_name;
    return [ 400, 'text/plain; charset=utf-8', "Invalid skill route\n" ] if !$route;
    
    require Developer::Dashboard::SkillDispatcher;
    my $dispatcher = Developer::Dashboard::SkillDispatcher->new( paths => $self->{pages} ? $self->{pages}{paths} : undef );
    my ( $query_params, $body_params ) = $self->_request_params(%args);
    return $dispatcher->route_response(
        app          => $self,
        body_params  => $body_params,
        headers      => $args{headers} || {},
        path         => $args{path} || '',
        query_params => $query_params,
        remote_addr  => $args{remote_addr},
        route        => $route,
        skill_name   => $skill_name,
    );
}

lib/Developer/Dashboard/Web/App.pm  view on Meta::CPAN

}

# _legacy_app_response(%args)
# Loads an older /app/<name> resource as either a bookmark page or saved URL forward.
# Input: bookmark id and request metadata.
# Output: response array reference.
sub _legacy_app_response {
    my ( $self, %args ) = @_;
    my $id = $args{id} || die 'Missing app id';
    my $parsed = eval { $self->_load_named_page($id) };
    if ($parsed) {
        $parsed = $self->_page_with_runtime_state(
            $parsed,
            query_params => $args{query_params} || {},
            body_params  => $args{body_params}  || {},
            path         => '/app/' . $id,
            remote_addr  => $args{remote_addr},
            headers      => $args{headers},
        );
        $parsed = $self->{runtime}->prepare_page(
            page            => $parsed,
            source          => 'saved',
            runtime_context => { params => {} },
        );
        return [ 200, 'text/html; charset=utf-8', $self->_render_page_html( $parsed, 'render' ) ];
    }

    my $raw = eval { $self->{pages}->read_saved_entry($id) };
    if ( !defined $raw || $@ ) {
        my $skill_response = $self->_skill_app_fallback_response( id => $id, %args );
        return $skill_response if $skill_response;
        return $self->_missing_named_page_response($id);
    }
    my $target = _trim($raw);
    my $uri = URI->new($target);
    my $path = $uri->path;
    my %bookmark_params = _parse_query( scalar( $uri->query // '' ) );
    my %forward_params = (
        %bookmark_params,
        %{ $args{query_params} || {} },
        %{ $args{body_params}  || {} },
    );
    my $query = _build_query( \%forward_params );
    return $self->dispatch_request(
        path        => $path,
        query       => $query,
        method      => 'GET',
        body        => '',
        remote_addr => $args{remote_addr},
        headers     => $args{headers} || {},
    );
}

# _skill_app_fallback_response(%args)
# Attempts the /app/<skill> or /app/<skill>/<page> fallback before the blank saved-page editor opens.
# Input: unresolved app id plus normalized request metadata.
# Output: response array reference for a matched skill route, a 404 for missing namespaced skill routes, or undef when the id is not a skill route.
sub _skill_app_fallback_response {
    my ( $self, %args ) = @_;
    my $id = $args{id} || return;
    my @segments = grep { defined && $_ ne '' } split m{/+}, $id;
    return if !@segments;

    require Developer::Dashboard::SkillDispatcher;
    require Developer::Dashboard::SkillManager;
    my $dispatcher = Developer::Dashboard::SkillDispatcher->new( paths => $self->{pages} ? $self->{pages}{paths} : undef );
    my $manager = Developer::Dashboard::SkillManager->new( paths => $self->{pages} ? $self->{pages}{paths} : undef );
    my $installed_skill = $manager->get_skill_path( $segments[0], include_disabled => 1 );
    return $segments[1] ? [ 404, 'text/plain; charset=utf-8', "Not found\n" ] : undef if !$installed_skill;
    my $spec = $dispatcher->resolve_route_segments( \@segments, include_disabled => 1 );
    return $segments[1] ? [ 404, 'text/plain; charset=utf-8', "Not found\n" ] : undef if !$spec;
    if ( !@{ $spec->{skill_layers} || [] } ) {
        return [ 404, 'text/plain; charset=utf-8', "Not found\n" ];
    }

    return $dispatcher->route_response(
        app          => $self,
        skill_name   => $spec->{skill_name},
        route        => join( '/', @{ $spec->{route_segments} || [] } ),
        query_params => $args{query_params} || {},
        body_params  => $args{body_params}  || {},
        remote_addr  => $args{remote_addr},
        headers      => $args{headers} || {},
        path         => '/app/' . $id,
    );
}

# _resolve_skill_route_spec(@segments)
# Resolves the longest installed skill-prefix for a slash-delimited route tail.
# Input: one list of path segments.
# Output: hash reference with skill_name, route_segments, and skill_layers, or undef.
sub _resolve_skill_route_spec {
    my ( $self, @segments ) = @_;
    return $self->_skill_dispatcher->resolve_route_segments( \@segments );
}

# _custom_skill_route_response(%args)
# Resolves one non-smart custom skill route path after all primary routes have
# already declined to handle the request.
# Input: normalized request metadata plus route_path.
# Output: response array reference or undef when no custom skill route matches.
sub _custom_skill_route_response {
    my ( $self, %args ) = @_;
    my $route_path = $args{route_path} || '';
    return if $route_path eq '' || $route_path eq '/';
    my $spec = $self->_skill_dispatcher->resolve_custom_route_path($route_path);
    return if !$spec;
    if ( !( $spec->{skill_name} || '' ) ) {
        my $kind = $spec->{kind} || '';
        my $dispatch_path = '';
        if ( $kind eq 'app' ) {
            $dispatch_path = '/app/' . ( $spec->{route_id} || '' );
        }
        elsif ( $kind eq 'ajax' ) {
            $dispatch_path = '/ajax/' . ( $spec->{ajax_file} || '' );
        }
        elsif ( grep { $_ eq $kind } qw(js css others) ) {
            $dispatch_path = '/' . $kind . '/' . ( $spec->{file} || '' );
        }
        return if $dispatch_path eq '';
        return $self->dispatch_request(



( run in 0.921 second using v1.01-cache-2.11-cpan-71847e10f99 )