Route by an OpenAPI 3 document, rather than a list of regexes

A router exported @routes: regex keys, tried with m/^$key$/ in array order
after an exact pass.  The one real router builds that array from a hash, so
its regex routes were tried in an order that changed from process to
process, and the "longest first" that respond() promised was never done.
Every literal key was also tried as a regex, so the dot of /humans.txt
matched any character.  Each parameter was checked by a coderef of its own,
and the catalog of routes could not be encoded, because of those coderefs.

A router now exports %openapi, an OpenAPI 3 document as Perl data, and the
new TPSGI::Router compiles it.  The callback is the operation's
x-tpsgi-callback, x-tpsgi-data and x-tpsgi-env replace data and env, and the
callback finds the whole operation in $query->{dispatcher}.  A template
takes {name}, several to a segment, and a {name+} that takes the rest of the
path.  Its literal text is quotemeta'd, and no variable takes a newline,
which keeps what the old test of extract_query asked of a dot.  The most
concrete template wins, by a total order of segment kind, then literal
length, then the string.  So the order never comes from a hash.

JSON::Validator checks each request against the operation's parameters and
requestBody, and coerces the values.  validate_request() coerces its own
copy of each value, so the router hands it getters and writes the coerced
values back.  The old strict rule stays: an operation that declares a query
parameter or a body takes no undeclared query key.  A body of a media type
that the operation does not take is a 415, and a path with a method that it
has no route for is a 405 with Allow, where it was a 400.

A router that still has @routes dies as it loads, through cannot_start(),
and says where to read.  Compiling a document takes about 50 ms, against
about 27 us to validate a request, and new() runs per request.  So the
router is built once per worker, for each list of router files.

A request that failed validation got badrequest() with the query, which has
no method and no path, so the log line warned and the warning was fatal.  It
now gets what respond() knows of the request.

Each new rule was broken once on purpose, and the test of it failed: the
exact pass, quotemeta, the newline rule, the segment rank, the literal
length, the twin and duplicate templates, a {name+} that is not last, HEAD,
405 and Allow, 415, the undeclared key, the write-back of coerced values, a
callback by name and a missing one, an invalid document, a stale router,
the cache and x-tpsgi-data.  Content type negotiation is JSON::Validator's
own negotiate_content_type(), not a second copy.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>

.pod_stopwords

@@ -173,11 +173,13 @@ namespace
 nginx
 NIC
 NONINFRINGEMENT
+notallowed
 notfound
 NTP
 OAuth
 ok
 OOM
+OpenAPI
 overcommit
 overcommits
 overcommitted

Changes

@@ -2,3 +2,8 @@ Revision history for TPSGI
 
 0.001 2026-10-23 TEODESIAN
     - Initial Release
+    - Route by an OpenAPI 3 document: a router exports %openapi in place of
+      @routes, and a router that still has @routes dies as it loads.
+      Templates take {name} and a final {name+}, the most concrete template
+      wins, and parameters are validated and coerced by JSON::Validator.
+      A path with a method that it has no route for is a 405, not a 400.

README.md

@@ -12,11 +12,18 @@ A router module, which `routers` in `~/.tpsgi.ini` names:
 
 ```perl
 package My::Routes;
-
-our @routes = (
-    '/hello' => {
-        method    => 'GET',
-        callbacks => { 'text/html' => \&hello },
+use Mojo::JSON ();
+
+our %openapi = (
+    openapi => '3.0.3',
+    info    => { title => 'My routes', version => '1' },
+    paths   => {
+        '/hello' => {
+            get => {
+                'x-tpsgi-callback' => \&hello,
+                responses          => { 200 => { description => 'A greeting' } },
+            },
+        },
     },
 );
 
@@ -69,9 +76,18 @@ the user.  FATAL logs at the emergency level and then dies with the line.
 
 ## new(%options)
 
-Load the routers and build the routing table.  It dies unless it runs as
-`user`, and `http_user` and `tpsgi_dir` are set.  get\_config() returns the
-options, and among them are:
+Load the routers, and build the TPSGI::Router of their `%openapi` documents.
+It dies unless it runs as `user`, and `http_user` and `tpsgi_dir` are set.
+It also dies when a router does not load, when its document is not one that
+TPSGI::Router accepts, and when a router still defines `@routes` instead of
+`%openapi`.
+
+new() runs for every request, and compiling a document takes much longer than
+answering one.  So the router is built once in each worker, for each list of
+router files, and kept.  A HUP replaces the workers, so a changed router is
+compiled again.
+
+get\_config() returns the options, and among them are:
 
 ```
 custom_log
@@ -86,10 +102,9 @@ auth
 The directory index files, in the order they are tried: the `indices` option,
 then `index.html`, `index.htm` and `index.cgi`.
 
-## routes() = ARRAYREF
+## routes() = TPSGI::Router
 
-The routing table: each route's pattern, then its definition, for every router
-in the order they were loaded.
+The router that new() built from the `%openapi` of every router.
 
 ## serve($fullpath, $path, $start, $streaming, $ranges, $last\_fetch, $deflate)
 
@@ -111,7 +126,7 @@ Redirects to the provided page.
 
 Return a generic HTTP 200 OK
 
-## notfound, forbidden, badrequest, toolong, error, unavailable
+## notfound, forbidden, badrequest, notallowed, unsupported, toolong, error, unavailable
 
 If you need to return these HTTP errors, return these within a route:
 
@@ -153,7 +168,9 @@ ever serves.  A fresh worker tries again from nothing.
 ## respond($env) = PSGI response
 
 Answer one request: from a route when one matches, by running a CGI when the
-file under `www/` is executable, and otherwise by serving the file.
+file under `www/` is executable, and otherwise by serving the file.  A path
+that a route matches, with a method that no route of it has, gets
+notallowed().
 
 ## mangle\_filename($path) = STRING
 
@@ -172,17 +189,19 @@ and it has no extension or one of `cgi`, `sh`, `exe`, `pl`, `php` and `py`.
 
 ## route($route, $env, %request) = PSGI response
 
-Run the callback of $route that answers the request's content type, with the
-query that extract\_query() builds.  respond() calls it, with %request holding
-`fullpath`, `path`, `start`, `last_fetch`, `deflate`, `domain` and
-`port`.
+Run the callback of $route, which TPSGI::Router::match() returned, with the
+query that extract\_query() builds.  In CGI mode, which `x-tpsgi-env` asks
+for, the query is not built, and the callback gets the request as %ENV
+instead.  respond() calls route(), with %request holding `fullpath`, `path`,
+`start`, `last_fetch`, `deflate`, `domain` and `port`.
 
 ## extract\_query($path, $route, $env) = HASHREF
 
 The query a route's callback is given: the query string, then the POST body,
-then the route's captures and its `data`, each over the last.  When the route
-names `parameters`, a parameter that fails its validator, or one it does not
-name, gets a badrequest() instead.
+then the path parameters of $route and the operation's `x-tpsgi-data`, each
+over the last.  First TPSGI::Router::validate() checks the request against the
+operation.  A request that fails gets unsupported() for a 415 and badrequest()
+for a 400, and the reasons go to the log at the debug level.
 
 ## cgi($env, $fullpath, $file\_actual, $last\_fetch) = PSGI response
 
@@ -358,33 +377,110 @@ All the CPAN deps should be updated out-of-band and the service manually restart
 
 # CUSTOM ROUTING
 
-All passed routing modules will be required, and combined to form a routing table so you have an analogue to rewrite rules.
-
-Routing Modules look like so:
+tPSGI requires each router module, and routes requests by the OpenAPI 3
+document that each one exports as `%openapi`.  A router can also export
+`%aliases`, `%watches` and `generic_route()`.
 
 ```perl
-our @routes = (
-    '/foo/(\w+)/save' => {
-        method    => 'GET',
-        callbacks => { # Run these subroutines to execute the appropriate handler given the content-type.  Expects normal PSGI output.
-            'text/html'        => \&render,
-            'application/json' => \&dump,
+package My::Routes;
+use Mojo::JSON ();
+
+our %openapi = (
+    openapi => '3.0.3',
+    info    => { title => 'My routes', version => '1' },
+    paths   => {
+        '/sitemap/{map}.xml' => {
+            get => {
+                'x-tpsgi-callback' => \&sitemap,
+                'x-myapp-nomap'    => Mojo::JSON::true,
+                parameters         => [
+                    {
+                        name     => 'map',
+                        in       => 'path',
+                        required => Mojo::JSON::true,
+                        schema   => { type => 'integer' },
+                    },
+                ],
+                responses => { 200 => { description => 'One page of the sitemap' } },
+            },
+        },
+        '/lib/{module+}' => {
+            get => {
+                'x-tpsgi-callback' => 'My::Routes::manual',
+                'x-tpsgi-data'     => { section => 'manual' },
+                parameters         => [
+                    {
+                        name     => 'module+',
+                        in       => 'path',
+                        required => Mojo::JSON::true,
+                        schema   => { type => 'string' },
+                    },
+                ],
+                responses => { 200 => { description => 'The manual of a module' } },
+            },
         },
-        noindex   => 0, # Explicitly exclude this in robots.txt
-        nomap     => 0, # Don't put this in the sitemap
-        acls      => ['admin'], # Route requires both authentication by auth handler and the auth'd user to have the provided ACLs.
-        data      => { baz => 'throb' }, # Arbitrary data to inject into the GET/POST data hashref
-        captures  => ['name','parameter'], # Name parameters of the capture groups in the route key.  Suppose we want /foo/don/keys here.
-        static    => 1, # Whether we can save a static render of this
-        invalidates => ['/foo/(\w+)'], # Static renders which are invalidated by this route returning a successful response code.
     },
-    ...
 );
 ```
 
