File Coverage

blib/lib/PAGI/App/Router.pm

Criterion	Covered	Total	%
statement	363	399	90.9
branch	122	142	85.9
condition	57	85	67.0
subroutine	31	35	88.5
pod	11	20	55.0
total	584	681	85.7

package PAGI::App::Router;

use strict;
use warnings;
use Future::AsyncAwait;
use Scalar::Util qw(blessed);
use Carp qw(croak);

=encoding UTF-8

=head1 NAME

PAGI::App::Router - Unified routing for HTTP, WebSocket, and SSE

=head1 SYNOPSIS

    use PAGI::App::Router;

    my $router = PAGI::App::Router->new;

    # HTTP routes (method + path)
    $router->get('/users/:id' => $get_user);
    $router->post('/users' => $create_user);
    $router->delete('/users/:id' => $delete_user);

    # Routes with middleware
    $router->get('/admin' => [$auth_mw, $log_mw] => $admin_handler);
    $router->post('/api/data' => [$rate_limit] => $data_handler);

    # WebSocket routes (path only)
    $router->websocket('/ws/chat/:room' => $chat_handler);

    # SSE routes (path only)
    $router->sse('/events/:channel' => $events_handler);

    # Mount with middleware (applies to all sub-routes)
    $router->mount('/api' => [$auth_mw] => $api_router->to_app);

    # Mount from a package (auto-require + to_app)
    $router->mount('/admin' => 'MyApp::Admin');

    # Static files as fallback
    $router->mount('/' => $static_files);

    # Named routes for URL generation
    $router->get('/users/:id' => $get_user)->name('users.get');
    $router->post('/users' => $create_user)->name('users.create');

    my $url = $router->uri_for('users.get', { id => 42 });
    # Returns: "/users/42"

    # Namespace mounted routers
    $router->mount('/api/v1' => $api_router)->as('api');
    $router->uri_for('api.users.get', { id => 42 });
    # Returns: "/api/v1/users/42"

    # Match any HTTP method
    $router->any('/health' => $health_handler);
    $router->any('/resource' => $handler, method => ['GET', 'POST']);

    # Path constraints (inline)
    $router->get('/users/{id:\d+}' => $get_user);

    # Path constraints (chained)
    $router->get('/posts/:slug' => $get_post)
        ->constraints(slug => qr/^[a-z0-9-]+$/);

    # Route grouping (flattened into parent)
    $router->group('/api' => [$auth_mw] => sub {
        my ($r) = @_;
        $r->get('/users' => $list_users);
        $r->post('/users' => $create_user);
    });

    # Include routes from another router
    $router->group('/api/v2' => $v2_router);

    # Include routes from a package
    $router->group('/api/users' => 'MyApp::Routes::Users');

    my $app = $router->to_app;  # Handles all scope types

=cut

sub new {
    my ($class, %args) = @_;

    return bless {
        routes           => [],
        websocket_routes => [],
        sse_routes       => [],
        mounts           => [],
        not_found        => $args{not_found},
        _group_stack     => [],   # for group() prefix/middleware accumulation
        _named_routes    => {},   # name => route info
        _last_route      => undef, # for ->name() chaining
        _last_mount      => undef, # for ->as() chaining
    }, $class;
}

sub mount {
    my ($self, $prefix, @rest) = @_;
    $prefix =~ s{/$}{};  # strip trailing slash
    my ($middleware, $app_or_router) = $self->_parse_route_args(@rest);

    my $sub_router;
    my $app;
    if (blessed($app_or_router) && $app_or_router->isa('PAGI::App::Router')) {
        $sub_router = $app_or_router;
        $app = $sub_router->to_app;
    }
    elsif (!ref($app_or_router)) {
        # String form: auto-require and call ->to_app
        my $pkg = $app_or_router;
        {
            local $@;
            eval "require $pkg; 1" or croak "Failed to load '$pkg': $@";
        }
        croak "'$pkg' does not have a to_app() method" unless $pkg->can('to_app');
        $app = $pkg->to_app;
    }
    else {
        $app = $app_or_router;
    }

    my $mount = {
        prefix      => $prefix,
        app         => $app,
        middleware  => $middleware,
        sub_router  => $sub_router,  # Keep reference for ->as()
    };
    push @{$self->{mounts}}, $mount;
    $self->{_last_mount} = $mount;
    $self->{_last_route} = undef;  # Clear route tracking

    return $self;
}

