Support URI with a dot in a pattern

Fixes #14
khrt · May 6, 2021 · a52f959 · a52f959
1 parent 498fa70
commit a52f959
Show file tree

Hide file tree

Showing 8 changed files with 79 additions and 45 deletions.
diff --git a/Changes b/Changes
@@ -1,5 +1,6 @@
 0.94
     * Add support for form input;
+    * Add support for URIs with a dot in route pattern;
 
 0.93
     * Take `result_class` of `DBIx::Class::ResultSet` instead of asking for columns info on the actual data row (#110);

diff --git a/examples/pod-synopsis-app/darth.pl b/examples/pod-synopsis-app/darth.pl
@@ -119,4 +119,18 @@
     };
 };
 
+
+resource 'domain' => sub {
+    params requires('name', type => Str, regex => qr/[^.]+\.[^.]+/); # ^/domain/(?<name>(?:[.]+.[.]+))(?:\.[^.]+?)?$
+    # params requires('name', type => Str, regex => qr/google.com/); # ^/domain/(?<name>(?:google.com))(?:\.[^.]+?)?$
+    # params requires('name', type => Str); # ^/domain/(?<name>[^/]+?)(?:\.[^.]+?)?$
+    route_param 'name' => sub {
+        get sub {
+            my $params = shift;
+            $params;
+        };
+    };
+};
+
+
 run;
