[Catalyst-commits] r11024 - in
Catalyst-Runtime/5.80/branches/contextual_uri_for: lib
lib/Catalyst lib/Catalyst/DispatchType t t/aggregate
t/lib/TestApp/Controller
pjfl at dev.catalyst.perl.org
pjfl at dev.catalyst.perl.org
Sat Aug 1 21:56:37 GMT 2009
Author: pjfl
Date: 2009-08-01 21:56:37 +0000 (Sat, 01 Aug 2009)
New Revision: 11024
Removed:
Catalyst-Runtime/5.80/branches/contextual_uri_for/t/lib/TestApp/Controller/Chained/
Catalyst-Runtime/5.80/branches/contextual_uri_for/t/unit_core_contextual_uri_for.t
Modified:
Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst.pm
Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/DispatchType.pm
Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/DispatchType/Chained.pm
Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/DispatchType/Regex.pm
Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/Dispatcher.pm
Catalyst-Runtime/5.80/branches/contextual_uri_for/t/aggregate/unit_core_uri_for_action.t
Log:
- Flattens captures/args for both regex and chained actions
Modified: Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/DispatchType/Chained.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/DispatchType/Chained.pm 2009-08-01 19:04:08 UTC (rev 11023)
+++ Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/DispatchType/Chained.pm 2009-08-01 21:56:37 UTC (rev 11024)
@@ -397,6 +397,50 @@
return Catalyst::ActionChain->from_chain([reverse @chain]);
}
+=head2 $self->splice_captures_from( $c, $action, $args )
+
+Calculates the number of capture args for the given action,
+splices off the front of the supplied args, and pushes them back
+on the args list wrapped in an array ref
+
+
+=cut
+
+sub splice_captures_from {
+ my ($self, $c, $action, $args) = @_; my $attrs = $action->attributes;
+
+ return 0 unless ($attrs->{Chained});
+
+ if ($attrs->{CaptureArgs}) {
+ $c->log->debug( 'Action '.$action->reverse.' is a midpoint' )
+ if ($c->debug);
+ return 1;
+ }
+
+ my @captures = ();
+ my @chain = @{ $self->expand_action( $action )->chain }; 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 @{ $args }) {
+ $c->log->debug( 'Action '.$action->reverse.' insufficient args' )
+ if ($c->debug);
+ return 1;
+ }
+
+ push @captures, splice @{ $args }, 0, $num_caps;
+ }
+
+ if (defined $args->[ $attrs->{Args}->[0] ]) {
+ $c->log->debug( 'Action '.$action->reverse.' too many args' )
+ if ($c->debug);
+ }
+
+ unshift @{ $args }, \@captures if (defined $captures[0]);
+
+ return 1;
+}
+
__PACKAGE__->meta->make_immutable;
=head1 USAGE
Modified: Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/DispatchType/Regex.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/DispatchType/Regex.pm 2009-08-01 19:04:08 UTC (rev 11023)
+++ Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/DispatchType/Regex.pm 2009-08-01 21:56:37 UTC (rev 11024)
@@ -164,6 +164,39 @@
return undef;
}
+=head2 $self->splice_captures_from( $c, $action, $args )
+
+Iterates over the regular expressions defined for the action. Stops when
+the number of captures equals the number of supplied args. Replaces the
+list of args with a list containing an array ref of args
+
+=cut
+
+sub splice_captures_from {
+ my ($self, $c, $action, $args) = @_; my $regexes;
+
+ return 0 unless ($regexes = $action->attributes->{Regex});
+
+ foreach my $orig (@{ $regexes }) {
+ my $re = "$orig"; $re =~ s/^\^//; $re =~ s/\$$//;
+ my $num_caps = 0;
+
+ while (my ($front, $rest) = split /\(/, $re, 2) {
+ last unless (defined $rest);
+
+ ($rest, $re) = Text::Balanced::extract_bracketed( "(${rest}", '(');
+ $num_caps++;
+ }
+
+ next unless ($num_caps == scalar @{ $args });
+
+ @{ $args } = ( [ @{ $args } ] );
+ return 1;
+ }
+
+ return 1;
+}
+
=head1 AUTHORS
Catalyst Contributors, see Catalyst.pm
Modified: Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/DispatchType.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/DispatchType.pm 2009-08-01 19:04:08 UTC (rev 11023)
+++ Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/DispatchType.pm 2009-08-01 21:56:37 UTC (rev 11024)
@@ -73,6 +73,15 @@
sub expand_action { }
+=head2 $self->splice_captures_from
+
+Default fallback, returns nothing. See L<Catalyst::Dispatcher> for more info
+about splice_captures_from.
+
+=cut
+
+sub splice_captures_from { 0 }
+
sub _is_low_precedence { 0 }
=head1 AUTHORS
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-08-01 19:04:08 UTC (rev 11023)
+++ Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst/Dispatcher.pm 2009-08-01 21:56:37 UTC (rev 11024)
@@ -391,8 +391,6 @@
if ( $c->debug && @args );
}
-# ' Emacs highlight fix. Remove before commit
-
=head2 $self->get_action( $action, $namespace )
returns a named action from a given namespace.
@@ -421,111 +419,6 @@
$self->_action_hash->{$path};
}
-=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);
-
- return unless ($cname and $controller = $c->controller( $cname ));
-
- 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
-
- return $action;
-}
-
-=head2 $self->get_action_by_private_path( q(namespace/method_name) );
-
-Returns the action associated with the private action path. Provides
-defaults for namespace and method name. The namespace defaults to that
-of the current action, a namespace of I<root> is mapped to I</>. The
-method name defaults to C<< $c->config->{dispatcher_default_action} >>
-if set, 'default' otherwise
-
-=cut
-
-sub get_action_by_private_path {
- # 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.$default_action unless (defined $path);
- $path .= $sep.$default_action if (0 > index $path, $sep);
-
- # Extract the action attributes
- my (@parts) = split m{ $sep }mx, $path;
- my $name = pop @parts;
- my $namespace = join $sep, @parts;
-
- # 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 ||= $default_action;
-
- # Return the action for this namespace/name pair
- return $self->get_action( $name, $namespace );
-}
-
-=head2 $self->splice_captures_from( $c, $action, $args )
-
-Gets the action chain for the supplied action. Calculates the number
-of capture args and returns and array ref spliced off the front of the
-supplied args
-
-=cut
-
-sub splice_captures_from {
- my ($self, $c, $action, $cdr) = @_; my $attrs = $action->attributes || {};
-
- if ($attrs->{CaptureArgs}) {
- $c->log->debug( 'Action '.$action->reverse.' is a midpoint' )
- if ($c->debug);
-
- return;
- }
-
- my @captures = ();
- my @chain = @{ $self->expand_action( $action )->chain }; pop @chain;
- my $params = $cdr && $cdr->[0] && ref $cdr->[-1] eq q(HASH)
- ? pop @{ $cdr } : undef;
-
- # Now start from the root of the chain, populate captures
- for my $num_caps (map { $_->attributes->{CaptureArgs}->[0] } @chain) {
- if ($num_caps > scalar @{ $cdr }) {
- $c->log->debug( 'Action '.$action->reverse.' insufficient args' )
- if ($c->debug);
-
- return;
- }
-
- push @captures, splice @{ $cdr }, 0, $num_caps;
- }
-
- push @{ $cdr }, $params if ($params); # Restore query parameters
-
- return \@captures;
-}
-
=head2 $self->get_actions( $c, $action, $namespace )
=cut
@@ -604,6 +497,31 @@
return $action;
}
+=head2 $self->splice_captures_from( $c, $action, $args )
+
+Does nothing if the first element of the list that C<$args> references
+is an array ref. Otherwise calls this method in each dispatch type,
+stopping when the first one returns true
+
+=cut
+
+sub splice_captures_from {
+ my ($self, $c, $action, $args) = @_;
+
+ return if (!$args || (scalar @{ $args } && ref $args->[0] eq 'ARRAY'));
+
+ my $params = scalar @{ $args } && ref $args->[-1] eq 'HASH'
+ ? pop @{ $args } : undef;
+
+ foreach my $dispatch_type ( @{ $self->_dispatch_types } ) {
+ last if ($dispatch_type->splice_captures_from( $c, $action, $args ));
+ }
+
+ push @{ $args }, $params if ($params); # Restore query parameters
+
+ return;
+}
+
=head2 $self->register( $c, $action )
Make sure all required dispatch types for this action are loaded, then
Modified: Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst.pm 2009-08-01 19:04:08 UTC (rev 11023)
+++ Catalyst-Runtime/5.80/branches/contextual_uri_for/lib/Catalyst.pm 2009-08-01 21:56:37 UTC (rev 11024)
@@ -1186,13 +1186,14 @@
=cut
sub uri_for {
- my ( $c, $path, @args ) = @_; my $action;
+ my ( $c, $path, @args ) = @_;
- if ( $action = $c->_get_action_and_flatten_args( $path, \@args ) ) {
- # Have an action object
+ if ( blessed($path) ) { # action object
+ $c->dispatcher->splice_captures_from( $c, $path, \@args );
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,43 +1253,6 @@
$res;
}
-=head2 $c->_get_action_and_flatten_args( $c, $action, \@args )
-
-=head2 $c->_get_action_and_flatten_args( $c, $controller_name, \@args )
-
-=head2 $c->_get_action_and_flatten_args( $c, $private_action_path, \@args )
-
-Get an action object from the first one or two supplied args. Splice
-the capture args from the supplied args if required
-
-=cut
-
-sub _get_action_and_flatten_args {
- my ($c, $car, $cdr) = @_; my $action;
-
- return $action if ($action = $car and blessed( $car ));
-
- return unless ($c->config->{contextual_uri_for});
-
- $action = $c->dispatcher->get_action_by_controller( $c, $car, $cdr );
-
- unless ($action) {
- $action = $c->dispatcher->get_action_by_private_path( $c, $car );
- }
-
- return unless ($action);
-
- my $attrs = $action->attributes || {};
-
- return $action unless ($attrs->{Chained});
-
- my $captures = $c->dispatcher->splice_captures_from( $c, $action, $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/aggregate/unit_core_uri_for_action.t
===================================================================
--- Catalyst-Runtime/5.80/branches/contextual_uri_for/t/aggregate/unit_core_uri_for_action.t 2009-08-01 19:04:08 UTC (rev 11023)
+++ Catalyst-Runtime/5.80/branches/contextual_uri_for/t/aggregate/unit_core_uri_for_action.t 2009-08-01 21:56:37 UTC (rev 11024)
@@ -8,7 +8,7 @@
use Test::More;
-plan tests => 29;
+plan tests => 42;
use_ok('TestApp');
@@ -112,10 +112,18 @@
"http://127.0.0.1/foo/action/regexp/foo/123/bar/baz?q=1",
"uri_for correct for regex with captures, args and query");
+is($context->uri_for($regex_action, 'foo', 123, { q => 1 }),
+ "http://127.0.0.1/foo/action/regexp/foo/123?q=1",
+ "uri_for correct for regex no captures with args and query");
+
is($context->uri_for($chained_action, [ 1 ], 2, { q => 1 }),
"http://127.0.0.1/foo/chained/foo/1/end/2?q=1",
"uri_for correct for chained with captures, args and query");
+is($context->uri_for($chained_action, 1, 2, { q => 1 }),
+ "http://127.0.0.1/foo/chained/foo/1/end/2?q=1",
+ "uri_for correct for chained no captures with args and query");
+
#
# More Chained with Context Tests
#
@@ -124,47 +132,89 @@
'http://127.0.0.1/foo/chained/foo2/1/2/end2/3/4?x=5',
'uri_for_action correct for chained with multiple captures and args' );
+ is( $context->uri_for_action( '/action/chained/endpoint2', qw(1 2 3 4), { x => 5 } ),
+ 'http://127.0.0.1/foo/chained/foo2/1/2/end2/3/4?x=5',
+ 'uri_for_action correct for chained without captures with multiple args' );
+
is( $context->uri_for_action( '/action/chained/three_end', [1,2,3], (4,5,6) ),
'http://127.0.0.1/foo/chained/one/1/two/2/3/three/4/5/6',
'uri_for_action correct for chained with multiple capturing actions' );
+ is( $context->uri_for_action( '/action/chained/three_end', qw(1 2 3 4 5 6) ),
+ 'http://127.0.0.1/foo/chained/one/1/two/2/3/three/4/5/6',
+ 'uri_for_action correct for chained no captures multi capturing actions' );
+
+ ok( ! defined( $context->uri_for_action( '/action/chained/foo2' ) ),
+ 'uri_for_action returns undef for chained action midpoints' );
+
my $action_needs_two = '/action/chained/endpoint2';
-
+
ok( ! defined( $context->uri_for_action($action_needs_two, [1], (2,3)) ),
'uri_for_action returns undef for not enough captures' );
-
+
+ ok( ! defined( $context->uri_for_action($action_needs_two, 1) ),
+ 'uri_for_action returns undef for not enough captures/args total' );
+
is( $context->uri_for_action($action_needs_two, [1,2], (2,3)),
'http://127.0.0.1/foo/chained/foo2/1/2/end2/2/3',
'uri_for_action returns correct uri for correct captures' );
-
+
+ is( $context->uri_for_action($action_needs_two, qw(1 2 2 3)),
+ 'http://127.0.0.1/foo/chained/foo2/1/2/end2/2/3',
+ 'uri_for_action returns correct uri for correct captures/args total' );
+
ok( ! defined( $context->uri_for_action($action_needs_two, [1,2,3], (2,3)) ),
'uri_for_action returns undef for too many captures' );
-
+
is( $context->uri_for_action($action_needs_two, [1,2], (3)),
'http://127.0.0.1/foo/chained/foo2/1/2/end2/3',
'uri_for_action returns uri with lesser args than specified on action' );
+ is( $context->uri_for_action($action_needs_two, qw(1 2 3)),
+ 'http://127.0.0.1/foo/chained/foo2/1/2/end2/3',
+ 'uri_for_action returns uri with lesser args and no captures' );
+
is( $context->uri_for_action($action_needs_two, [1,2], (3,4,5)),
'http://127.0.0.1/foo/chained/foo2/1/2/end2/3/4/5',
'uri_for_action returns uri with more args than specified on action' );
+ is( $context->uri_for_action($action_needs_two, qw(1 2 3 4 5)),
+ 'http://127.0.0.1/foo/chained/foo2/1/2/end2/3/4/5',
+ 'uri_for_action returns uri with more args and no captures' );
+
is( $context->uri_for_action($action_needs_two, [1,''], (3,4)),
'http://127.0.0.1/foo/chained/foo2/1//end2/3/4',
'uri_for_action returns uri with empty capture on undef capture' );
+ is( $context->uri_for_action($action_needs_two, 1, '', 3, 4),
+ 'http://127.0.0.1/foo/chained/foo2/1//end2/3/4',
+ 'uri_for_action returns uri with no captures and empty arg' );
+
is( $context->uri_for_action($action_needs_two, [1,2], ('',3)),
'http://127.0.0.1/foo/chained/foo2/1/2/end2//3',
'uri_for_action returns uri with empty arg on undef argument' );
+ is( $context->uri_for_action($action_needs_two, 1, 2, '', 3),
+ 'http://127.0.0.1/foo/chained/foo2/1/2/end2//3',
+ 'uri_for_action returns uri no captures with empty arg on undef argument' );
+
is( $context->uri_for_action($action_needs_two, [1,2], (3,'')),
'http://127.0.0.1/foo/chained/foo2/1/2/end2/3/',
'uri_for_action returns uri with empty arg on undef last argument' );
+ is( $context->uri_for_action($action_needs_two, 1, 2, 3, ''),
+ 'http://127.0.0.1/foo/chained/foo2/1/2/end2/3/',
+ 'uri_for_action returns uri no captures empty arg undef last argument' );
+
my $complex_chained = '/action/chained/empty_chain_f';
is( $context->uri_for_action( $complex_chained, [23], (13), {q => 3} ),
'http://127.0.0.1/foo/chained/empty/23/13?q=3',
'uri_for_action returns correct uri for chain with many empty path parts' );
+ is( $context->uri_for_action( $complex_chained, 23, 13, {q => 3} ),
+ 'http://127.0.0.1/foo/chained/empty/23/13?q=3',
+ 'uri_for_action returns correct uri for chain no captures empty path parts' );
+
eval { $context->uri_for_action( '/does/not/exist' ) };
like $@, qr{^Can't find action for path '/does/not/exist'},
'uri_for_action croaks on nonexistent path';
Deleted: 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-08-01 19:04:08 UTC (rev 11023)
+++ Catalyst-Runtime/5.80/branches/contextual_uri_for/t/unit_core_contextual_uri_for.t 2009-08-01 21:56:37 UTC (rev 11024)
@@ -1,163 +0,0 @@
-use strict;
-use warnings;
-use File::Spec::Functions;
-use FindBin qw( $Bin );
-use lib catdir( $Bin, updir, q(lib) ), catdir( $Bin, q(lib) );
-
-use English qw( -no_match_vars );
-use Test::More tests => 26;
-use URI;
-
-{ package TestApp;
-
- use Catalyst;
-
- __PACKAGE__->config
- ( contextual_uri_for => 1,
- dispatcher_default_action => q(default_endpoint), );
-
- __PACKAGE__->setup;
-
- 1;
-}
-
-my $request = Catalyst::Request->new( {
- base => URI->new( q(http://127.0.0.1) ) } );
-
-my $context = TestApp->new( { request => $request } );
-
-is( $context->uri_for,
- q(http://127.0.0.1/),
- 'URI for default private path with no args at all' );
-
-is( $context->uri_for( q(), q(en) ),
- q(http://127.0.0.1/en),
- 'URI for default private path plus leading capture arg' );
-
-is( $context->uri_for( qw(root) ),
- q(http://127.0.0.1/),
- 'URI for private path with default action name and no args at all' );
-
-is( $context->uri_for( qw(/just_one_arg a) ),
- q(http://127.0.0.1/just_one_arg/a),
- 'URI for private path with default namespace' );
-
-is( $context->uri_for( qw(root/just_one_arg a) ),
- q(http://127.0.0.1/just_one_arg/a),
- 'URI for private path with just one arg and no captures' );
-
-is( $context->uri_for( qw(root/slurpy_endpoint en a) ),
- q(http://127.0.0.1/en/midpoint_capture/a/slurpy_endpoint),
- 'URI for slurpy_endpoint no args or params' );
-
-is( $context->uri_for( qw(root/slurpy_endpoint en a b c) ),
- q(http://127.0.0.1/en/midpoint_capture/a/slurpy_endpoint/b/c),
- 'URI for slurpy_endpoint with some args' );
-
-is( $context->uri_for( qw(root/slurpy_endpoint en a b c), { key1 => q(value1) } ),
- q(http://127.0.0.1/en/midpoint_capture/a/slurpy_endpoint/b/c?key1=value1),
- 'URI for slurpy_endpoint with some args and params' );
-
-is( $context->uri_for( qw(Chained::ContextualUriFor slurpy_endpoint en a b c) ),
- q(http://127.0.0.1/en/midpoint_capture/a/slurpy_endpoint/b/c),
- 'URI for controller and method' );
-
-is( $context->uri_for( q(Chained::ContextualUriFor) ),
- 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
-# End:
More information about the Catalyst-commits
mailing list