コントローラ名にマッチさせてなにかしたりとかできるようにした

git-svn-id: http://svn.coderepos.org/share/lang/perl/HTTPx-Dispatcher/trunk@10433 d0d07461-0603-4401-acd4-de1884942a52

Makefile.PL

@@ -2,7 +2,7 @@ use inc::Module::Install;
 name 'HTTPx-Dispatcher';
 all_from 'lib/HTTPx/Dispatcher.pm';
 
-requires 'Class::Accessor::Fast'    => 0.31;
+requires 'Class::Accessor::Fast'    => 0.30;
 requires 'Exporter'                 => 5.58;
 requires 'HTTP::Request'            => 1.40;
 

lib/HTTPx/Dispatcher/Rule.pm

@@ -123,12 +123,23 @@ sub _condition_check_function {
 sub uri_for {
     my ($self, $args) = @_;
 
-    if (join(' ', sort keys %$args) eq join(' ', sort @{ $self->capture }) ) {
-        my $uri = $self->pattern;
-        $uri =~ s{:([a-z0-9A-Z]+)}{
-            $args->{ $1 }
-        }ge;
-        "/$uri";
+    my $uri = $self->pattern;
+    my %args = %$args;
+    while (my ($key, $val) = each %args) {
+         $uri = $self->_uri_for_match($uri, $key, $val) or return;
+    }
+    return "/$uri";
+}
+
+sub _uri_for_match {
+    my ($self, $uri, $key, $val) = @_;
+
+    if ($self->{$key} && $self->{$key} eq $val) { return $uri }
+
+    if ($uri =~ s{:$key}{$val}) {
+        return $uri;
+    } else {
+        return;
     }
 }
 

t/02_uri_for.t

@@ -53,3 +53,9 @@ connect ':controller/:action/:id';
 --- uri_for:    {controller => 'entry', action => 'show', id => 3}
 --- expected:   /entry/show/3
 
+===
+--- dispatcher
+connect 'content/:id' => { controller => 'Content', action => 'show'  };
+--- uri_for:  { controller => 'Content', action => 'show', 'id' => 3 }
+--- expected:   /content/3
+