-Note that this is an array, as we want this to preserve order. Fat commas are used to hint that this is in fact a tuple.
+The document is Perl data.  A boolean in it must be `Mojo::JSON::true` or
+`Mojo::JSON::false`.  `\1` and `builtin::true` fail the check against the
+OpenAPI schema.  Write the full name: `use 5.040` imports `builtin::true` as
+`true`, and that wins over an imported `Mojo::JSON::true`.
+
+new() dies when a document is not valid, so a broken router fails as it loads,
+and not at the first request.  A router that still defines `@routes` and no
+`%openapi` dies the same way.
+
+## Templates
+
+Each key of `paths` is a template.  `{name}` matches any text up to the next
+slash, and one segment can hold several variables and literal text, as in
+`{map}.xml`.  `{name+}` matches the rest of the path, slashes and all, and it
+must be the whole last segment.  Its parameter is named `name+`, and the query
+gives its value as `name`.  Any other character matches only itself.  No
+variable matches a newline.
+
+When more than one template matches, the most concrete one wins.  Literal
+segments win over segments with variables, segments that mix text and
+variables win over a lone `{name}`, and `{name+}` comes last.  Then the
+template with more literal characters wins, and then the one that sorts first.
+[TPSGI::Router](https://metacpan.org/pod/TPSGI%3A%3ARouter) says this in full.
+
+A path that a template matches, with a method that no matching template has,
+gets a 405 with an `Allow` header.  HEAD uses the `get` operation when there
+is no `head` one.
+
+## Operations
+
+The `x-tpsgi-` keys of an operation are tPSGI's:
+
+```perl
+x-tpsgi-callback  The sub that answers the request: a CODE reference, or
+                  the fully qualified name of a sub.  Required.
+x-tpsgi-data      A HASH, which is merged over the query.
+x-tpsgi-env       True for CGI mode: the callback gets the request as a
+                  CGI %ENV, and no query is built.
+```
+
+Any other `x-` key is the application's.  The callback finds the whole
+operation in `$query->{dispatcher}`, and the template that matched in
+`$query->{route_template}`.
+
+## Validation
+
+Before the callback runs, tPSGI checks the request against the operation's
+`parameters` and `requestBody`.  Values are coerced to their schema, so an
+integer arrives as a number.  A request that fails gets a 400, and the reasons
+go to the log at the debug level, not into the page.  The 400 is also the
+answer to a query key that the operation does not declare, when the operation
+declares a query parameter or a request body.  A form body is as strict as the
+`additionalProperties` of its schema.  A body whose media type is not among
+the `content` of the `requestBody` gets a 415.
+
+## Callbacks
 
-Router callbacks are passed the TPSGI object and the raw query, which means you can do:
+A callback is passed the TPSGI object and the query, which means you can do:
 
 ```perl
 sub route {
@@ -393,7 +489,8 @@ sub route {
     $self->ERROR("eeee");
     $self->DEBUG("blah");
 
-    # Either from the GET or POST data, POST is preferred when both are present.
+    # From the query string, the POST body, the path or x-tpsgi-data, in
+    # that order: a later one wins.
     my $param = $query->{param};
 
     my %headers = ...;

lib/TPSGI.pm

@@ -36,6 +36,7 @@ use Log::Dispatch;
 use Log::Dispatch::Screen;
 use Log::Dispatch::FileRotate;
 use TPSGI::Startup;
+use TPSGI::Router;
 
 # We have a DEBUG var which is plus ultra for extra sensitive stuff beyond just passing verbose
 our $debug = $ENV{TPSGI_DEBUG};
@@ -222,9 +223,18 @@ sub FATAL {
 
 =head2 new(%options)
 
-Load the routers and build the routing table.  It dies unless it runs as
-C<user>, and C<http_user> and C<tpsgi_dir> are set.  get_config() returns the
-options, and among them are:
+Load the routers, and build the TPSGI::Router of their C<%openapi> documents.
+It dies unless it runs as C<user>, and C<http_user> and C<tpsgi_dir> are set.
+It also dies when a router does not load, when its document is not one that
+TPSGI::Router accepts, and when a router still defines C<@routes> instead of
+C<%openapi>.
+
+new() runs for every request, and compiling a document takes much longer than
+answering one.  So the router is built once in each worker, for each list of
+router files, and kept.  A HUP replaces the workers, so a changed router is
+compiled again.
+
+get_config() returns the options, and among them are:
 
     custom_log
     verbose
@@ -250,7 +260,7 @@ sub new {
     my $self = bless( \%options, $class );
     $self->{ip} = '0.0.0.0';
 
-    my @routes;
+    my @documents;
     my %aliases;
 
     # XXX TODO make these routes able to be fully qualified namespaces (::)!
@@ -269,15 +279,14 @@ sub new {
         $self->DEBUG("require $options{tpsgi_dir}/$route");
         my $success = eval { require "$options{tpsgi_dir}/$route"; 1; };    ## no critic (RequireBarewordIncludes) -- a router is named by its file
         if ($success) {
-            my ( $pkg_routes, $pkg_aliases, $pkg_watches ) = do {
+            my ( $pkg_openapi, $pkg_routes, $pkg_aliases, $pkg_watches ) = do {
                 no strict 'refs';                                           # the router's own package variables, by name
-                ( \@{"${package}::routes"}, \%{"${package}::aliases"}, \%{"${package}::watches"} );
+                ( \%{"${package}::openapi"}, \@{"${package}::routes"}, \%{"${package}::aliases"}, \%{"${package}::watches"} );
             };
 
-            for ( my $i = 0; $i < @$pkg_routes; $i += 2 ) {
-                $self->DEBUG("Registered route $pkg_routes->[$i]");
-            }
-            push( @routes, @$pkg_routes );
+            die "$route defines \@routes and no %openapi.  tPSGI routes by an OpenAPI 3 document now: see CUSTOM ROUTING in perldoc TPSGI.\n"
+              if @$pkg_routes && !%$pkg_openapi;
+            push( @documents, $route => $pkg_openapi ) if %$pkg_openapi;
 
             foreach my $al ( keys(%$pkg_aliases) ) {
                 $self->DEBUG("aliased route $al to $pkg_aliases->{$al}");
@@ -302,15 +311,17 @@ sub new {
         }
     }
 
-    # Set the pattern used to discover the route if needed later.
-    for ( my $i = 0; $i < scalar(@routes); $i += 2 ) {
-        $routes[ $i + 1 ]{pattern} = $routes[$i];
-    }
+    state %routers;
+    my $router_key = join( "\0", $options{tpsgi_dir}, @{ $self->{routers} } );
+    $self->{router} = $routers{$router_key} //= do {
+        my $router = TPSGI::Router->new(@documents);
+        $self->DEBUG("Registered route \U$_->{method}\E $_->{template}") foreach $router->routes();
+        $router;
+    };
 
     $self->{indices} //= [];
     $self->{indices} = [ @{ $self->{indices} }, qw{index.html index.htm index.cgi} ];
 
-    $self->{routes}    = \@routes;
     $self->{aliases}   = \%aliases;
     $self->{callbacks} = [];
 
@@ -329,16 +340,15 @@ sub indices {
     return $self->{indices};
 }
 
-=head2 routes() = ARRAYREF
+=head2 routes() = TPSGI::Router
 
-The routing table: each route's pattern, then its definition, for every router
-in the order they were loaded.
+The router that new() built from the C<%openapi> of every router.
 
 =cut
 
 sub routes {
     my $self = shift;
-    return $self->{routes};
+    return $self->{router};
 }
 
 =head2 serve($fullpath, $path, $start, $streaming, $ranges, $last_fetch, $deflate)
@@ -570,7 +580,7 @@ sub ok {
     return generic( $body, 200, $query );
 }
 
-=head2 notfound, forbidden, badrequest, toolong, error, unavailable
+=head2 notfound, forbidden, badrequest, notallowed, unsupported, toolong, error, unavailable
 
 If you need to return these HTTP errors, return these within a route:
 
@@ -603,6 +613,21 @@ sub badrequest {
     return generic( $body, 400, $query );
 }
 
+sub notallowed {
+    my ( $self, $query, @allow ) = @_;
+    $self->INFO("$query->{method} 405 $query->{fullpath}");
+    my $res = generic( 'Method Not Allowed', 405, $query );
+    push( @{ $res->[1] }, Allow => join( ', ', @allow ) ) if ref $res eq 'ARRAY';
+    return $res;
+}
+
+sub unsupported {
+    my ( $self, $query, $body ) = @_;
+    $self->INFO("$query->{method} 415 $query->{fullpath}");
+    $body //= 'Unsupported Media Type';
+    return generic( $body, 415, $query );
+}
+
 sub toolong {
     my ( $self, $query, $body ) = @_;
     $self->INFO("$query->{method} 419 $query->{fullpath}");
@@ -701,19 +726,12 @@ sub cannot_start {
 
 my %etags;
 
-# A router's pattern means what the router wrote, so none of this file's
-# default flags apply to it: /aa would make \w ASCII only, /x would drop its
-# spaces, and /s would change what a dot matches.
-my sub match_route {
-    my ( $path, $pattern ) = @_;
-    no re '/aasx';
-    return $path =~ m/^$pattern$/;    ## no critic (RequireDefault RequireExtendedFormatting RequireDotMatchAnything)
-}
-
 =head2 respond($env) = PSGI response
 
 Answer one request: from a route when one matches, by running a CGI when the
-file under F<www/> is executable, and otherwise by serving the file.
+file under F<www/> is executable, and otherwise by serving the file.  A path
+that a route matches, with a method that no route of it has, gets
+notallowed().
 
 =cut
 
@@ -804,24 +822,8 @@ sub respond {
 
     my $streaming = $env->{'psgi.streaming'};
 
-    # If we have an actual route, just use it.
-    my $r           = $self->routes;
-    my $route_index = List::Util::first { ( $r->[$_] // '' ) eq $path } 0 .. scalar(@$r);
-
-    my $route_actual;
-    $route_actual = $r->[ $route_index + 1 ] if defined($route_index);
-
-    # Might be a regexed route. Sort reversed so we try the longest routes first.
-    if ( !$route_actual && @$r ) {
-        my $matched = List::Util::first {
-
-            # Here's where you want to use Regexp::Debugger in the context of call.pl to debug routes... EX:
-            # perl ./call.pl GET /path/to/route
-            match_route( $path, $r->[$_] );
-        }
-        0 .. scalar(@$r) - 1;
-        $route_actual = $r->[ $matched + 1 ] if defined($matched);
-    }
+    my $route_actual = $self->routes->match( $method, $path );
+    return $self->notallowed( $cur_query, @{ $route_actual->{allow} } ) if $route_actual && $route_actual->{status};
 
     if ($route_actual) {
         return $self->route(
@@ -924,10 +926,11 @@ sub appears_executable {
 
 =head2 route($route, $env, %request) = PSGI response
 
-Run the callback of $route that answers the request's content type, with the
-query that extract_query() builds.  respond() calls it, with %request holding
-C<fullpath>, C<path>, C<start>, C<last_fetch>, C<deflate>, C<domain> and
-C<port>.
+Run the callback of $route, which TPSGI::Router::match() returned, with the
+query that extract_query() builds.  In CGI mode, which C<x-tpsgi-env> asks
+for, the query is not built, and the callback gets the request as %ENV
+instead.  respond() calls route(), with %request holding C<fullpath>, C<path>,
+C<start>, C<last_fetch>, C<deflate>, C<domain> and C<port>.
 
 =cut
 
@@ -935,29 +938,18 @@ sub route {
     my ( $self, $route, $env, %request ) = @_;
     my ( $fullpath, $path, $start ) = @request{qw{fullpath path start}};
 
-    $self->DEBUG( 'Executing route ' . $route->{pattern} );
-
-    $route->{method} = $env->{REQUEST_METHOD} if $route->{method} eq '*';
-    my $content_type = $env->{CONTENT_TYPE} || 'text/html';    # If not set, that's the assumption.
-    return $self->badrequest($cur_query) unless List::Util::any { $_ eq $env->{REQUEST_METHOD} } grep { defined $_ } ( 'HEAD', $route->{method} );
-
-    my $callback;
-    if ( exists $route->{callbacks}{'*'} ) {
-        $callback = $route->{callbacks}{'*'};
-    }
-    else {
-        return $self->badrequest($cur_query) unless exists $route->{callbacks}{$content_type};
-        $callback = $route->{callbacks}{$content_type};
-    }
+    $self->DEBUG("Executing route \U$route->{method}\E $route->{template}");
 
+    my $operation = $route->{operation};
+    my $cgi_mode  = $operation->{'x-tpsgi-env'};
     my $streaming = $env->{'psgi.streaming'};
 
     # Build the query data for passing to a route.
-    # GET, POST, URI captures, then explicit data overrides.
+    # GET, POST, path parameters, then explicit data overrides.
     my $query = {};
 
     # If we're running in CGI mode, leave everything as-is.
-    $query = $self->extract_query( $path, $route, $env ) unless $route->{env};
+    $query = $self->extract_query( $path, $route, $env ) unless $cgi_mode;
 
     # We failed validation if $query isn't a hashref.
     return $query if ref $query eq 'ARRAY';
@@ -971,37 +963,37 @@ sub route {
     $query->{start}  = $start;
 
     # Put things to tv_interval in here for Server-Timing
-    $query->{fullpath}   = $fullpath;
-    $query->{method}     = $route->{method};
-    $query->{route}      = $path;
-    $query->{cookies}    = $env->{HTTP_COOKIE};
-    $query->{dnt}        = $env->{HTTP_DNT};
-    $query->{nosellinfo} = $env->{HTTP_SEC_GPC};
-    $query->{port}       = $request{port};
-    $query->{scheme}     = $env->{'psgi.url_scheme'} // 'http';
-    $query->{method}     = $env->{REQUEST_METHOD};
-    $query->{lang}       = $env->{HTTP_ACCEPT_LANGUAGE};
-    $query->{accept}     = $env->{HTTP_ACCEPT};
-    $query->{has_query}  = !!$env->{QUERY_STRING};
-    $query->{domain}     = $request{domain};
-    $query->{dispatcher} = $route;
-    $query->{ip}         = $cur_query->{ip};
-    $query->{ua}         = $cur_query->{ua};
-    $query->{referer}    = $cur_query->{referer};
+    $query->{fullpath}       = $fullpath;
+    $query->{route}          = $path;
+    $query->{route_template} = $route->{template};
+    $query->{cookies}        = $env->{HTTP_COOKIE};
+    $query->{dnt}            = $env->{HTTP_DNT};
+    $query->{nosellinfo}     = $env->{HTTP_SEC_GPC};
+    $query->{port}           = $request{port};
+    $query->{scheme}         = $env->{'psgi.url_scheme'} // 'http';
+    $query->{method}         = $env->{REQUEST_METHOD};
+    $query->{lang}           = $env->{HTTP_ACCEPT_LANGUAGE};
+    $query->{accept}         = $env->{HTTP_ACCEPT};
+    $query->{has_query}      = !!$env->{QUERY_STRING};
+    $query->{domain}         = $request{domain};
+    $query->{dispatcher}     = $operation;
+    $query->{ip}             = $cur_query->{ip};
+    $query->{ua}             = $cur_query->{ua};
+    $query->{referer}        = $cur_query->{referer};
 
     # This allows for better error handlers if we die in the route.
     $cur_query = $query;
 
     # Setup the CGI vars they expect IF requested
-    local %ENV = ( %ENV, CGI::Emulate::PSGI->emulate_environment($env) ) if $route->{env};
+    local %ENV = ( %ENV, CGI::Emulate::PSGI->emulate_environment($env) ) if $cgi_mode;
 
     # Emulate mod_unique_id
-    local $ENV{UNIQUE_ID} = UUID::uuid() if $route->{env};
+    local $ENV{UNIQUE_ID} = UUID::uuid() if $cgi_mode;
 
     # Run any watch callbacks, and make this a truly 'dynamic' application if requested.
     $self->handle_changes();
 
-    my $output = $callback->( $self, $query );
+    my $output = $route->{callback}->( $self, $query );
 
     # If it's streaming, just hand it off.
     # It's up to the caller to handle things like running post-close callbacks in this event.
@@ -1026,19 +1018,21 @@ sub route {
 =head2 extract_query($path, $route, $env) = HASHREF
 
 The query a route's callback is given: the query string, then the POST body,
-then the route's captures and its C<data>, each over the last.  When the route
-names C<parameters>, a parameter that fails its validator, or one it does not
-name, gets a badrequest() instead.
+then the path parameters of $route and the operation's C<x-tpsgi-data>, each
+over the last.  First TPSGI::Router::validate() checks the request against the
+operation.  A request that fails gets unsupported() for a 415 and badrequest()
+for a 400, and the reasons go to the log at the debug level.
 
 =cut
 
 sub extract_query {
     my ( $self, $path, $route, $env ) = @_;
 
-    my $query;
+    my $query = {};
     $query = URL::Encode::url_params_mixed( $env->{QUERY_STRING} ) if $env->{QUERY_STRING};
 
-    #Actually parse the POSTDATA and dump it into the QUERY object if this is a POST
+    #Actually parse the POSTDATA if this is a POST
+    my ( $form, $uploads );
     if ( $env->{REQUEST_METHOD} eq 'POST' ) {
 
         my $body = HTTP::Body->new( $env->{CONTENT_TYPE}, $env->{CONTENT_LENGTH} );
@@ -1046,45 +1040,33 @@ sub extract_query {
             $body->add($buf);
         }
 
-        @$query{ keys( %{ $body->param } ) }  = values( %{ $body->param } );
-        @$query{ keys( %{ $body->upload } ) } = values( %{ $body->upload } );
+        # A POST with no body has nothing for a requestBody schema to judge.
+        $form    = { %{ $body->param } } if $env->{CONTENT_TYPE} || $env->{CONTENT_LENGTH};
+        $uploads = $body->upload;
     }
 
-    if ( ref $route->{captures} eq 'ARRAY' ) {
-        my @captures = match_route( $path, $route->{pattern} );
-        @$query{ @{ $route->{captures} } } = @captures;
-    }
+    my ( $status, @errors ) = $self->routes->validate(
+        $route,
+        query        => $query,
+        body         => $form,
+        content_type => $env->{CONTENT_TYPE},
+        env          => $env,
+    );
+    if ($status) {
+        $self->DEBUG("Rejected $path: $_") foreach @errors;
 
-    if ( ref $route->{data} eq 'HASH' ) {
-        @$query{ keys( %{ $route->{data} } ) } = values( %{ $route->{data} } );
+        # What respond() knows of the request, which the log line and the
+        # error page need.  The query has neither the method nor the path.
+        my $request = { method => $env->{REQUEST_METHOD}, fullpath => $path, %$cur_query };
+        return $status == 415 ? $self->unsupported($request) : $self->badrequest($request);
     }
 
-    # Now that we've parsed the query and know where we want to go,
-    # we should (optionally) murder everything the route does not explicitly want, and validate what it does
-    my $parameters = $route->{parameters};
-    if ( ref $parameters eq 'HASH' && %$parameters ) {
-        my @known_params = keys(%$parameters);
-        for my $param (@known_params) {
-            die "Invalid route definition for $path: parameter $param must correspond to a validation CODEREF." unless ref $parameters->{$param} eq 'CODE';
+    @$query{ keys(%$form) }                = values(%$form)    if $form;
+    @$query{ keys(%$uploads) }             = values(%$uploads) if $uploads;
+    @$query{ keys( %{ $route->{path} } ) } = values( %{ $route->{path} } );
 
-            # A missing parameter is not necessarily a problem.
-            next unless $query->{$param};
-
-            # But if we have it, and it's bad, nack it, so that scanners get fail2banned.
-            $self->DEBUG("Rejected $path for bad query param $param");
-            return $self->badrequest($query) unless $parameters->{$param}->( $query->{$param} );
-        }
-
-        # Without this logging will break.
-        push( @known_params, qw{tpsgi ip ua user referer route dispatcher} );
-
-        # Smack down passing of unnecessary fields; this catches bugs
-        foreach my $field ( keys(%$query) ) {
-            next if List::Util::any { $field eq $_ } @known_params;
-            $self->WARN("Unexpected parameter $field passed");
-            return $self->badrequest($query);
-        }
-    }
+    my $data = $route->{operation}{'x-tpsgi-data'};
+    @$query{ keys(%$data) } = values(%$data) if ref $data eq 'HASH';
 
     return $query;
 }
@@ -1676,11 +1658,18 @@ __END__
 A router module, which C<routers> in F<~/.tpsgi.ini> names:
 
     package My::Routes;
-
-    our @routes = (
-        '/hello' => {
-            method    => 'GET',
-            callbacks => { 'text/html' => \&hello },
+    use Mojo::JSON ();
+
+    our %openapi = (
+        openapi => '3.0.3',
+        info    => { title => 'My routes', version => '1' },
+        paths   => {
+            '/hello' => {
+                get => {
+                    'x-tpsgi-callback' => \&hello,
+                    responses          => { 200 => { description => 'A greeting' } },
+                },
+            },
         },
     );
 
@@ -1731,31 +1720,106 @@ All the CPAN deps should be updated out-of-band and the service manually restart
 
 =head1 CUSTOM ROUTING
 
-All passed routing modules will be required, and combined to form a routing table so you have an analogue to rewrite rules.
-
-Routing Modules look like so:
+tPSGI requires each router module, and routes requests by the OpenAPI 3
+document that each one exports as C<%openapi>.  A router can also export
+C<%aliases>, C<%watches> and C<generic_route()>.
 
-    our @routes = (
-        '/foo/(\w+)/save' => {
-            method    => 'GET',
-            callbacks => { # Run these subroutines to execute the appropriate handler given the content-type.  Expects normal PSGI output.
-                'text/html'        => \&render,
-                'application/json' => \&dump,
+    package My::Routes;
+    use Mojo::JSON ();
+
+    our %openapi = (
+        openapi => '3.0.3',
+        info    => { title => 'My routes', version => '1' },
+        paths   => {
+            '/sitemap/{map}.xml' => {
+                get => {
+                    'x-tpsgi-callback' => \&sitemap,
+                    'x-myapp-nomap'    => Mojo::JSON::true,
+                    parameters         => [
+                        {
+                            name     => 'map',
+                            in       => 'path',
+                            required => Mojo::JSON::true,
+                            schema   => { type => 'integer' },
+                        },
+                    ],
+                    responses => { 200 => { description => 'One page of the sitemap' } },
+                },
+            },
+            '/lib/{module+}' => {
+                get => {
+                    'x-tpsgi-callback' => 'My::Routes::manual',
+                    'x-tpsgi-data'     => { section => 'manual' },
+                    parameters         => [
+                        {
+                            name     => 'module+',
+                            in       => 'path',
+                            required => Mojo::JSON::true,
+                            schema   => { type => 'string' },
+                        },
+                    ],
+                    responses => { 200 => { description => 'The manual of a module' } },
+                },
             },
-            noindex   => 0, # Explicitly exclude this in robots.txt
-            nomap     => 0, # Don't put this in the sitemap
-            acls      => ['admin'], # Route requires both authentication by auth handler and the auth'd user to have the provided ACLs.
-            data      => { baz => 'throb' }, # Arbitrary data to inject into the GET/POST data hashref
-            captures  => ['name','parameter'], # Name parameters of the capture groups in the route key.  Suppose we want /foo/don/keys here.
-            static    => 1, # Whether we can save a static render of this
-            invalidates => ['/foo/(\w+)'], # Static renders which are invalidated by this route returning a successful response code.
         },
-        ...
     );
 
-Note that this is an array, as we want this to preserve order. Fat commas are used to hint that this is in fact a tuple.
+The document is Perl data.  A boolean in it must be C<Mojo::JSON::true> or
+C<Mojo::JSON::false>.  C<\1> and C<builtin::true> fail the check against the
+OpenAPI schema.  Write the full name: C<use 5.040> imports C<builtin::true> as
+C<true>, and that wins over an imported C<Mojo::JSON::true>.
+
+new() dies when a document is not valid, so a broken router fails as it loads,
+and not at the first request.  A router that still defines C<@routes> and no
+C<%openapi> dies the same way.
+
+=head2 Templates
+
+Each key of C<paths> is a template.  C<{name}> matches any text up to the next
+slash, and one segment can hold several variables and literal text, as in
+C<{map}.xml>.  C<{name+}> matches the rest of the path, slashes and all, and it
+must be the whole last segment.  Its parameter is named C<name+>, and the query
+gives its value as C<name>.  Any other character matches only itself.  No
+variable matches a newline.
+
+When more than one template matches, the most concrete one wins.  Literal
+segments win over segments with variables, segments that mix text and
+variables win over a lone C<{name}>, and C<{name+}> comes last.  Then the
+template with more literal characters wins, and then the one that sorts first.
+L<TPSGI::Router> says this in full.
+
+A path that a template matches, with a method that no matching template has,
+gets a 405 with an C<Allow> header.  HEAD uses the C<get> operation when there
+is no C<head> one.
+
+=head2 Operations
+
+The C<x-tpsgi-> keys of an operation are tPSGI's:
+
+    x-tpsgi-callback  The sub that answers the request: a CODE reference, or
+                      the fully qualified name of a sub.  Required.
+    x-tpsgi-data      A HASH, which is merged over the query.
+    x-tpsgi-env       True for CGI mode: the callback gets the request as a
+                      CGI %ENV, and no query is built.
+
+Any other C<x-> key is the application's.  The callback finds the whole
+operation in C<< $query->{dispatcher} >>, and the template that matched in
+C<< $query->{route_template} >>.
+
+=head2 Validation
+
+Before the callback runs, tPSGI checks the request against the operation's
+C<parameters> and C<requestBody>.  Values are coerced to their schema, so an
+integer arrives as a number.  A request that fails gets a 400, and the reasons
+go to the log at the debug level, not into the page.  The 400 is also the
+answer to a query key that the operation does not declare, when the operation
+declares a query parameter or a request body.  A form body is as strict as the
+C<additionalProperties> of its schema.  A body whose media type is not among
+the C<content> of the C<requestBody> gets a 415.
+
+=head2 Callbacks
 
-Router callbacks are passed the TPSGI object and the raw query, which means you can do:
+A callback is passed the TPSGI object and the query, which means you can do:
 
     sub route {
         my ($self, $query) = @_;
@@ -1763,7 +1827,8 @@ Router callbacks are passed the TPSGI object and the raw query, which means you
         $self->ERROR("eeee");
         $self->DEBUG("blah");
 
-        # Either from the GET or POST data, POST is preferred when both are present.
+        # From the query string, the POST body, the path or x-tpsgi-data, in
+        # that order: a later one wins.
         my $param = $query->{param};
 
         my %headers = ...;

lib/TPSGI/Router.pm

@@ -0,0 +1,428 @@
+package TPSGI::Router;
+
+# ABSTRACT: Match requests to the operations of OpenAPI 3 documents, and validate them
+
+use 5.040;
+use warnings FATAL => 'all';
+use re '/aasx';
+
+use List::Util ();
+use JSON::Validator::Schema::OpenAPIv3;
+use JSON::Validator::Util ();
+
+=head1 SYNOPSIS
+
+    my $router = TPSGI::Router->new( 'lib/My/Routes.pm' => \%My::Routes::openapi );
+
+    sub answer {
+        my ( $tpsgi, $method, $path, %query ) = @_;
+
+        my $request = { method => $method, fullpath => $path };
+        my $route   = $router->match( $method, $path );
+        return $tpsgi->notfound($request) unless $route;
+        return $tpsgi->notallowed( $request, @{ $route->{allow} } ) if $route->{status};
+
+        my ( $status, @errors ) = $router->validate( $route, query => \%query );
+        return $tpsgi->badrequest($request) if $status;
+        return $route->{callback}->( $tpsgi, { %query, %{ $route->{path} } } );
+    }
+
+=head1 DESCRIPTION
+
+TPSGI::Router compiles the C<%openapi> document of each router once.  Then it
+answers which operation a request is for, and whether the request is valid for
+that operation.
+
+Each key of C<paths> is a template.  A template is a list of segments, which
+slashes separate.  A segment is made of literal text and variables:
+
+=over
+
+=item C<{name}> is any text up to the next slash.  One segment can hold several
+variables and literal text, for example C<{map}.xml>.
+
+=item C<{name+}> is the rest of the path, slashes and all.  It must be the whole
+last segment, as in C</lib/{module+}>.  Declare its parameter with the name
+C<name+>.  The query gives its value to the callback as C<name>.
+
+=back
+
+A literal character matches only itself, so the C<.> of C</humans.txt> matches
+only a dot.  No variable matches a newline.
+
+When more than one template matches a path, the most concrete one wins.  The
+segments are compared in order.  A literal segment comes first, then a segment
+of literal text and variables, then a lone C<{name}>, then a C<{name+}>.  If
+that does not decide, the template with more literal characters wins, and then
+the template that sorts first as a string.  So the order never depends on the
+order of a hash.
+
+=cut
+
+my @methods = qw{get put post delete options head patch trace};
+
+# The keys of the query that tPSGI sets itself.  The query string can hold
+# them without a 400, because route() replaces them anyway.
+my @reserved = qw{tpsgi ip ua user referer route dispatcher};
+
+# How concrete a segment is.  A lower rank wins.
+my %rank = (
+    literal => 0,
+    mixed   => 1,
+    single  => 2,
+    rest    => 3,
+);
+
+=head1 METHODS
+
+=head2 new(@pairs) = TPSGI::Router
+
+Compile the documents.  @pairs is a list of names and documents, for example
+the file of each router and its C<%openapi>.  The name goes into each error.
+
+new() dies with the reason when a document is not valid OpenAPI 3, when an
+operation has no C<x-tpsgi-callback>, or when its callback is a name that is
+not a defined sub.  It also dies on two templates that differ only in the names
+of their variables, and on one template and method in two documents.
+
+=cut
+
+sub new {
+    my ( $class, @pairs ) = @_;
+
+    my $self = bless( { by_template => {}, shapes => {}, exact => {} }, $class );
+    while ( my ( $name, $document ) = splice( @pairs, 0, 2 ) ) {
+        $self->add_document( $name, $document );
+    }
+
+    my @templated = grep { !$_->{literal} } values( %{ $self->{by_template} } );
+    $self->{templated} = [ sort { by_precedence( $a, $b ) } @templated ];
+    $self->{exact}{ $_->{template} } = $_ for grep { $_->{literal} } values( %{ $self->{by_template} } );
+
+    return $self;
+}
+
+=head2 add_document($name, $document)
+
+Check $document as OpenAPI 3, and add each of its operations.  new() calls it
+for each pair.
+
+=cut
+
+sub add_document {
+    my ( $self, $name, $document ) = @_;
+
+    die "$name: the router's %openapi is not a HASH reference\n" unless ref $document eq 'HASH';
+
+    my $schema = JSON::Validator::Schema::OpenAPIv3->new($document);
+    my @errors = @{ $schema->errors };
+    die "$name: %openapi is not a valid OpenAPI 3 document:\n" . join( "\n", map { "  $_" } @errors ) . "\n" if @errors;
+
+    my $paths = $schema->get( ['paths'] ) // {};
+    foreach my $template ( sort keys(%$paths) ) {
+        my $matcher = $self->matcher_for( $name, $template );
+        foreach my $method ( grep { exists $paths->{$template}{$_} } @methods ) {
+            die "$name: \U$method\E $template is also a route of $matcher->{methods}{$method}{router}\n" if $matcher->{methods}{$method};
+
+            my $operation = $paths->{$template}{$method};
+            $matcher->{methods}{$method} = {
+                router    => $name,
+                template  => $template,
+                method    => $method,
+                operation => $operation,
+                schema    => $schema,
+                callback  => resolve_callback( "$name: \U$method\E $template", $operation->{'x-tpsgi-callback'} ),
+                %{ $self->rules_for( $schema, $method, $template ) },
+            };
+        }
+    }
+    return;
+}
+
+=head2 matcher_for($name, $template) = HASHREF
+
+The compiled form of $template, made the first time it is asked for.  It dies
+when $template is not a template, and when another template differs from it
+only in the names of its variables.
+
+=cut
+
+sub matcher_for {
+    my ( $self, $name, $template ) = @_;
+
+    return $self->{by_template}{$template} if $self->{by_template}{$template};
+
+    my $matcher = compile_template($template);
+    my $twin    = $self->{shapes}{ $matcher->{shape} };
+    die "$name: $template and $twin match the same paths, and differ only in the names of their variables\n" if $twin;
+    $self->{shapes}{ $matcher->{shape} } = $template;
+
+    return $self->{by_template}{$template} = $matcher;
+}
+
+=head2 compile_template($template) = HASHREF
+
+A function.  The compiled form of $template: its regular expression, the names of
+its variables, the rank of each segment, its count of literal characters, and
+its shape, which is the template with every variable name left out.  It dies
+when the template does not start with a slash, when a brace is not part of a
+variable, and when a C<{name+}> is not the whole last segment.
+
+=cut
+
+sub compile_template {
+    my ($template) = @_;
+
+    die "The template $template does not start with a slash\n" unless index( $template, '/' ) == 0;
+
+    my @segments = split( m{/}, substr( $template, 1 ), -1 );
+    my ( @regex, @ranks, @variables );
+    my $literal_length = 0;
+    my $shape          = '';
+
+    foreach my $i ( 0 .. $#segments ) {
+        my $segment = $segments[$i];
+        my @parts   = $segment =~ m/ ( \{ [^{}]* \} | [^{}]+ ) /g;
+        die "The template $template has a brace that is not part of a {variable}\n" unless join( '', @parts ) eq $segment;
+
+        my ( $regex, $variables ) = ( '', 0 );
+        foreach my $part (@parts) {
+            my ($variable) = $part =~ m/ \A \{ ( [^{}]+ ) \} \z /;
+            if ( !defined $variable ) {
+                $regex .= quotemeta($part);
+                $shape .= $part;
+                $literal_length += length($part);
+                next;
+            }
+            $variables++;
+            my $is_rest = $variable =~ s/ [+] \z //;
+            die "The template $template has an empty {variable}\n"                        if $variable eq '';
+            die "In the template $template, {$variable+} is not the whole last segment\n" if $is_rest && ( @parts > 1 || $i < $#segments );
+
+            # \N, so that no variable takes a newline that a %0A decoded to.
+            $regex .= $is_rest ? '(\N+)' : '([^/\n]+?)';
+            $shape .= $is_rest ? '{+}'   : '{}';
+            push( @variables, $variable );
+        }
+        $shape .= '/' if $i < $#segments;
+
+        my $kind = !$variables ? 'literal' : @parts > 1 ? 'mixed' : $regex eq '(\N+)' ? 'rest' : 'single';
+        push( @ranks, $rank{$kind} );
+        push( @regex, $regex );
+    }
+
+    my $source = '\A/' . join( '/', @regex ) . '\z';
+    return {
+        template       => $template,
+        regex          => qr/$source/,
+        variables      => \@variables,
+        ranks          => \@ranks,
+        literal_length => $literal_length,
+        literal        => !@variables,
+        shape          => "/$shape",
+        methods        => {},
+    };
+}
+
+=head2 by_precedence($a, $b) = INTEGER
+
+A function, for sort.  Below zero when the compiled template $a is tried
+before $b, as DESCRIPTION says.
+
+=cut
+
+sub by_precedence {
+    my ( $left, $right ) = @_;
+
+    my @l = @{ $left->{ranks} };
+    my @r = @{ $right->{ranks} };
+    foreach my $i ( 0 .. List::Util::min( $#l, $#r ) ) {
+        return $l[$i] <=> $r[$i] if $l[$i] != $r[$i];
+    }
+    return @l <=> @r || $right->{literal_length} <=> $left->{literal_length} || $left->{template} cmp $right->{template};
+}
+
+=head2 resolve_callback($what, $callback) = CODE
+
+A function.  $callback when it is a CODE reference, and the sub that it names
+when it is a fully qualified name.  It dies, and names $what, when there is no
+callback or no such sub.
+
+=cut
+
+sub resolve_callback {
+    my ( $what, $callback ) = @_;
+
+    die "$what has no x-tpsgi-callback\n" unless defined $callback;
+    return $callback                                                                  if ref $callback eq 'CODE';
+    die "$what: x-tpsgi-callback is neither a CODE reference nor the name of a sub\n" if ref $callback;
+
+    my $code = do {
+        no strict 'refs';    # a sub that the router names
+        defined &{$callback} ? \&{$callback} : undef;
+    };
+    die "$what: x-tpsgi-callback names $callback, which is not a defined sub\n" unless $code;
+    return $code;
+}
+
+=head2 rules_for($schema, $method, $template) = HASHREF
+
+What validate() checks of one operation beyond its schema: the names of its
+query parameters, whether an undeclared key in the query is a 400, and the
+media types of its request body.
+
+=cut
+
+sub rules_for {
+    my ( $self, $schema, $method, $template ) = @_;
+
+    my @parameters = @{ $schema->parameters_for_request( [ $method, $template ] ) };
+    my %declared   = map  { $_->{name} => 1 } grep { $_->{in} eq 'query' } @parameters;
+    my ($body)     = grep { $_->{in} eq 'body' } @parameters;
+
+    return {
+        query_names => \%declared,
+        strict      => ( %declared || $body ) ? 1                                            : 0,
+        body_types  => $body                  ? [ sort keys( %{ $body->{content} // {} } ) ] : undef,
+    };
+}
+
+=head2 match($method, $path) = HASHREF
+
+The route of a request, or undef when no template matches $path.
+
+The route holds C<template>, C<method>, C<operation>, C<callback>, C<schema>
+and C<path>, which maps each variable to its value.  The names in C<path> have
+no C<+>.
+
+When a template matches and none of the matching templates has an operation
+for $method, the HASH holds C<status>, which is 405, and C<allow>, the methods
+that they do have.  A HEAD request falls back to C<get>.
+
+=cut
+
+sub match {
+    my ( $self, $method, $path ) = @_;
+
+    $method = lc($method);
+    my @tried;
+    foreach my $matcher ( grep { defined } $self->{exact}{$path}, @{ $self->{templated} } ) {
+        my @values = $matcher->{literal} ? () : $path =~ $matcher->{regex};
+        next unless $matcher->{literal} || @values;
+        push( @tried, $matcher );
+
+        my $route = $matcher->{methods}{$method};
+        $route //= $matcher->{methods}{get} if $method eq 'head';
+        next unless $route;
+
+        my %values;
+        @values{ @{ $matcher->{variables} } } = @values;
+        return { %$route, path => \%values };
+    }
+    return unless @tried;
+
+    my %allow = map {
+        map { uc($_) => 1 }
+          keys( %{ $_->{methods} } )
+    } @tried;
+    $allow{HEAD} = 1 if $allow{GET};
+    return { status => 405, allow => [ sort keys(%allow) ] };
+}
+
+=head2 validate($route, %request) = LIST
+
+Check a request against the operation of the $route that match() returned.
+%request holds C<query> and C<body>, each a HASH reference, C<content_type>,
+and C<env>, the PSGI environment, from which the headers and cookies come.
+
+It returns an empty list when the request is valid.  Otherwise it returns a
+status and the reasons.  The status is 415 when the operation has a request
+body and the media type of the request is not among its C<content>.  It is 400
+when a parameter or the body does not match its schema, and when the query
+holds a key that the operation does not declare.  The last rule holds only for
+an operation that declares a query parameter or a request body.
+
+The values of C<path>, C<query> and C<body> are coerced in place, so a parameter
+of type integer arrives as a number.
+
+=cut
+
+sub validate {
+    my ( $self, $route, %request ) = @_;
+
+    my $query = $request{query} // {};
+    my $body  = $request{body};
+    my $env   = $request{env} // {};
+
+    if ( $route->{body_types} && defined $body ) {
+        my $type = $request{content_type} // '';
+        return ( 415, "/body: '$type' is not one of @{ $route->{body_types} }" ) unless JSON::Validator::Util::negotiate_content_type( $route->{body_types}, $type );
+    }
+
+    if ( $route->{strict} ) {
+        my %known      = ( %{ $route->{query_names} }, map { $_ => 1 } @reserved );
+        my @undeclared = grep { !$known{$_} } sort keys(%$query);
+        return ( 400, map { "/$_: the operation does not declare this parameter" } @undeclared ) if @undeclared;
+    }
+
+    my %cookies = map { split( m/=/, $_, 2 ) } split( m/ ; [ ]* /, $env->{HTTP_COOKIE} // '' );
+    my %headers = map {
+        my $name = lc( substr( $_, 5 ) );
+        $name =~ tr/_/-/;
+        ( $name => $env->{$_} )
+    } grep { index( $_, 'HTTP_' ) == 0 } keys(%$env);
+
+    my @seen;
+    my $getter = sub {
+        my ( $values, $fold ) = @_;
+        return sub {
+            my ($name) = @_;
+            my $key    = $fold->($name);
+            my $value  = { exists => exists $values->{$key}, value => $values->{$key} };
+            push( @seen, [ $values, $key, $value ] );
+            return $value;
+        };
+    };
+    my $as_is = sub { return $_[0] };
+
+    my @errors = $route->{schema}->validate_request(
+        [ $route->{method}, $route->{template} ],
+        {
+            path   => $getter->( $route->{path}, sub { my $name = shift; $name =~ s/ [+] \z //; return $name } ),
+            query  => $getter->( $query,         $as_is ),
+            header => $getter->( \%headers,      sub { return lc( $_[0] ) } ),
+            cookie => $getter->( \%cookies,      $as_is ),
+            body   => sub {
+                return { exists => defined $body, value => $body, content_type => $request{content_type} };
+            },
+        }
+    );
+
+    # validate_request() coerces its copy of each value, not the caller's.
+    foreach my $seen (@seen) {
+        my ( $values, $key, $value ) = @$seen;
+        $values->{$key} = $value->{value} if $value->{exists};
+    }
+
+    return unless @errors;
+    return ( 400, map { "$_" } @errors );
+}
+
+=head2 routes() = LIST
+
+Each route as a HASH reference with C<template> and C<method>, in the order
+match() tries them, for a caller that lists them.
+
+=cut
+
+sub routes {
+    my ($self) = @_;
+    my @matchers = ( map { $self->{exact}{$_} } sort keys( %{ $self->{exact} } ) );
+    push( @matchers, @{ $self->{templated} } );
+    return map {
+        my $matcher = $_;
+        map { $matcher->{methods}{$_} } grep { $matcher->{methods}{$_} } @methods
+    } @matchers;
+}
+
+1;

t/TPSGI-Router.t

@@ -0,0 +1,185 @@
+#!/usr/bin/env perl
+use 5.040;
+use warnings FATAL => 'all';
+use re '/aasx';
+
+use Test2::V0;
+use Test2::Plugin::NoWarnings;
+
+use Mojo::JSON ();
+
+use FindBin::libs;
+
+use TPSGI::Router;
+
+sub named { return 'named' }
+
+sub coderef { return 'coderef' }
+
+sub path_parameter {
+    my ( $name, %schema ) = @_;
+    return { name => $name, in => 'path', required => Mojo::JSON::true, schema => { type => 'string', %schema } };
+}
+
+sub operation {
+    my (%operation) = @_;
+    return { 'x-tpsgi-callback' => \&coderef, responses => { 200 => { description => 'ok' } }, %operation };
+}
+
+sub document {
+    my (%paths) = @_;
+    return { openapi => '3.0.3', info => { title => 'test', version => '1' }, paths => \%paths };
+}
+
+my $router = TPSGI::Router->new(
+    'Test.pm' => document(
+        '/sitemap/static.xml'    => { get => operation() },
+        '/sitemap/{map}.xml'     => { get => operation( parameters => [ path_parameter('map') ] ) },
+        '/sitemap/{map}.xml.gz'  => { get => operation( parameters => [ path_parameter('map') ] ) },
+        '/lib/{module+}'         => { get => operation( parameters => [ path_parameter('module+') ] ) },
+        '/lib/index'             => { get => operation() },
+        '/{year}-{month}/{slug}' => { get => operation( parameters         => [ map { path_parameter($_) } qw{year month slug} ] ) },
+        '/humans.txt'            => { get => operation( 'x-tpsgi-callback' => 'main::named' ) },
+        '/post/{slug}'           => { get => operation( parameters         => [ path_parameter('slug') ] ) },
+        '/form'                  => {
+            post => operation(
+                requestBody => {
+                    content => {
+                        'application/x-www-form-urlencoded' => {
+                            schema => {
+                                type                 => 'object',
+                                additionalProperties => Mojo::JSON::false,
+                                properties           => { count => { type => 'integer' } },
+                            },
+                        },
+                    },
+                },
+            ),
+        },
+        '/search' => {
+            get => operation(
+                parameters => [
+                    { name => 'limit', in => 'query', schema => { type => 'integer' } },
+                    { name => 'exact', in => 'query', schema => { type => 'boolean' } },
+                ],
+            ),
+        },
+        '/loose'            => { get => operation() },
+        '/news/{slug}'      => { get => operation( parameters => [ path_parameter('slug') ] ) },
+        '/{section}/latest' => { get => operation( parameters => [ path_parameter('section') ] ) },
+    ),
+);
+
+subtest 'a literal template wins over a variable' => sub {
+    is( $router->match( 'GET', '/sitemap/static.xml' )->{template}, '/sitemap/static.xml', 'the static sitemap is the static route' );
+    my $route = $router->match( 'GET', '/sitemap/1.xml' );
+    is( $route->{template},                                       '/sitemap/{map}.xml',    'and any other reaches the template' );
+    is( $route->{path},                                           { map => 1 },            'with the variable' );
+    is( $router->match( 'GET', '/sitemap/1.xml.gz' )->{template}, '/sitemap/{map}.xml.gz', 'and the compressed one its own template' );
+    is( $router->match( 'GET', '/lib/index' )->{template},        '/lib/index',            'a literal path wins over {name+}' );
+    is( $router->match( 'GET', '/news/latest' )->{template},      '/news/{slug}',          'and an earlier literal segment wins over more literal characters' );
+};
+
+subtest 'variables' => sub {
+    my $route = $router->match( 'GET', '/2026-10/hello' );
+    is( $route->{path}, { year => 2026, month => 10, slug => 'hello' }, 'two variables in one segment' );
+
+    $route = $router->match( 'GET', '/lib/Trog/Auth.html' );
+    is( $route->{path}, { module => 'Trog/Auth.html' }, '{module+} takes the rest of the path, slashes and all, as module' );
+
+    my $cafe = "caf\N{LATIN SMALL LETTER E WITH ACUTE}";
+    is( $router->match( 'GET', "/post/$cafe" )->{path}, { slug => $cafe }, 'a variable takes a letter outside ASCII' );
+    is( $router->match( 'GET', "/post/a\nb" ),          undef,             'and no newline' );
+    is( $router->match( 'GET', '/post/a/b' ),           undef,             'and no slash' );
+    is( $router->match( 'GET', "/lib/a\nb" ),           undef,             'nor does {name+} take a newline' );
+};
+
+subtest 'a literal character is only itself' => sub {
+    is( $router->match( 'GET', '/humans.txt' )->{template}, '/humans.txt', 'the dot matches a dot' );
+    is( $router->match( 'GET', '/humansXtxt' ),             undef,         'and nothing else' );
+    is( $router->match( 'GET', '/sitemap/1Xxml' ),          undef,         'in a segment with a variable as well' );
+};
+
+subtest 'callbacks' => sub {
+    is( $router->match( 'GET', '/loose' )->{callback}->(),      'coderef', 'a CODE reference is the callback' );
+    is( $router->match( 'GET', '/humans.txt' )->{callback}->(), 'named',   'and a name is resolved to its sub' );
+
+    like(
+        dies { TPSGI::Router->new( 'Bad.pm' => document( '/x' => { get => { responses => { 200 => { description => 'ok' } } } } ) ) },
+        qr/Bad[.]pm:[ ]GET[ ]\/x[ ]has[ ]no[ ]x-tpsgi-callback/,
+        'an operation without a callback dies'
+    );
+    like(
+        dies { TPSGI::Router->new( 'Bad.pm' => document( '/x' => { get => operation( 'x-tpsgi-callback' => 'main::no_such_sub' ) } ) ) },
+        qr/no_such_sub,[ ]which[ ]is[ ]not[ ]a[ ]defined/,
+        'and so does a name that is not a sub'
+    );
+};
+
+subtest 'documents that are refused' => sub {
+    like(
+        dies { TPSGI::Router->new( 'Bad.pm' => { openapi => '3.0.3', paths => {} } ) },
+        qr/is[ ]not[ ]a[ ]valid[ ]OpenAPI[ ]3[ ]document/,
+        'an invalid document dies with the reason'
+    );
+    like(
+        dies { TPSGI::Router->new( 'Bad.pm' => document( '/a/{x}' => { get => operation() }, '/a/{y}' => { post => operation() } ) ) },
+        qr/[}][ ]and[ ]\/a\/[{].[}][ ]match[ ]the[ ]same/,
+        'two templates that differ only in their variable names die'
+    );
+    like(
+        dies { TPSGI::Router->new( 'One.pm' => document( '/a' => { get => operation() } ), 'Two.pm' => document( '/a' => { get => operation() } ) ) },
+        qr/Two[.]pm:[ ]GET[ ]\/a[ ]is[ ]also[ ]a[ ]route/,
+        'one template and method in two routers dies'
+    );
+    ok(
+        lives { TPSGI::Router->new( 'One.pm' => document( '/a' => { get => operation() } ), 'Two.pm' => document( '/a' => { post => operation() } ) ) },
+        'but two methods of one template in two routers do not'
+    ) or note $@;
+    like( dies { TPSGI::Router::compile_template('/a/{x+}/b') }, qr/not[ ]the[ ]whole[ ]last[ ]segment/, '{name+} before the last segment dies' );
+    like( dies { TPSGI::Router::compile_template('/a/b{x+}') },  qr/not[ ]the[ ]whole[ ]last[ ]segment/, 'and so does {name+} with text beside it' );
+    like( dies { TPSGI::Router::compile_template('/a/{x') },     qr/a[ ]brace[ ]that[ ]is[ ]not/,        'and a brace that is not a variable' );
+};
+
+subtest 'methods' => sub {
+    is( $router->match( 'HEAD', '/loose' )->{method}, 'get', 'HEAD falls back to get' );
+
+    my $route = $router->match( 'POST', '/loose' );
+    is( $route->{status},                    405,            'a path whose template has no operation for the method is a 405' );
+    is( $route->{allow},                     [qw{GET HEAD}], 'which names the methods it does have' );
+    is( $router->match( 'GET', '/nowhere' ), undef,          'and a path that no template matches is nothing at all' );
+};
+
+subtest 'validation' => sub {
+    my $route = $router->match( 'GET', '/search' );
+    my %query = ( limit => '5', exact => 'true' );
+    is( [ $router->validate( $route, query => \%query ) ], [],                         'a valid query passes' );
+    is( Mojo::JSON::encode_json( \%query ),                '{"exact":true,"limit":5}', 'and arrives coerced: a number and a boolean, not two strings' );
+
+    my ( $status, @errors ) = $router->validate( $route, query => { limit => 'many' } );
+    is( $status, 400, 'a value that its schema refuses is a 400' );
+    like( \@errors, [qr/\/limit:[ ]Expected[ ]integer/], 'for that reason' );
+
+    ( $status, @errors ) = $router->validate( $route, query => { limit => 1, junk => 1 } );
+    is( $status, 400, 'an undeclared query key is a 400' );
+    like( \@errors, [qr/\/junk:/], 'and named' );
+    is( [ $router->validate( $route,                            query => { limit    => 1, route => '/x' } ) ], [], 'except a key that tPSGI sets itself' );
+    is( [ $router->validate( $router->match( 'GET', '/loose' ), query => { anything => 1 } ) ],                [], 'and an operation that declares nothing takes anything' );
+
+    $route = $router->match( 'POST', '/form' );
+    my $form_type = 'application/x-www-form-urlencoded';
+    is( [ $router->validate( $route, body => { count => '3' }, content_type => $form_type ) ], [], 'a form that its schema takes passes' );
+    ( $status, @errors ) = $router->validate( $route, body => { count => 3, junk => 1 }, content_type => $form_type );
+    is( $status, 400, 'a form key that additionalProperties refuses is a 400' );
+    like( \@errors, [qr/Properties[ ]not[ ]allowed:[ ]junk/], 'for that reason' );
+    ( $status, @errors ) = $router->validate( $route, body => { count => 3 }, content_type => 'text/plain' );
+    is( $status,                                                                                              415, 'a body of a media type the operation does not take is a 415' );
+    is( [ $router->validate( $route, body => { count => 3 }, content_type => "$form_type; charset=UTF-8" ) ], [],  'and parameters of the media type do not count' );
+};
+
+subtest 'precedence' => sub {
+    my @order = map { $_->{template} } grep { index( $_->{template}, '/sitemap/' ) == 0 || index( $_->{template}, '/lib/' ) == 0 } $router->routes();
+    is( \@order, [qw{/lib/index /sitemap/static.xml /sitemap/{map}.xml.gz /sitemap/{map}.xml /lib/{module+}}], 'literal routes first, then by segment, then by literal length' );
+};
+
+done_testing();

t/TPSGI.t

@@ -141,20 +141,83 @@ subtest 'serve_ranges' => sub {
     close($fh) or die "Cannot close: $!";
 };
 
-# A router's pattern is matched as the router wrote it, whatever flags this
-# distribution's own regexes carry.
+# Writes a router module into $dir, and returns its name relative to $dir.
+sub write_router {
+    my ( $package, $body ) = @_;
+    Mojo::File->new("$dir/$package.pm")->spew("package $package;\nuse 5.040;\nuse Mojo::JSON ();\n$body\n1;\n");
+    return "$package.pm";
+}
+
+my %new_options = (
+    %options,
+    user      => scalar getpwuid($>),
+    http_user => scalar getgrgid( ( getpwuid($>) )[3] ),
+    tpsgi_dir => $dir,
+);
+
+subtest 'new' => sub {
+    my $stale = write_router( 'StaleRouter', q{our @routes = ( '/x' => { method => 'GET', callbacks => { '*' => sub { } } } );} );
+    like(
+        dies { TPSGI->new( %new_options, routers => [$stale] ) },
+        qr/StaleRouter[.]pm[ ]defines[ ]\@routes[ ]and[ ]no/,
+        'a router that still has @routes dies as it loads'
+    );
+
+    my $router = write_router( 'GoodRouter', <<~'ROUTER' );
+        our %openapi = (
+            openapi => '3.0.3',
+            info    => { title => 'good', version => '1' },
+            paths   => {
+                '/post/{slug}' => {
+                    get => {
+                        'x-tpsgi-callback' => sub { },
+                        'x-tpsgi-data'     => { from => 'data' },
+                        parameters         => [
+                            { name => 'slug',  in => 'path',  required => Mojo::JSON::true, schema => { type => 'string' } },
+                            { name => 'limit', in => 'query', schema   => { type => 'integer' } },
+                        ],
+                        responses => { 200 => { description => 'ok' } },
+                    },
+                },
+            },
+        );
+        ROUTER
+    my $first = TPSGI->new( %new_options, routers => [$router] );
+    is( $first->routes->match( 'GET', '/post/hello' )->{template}, '/post/{slug}', 'a router with %openapi routes' );
+    ref_is( TPSGI->new( %new_options, routers => [$router] )->routes, $first->routes, 'and the next request in the worker reuses the router' );
+};
+
 subtest 'extract_query' => sub {
-    my $tpsgi = bless( { %options, ip => '0.0.0.0' }, 'TPSGI' );
+    my $tpsgi = TPSGI->new( %new_options, routers => ['GoodRouter.pm'] );
     my $env   = { REQUEST_METHOD => 'GET' };
+    my $cafe  = "caf\N{LATIN SMALL LETTER E WITH ACUTE}";
+
+    my $query = $tpsgi->extract_query( "/post/$cafe", $tpsgi->routes->match( 'GET', "/post/$cafe" ), $env );
+    is( $query->{slug}, $cafe,  'a path parameter, outside ASCII too, is in the query' );
+    is( $query->{from}, 'data', 'and so is x-tpsgi-data' );
+
+    $query = $tpsgi->extract_query( '/post/x', $tpsgi->routes->match( 'GET', '/post/x' ), { %$env, QUERY_STRING => 'limit=5' } );
+    is( $query->{limit}, 5,   'the query string is in the query' );
+    is( $query->{slug},  'x', 'beside the path parameter' );
 
-    my $query = $tpsgi->extract_query( "/post/caf\N{LATIN SMALL LETTER E WITH ACUTE}", { pattern => '/post/(\w+)', captures => ['slug'] }, $env );
-    is( $query->{slug}, "caf\N{LATIN SMALL LETTER E WITH ACUTE}", 'a \\w in a route matches a letter outside ASCII' );
+    local @Test::Logger::Capture::lines;
+    my $res = $tpsgi->extract_query( '/post/x', $tpsgi->routes->match( 'GET', '/post/x' ), { %$env, QUERY_STRING => 'limit=many' } );
+    is( ref $res,  'ARRAY', 'a query that fails validation is an answer, not a query' );
+    is( $res->[0], 400,     'a 400' );
+    unlike( $res->[2][0], qr/integer/, 'which does not say why' );
+
+    $res = $tpsgi->extract_query( '/post/x', $tpsgi->routes->match( 'GET', '/post/x' ), { %$env, QUERY_STRING => 'junk=1' } );
+    is( $res->[0], 400, 'and so is one with a key that the operation does not declare' );
 
-    $query = $tpsgi->extract_query( '/a b/c', { pattern => '/a b/(\w+)', captures => ['name'] }, $env );
-    is( $query->{name}, 'c', 'and a space in a route is a space' );
+    $res = $tpsgi->extract_query( '/post/x', $tpsgi->routes->match( 'GET', '/post/x' ), { %$env, QUERY_STRING => 'slug=y' } );
+    is( $res->[0], 400, 'even when the path declares it' );
+};
 
-    $query = $tpsgi->extract_query( "/note/x\ny", { pattern => '/note/(.+)', captures => ['text'] }, $env );
-    is( $query->{text}, undef, 'and a dot does not match a newline' );
+subtest 'respond, with a method that the path does not have' => sub {
+    my $tpsgi = TPSGI->new( %new_options, routers => ['GoodRouter.pm'] );
+    my $res   = $tpsgi->respond( { REQUEST_METHOD => 'POST', PATH_INFO => '/post/x', REQUEST_URI => '/post/x', HTTP_HOST => 'test.test' } );
+    is( $res->[0],                   405,         'is a 405' );
+    is( { @{ $res->[1] } }->{Allow}, 'GET, HEAD', 'which names the methods it has' );
 };
 
 done_testing();