sub get     { my ($self, $path, @rest) = @_; $self->route('GET', $path, @rest) }
sub post    { my ($self, $path, @rest) = @_; $self->route('POST', $path, @rest) }
sub put     { my ($self, $path, @rest) = @_; $self->route('PUT', $path, @rest) }
sub patch   { my ($self, $path, @rest) = @_; $self->route('PATCH', $path, @rest) }
sub delete  { my ($self, $path, @rest) = @_; $self->route('DELETE', $path, @rest) }
sub head    { my ($self, $path, @rest) = @_; $self->route('HEAD', $path, @rest) }
sub options { my ($self, $path, @rest) = @_; $self->route('OPTIONS', $path, @rest) }

sub any {
    my ($self, $path, @rest) = @_;

    # Parse optional trailing key-value args (method => [...])
    my %opts;
    if (@rest >= 2 && !ref($rest[-2]) && $rest[-2] eq 'method') {
        %opts = splice(@rest, -2);
    }

    my $method = $opts{method} // '*';
    if (ref($method) eq 'ARRAY') {
        $method = [map { uc($_) } @$method];
    }

    $self->route($method, $path, @rest);
}

sub group {
    my ($self, $prefix, @rest) = @_;
    $prefix =~ s{/$}{}; # strip trailing slash

    my ($middleware, $target) = $self->_parse_route_args(@rest);

    my %names_before = map { $_ => 1 } keys %{$self->{_named_routes}};

    if (ref($target) eq 'CODE') {
        push @{$self->{_group_stack}}, {
            prefix     => $prefix,
            middleware => [@$middleware],
        };
        $target->($self);
        pop @{$self->{_group_stack}};
    }
    elsif (blessed($target) && $target->isa('PAGI::App::Router')) {
        push @{$self->{_group_stack}}, {
            prefix     => $prefix,
            middleware => [@$middleware],
        };
        $self->_include_router($target);
        pop @{$self->{_group_stack}};
    }
    elsif (!ref($target)) {
        # String form: auto-require and call ->router
        my $pkg = $target;
        {
            local $@;
            eval "require $pkg; 1" or croak "Failed to load '$pkg': $@";
        }
        croak "'$pkg' does not have a router() method" unless $pkg->can('router');
        my $router_obj = $pkg->router;
        croak "'${pkg}->router()' must return a PAGI::App::Router, got "
            . (ref($router_obj) || 'scalar')
            unless blessed($router_obj) && $router_obj->isa('PAGI::App::Router');

        push @{$self->{_group_stack}}, {
            prefix     => $prefix,
            middleware => [@$middleware],
        };
        $self->_include_router($router_obj);
        pop @{$self->{_group_stack}};
    }
    else {
        croak "group() target must be a coderef, PAGI::App::Router, or package name, got "
            . (ref($target) || 'scalar');
    }

    my @new_names = grep { !$names_before{$_} } keys %{$self->{_named_routes}};
    $self->{_last_group_names} = @new_names ? \@new_names : undef;

    $self->{_last_route} = undef;
    $self->{_last_mount} = undef;

    return $self;
}

sub websocket {
    my ($self, $path, @rest) = @_;
    my ($middleware, $app) = $self->_parse_route_args(@rest);

    # Apply accumulated group context (reverse: innermost prefix first)
    for my $ctx (reverse @{$self->{_group_stack}}) {
        $path = $ctx->{prefix} . $path;
        unshift @$middleware, @{$ctx->{middleware}};
    }

    my ($regex, $names, $constraints) = $self->_compile_path($path);
    my $route = {
        path        => $path,
        regex       => $regex,
        names       => $names,
        constraints => $constraints,
        app         => $app,
        middleware  => $middleware,
    };
    push @{$self->{websocket_routes}}, $route;
    $self->{_last_route} = $route;
    $self->{_last_mount} = undef;

    return $self;
}