diff --git a/lib/Raisin.pm b/lib/Raisin.pm
@@ -187,7 +187,7 @@ sub psgi {
         $self->hook('before_validation')->($self);
 
         # Validation and coercion of declared params
-        if (!$req->prepare_params($route->params, $route->named)) {
+        if (!$req->build_params($route)) {
             $res->status(HTTP_BAD_REQUEST);
             $res->body('Invalid Parameters');
             return $res->finalize;
@@ -230,7 +230,7 @@ sub before_finalize {
     my $self = shift;
 
     $self->res->status(HTTP_OK) unless $self->res->status;
-    $self->res->header('X-Framework' => 'Raisin ' . __PACKAGE__->VERSION);
+    $self->res->header('X-Framework' => 'Raisin ' . (__PACKAGE__->VERSION || 'dev'));
 
     if ($self->api_version) {
         $self->res->header('X-API-Version' => $self->api_version);
@@ -963,6 +963,21 @@ Response format can be determined by C<Accept header> or C<route extension>.
 Serialization takes place automatically. So, you do not have to call
 C<encode_json> in each C<JSON> API implementation.
 
+The response format (and thus the automatic serialization) is determined in the following order:
+
+=over
+
+=item * Use the file extension, if specified. If the file is .json, choose the JSON format.
+
+=item * Attempt to find an acceptable format from the Accept header.
+
+=item * Use the default format, if specified by the default_format option.
+
+=item * Default to C<YAML>.
+
+=back
+
+
 Your API can declare to support only one serializator by using L<Raisin/api_format>.
 
 Custom formatters for existing and additional types can be defined with a

diff --git a/lib/Raisin/Middleware/Formatter.pm b/lib/Raisin/Middleware/Formatter.pm
@@ -32,7 +32,7 @@ sub call {
         my %media_types_map_flat_hash = $self->decoder->media_types_map_flat_hash;
 
         my ($ctype) = split /;/, $req->content_type, 2;
-        my $format = $media_types_map_flat_hash{ $ctype};
+        my $format = $media_types_map_flat_hash{$ctype};
         unless ($format) {
             Raisin::log(info => "unsupported media type: ${ \$req->content_type }");
             return Plack::Response->new(HTTP_UNSUPPORTED_MEDIA_TYPE)->finalize;
@@ -82,14 +82,13 @@ sub negotiate_format {
     my @allowed_formats = $self->allowed_formats_for_requested_route($req);
 
     # PRECEDENCE:
-    #   - extension
+    #   - extension, and is known
     #   - headers
     #   - default
-
     my @wanted_formats = do {
-        my $ext = _path_has_extension($req->path);
-        if ($ext) {
-            $self->format_from_extension($ext);
+        my $ext_format = $self->format_from_extension($req->path);
+        if ($ext_format) {
+            $ext_format;
         }
         elsif (_accept_header_set($req->header('Accept'))) {
             # In case of wildcard matches, we default to first allowed format
@@ -102,14 +101,16 @@ sub negotiate_format {
 
     my @matching_formats = grep {
         my $format = $_;
-        grep { $format eq $_ } @allowed_formats
+        grep { $format && $format eq $_ } @allowed_formats
     } @wanted_formats;
 
     shift @matching_formats;
 }
 
 sub format_from_extension {
-    my ($self, $ext) = @_;
+    my ($self, $path) = @_;
+
+    my $ext = _path_has_extension($path);
     return unless $ext;
 
     # Trim leading dot in the extension.

diff --git a/lib/Raisin/Request.pm b/lib/Raisin/Request.pm
@@ -9,31 +9,26 @@ package Raisin::Request;
 
 use parent 'Plack::Request';
 
-sub prepare_params {
-    my ($self, $declared, $named) = @_;
+sub build_params {
+    my ($self, $endpoint) = @_;
 
-    $self->{'raisin.declared'} = $declared;
-
-    # PRECEDENCE:
-    #   - path
-    #   - query
-    #   - body
     my %params = (
-        %{ $self->env->{'raisinx.body_params'} || {} },
-        %{ $self->query_parameters->as_hashref_mixed || {} },
-        %{ $named || {} },
+        %{ $self->env->{'raisinx.body_params'} || {} },         # 3. Body
+        %{ $self->query_parameters->as_hashref_mixed || {} },   # 2. Query
+        %{ $endpoint->named || {} },                            # 1. Path
     );
 
     $self->{'raisin.parameters'} = \%params;
+    $self->{'raisin.declared'} = $endpoint->params;
 
-    my $retval = 1;
+    my $success = 1;
 
-    foreach my $p (@$declared) {
+    foreach my $p (@{ $endpoint->params }) {
         my $name = $p->name;
         my $value = $params{$name};
 
         if (not $p->validate(\$value)) {
-            $retval = 0;
+            $success = 0;
             $p->required ? return : next;
         }
 
@@ -43,7 +38,7 @@ sub prepare_params {
         $self->{'raisin.declared_params'}{$name} = $value;
     }
 
-    $retval;
+    $success;
 }
 
 sub declared_params { shift->{'raisin.declared_params'} }
@@ -65,7 +60,7 @@ Extends L<Plack::Request>.
 
 =head3 declared_params
 
-=head3 prepare_params
+=head3 build_params
 
 =head3 raisin_parameters
 

diff --git a/lib/Raisin/Routes/Endpoint.pm b/lib/Raisin/Routes/Endpoint.pm
@@ -36,8 +36,7 @@ sub new {
     # Populate params index
     for my $p (@{ $self->params }) {
         if ($p->named && (my $re = $p->regex)) {
-            $re =~ s/[\$^]//g;
-            $self->{check}{ $p->name } = $re;
+            $self->{check}{$p->name} = $re;
         }
     }
 
@@ -99,18 +98,15 @@ sub match {
     return if $path !~ $self->regex;
 
     my %captured = %+;
-
-    foreach my $p (@{ $self->params }) {
-        next unless $p->named;
-        my $copy = $captured{ $p->name };
-        return unless $p->validate(\$copy, 'quite');
-    }
-
     $self->named(\%captured);
 
     1;
 }
 
+# TODO Rename methods:
+#   named -> captured
+#   path -> pattern
+
 1;
 
 __END__

diff --git a/t/unit/request.t b/t/unit/request.t
@@ -71,7 +71,7 @@ subtest 'precedence' => sub {
         my $req = Raisin::Request->new($case->{env});
 
         $r->match($case->{env}{REQUEST_METHOD}, $case->{env}{PATH_INFO});
-        $req->prepare_params($r->params, $r->named);
+        $req->build_params($r);
 
         is $req->raisin_parameters->{id}, $case->{expected};
     }
@@ -156,7 +156,7 @@ subtest 'validation' => sub {
         my $req = Raisin::Request->new($case->{env});
 
         $r->match($case->{env}{REQUEST_METHOD}, $case->{env}{PATH_INFO});
-        is $req->prepare_params($r->params, $r->named), $case->{expected}{ret};
+        is $req->build_params($r), $case->{expected}{ret};
 
         next unless $case->{expected}{ret};
 

diff --git a/t/unit/routes/endpoint.t b/t/unit/routes/endpoint.t
@@ -4,7 +4,7 @@ use warnings;
 
 use Test::More;
 
-use Types::Standard qw(Int);
+use Types::Standard qw(Int Str);
 
 use Raisin::Param;
 use Raisin::Routes::Endpoint;
@@ -75,13 +75,12 @@ my @CASES = (
         input => { method => 'put', path => '/api/item/42' },
         expected => undef,
     },
-    # TODO: GitHub issue #14
     {
         object => {
             method => 'GET',
-            path => '/api/user/:id',
+            path => '/domain/:name',
         },
-        input => { method => 'get', path => '/api/user/i.d'},
+        input => { method => 'get', path => '/domain/example.com'},
         expected => 1,
     },
 );
@@ -94,7 +93,6 @@ sub _make_object {
 subtest 'accessors' => sub {
     for my $case (@CASES) {
         my $e = _make_object($case->{object});
-        #isa_ok $e, 'Raisin::Routes::Endpoint', 'e';
 
         subtest '-' => sub {
             for my $m (keys %{ $case->{object} }) {
@@ -108,21 +106,35 @@ subtest 'match' => sub {
     for my $case (@CASES) {
         subtest "$case->{object}{method}:$case->{object}{path}" => sub {
             my $e = _make_object($case->{object});
-            #isa_ok $e, 'Raisin::Routes::Endpoint', 'e';
 
             my $is_matched = $e->match($case->{input}{method}, $case->{input}{path});
-
             is $is_matched, $case->{expected}, 'match';
 
             # named params
             if ($is_matched && @{ $e->params }) {
                 for my $p (@{ $e->params }) {
-                    # TODO: GitHub issue #14
                     ok $e->named->{$p->name}, 'named: ' . $p->name;
                 }
             }
         };
     }
 };
 
+subtest '_build_regex' => sub {
+    my $e = Raisin::Routes::Endpoint->new(
+        code   => sub { 1 },
+        method => 'GET',
+        params => [
+            Raisin::Param->new(
+                named    => 1,
+                required => 1,
+                spec     => {name => 'name', type => Str, regex => qr/[^.]+\.[^.]+/,},
+                type     => 'requires',
+            ),
+        ],
+        path => '/domain/:name',
+    );
+    is $e->regex, '(?^:^/domain/(?<name>(?^:[^.]+\.[^.]+))(?:\.[^.]+?)?$)', 'regex';
+};
+
 done_testing;