[Catalyst-commits] r10944 - in
Catalyst-Runtime/5.80/branches/contextual_uri_for: lib
lib/Catalyst t
pjfl at dev.catalyst.perl.org
pjfl at dev.catalyst.perl.org
Wed Jul 22 19:12:36 GMT 2009
Author: pjfl
Date: 2009-07-22 19:12:35 +0000 (Wed, 22 Jul 2009)
New Revision: 10944
Modified:
Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst.pm
Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/Action.pm
Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/Dispatcher.pm
Catalyst-Runtime/5.80/branches/contextual_uri_for/t/unit_core_contextual_uri_for.t
Log:
- ContextualUriFor now passws all tests
Modified: Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/Action.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/Action.pm 2009-07-22 18:44:46 UTC (rev 10943)
+++ Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/Action.pm 2009-07-22 19:12:35 UTC (rev 10944)
@@ -90,6 +90,47 @@
return $a1_args <=> $a2_args;
}
+=head2 $self->splice_cpatures_from( $c, $args )
+
+=cut
+
+sub splice_captures_from {
+ my ($self, $c, $cdr) = @_;
+
+ my @captures = ();
+ my $attrs = $self->attributes || {};
+ my @chain = @{ $c->dispatcher->expand_action( $self )->chain };
+ my $params = $cdr && $cdr->[0] && ref $cdr->[-1] eq q(HASH)
+ ? pop @{ $cdr } : undef;
+
+ if ($attrs->{CaptureArgs}) {
+ my $error = 'Action '.$self->reverse.' is a midpoint';
+
+ $c->log->debug( $error ) if ($c->debug);
+
+ return;
+ }
+
+ pop @chain;
+
+ # Now start from the root of the chain, populate captures
+ for my $num_caps (map { $_->attributes->{CaptureArgs}->[0] } @chain) {
+ if ($num_caps > scalar @{ $cdr }) {
+ my $error = 'Action '.$self->reverse.' insufficient args';
+
+ $c->log->debug( $error ) if ($c->debug);
+
+ return;
+ }
+
+ push @captures, splice @{ $cdr }, 0, $num_caps;
+ }
+
+ push @{ $cdr }, $params if ($params); # Restore query parameters
+
+ return \@captures;
+}
+
__PACKAGE__->meta->make_immutable;
1;
@@ -151,6 +192,9 @@
Provided by Moose
+=head2 splice_captures_from
+
+
=head1 AUTHORS
Catalyst Contributors, see Catalyst.pm
Modified: Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/Dispatcher.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/Dispatcher.pm 2009-07-22 18:44:46 UTC (rev 10943)
+++ Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/Dispatcher.pm 2009-07-22 19:12:35 UTC (rev 10944)
@@ -419,6 +419,83 @@
$self->_action_hash->{$path};
}
+=head2 $self->get_action_by_type( @args )
+
+Returns the action object for the specified args if one exists, otherwise
+returns C<undef>. Calls L</get_action_with_defaults> and if that does not
+return an action, calls L</get_action_by_controller>
+
+=cut
+
+sub get_action_by_type {
+ # Return an action object or undef
+ my ($self, $c, $car, $cdr) = @_; my $action;
+
+ return $action if ($action = $car and blessed( $car ));
+ return $action if ($action = $self->get_action_with_defaults( $c, $car ));
+ return $action
+ if ($action = $self->get_action_by_controller( $c, $car, $cdr ));
+ return;
+}
+
+=head2 $self->get_action_by_controller( qw(Controller::Class method_name) );
+
+Returns the action associated with the given controller and method. Provides
+a default for the method name if one is not supplied
+
+=cut
+
+sub get_action_by_controller {
+ # Return an action object if parameters are a controller class and method
+ my ($self, $c, $cname, $cdr) = @_;
+
+ my ($action, $controller); my $sep = q(/); $cdr ||= [];
+
+ return unless ($cname and $controller = $c->controller( $cname ));
+
+ my $path = $controller->action_namespace.$sep.($cdr->[0] || q());
+
+ $path = q(root) if ($path eq $sep);
+
+ return unless ($action = $self->get_action_with_defaults( $c, $path ));
+
+ shift @{ $cdr }; # Loose the controller method name
+
+ return $action;
+}
+
+=head2 $self->get_action_with_defaults( q(namespace/method_name) );
+
+Returns the action associated with the private action path. Provides
+defaults for namespace and method name. A namespace of I<root>
+is mapped to I</>
+
+=cut
+
+sub get_action_with_defaults {
+ # Return an action object. Provide defaults for a call to get_action
+ my ($self, $c, $path) = @_; my $sep = q(/);
+
+ return unless ($path or $c->config->{dispatcher_defaults_to_action});
+
+ # Normalise the path. It must contain a sep char
+ $path ||= $sep;
+ $path .= $sep if (0 > index $path, $sep);
+
+ # Extract the action attributes
+ my ($namespace, $name) = split m{ $sep }mx, $path;
+
+ # Default the namespace and expand the root symbol
+ $namespace ||= ($c->action && $c->action->namespace) || $sep;
+ $namespace = $sep if ($namespace eq q(root));
+
+ # Default the method name if one was not provided
+ $name ||= $c->config->{dispatcher_default_action} || q(default);
+
+ # Return the action for this namespace/name pair
+ return $self->get_action( $name, $namespace );
+}
+
=head2 $self->get_actions( $c, $action, $namespace )
=cut
Modified: Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst.pm 2009-07-22 18:44:46 UTC (rev 10943)
+++ Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst.pm 2009-07-22 19:12:35 UTC (rev 10944)
@@ -1186,13 +1186,13 @@
=cut
sub uri_for {
- my ( $c, $path, @args ) = @_;
+ my ( $c, $path, @args ) = @_; my $action;
- if ( blessed($path) ) { # action object
+ if ( $action = $c->_get_action_and_flatten_args( $path, \@args ) ) {
+ # Have an action object
my $captures = ( scalar @args && ref $args[0] eq 'ARRAY'
? shift(@args)
: [] );
- my $action = $path;
$path = $c->dispatcher->uri_for_action($action, $captures);
if (not defined $path) {
$c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
@@ -1252,6 +1252,28 @@
$res;
}
+=head2 $c->_get_action_and_flatten_args
+
+=cut
+
+sub _get_action_and_flatten_args {
+ my ($c, $car, $cdr) = @_; my $action;
+
+ unless ($action = $c->dispatcher->get_action_by_type( $c, $car, $cdr )) {
+ return;
+ }
+
+ my $attrs = $action->attributes || {};
+
+ return $action unless ($attrs->{Chained});
+
+ my $captures = $action->splice_captures_from( $c, $cdr );
+
+ unshift @{ $cdr }, $captures if ($captures);
+
+ return $action;
+}
+
=head2 $c->uri_for_action( $path, \@captures?, @args?, \%query_values? )
=head2 $c->uri_for_action( $action, \@captures?, @args?, \%query_values? )
Modified: Catalyst-Runtime/5.80/branches/contextual_uri_for/t/unit_core_contextual_uri_for.t
===================================================================
--- Catalyst-Runtime/5.80/branches/contextual_uri_for/t/unit_core_contextual_uri_for.t 2009-07-22 18:44:46 UTC (rev 10943)
+++ Catalyst-Runtime/5.80/branches/contextual_uri_for/t/unit_core_contextual_uri_for.t 2009-07-22 19:12:35 UTC (rev 10944)
@@ -2,23 +2,22 @@
use warnings;
use File::Spec::Functions;
use FindBin qw( $Bin );
-use lib catdir( $Bin, q(lib) );
+use lib catdir( $Bin, updir, q(lib) ), catdir( $Bin, q(lib) );
use English qw( -no_match_vars );
-use Test::More tests => 13;
+use Test::More tests => 11;
use URI;
use_ok( q(TestApp) );
my $request = Catalyst::Request->new( {
- base => URI->new( q(http://127.0.0.1) ) } );
+ base => URI->new( q(http://127.0.0.1) ) } );
-my $context = TestApp->new( {
- config => { uri_for_defaults_to_action => 1,
- uri_for_default_action => q(default_endpoint),
- uri_for_on_error => q(die) },
- request => $request } );
+my $context = TestApp->new( { request => $request } );
+$context->config( dispatcher_defaults_to_action => 1,
+ dispatcher_default_action => q(default_endpoint), );
+
is( $context->uri_for,
q(http://127.0.0.1/),
'URI for default private path with no args at all' );
@@ -59,19 +58,7 @@
q(http://127.0.0.1/),
'URI for controller and default method' );
-eval { $context->uri_for( qw(root/midpoint_capture en) ) };
-
-like( $EVAL_ERROR,
- qr(\A Action \s midpoint_capture \s is \s a \s midpoint)msx,
- 'Midpoint detected' );
-
-eval { $context->uri_for( qw(root/slurpy_endpoint en) ) };
-
-like( $EVAL_ERROR,
- qr(\A Action \s slurpy_endpoint \s insufficient \s args)msx,
- 'Insufficient args' );
-
# Local Variables:
# mode: perl
-# tab-width: 3
+# tab-width: 4
# End:
More information about the Catalyst-commits
mailing list