sub sse {
    my ($self, $path, @rest) = @_;
    my ($middleware, $app) = $self->_parse_route_args(@rest);

    # Apply accumulated group context (reverse: innermost prefix first)
    for my $ctx (reverse @{$self->{_group_stack}}) {
        $path = $ctx->{prefix} . $path;
        unshift @$middleware, @{$ctx->{middleware}};
    }

    my ($regex, $names, $constraints) = $self->_compile_path($path);
    my $route = {
        path        => $path,
        regex       => $regex,
        names       => $names,
        constraints => $constraints,
        app         => $app,
        middleware  => $middleware,
    };
    push @{$self->{sse_routes}}, $route;
    $self->{_last_route} = $route;
    $self->{_last_mount} = undef;

    return $self;
}

sub route {
    my ($self, $method, $path, @rest) = @_;

    my ($middleware, $app) = $self->_parse_route_args(@rest);

    # Apply accumulated group context (reverse: innermost prefix first)
    for my $ctx (reverse @{$self->{_group_stack}}) {
        $path = $ctx->{prefix} . $path;
        unshift @$middleware, @{$ctx->{middleware}};
    }

    my ($regex, $names, $constraints) = $self->_compile_path($path);
    my $route = {
        method      => ref($method) eq 'ARRAY' ? $method : ($method eq '*' ? '*' : uc($method)),
        path        => $path,
        regex       => $regex,
        names       => $names,
        constraints => $constraints,
        app         => $app,
        middleware  => $middleware,
    };
    push @{$self->{routes}}, $route;
    $self->{_last_route} = $route;
    $self->{_last_mount} = undef;  # Clear mount tracking

    return $self;
}

sub _compile_path {
    my ($self, $path) = @_;

    my @names;
    my @constraints;
    my $regex = '';

    # Tokenize the path
    my $remaining = $path;
    while (length $remaining) {
        # {name:pattern} — constrained parameter
        if ($remaining =~ s/^\{(\w+):([^}]+)\}//) {
            push @names, $1;
            push @constraints, [$1, $2];
            $regex .= "([^/]+)";
        }
        # {name} — unconstrained parameter (same as :name)
        elsif ($remaining =~ s/^\{(\w+)\}//) {
            push @names, $1;
            $regex .= "([^/]+)";
        }
        # *name — wildcard/splat
        elsif ($remaining =~ s/^\*(\w+)//) {
            push @names, $1;
            $regex .= "(.+)";
        }
        # :name — named parameter (legacy syntax)
        elsif ($remaining =~ s/^:(\w+)//) {
            push @names, $1;
            $regex .= "([^/]+)";
        }
        # Literal text up to next special token
        elsif ($remaining =~ s/^([^{:*]+)//) {
            $regex .= quotemeta($1);
        }
        # Safety: consume one character to avoid infinite loop
        else {
            $regex .= quotemeta(substr($remaining, 0, 1, ''));
        }
    }

    return (qr{^$regex$}, \@names, \@constraints);
}

sub _check_constraints {
    my ($self, $route, $params) = @_;
    for my $constraints_list ($route->{constraints} // [], $route->{_user_constraints} // []) {
        for my $c (@$constraints_list) {
            my ($name, $pattern) = @$c;
            my $value = $params->{$name} // return 0;
            return 0 unless $value =~ m/^(?:$pattern)$/;
        }
    }
    return 1;
}

# ============================================================
# Named Routes
# ============================================================

sub name {
    my ($self, $name) = @_;

    croak "name() called without a preceding route" unless $self->{_last_route};
    croak "Route name required" unless defined $name && length $name;
    croak "Named route '$name' already exists" if exists $self->{_named_routes}{$name};

    my $route = $self->{_last_route};
    $route->{name} = $name;
    $self->{_named_routes}{$name} = {
        path   => $route->{path},
        names  => $route->{names},
        prefix => '',
    };

    return $self;
}

sub constraints {
    my ($self, %new_constraints) = @_;

    croak "constraints() called without a preceding route" unless $self->{_last_route};

    my $route = $self->{_last_route};
    my $user_constraints = $route->{_user_constraints} //= [];

    for my $name (keys %new_constraints) {
        my $pattern = $new_constraints{$name};
        croak "Constraint for '$name' must be a Regexp (qr//), got " . ref($pattern)
            unless ref($pattern) eq 'Regexp';
        push @$user_constraints, [$name, $pattern];
    }

    return $self;
}

