add *.* and **.* dispatch patterns

diff --git a/Changes b/Changes
index e49d16a..e20ebdb 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,6 @@
 Change log for Web::Simple
 
+  - Add *.* and **.* dispatch types to keep extension
   - Add Antiquated Perl slides in a POD document.
 
 0.008 - 2011-02-16

diff --git a/lib/Web/Dispatch/Parser.pm b/lib/Web/Dispatch/Parser.pm
index ad05e5d..a6b2332 100644 (file)
--- a/lib/Web/Dispatch/Parser.pm
+++ b/lib/Web/Dispatch/Parser.pm
@@ -124,6 +124,7 @@ sub _url_path_match {
   for ($_[1]) {
     my @path;
     my $end = '';
+    my $keep_dot;
     PATH: while (/\G\//gc) {
       /\G\.\.\./gc
         and do {
@@ -132,8 +133,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.'$';

diff --git a/lib/Web/Simple.pm b/lib/Web/Simple.pm
index d12a12a..31fa56a 100644 (file)
--- a/lib/Web/Simple.pm
+++ b/lib/Web/Simple.pm
@@ -343,6 +343,15 @@ specification will match like this:
   /foo/        # match and strip path to '/'
   /foo/bar/baz # match and strip path to '/bar/baz'
 
+Note: Since Web::Simple handles a concept of file extensions, * and **
+matchers will not by default match things after a final dot, and this
+can be modified by using *.* and **.* in the final position, i.e.:
+
+  /one/*       matches /one/two.three    and captures "two"
+  /one/*.*     matches /one/two.three    and captures "two.three"
+  /**          matches /one/two.three    and captures "one/two"
+  /**.*        matches /one/two.three    and captures "one/two.three"
+
 =head3 Extension matches
 
   sub (.html) {

diff --git a/t/dispatch_parser.t b/t/dispatch_parser.t
index caa4e45..b42bb61 100644 (file)
--- a/t/dispatch_parser.t
+++ b/t/dispatch_parser.t
@@ -259,6 +259,23 @@ my $dp = Web::Dispatch::Parser->new;
    );
 }
 
+{
+  my @dot_pairs = (
+    [ '/one/*' => 'two' ],
+    [ '/one/*.*' => 'two.three' ],
+    [ '/**' => 'one/two' ],
+    [ '/**.*' => 'one/two.three' ],
+  );
+
+  foreach my $p (@dot_pairs) {
+    is_deeply(
+      [ $dp->parse($p->[0])->({ PATH_INFO => '/one/two.three' }) ],
+      [ {}, $p->[1] ],
+      "${\$p->[0]} matches /one/two.three and returns ${\$p->[1]}"
+    );
+  }
+}
+
 #
 # query string
 #