refactor dispatch some more

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

diff --git a/lib/Web/Dispatch/Predicates.pm b/lib/Web/Dispatch/Predicates.pm
index fff7542..bfc5f2f 100644 (file)
--- a/lib/Web/Dispatch/Predicates.pm
+++ b/lib/Web/Dispatch/Predicates.pm
@@ -3,7 +3,10 @@ package Web::Dispatch::Predicates;
 use strictures 1;
 use base qw(Exporter);
 
-our @EXPORT = qw(match_and match_or match_method match_path match_path_strip);
+our @EXPORT = qw(
+  match_and match_or match_method match_path match_path_strip
+  match_extension
+);
 
 sub match_and {
   my @match = @_;
@@ -14,12 +17,12 @@ sub match_and {
     my @got;
     foreach my $match (@match) {
       if (my @this_got = $match->($my_env)) {
-       my %change_env = %{shift(@this_got)};
-       @{$my_env}{keys %change_env} = values %change_env;
-       @{$new_env}{keys %change_env} = values %change_env;
-       push @got, @this_got;
+        my %change_env = %{shift(@this_got)};
+        @{$my_env}{keys %change_env} = values %change_env;
+        @{$new_env}{keys %change_env} = values %change_env;
+        push @got, @this_got;
       } else {
-       return;
+        return;
       }
     }
     return ($new_env, @got);
@@ -63,8 +66,8 @@ sub match_path_strip {
     my ($env) = @_;
     if (my @cap = ($env->{PATH_INFO} =~ /$re/)) {
       $cap[0] = {
-       SCRIPT_NAME => ($env->{SCRIPT_NAME}||'').$cap[0],
-       PATH_INFO => pop(@cap),
+        SCRIPT_NAME => ($env->{SCRIPT_NAME}||'').$cap[0],
+        PATH_INFO => pop(@cap),
       };
       return @cap;
     }
@@ -72,4 +75,19 @@ sub match_path_strip {
   }
 }
 
+sub match_extension {
+  my ($extension) = @_;
+  my $wild = (!$extension or $extension eq '*');
+  my $re = $wild
+             ? qr/\.(\w+)$/
+             : qr/\.(\Q${extension}\E)$/;
+  sub {
+    if ($_[0]->{PATH_INFO} =~ $re) {
+      ($wild ? ({}, $1) : {});
+    } else {
+      ();
+    }
+  };
+}
+
 1;