extended uri_for, added uri_for_action to dispatcher

diff --git a/Changes b/Changes
index d9f8534..22b8ca1 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,6 @@
 This file documents the revision history for Perl extension Catalyst.
 
+        - extended uri_for, added dispatcher->uri_for_action
         - added Catalyst::Base->action_for('methodname')
         - checked and tested :Args multimethod dispatch
         - added ability to set action attributes from controller config

diff --git a/Makefile.PL b/Makefile.PL
index e686e81..8a7218e 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -29,6 +29,7 @@ requires 'Time::HiRes';
 requires 'Tree::Simple' => '1.15';
 requires 'Tree::Simple::Visitor::FindByPath';
 requires 'URI' => '1.35';
+requires 'Text::Balanced'; # core in 5.8.x but mentioned for completeness
 
 feature 'Apache/mod_perl Support',
   -default                   => 0,

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 1068f27..8cccb9a 100644 (file)
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -865,6 +865,11 @@ end of the path.  If the last argument to uri_for is a hash reference,
 it is assumed to contain GET parameter key/value pairs, which will be
 appended to the URI in standard fashion.
 
+Instead of $path, you can also optionally pass a $action object which will
+be resolved to a path using $c->dispatcher->uri_for_action; if the first
+element of @args is an arrayref it is treated as a list of captures to be
+passed to uri_for_action.
+
 =cut
 
 sub uri_for {
@@ -875,6 +880,14 @@ sub uri_for {
     $basepath .= '/';
     my $namespace = $c->namespace || '';
 
+    if ( Scalar::Util::blessed($path) ) { # action object
+        my $captures = ( scalar @args && ref $args[0] eq 'ARRAY'
+                         ? shift(@args)
+                         : [] );
+        $path = $c->dispatcher->uri_for_action($path, $captures);
+        return undef unless defined($path);
+    }
+
     # massage namespace, empty if absolute path
     $namespace =~ s/^\/// if $namespace;
     $namespace .= '/' if $namespace;

diff --git a/lib/Catalyst/DispatchType.pm b/lib/Catalyst/DispatchType.pm
index 196d3fd..ba676c9 100644 (file)
--- a/lib/Catalyst/DispatchType.pm
+++ b/lib/Catalyst/DispatchType.pm
@@ -44,6 +44,18 @@ Should return true if it registers something, or false otherwise.
 
 sub register { }
 
+=head2 $self->uri_for_action( $action, \@captures )
+
+abstract method, to be implemented by dispatchtypes. Takes a
+L<Catalyst::Action> object and an arrayref of captures, and should
+return either a URI part which if placed in $c->req->path would cause
+$self->match to match this action and set $c->req->captures to the supplied
+arrayref, or undef if unable to do so.
+
+=cut
+
+sub uri_for_action { }
+
 =head1 AUTHOR
 
 Matt S Trout

diff --git a/lib/Catalyst/DispatchType/Index.pm b/lib/Catalyst/DispatchType/Index.pm
index 58420e3..fbe9faa 100644 (file)
--- a/lib/Catalyst/DispatchType/Index.pm
+++ b/lib/Catalyst/DispatchType/Index.pm
@@ -37,6 +37,23 @@ sub match {
     return 0;
 }
 
+=head2 $self->uri_for_action( $action, $captures )
+
+get a URI part for an action; always returns undef is $captures is set
+since index actions don't have captures
+
+=cut
+
+sub uri_for_action {
+    my ( $self, $action, $captures ) = @_;
+
+    return undef if @$captures;
+
+    return undef unless $action->name eq 'index';
+
+    return "/".$action->namespace;
+}
+
 =head1 AUTHOR
 
 Sebastian Riedel, C<sri@cpan.org>

diff --git a/lib/Catalyst/DispatchType/Path.pm b/lib/Catalyst/DispatchType/Path.pm
index ac28382..c13f73c 100644 (file)
--- a/lib/Catalyst/DispatchType/Path.pm
+++ b/lib/Catalyst/DispatchType/Path.pm
@@ -93,6 +93,29 @@ sub register_path {
     return 1;
 }
 
+=head2 $self->uri_for_action($action, $captures)
+
+get a URI part for an action; always returns undef is $captures is set
+since Path actions don't have captures
+
+=cut
+
+sub uri_for_action {
+    my ( $self, $action, $captures ) = @_;
+
+    return undef if @$captures;
+
+    if (my $paths = $action->attributes->{Path}) {
+        my $path = $paths->[0];
+        $path = '/' unless length($path);
+        $path = "/${path}" unless ($path =~ m/^\//);
+        $path = URI->new($path)->canonical;
+        return $path;
+    } else {
+        return undef;
+    }
+}
+
 =head1 AUTHOR
 
 Matt S Trout

diff --git a/lib/Catalyst/DispatchType/Regex.pm b/lib/Catalyst/DispatchType/Regex.pm
index a32dfa5..c40be54 100644 (file)
--- a/lib/Catalyst/DispatchType/Regex.pm
+++ b/lib/Catalyst/DispatchType/Regex.pm
@@ -3,6 +3,7 @@ package Catalyst::DispatchType::Regex;
 use strict;
 use base qw/Catalyst::DispatchType::Path/;
 use Text::SimpleTable;
+use Text::Balanced ();
 
 =head1 NAME
 
@@ -104,6 +105,38 @@ sub register_regex {
     );
 }
 
+=head2 $self->uri_for_action($action, $captures)
+
+returns a URI for this action if it can find a regex attributes that contains
+the correct number of () captures. Note that this may function incorrectly
+in the case of nested captures - if your regex does (...(..))..(..) you'll
+need to pass the first and third captures only.
+
+=cut
+
+sub uri_for_action {
+    my ( $self, $action, $captures ) = @_;
+
+    if (my $regexes = $action->attributes->{Regex}) {
+        REGEX: foreach my $orig (@$regexes) {
+            my $re = "$orig";
+            $re =~ s/^\^//;
+            $re =~ s/\$$//;
+            my $final = '/';
+            my @captures = @$captures;
+            while (my ($front, $rest) = split(/\(/, $re, 2)) {
+                ($rest, $re) =
+                    Text::Balanced::extract_bracketed("(${rest}", '(');
+                next REGEX unless @captures;
+                $final .= $front.shift(@captures);
+            }
+            next REGEX if @captures;
+            return $final;
+         }
+    }
+    return undef;
+}
+
 =head1 AUTHOR
 
 Matt S Trout

diff --git a/lib/Catalyst/Dispatcher.pm b/lib/Catalyst/Dispatcher.pm
index 29a6e89..f44b9db 100644 (file)
--- a/lib/Catalyst/Dispatcher.pm
+++ b/lib/Catalyst/Dispatcher.pm
@@ -312,6 +312,7 @@ Returns the named action by its full path.
 
 sub get_action_by_path {
     my ( $self, $path ) = @_;
+    $path =~ s/^\///;
     $path = "/$path" unless $path =~ /\//;
     $self->action_hash->{$path};
 }
@@ -355,6 +356,27 @@ sub get_containers {
     my @parts = split '/', $namespace;
 }
 
+=head2 $self->uri_for_action($action, \@captures)
+
+Takes a Catalyst::Action object and action parameters and returns a URI
+part such that if $c->req->path were this URI part, this action would be
+dispatched to with $c->req->captures set to the supplied arrayref.
+
+If the action object is not available for external dispatch or the dispatcher
+cannot determine an appropriate URI, this method will return undef.
+
+=cut
+
+sub uri_for_action {
+    my ( $self, $action, $captures) = @_;
+    $captures ||= [];
+    foreach my $dispatch_type ( @{ $self->dispatch_types } ) {
+        my $uri = $dispatch_type->uri_for_action( $action, $captures );
+        return $uri if defined($uri);
+    }
+    return undef;
+}
+
 =head2 $self->register( $c, $action )
 
 Make sure all required dispatch types for this action are loaded, then