sub as {
    my ($self, $namespace) = @_;

    croak "Namespace required" unless defined $namespace && length $namespace;

    # Handle group namespacing
    if ($self->{_last_group_names} && @{$self->{_last_group_names}}) {
        for my $name (@{$self->{_last_group_names}}) {
            my $info = delete $self->{_named_routes}{$name};
            my $full_name = "$namespace.$name";
            croak "Named route '$full_name' already exists"
                if exists $self->{_named_routes}{$full_name};
            $self->{_named_routes}{$full_name} = $info;
        }
        $self->{_last_group_names} = undef;
        return $self;
    }

    # Handle mount namespacing
    croak "as() called without a preceding mount or group"
        unless $self->{_last_mount};

    my $mount = $self->{_last_mount};
    my $sub_router = $mount->{sub_router};

    croak "as() requires mounting a router object, not an app coderef"
        unless $sub_router;

    # Import all named routes from sub-router with namespace prefix
    my $prefix = $mount->{prefix};
    for my $name (keys %{$sub_router->{_named_routes}}) {
        my $info = $sub_router->{_named_routes}{$name};
        my $full_name = "$namespace.$name";
        $self->{_named_routes}{$full_name} = {
            path   => $info->{path},
            names  => $info->{names},
            prefix => $prefix . ($info->{prefix} // ''),
        };
    }

    return $self;
}

sub named_routes {
    my ($self) = @_;
    return { %{$self->{_named_routes}} };
}

sub uri_for {
    my ($self, $name, $path_params, $query_params) = @_;

    $path_params  //= {};
    $query_params //= {};

    my $info = $self->{_named_routes}{$name}
        or croak "Unknown route name: '$name'";

    my $path = $info->{path};
    my $prefix = $info->{prefix} // '';

    # Substitute path parameters
    for my $param_name (@{$info->{names}}) {
        unless (exists $path_params->{$param_name}) {
            croak "Missing required path parameter '$param_name' for route '$name'";
        }
        my $value = $path_params->{$param_name};
        $path =~ s/:$param_name\b/$value/
            || $path =~ s/\{$param_name(?::[^}]*)?\}/$value/
            || $path =~ s/\*$param_name\b/$value/;
    }

    # Prepend mount prefix
    $path = $prefix . $path if $prefix;

    # Add query string if any
    if (%$query_params) {
        my @pairs;
        for my $key (sort keys %$query_params) {
            my $value = $query_params->{$key};
            # Simple URL encoding
            $key   =~ s/([^A-Za-z0-9\-_.~])/sprintf("%%%02X", ord($1))/ge;
            $value =~ s/([^A-Za-z0-9\-_.~])/sprintf("%%%02X", ord($1))/ge;
            push @pairs, "$key=$value";
        }
        $path .= '?' . join('&', @pairs);
    }

    return $path;
}

sub _include_router {
    my ($self, $source) = @_;

    # Re-register HTTP routes through route() (stack applies prefix/middleware)
    for my $route (@{$source->{routes}}) {
        $self->route(
            $route->{method},
            $route->{path},
            [@{$route->{middleware}}],
            $route->{app},
        );
        if ($route->{name}) {
            $self->name($route->{name});
        }
        if ($route->{_user_constraints} && @{$route->{_user_constraints}}) {
            my %uc = map { $_->[0] => $_->[1] } @{$route->{_user_constraints}};
            $self->constraints(%uc);
        }
    }

    # Re-register WebSocket routes
    for my $route (@{$source->{websocket_routes}}) {
        $self->websocket(
            $route->{path},
            [@{$route->{middleware}}],
            $route->{app},
        );
        if ($route->{name}) {
            $self->name($route->{name});
        }
        if ($route->{_user_constraints} && @{$route->{_user_constraints}}) {
            my %uc = map { $_->[0] => $_->[1] } @{$route->{_user_constraints}};
            $self->constraints(%uc);
        }
    }

    # Re-register SSE routes
    for my $route (@{$source->{sse_routes}}) {
        $self->sse(
            $route->{path},
            [@{$route->{middleware}}],
            $route->{app},
        );
        if ($route->{name}) {
            $self->name($route->{name});
        }
        if ($route->{_user_constraints} && @{$route->{_user_constraints}}) {
            my %uc = map { $_->[0] => $_->[1] } @{$route->{_user_constraints}};
            $self->constraints(%uc);
        }
    }
}

