the "word" path part regex only allows singular period characters

[catagits/Web-Simple.git] / lib / Web / Dispatch / Parser.pm

diff --git a/lib/Web/Dispatch/Parser.pm b/lib/Web/Dispatch/Parser.pm
index 2e2afba..e3ea504 100644 (file)
--- a/lib/Web/Dispatch/Parser.pm
+++ b/lib/Web/Dispatch/Parser.pm
@@ -35,6 +35,7 @@ sub parse {
 
 sub _parse_spec {
   my ($self, $spec, $nested) = @_;
+  return sub { {} } unless length($spec);
   for ($_[1]) {
     my @match;
     PARSE: { do {
@@ -115,6 +116,10 @@ sub _parse_spec_section {
     # %<param spec>
     /\G\%/gc and
       return $self->_parse_param_handler($_, 'body');
+
+    # *<param spec>
+    /\G\*/gc and
+      return $self->_parse_param_handler($_, 'uploads');
   }
   return; # () will trigger the blam in our caller
 }
@@ -124,6 +129,7 @@ sub _url_path_match {
   for ($_[1]) {
     my @path;
     my $end = '';
+    my $keep_dot;
     PATH: while (/\G\//gc) {
       /\G\.\.\./gc
         and do {
@@ -132,8 +138,13 @@ sub _url_path_match {
         };
       push @path, $self->_url_path_segment_match($_)
         or $self->_blam("Couldn't parse path match segment");
+      /\G\.\*/gc
+        and do {
+          $keep_dot = 1;
+          last PATH;
+        };
     }
-    if (@path && !$end) {
+    if (@path && !$end && !$keep_dot) {
       length and $_ .= '(?:\.\w+)?' for $path[-1];
     }
     my $re = '^('.join('/','',@path).')'.$end.'$';
@@ -154,7 +165,17 @@ sub _url_path_segment_match {
     /\G(?:(?=[+|\)])|$)/gc and
       return '';
     # word chars only -> exact path part match
-    /\G([\w\-]+)/gc and
+    /
+        \G(
+            (?:             # start matching at a space followed by:
+                    [\w\-]  # word chars or dashes
+                |           # OR
+                    \.      # a period
+                    (?!\.)  # not followed by another period
+            )
+            +               # then grab as far as possible
+        )
+    /gcx and
       return "\Q$1";
     # ** -> capture unlimited path parts
     /\G\*\*/gc and
@@ -169,9 +190,6 @@ sub _url_path_segment_match {
 sub _parse_param_handler {
   my ($self, $spec, $type) = @_;
 
-  require Web::Simple::ParamParser;
-  my $unpacker = Web::Simple::ParamParser->can("get_unpacked_${type}_from");
-
   for ($_[1]) {
     my (@required, @single, %multi, $star, $multistar, %positional, $have_kw);
     my %spec;
@@ -218,10 +236,7 @@ sub _parse_param_handler {
       }
     } while (/\G\&/gc) }
 
-    return sub {
-      my $raw = $unpacker->($_[0]);
-      Web::Dispatch::Predicates::_extract_params($raw, \%spec);
-    };
+    return Web::Dispatch::Predicates->can("match_${type}")->(\%spec);
   }
 }