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