change the way we do this logic for older perl compat
[catagits/Catalyst-Runtime.git] / t / aggregate / unit_core_uri_for.t
CommitLineData
fbcc39ad 1use strict;
2use warnings;
2689f8a4 3use FindBin qw/$Bin/;
4use lib "$FindBin::Bin/../lib";
62b64711 5use Test::More;
fbcc39ad 6use URI;
7
2689f8a4 8use_ok('TestApp');
fbcc39ad 9
fa32ac82 10my $request = Catalyst::Request->new( {
7c1c4dc6 11 _log => Catalyst::Log->new,
fa32ac82 12 base => URI->new('http://127.0.0.1/foo')
13 } );
2689f8a4 14my $dispatcher = TestApp->dispatcher;
15my $context = TestApp->new( {
fa32ac82 16 request => $request,
17 namespace => 'yada',
18 } );
fbcc39ad 19
20is(
21 Catalyst::uri_for( $context, '/bar/baz' )->as_string,
22 'http://127.0.0.1/foo/bar/baz',
23 'URI for absolute path'
24);
25
26is(
27 Catalyst::uri_for( $context, 'bar/baz' )->as_string,
28 'http://127.0.0.1/foo/yada/bar/baz',
29 'URI for relative path'
30);
31
d3e7a648 32is(
33 Catalyst::uri_for( $context, '', 'arg1', 'arg2' )->as_string,
34 'http://127.0.0.1/foo/yada/arg1/arg2',
35 'URI for undef action with args'
36);
37
38
fbcc39ad 39is( Catalyst::uri_for( $context, '../quux' )->as_string,
40 'http://127.0.0.1/foo/quux', 'URI for relative dot path' );
fdba7a9d 41
8327e2e2 42is(
43 Catalyst::uri_for( $context, 'quux', { param1 => 'value1' } )->as_string,
44 'http://127.0.0.1/foo/yada/quux?param1=value1',
45 'URI for undef action with query params'
46);
47
57e74a1e 48is (Catalyst::uri_for( $context, '/bar/wibble?' )->as_string,
49 'http://127.0.0.1/foo/bar/wibble%3F', 'Question Mark gets encoded'
50);
5d50f369 51
57e74a1e 52is( Catalyst::uri_for( $context, qw/bar wibble?/, 'with space' )->as_string,
53 'http://127.0.0.1/foo/yada/bar/wibble%3F/with%20space', 'Space gets encoded'
54);
55
f0417b32 56is(
57 Catalyst::uri_for( $context, '/bar', 'with+plus', { 'also' => 'with+plus' })->as_string,
58 'http://127.0.0.1/foo/bar/with+plus?also=with%2Bplus',
59 'Plus is not encoded'
60);
57e74a1e 61
3a6d7f15 62is(
63 Catalyst::uri_for( $context, '/bar#fragment', { param1 => 'value1' } )->as_string,
02336198 64 'http://127.0.0.1/foo/bar?param1=value1#fragment',
9d1f9508 65 'URI for path with fragment and query params 1'
3a6d7f15 66);
5a8e2ba0 67
9d1f9508 68is(
69 Catalyst::uri_for( $context, '/bar#fragment^%$', { param1 => 'value1' } )->as_string,
02336198 70 'http://127.0.0.1/foo/bar?param1=value1#fragment^%$',
9d1f9508 71 'URI for path with fragment and query params 3'
72);
73
6b9f9ef7 74is(
02336198 75 Catalyst::uri_for( $context, '/foo#bar/baz', { param1 => 'value1' } )->as_string,
76 'http://127.0.0.1/foo/foo?param1=value1#bar/baz',
77 'URI for path with fragment and query params 3'
6b9f9ef7 78);
79
5789a3d8 80# test with utf-8
81is(
82 Catalyst::uri_for( $context, 'quux', { param1 => "\x{2620}" } )->as_string,
83 'http://127.0.0.1/foo/yada/quux?param1=%E2%98%A0',
84 'URI for undef action with query params in unicode'
85);
2f381252 86is(
87 Catalyst::uri_for( $context, 'quux', { 'param:1' => "foo" } )->as_string,
88 'http://127.0.0.1/foo/yada/quux?param%3A1=foo',
89 'URI for undef action with query params in unicode'
90);
5789a3d8 91
fbb513f7 92# test with object
93is(
94 Catalyst::uri_for( $context, 'quux', { param1 => $request->base } )->as_string,
95 'http://127.0.0.1/foo/yada/quux?param1=http%3A%2F%2F127.0.0.1%2Ffoo',
96 'URI for undef action with query param as object'
97);
98
fa32ac82 99$request->base( URI->new('http://localhost:3000/') );
100$request->match( 'orderentry/contract' );
fdba7a9d 101is(
102 Catalyst::uri_for( $context, '/Orderentry/saveContract' )->as_string,
103 'http://localhost:3000/Orderentry/saveContract',
104 'URI for absolute path'
105);
bdcb95ef 106
107{
fa32ac82 108 $request->base( URI->new('http://127.0.0.1/') );
bdcb95ef 109
fa32ac82 110 $context->namespace('');
bdcb95ef 111
112 is( Catalyst::uri_for( $context, '/bar/baz' )->as_string,
113 'http://127.0.0.1/bar/baz', 'URI with no base or match' );
fcea752e 114
115 # test "0" as the path
116 is( Catalyst::uri_for( $context, qw/0 foo/ )->as_string,
117 'http://127.0.0.1/0/foo', '0 as path is ok'
118 );
119
bdcb95ef 120}
5789a3d8 121
d0f0fcf6 122# test with undef -- no warnings should be thrown
123{
124 my $warnings = 0;
125 local $SIG{__WARN__} = sub { $warnings++ };
126
127 Catalyst::uri_for( $context, '/bar/baz', { foo => undef } )->as_string,
128 is( $warnings, 0, "no warnings emitted" );
129}
130
7a2295bc 131# Test with parameters '/', 'foo', 'bar' - should not generate a //
132is( Catalyst::uri_for( $context, qw| / foo bar | )->as_string,
133 'http://127.0.0.1/foo/bar', 'uri is /foo/bar, not //foo/bar'
134);
135
6a99f9e6 136TODO: {
137 local $TODO = 'RFCs are for people who, erm - fix this test..';
1b5227a1 138 # Test rfc3986 reserved characters. These characters should all be escaped
139 # according to the RFC, but it is a very big feature change so I've removed it
6a99f9e6 140 no warnings; # Yes, everything in qw is sane
141 is(
142 Catalyst::uri_for( $context, qw|! * ' ( ) ; : @ & = $ / ? % # [ ] ,|, )->as_string,
1b5227a1 143 'http://127.0.0.1/%21/%2A/%27/%2B/%29/%3B/%3A/%40/%26/%3D/%24/%2C/%2F/%3F/%25/%23/%5B/%5D',
144 'rfc 3986 reserved characters'
145 );
1b5227a1 146
294773ca 147 # jshirley bug - why the hell does only one of these get encoded
148 # has been like this forever however.
149 is(
150 Catalyst::uri_for( $context, qw|{1} {2}| )->as_string,
151 'http://127.0.0.1/{1}/{2}',
152 'not-escaping unreserved characters'
153 );
154}
6a99f9e6 155
1f851263 156# make sure caller's query parameter hash isn't messed up
157{
158 my $query_params_base = {test => "one two",
159 bar => ["foo baz", "bar"]};
160 my $query_params_test = {test => "one two",
161 bar => ["foo baz", "bar"]};
162 Catalyst::uri_for($context, '/bar/baz', $query_params_test);
163 is_deeply($query_params_base, $query_params_test,
164 "uri_for() doesn't mess up query parameter hash in the caller");
165}
62b64711 166
2689f8a4 167
168{
169 my $path_action = $dispatcher->get_action_by_path(
170 '/action/path/six'
171 );
172
173 # 5.80018 is only encoding the first of the / in the arg.
174 is(
175 Catalyst::uri_for( $context, $path_action, 'foo/bar/baz' )->as_string,
176 'http://127.0.0.1/action/path/six/foo%2Fbar%2Fbaz',
177 'Escape all forward slashes in args as %2F'
178 );
179}
180
76cd735d 181{
182 my $index_not_private = $dispatcher->get_action_by_path(
183 '/action/chained/argsorder/index'
184 );
185
186 is(
187 Catalyst::uri_for( $context, $index_not_private )->as_string,
188 'http://127.0.0.1/argsorder',
189 'Return non-DispatchType::Index path for index action with args'
190 );
191}
62b64711 192
0ee04045 193{
194 package MyStringThing;
195
196 use overload '""' => sub { $_[0]->{string} }, fallback => 1;
197}
62b64711 198
0ee04045 199is(
200 Catalyst::uri_for( $context, bless( { string => 'test' }, 'MyStringThing' ) ),
201 'http://127.0.0.1/test',
202 'overloaded object handled correctly'
203);
204
205done_testing;