sub _parse_route_args {
    my ($self, @args) = @_;

    if (@args == 2 && ref($args[0]) eq 'ARRAY') {
        # (\@middleware, $app)
        my ($middleware, $app) = @args;
        $self->_validate_middleware($middleware);
        return ($middleware, $app);
    }
    elsif (@args == 1) {
        # ($app) - no middleware
        return ([], $args[0]);
    }
    else {
        croak 'Invalid route arguments: expected ($app) or (\@middleware => $app)';
    }
}

sub _validate_middleware {
    my ($self, $middleware) = @_;

    for my $mw (@$middleware) {
        if (ref($mw) eq 'CODE') {
            # Coderef is valid
            next;
        }
        elsif (blessed($mw) && $mw->can('call')) {
            # PAGI::Middleware instance with call() method
            next;
        }
        else {
            my $type = ref($mw) || 'scalar';
            croak "Invalid middleware: expected coderef or object with ->call method, got $type";
        }
    }
}

sub _build_middleware_chain {
    my ($self, $middlewares, $app) = @_;

    return $app unless $middlewares && @$middlewares;

    my $chain = $app;

    for my $mw (reverse @$middlewares) {
        my $next = $chain;

        if (ref($mw) eq 'CODE') {
            # Coderef with $next signature
            $chain = async sub {
                my ($scope, $receive, $send) = @_;
                await $mw->($scope, $receive, $send, async sub {
                    await $next->($scope, $receive, $send);
                });
            };
        }
        else {
            # PAGI::Middleware instance - use existing call()
            $chain = async sub {
                my ($scope, $receive, $send) = @_;
                await $mw->call($scope, $receive, $send, $next);
            };
        }
    }

    return $chain;
}

