[Catalyst-commits] r10992 - in Catalyst-Runtime/5.80/branches/contextual_uri_for: lib/Catalyst t

pjfl at dev.catalyst.perl.org pjfl at dev.catalyst.perl.org
Mon Jul 27 16:14:46 GMT 2009


Author: pjfl
Date: 2009-07-27 16:14:45 +0000 (Mon, 27 Jul 2009)
New Revision: 10992

Modified:
   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:
- Finished testing contextual uri_for

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-27 02:39:07 UTC (rev 10991)
+++ Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/Dispatcher.pm	2009-07-27 16:14:45 UTC (rev 10992)
@@ -391,6 +391,8 @@
       if ( $c->debug && @args );
 }
 
+# ' Emacs highlight fix. Remove before commit
+
 =head2 $self->get_action( $action, $namespace )
 
 returns a named action from a given namespace.
@@ -428,15 +430,16 @@
 
 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); $cdr ||= [];
+    my ($self, $c, $cname, $cdr) = @_; my ($action, $controller);
 
     return unless ($cname and $controller = $c->controller( $cname ));
 
-    my $sep  = q(/);
-    my $path = $controller->action_namespace.$sep.($cdr->[0] || q());
+    my $sep = q(/); my $path = $controller->action_namespace;
 
     $path = q(root) if ($path eq $sep);
 
+    $cdr ||= []; $path .= $sep.($cdr->[0] || q());
+
     return unless ($action = $self->get_action_by_private_path( $c, $path ));
 
     shift @{ $cdr }; # Loose the controller method name
@@ -458,19 +461,26 @@
     # Return an action object. Provide defaults for a call to get_action
     my ($self, $c, $path) = @_; my $sep = q(/);
 
+    my $default_action = $c->config->{dispatcher_default_action} || q(default);
+
     # Normalise the path. It must contain a sep char
-    $path ||= $sep;
-    $path  .= $sep if (0 > index $path, $sep);
+    $path  = $sep.$default_action unless (defined $path);
+    $path .= $sep.$default_action if     (0 > index $path, $sep);
 
     # Extract the action attributes
-    my ($namespace, $name) = split m{ $sep }mx, $path;
+    my (@parts)   = split m{ $sep }mx, $path;
+    my $name      = pop @parts;
+    my $namespace = join $sep, @parts;
 
-    # Default the namespace and expand the root symbol
-    $namespace ||= ($c->action && $c->action->namespace) || $sep;
-    $namespace   = $sep if ($namespace eq q(root));
+    # Default the namespace
+    $namespace ||= ($c->action && $c->action->namespace) || q(root)
+       unless (length $namespace);
 
+    # Expand the root symbol
+    $namespace = $sep if ($namespace eq q(root));
+
     # Default the method name if one was not provided
-    $name ||= $c->config->{dispatcher_default_action} || q(default);
+    $name ||= $default_action;
 
     # Return the action for this namespace/name pair
     return $self->get_action( $name, $namespace );

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-27 02:39:07 UTC (rev 10991)
+++ Catalyst-Runtime/5.80/branches/contextual_uri_for/t/unit_core_contextual_uri_for.t	2009-07-27 16:14:45 UTC (rev 10992)
@@ -5,7 +5,7 @@
 use lib catdir( $Bin, updir, q(lib) ), catdir( $Bin, q(lib) );
 
 use English qw( -no_match_vars );
-use Test::More tests => 10;
+use Test::More tests => 26;
 use URI;
 
 {   package TestApp;
@@ -66,6 +66,97 @@
     q(http://127.0.0.1/),
     'URI for controller and default method' );
 
+# Existing tests
+
+$request = Catalyst::Request->new( {
+    base => URI->new( q(http://127.0.0.1/foo) ) } );
+
+$context = TestApp->new( { namespace => q(yada), request => $request } );
+
+is( $context->uri_for( '/bar/baz' ),
+    'http://127.0.0.1/foo/bar/baz',
+    'URI for absolute path' );
+
+is( $context->uri_for( 'bar/baz' ),
+    'http://127.0.0.1/foo/yada/bar/baz',
+    'URI for relative path' );
+
+# Not compatable with default private path
+#is( $context->uri_for( '', 'arg1', 'arg2' ),
+#    'http://127.0.0.1/foo/yada/arg1/arg2',
+#    'URI for undef action with args' );
+
+is( $context->uri_for( '../quux' ),
+    'http://127.0.0.1/foo/quux',
+    'URI for relative dot path' );
+
+is( $context->uri_for( 'quux', { param1 => 'value1' } ),
+    'http://127.0.0.1/foo/yada/quux?param1=value1',
+    'URI for undef action with query params' );
+
+is( $context->uri_for( '/bar/wibble?' ),
+    'http://127.0.0.1/foo/bar/wibble%3F',
+    'Question Mark gets encoded' );
+
+is( $context->uri_for( qw/bar wibble?/, 'with space' ),
+    'http://127.0.0.1/foo/yada/bar/wibble%3F/with%20space',
+    'Space gets encoded' );
+
+is( $context->uri_for( '/bar', 'with+plus', { 'also' => 'with+plus' } ),
+    'http://127.0.0.1/foo/bar/with+plus?also=with%2Bplus',
+    'Plus is not encoded' );
+
+is( $context->uri_for( 'quux', { param1 => "\x{2620}" } ),
+    'http://127.0.0.1/foo/yada/quux?param1=%E2%98%A0',
+    'URI for undef action with query params in unicode' );
+
+is( $context->uri_for( 'quux', { 'param:1' => "foo" } ),
+    'http://127.0.0.1/foo/yada/quux?param%3A1=foo',
+    'URI for undef action with query params in unicode' );
+
+is( $context->uri_for( 'quux', { param1 => $request->base } ),
+    'http://127.0.0.1/foo/yada/quux?param1=http%3A%2F%2F127.0.0.1%2Ffoo',
+    'URI for undef action with query param as object' );
+
+$request->base( URI->new( 'http://localhost:3000/' ) );
+$request->match( 'orderentry/contract' );
+
+is( $context->uri_for( '/Orderentry/saveContract' ),
+    'http://localhost:3000/Orderentry/saveContract',
+    'URI for absolute path' );
+
+$request->base( URI->new( 'http://127.0.0.1/' ) );
+$context->namespace( q() );
+
+is( $context->uri_for( '/bar/baz' ),
+    'http://127.0.0.1/bar/baz',
+    'URI with no base or match' );
+
+is( $context->uri_for( qw/0 foo/ ),
+    'http://127.0.0.1/0/foo',
+    '0 as path is ok' );
+
+{   my $warnings = 0;
+    local $SIG{__WARN__} = sub { $warnings++ };
+
+    $context->uri_for( '/bar/baz', { foo => undef } ),
+    is( $warnings, 0, "no warnings emitted" );
+}
+
+is( $context->uri_for( qw| / foo bar | ),
+    'http://127.0.0.1/foo/bar',
+    'uri is /foo/bar, not //foo/bar' );
+
+my $query_params_base = { test => "one two",
+                          bar  => [ "foo baz", "bar" ] };
+my $query_params_test = { test => "one two",
+                          bar  => [ "foo baz", "bar" ] };
+
+$context->uri_for( '/bar/baz', $query_params_test );
+is_deeply( $query_params_base,
+           $query_params_test,
+           "uri_for() doesn't mess up query parameter hash in the caller" );
+
 # Local Variables:
 # mode: perl
 # tab-width: 4




More information about the Catalyst-commits mailing list