1use strict; 2use warnings; 3use Test::More; 4use Test::Fatal; 5use Dancer2::Core::Request; 6use Dancer2::Core::Route; 7use Capture::Tiny 0.12 'capture_stderr'; 8use Ref::Util qw<is_regexpref>; 9use lib 't/lib'; 10 11my @tests = ( 12 [ [ 'get', '/', sub {11} ], '/', [ {}, 11 ] ], 13 [ [ 'get', '/', sub {11} ], 14 '/failure', 15 [ undef, 11 ] 16 ], 17 18 # token tests 19 [ [ 'get', '/hello/:name', sub {22} ], 20 '/hello/sukria', 21 [ { name => 'sukria' }, 22 ] 22 ], 23 [ [ 'get', '/hello/:name?', sub {22} ], 24 '/hello/', 25 [ { name => undef }, 22 ] 26 ], 27 28 # prefix tests 29 [ [ 'get', '/', sub {33}, '/forum' ], 30 '/forum/', 31 [ {}, 33 ] 32 ], 33 [ [ 'get', '/', sub {33}, '/forum' ], 34 '/forum/', 35 [ {}, 33 ] 36 ], 37 [ [ 'get', '/mywebsite', sub {33}, '/forum' ], 38 '/forum/mywebsite', 39 [ {}, 33 ] 40 ], 41 [ [ 'get', '', sub {'concat'}, '/' ], 42 '/', 43 [ {}, 'concat' ] 44 ], 45 46 # token in prefix tests 47 [ [ 'get', 'name', sub {35}, '/hello/:' ], 48 '/hello/sukria', 49 [ { name => 'sukria' }, 35 ], 50 ], 51 52 [ [ 'get', '/', sub {36}, '/hello/:name' ], 53 '/hello/sukria/', 54 [ { name => 'sukria' }, 36 ], 55 ], 56 57 # splat test 58 [ [ 'get', '/file/*.*', sub {44} ], 59 '/file/dist.ini', 60 [ { splat => [ 'dist', 'ini' ] }, 44 ] 61 ], 62 63 # splat in prefix 64 [ [ 'get', '', sub {42}, '/forum/*'], 65 '/forum/dancer', 66 [ { splat => [ 'dancer' ] }, 42 ] 67 ], 68 69 # megasplat test 70 [ [ 'get', '/file/**/*', sub {44} ], 71 '/file/some/where/42', 72 [ { splat => [ [ 'some', 'where' ], '42' ] }, 44 ] 73 ], 74 75 # megasplat consistently handles multiple slashes 76 [ [ 'get', '/foo/**', sub {'45a'} ], 77 '/foo/bar///baz', 78 [ { splat => [ [ 'bar', '', '', 'baz' ] ] }, '45a' ] 79 ], 80 [ [ 'get', '/foo/**', sub {'45b'} ], 81 '/foo/bar///', # empty trailing path segment 82 [ { splat => [ [ 'bar', '', '', '' ] ] }, '45b' ] 83 ], 84 85 # Optional megasplat test - with a value... 86 [ [ 'get', '/foo/?**?', sub {46} ], 87 '/foo/bar/baz', 88 [ { splat => [ [ 'bar', 'baz' ] ] }, 46 ], 89 ], 90 # ... and without 91 [ [ 'get', '/foo/?**?', sub {47} ], 92 '/foo', 93 [ { splat => [ [ ] ] }, 47 ], 94 ], 95 96 # mixed (mega)splat and tokens 97 [ [ 'get', '/some/:id/**/*', sub {55} ], 98 '/some/where/to/run/and/hide', 99 [ { id => 'where', splat => [ [ 'to', 'run', 'and' ], 'hide' ] }, 55 ] 100 ], 101 [ [ 'get', '/some/*/**/:id?', sub {55} ], 102 '/some/one/to/say/boo/', 103 [ { id => undef, splat => [ 'one', [ 'to', 'say', 'boo' ] ] }, 55 ] 104 ], 105 106 # supplied regex 107 [ [ 'get', qr{stuff(\d+)}, sub {44} ], '/stuff48', 108 [ { splat => [48] }, 44 ] 109 ], 110 [ [ 'get', qr{/stuff(\d+)}, sub {44}, '/foo' ], 111 '/foo/stuff48', 112 [ { splat => [48] }, 44 ], 113 ], 114 115); 116 117 118plan tests => 111; 119 120for my $t (@tests) { 121 my ( $route, $path, $expected ) = @$t; 122 123 if ( is_regexpref($expected) ) { 124 like( 125 exception { 126 my $r = Dancer2::Core::Route->new( 127 method => $route->[0], 128 regexp => $route->[1], 129 code => $route->[2], 130 prefix => $route->[3], 131 ); 132 }, 133 $expected, 134 "got expected exception for $path", 135 ); 136 } 137 else { 138 my $r = Dancer2::Core::Route->new( 139 method => $route->[0], 140 regexp => $route->[1], 141 code => $route->[2], 142 prefix => $route->[3], 143 ); 144 isa_ok $r, 'Dancer2::Core::Route'; 145 146 my $request = Dancer2::Core::Request->new( 147 env => { 148 PATH_INFO => $path, 149 REQUEST_METHOD => $route->[0], 150 } 151 ); 152 my $m; 153 is( capture_stderr { $m = $r->match($request) }, '', 154 "no warnings generated for $path" ); 155 is_deeply $m, $expected->[0], "got expected data for '$path'"; 156 157 { 158 package App; use Dancer2; ## no critic 159 } 160 161 use Dancer2::Core::App; 162 use Dancer2::Core::Response; 163 my $app = Dancer2::Core::App->new( 164 request => $request, 165 response => Dancer2::Core::Response->new, 166 ); 167 168 is $r->execute($app)->content, $expected->[1], "got expected result for '$path'"; 169 170 # failing request 171 my $failing_request = Dancer2::Core::Request->new( 172 env => { 173 PATH_INFO => '/something_that_doesnt_exist', 174 REQUEST_METHOD => 'GET', 175 }, 176 ); 177 178 $m = $r->match($failing_request); 179 is $m, undef, "don't match failing request"; 180 } 181} 182 183# captures test 184SKIP: { 185 skip "Need perl >= 5.10", 1 unless $] >= 5.010; 186 187 ## Regexp is parsed in compile time. So, eval with QUOTES to force to parse later. 188 my $route_regex; 189 190 ## no critic 191 192 eval q{ 193 $route_regex = qr{/(?<class> user | content | post )/(?<action> delete | find )/(?<id> \d+ )}x; 194 }; 195 196 ## use critic 197 198 my $r = Dancer2::Core::Route->new( 199 regexp => $route_regex, 200 code => sub { 201 'ok'; 202 }, 203 method => 'get', 204 ); 205 206 my $request = Dancer2::Core::Request->new( 207 env => { 208 PATH_INFO => '/user/delete/234', 209 REQUEST_METHOD => 'GET', 210 }, 211 ); 212 213 my $m = $r->match($request); 214 215 is_deeply $m, 216 { captures => { 217 class => 'user', 218 action => 'delete', 219 id => 234 220 } 221 }, 222 "named captures work"; 223} 224 225note "routes with options"; { 226 my $route_w_options = Dancer2::Core::Route->new( 227 method => 'get', 228 regexp => '/', 229 code => sub {'options'}, 230 options => { 'agent' => 'cURL' }, 231 ); 232 233 my $req = Dancer2::Core::Request->new( 234 path => '/', 235 method => 'get', 236 env => { 'HTTP_USER_AGENT' => 'mozilla' }, 237 ); 238 239 my $m = $route_w_options->match($req); 240 ok !defined $m, 'Route did not match'; 241 242 $req = Dancer2::Core::Request->new( 243 path => '/', 244 method => 'get', 245 env => { 'HTTP_USER_AGENT' => 'cURL' }, 246 ); 247 248 $m = $route_w_options->match($req); 249 ok defined $m, 'Route matched'; 250 251 $route_w_options = Dancer2::Core::Route->new( 252 method => 'get', 253 regexp => '/', 254 code => sub {'options'}, 255 options => { 256 'agent' => 'cURL', 257 'content_type' => 'foo', 258 }, 259 ); 260 261 $req = Dancer2::Core::Request->new( 262 path => '/', 263 method => 'get', 264 env => { 'HTTP_USER_AGENT' => 'cURL' }, 265 ); 266 267 # Check match more than once (each iterator wasn't reset, for loop is ok ) 268 $m = $route_w_options->match($req); 269 ok !defined $m, 'More options - Route did not match - test 1'; 270 $m = $route_w_options->match($req); 271 ok !defined $m, 'More options - Route did not match - test 2'; 272} 273 274subtest "typed route params" => sub { 275 my @tests = ( 276 { 277 name => "good type check", 278 route => { 279 regexp => '/some/:id[Int]', 280 }, 281 request => '/some/34', 282 match => { id => 34 }, 283 }, 284 { 285 name => "bad required type check", 286 route => { 287 regexp => '/some/:id[Int]', 288 }, 289 request => '/some/bad', 290 }, 291 { 292 name => "missing required type check", 293 route => { 294 regexp => '/some/:id[Int]', 295 }, 296 request => '/some/', 297 }, 298 { 299 name => "optional type check exists", 300 route => { 301 regexp => '/some/:id[Int]?', 302 }, 303 request => '/some/34', 304 match => { id => 34 }, 305 }, 306 { 307 name => "optional type check with bad token", 308 route => { 309 regexp => '/some/:id[Int]?', 310 }, 311 request => '/some/bad', 312 }, 313 { 314 name => "optional type check with empty token", 315 route => { 316 regexp => '/some/:id[Int]?', 317 }, 318 request => '/some/', 319 match => { id => undef }, 320 }, 321 { 322 name => "optional type check with empty token and optional missing trailing slash", 323 route => { 324 regexp => '/some/?:id[Int]?', 325 }, 326 request => '/some', 327 match => { id => undef }, 328 }, 329 { 330 name => "bad type", 331 route => { 332 regexp => '/some/:id[MyDate]?', 333 exception => qr/MyDate is not a known type constraint/, 334 }, 335 request => '/some/foo', 336 match => { id => undef }, 337 }, 338 { 339 name => "custom type with good match", 340 route => { 341 regexp => '/date/:date[MyDate]', 342 args => { type_library => 'TestTypeLibrary' }, 343 }, 344 request => '/date/2014-01-01', 345 match => { date => '2014-01-01' }, 346 }, 347 { 348 name => "custom type with bad match", 349 route => { 350 regexp => '/date/:date[MyDate]', 351 args => { type_library => 'TestTypeLibrary' }, 352 }, 353 request => '/date/X014-01-01', 354 }, 355 { 356 name => "type including type library but no type_library config setting", 357 route => { 358 regexp => '/date/:date[TestTypeLibrary::MyDate]', 359 }, 360 request => '/date/2014-01-01', 361 match => { date => '2014-01-01' }, 362 }, 363 { 364 name => "union of types", 365 route => { 366 regexp => '/date/:date[Int|TestTypeLibrary::MyDate]', 367 }, 368 request => '/date/2014-01-01', 369 match => { date => '2014-01-01' }, 370 }, 371 { 372 name => "union of types checking other type", 373 route => { 374 regexp => '/date/:date[Int|TestTypeLibrary::MyDate]', 375 }, 376 request => '/date/2014', 377 match => { date => '2014' }, 378 }, 379 { 380 name => "multiple typed tokens plus other tokens and splats", 381 route => { 382 regexp => '/:id[Int]/:date[MyDate]/:foo/*/**', 383 args => { type_library => 'TestTypeLibrary' }, 384 }, 385 request => '/42/2018-11-23/bar/dave/was/here', 386 match => { 387 id => 42, 388 date => '2018-11-23', 389 foo => 'bar', 390 splat => [ 'dave', [ 'was', 'here' ] ], 391 }, 392 }, 393 ); 394 395 for my $test (@tests) { 396 my $method = $test->{route}{method} || 'get'; 397 398 my %route_args = ( 399 method => $method, 400 regexp => $test->{route}{regexp}, 401 code => $test->{route}{code} || sub { 'OK' }, 402 $test->{route}{prefix} ? ( prefix => $test->{route}{prefix} ) : (), 403 $test->{route}{args} ? %{ $test->{route}{args} } : (), 404 ); 405 406 if ( my $exception = $test->{route}{exception} ) { 407 like exception { Dancer2::Core::Route->new(%route_args) }, 408 $exception, 409 "'$test->{name}' throws expected exception in route constructor"; 410 next; 411 } 412 413 my $route = Dancer2::Core::Route->new(%route_args); 414 my $request = Dancer2::Core::Request->new( 415 env => { 416 PATH_INFO => $test->{request}, 417 REQUEST_METHOD => $method, 418 } 419 ); 420 421 my $match; 422 is exception { 423 $match = $route->match($request) 424 }, undef, "'$test->{name}' does not throw an exception"; 425 426 my $expected = $test->{match}; 427 if ( defined $expected ) { 428 is_deeply $match, $expected, 429 "... and route matched with expected captures" 430 or diag explain $match; 431 } 432 else { 433 ok !defined $match, "... and route did not match" 434 or diag explain $match; 435 } 436 } 437}; 438