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