sub to_app {
    my ($self) = @_;

    my @routes           = @{$self->{routes}};
    my @websocket_routes = @{$self->{websocket_routes}};
    my @sse_routes       = @{$self->{sse_routes}};
    my @mounts           = @{$self->{mounts}};
    my $not_found        = $self->{not_found};

    # Pre-build middleware chains for efficiency
    for my $route (@routes, @websocket_routes, @sse_routes) {
        $route->{_handler} = $self->_build_middleware_chain($route->{middleware}, $route->{app});
    }
    for my $m (@mounts) {
        $m->{_handler} = $self->_build_middleware_chain($m->{middleware}, $m->{app});
    }

    # Helper to check mounts
    my $check_mounts = async sub {
        my ($scope, $receive, $send, $path) = @_;
        for my $m (sort { length($b->{prefix}) <=> length($a->{prefix}) } @mounts) {
            my $prefix = $m->{prefix};
            if ($path eq $prefix || $path =~ m{^\Q$prefix\E(/.*)$}) {
                my $sub_path = $1 // '/';
                my $new_scope = {
                    %$scope,
                    path      => $sub_path,
                    root_path => ($scope->{root_path} // '') . $prefix,
                };
                await $m->{_handler}->($new_scope, $receive, $send);
                return 1;  # Matched
            }
        }
        return 0;  # No match
    };

    return async sub {
        my ($scope, $receive, $send) = @_;
        my $type   = $scope->{type} // 'http';
        my $method = uc($scope->{method} // '');
        my $path   = $scope->{path} // '/';

        # Ignore lifespan events
        return if $type eq 'lifespan';

        # WebSocket routes (path-only matching) - check before mounts
        if ($type eq 'websocket') {
            for my $route (@websocket_routes) {
                if (my @captures = ($path =~ $route->{regex})) {
                    my %params;
                    for my $i (0 .. $#{$route->{names}}) {
                        $params{$route->{names}[$i]} = $captures[$i];
                    }

                    # Check constraints — skip route if any fail
                    next unless $self->_check_constraints($route, \%params);

                    my $new_scope = {
                        %$scope,
                        path_params => \%params,
                        'pagi.router' => { route => $route->{path} },
                    };
                    await $route->{_handler}->($new_scope, $receive, $send);
                    return;
                }
            }
            # No websocket route matched - try mounts as fallback
            if (await $check_mounts->($scope, $receive, $send, $path)) {
                return;
            }
            # No mount matched either - 404
            if ($not_found) {
                await $not_found->($scope, $receive, $send);
            } else {
                await $send->({
                    type => 'http.response.start',
                    status => 404,
                    headers => [['content-type', 'text/plain']],
                });
                await $send->({ type => 'http.response.body', body => 'Not Found', more => 0 });
            }
            return;
        }

        # SSE routes (path-only matching) - check before mounts
        if ($type eq 'sse') {
            for my $route (@sse_routes) {
                if (my @captures = ($path =~ $route->{regex})) {
                    my %params;
                    for my $i (0 .. $#{$route->{names}}) {
                        $params{$route->{names}[$i]} = $captures[$i];
                    }

                    # Check constraints — skip route if any fail
                    next unless $self->_check_constraints($route, \%params);

                    my $new_scope = {
                        %$scope,
                        path_params => \%params,
                        'pagi.router' => { route => $route->{path} },
                    };
                    await $route->{_handler}->($new_scope, $receive, $send);
                    return;
                }
            }
            # No SSE route matched - try mounts as fallback
            if (await $check_mounts->($scope, $receive, $send, $path)) {
                return;
            }
            # No mount matched either - 404
            if ($not_found) {
                await $not_found->($scope, $receive, $send);
            } else {
                await $send->({
                    type => 'http.response.start',
                    status => 404,
                    headers => [['content-type', 'text/plain']],
                });
                await $send->({ type => 'http.response.body', body => 'Not Found', more => 0 });
            }
            return;
        }

        # HTTP routes (method + path matching) - check routes first
        # HEAD should match GET routes
        my $match_method = $method eq 'HEAD' ? 'GET' : $method;

        my @method_matches;

        for my $route (@routes) {
            if (my @captures = ($path =~ $route->{regex})) {

                # Build params FIRST (needed for constraint checking)
                my %params;
                for my $i (0 .. $#{$route->{names}}) {
                    $params{$route->{names}[$i]} = $captures[$i];
                }

                # Check constraints — skip route if any fail
                next unless $self->_check_constraints($route, \%params);

                # Check method
                my $route_method = $route->{method};
                my $method_match = ref($route_method) eq 'ARRAY'
                    ? (grep { $_ eq $match_method || $_ eq $method } @$route_method)
                    : ($route_method eq '*' || $route_method eq $match_method || $route_method eq $method);

                if ($method_match) {
                    my $new_scope = {
                        %$scope,
                        path_params => \%params,
                        'pagi.router' => { route => $route->{path} },
                    };

                    await $route->{_handler}->($new_scope, $receive, $send);
                    return;
                }

                if (ref($route->{method}) eq 'ARRAY') {
                    push @method_matches, @{$route->{method}};
                } elsif ($route->{method} ne '*') {
                    push @method_matches, $route->{method};
                }
            }
        }

        # Path matched but method didn't - 405
        if (@method_matches) {
            my $allowed = join ', ', sort keys %{{ map { $_ => 1 } @method_matches }};
            await $send->({
                type => 'http.response.start',
                status => 405,
                headers => [
                    ['content-type', 'text/plain'],
                    ['allow', $allowed],
                ],
            });
            await $send->({ type => 'http.response.body', body => 'Method Not Allowed', more => 0 });
            return;
        }

        # No HTTP route matched - try mounts as fallback
        if (await $check_mounts->($scope, $receive, $send, $path)) {
            return;
        }

        # No mount matched either - 404
        if ($not_found) {
            await $not_found->($scope, $receive, $send);
        } else {
            await $send->({
                type => 'http.response.start',
                status => 404,
                headers => [['content-type', 'text/plain']],
            });
            await $send->({ type => 'http.response.body', body => 'Not Found', more => 0 });
        }
    };
}

1;

__END__