1use strict;
2use warnings FATAL => 'all';
3
4use Data::Dumper::Concise;
5use Test::More 'no_plan';
6use Plack::Test;
7
8{
9    use Web::Simple 't::Web::Simple::SubDispatchArgs';
10    package t::Web::Simple::SubDispatchArgs;
11
12    has 'attr' => (is=>'ro');
13
14    sub dispatch_request {
15        my $self = shift;
16        sub (/) {
17            $self->show_landing(@_);
18        },
19        sub(/...) {
20            q(GET + /user) => sub {
21                $self->show_users(@_);
22            },
23            sub (/user/*) {
24                sub (GET) {
25                    $self->show_user(@_);
26                },
27                sub (POST + %:id=&:@roles~) {
28                    $self->process_post(@_);
29                }
30            },
31        }
32    };
33
34    sub show_landing {
35        my ($self, @args) = @_;
36        local $self->{_dispatcher};
37        local $args[-1]->{'Web::Dispatch.original_env'};
38        return [
39            200, ['Content-Type' => 'application/perl' ],
40            [::Dumper \@args],
41        ];
42    }
43    sub show_users {
44        my ($self, @args) = @_;
45        local $self->{_dispatcher};
46        local $args[-1]->{'Web::Dispatch.original_env'};
47        return [
48            200, ['Content-Type' => 'application/perl' ],
49            [::Dumper \@args],
50        ];
51    }
52    sub show_user {
53        my ($self, @args) = @_;
54        local $self->{_dispatcher};
55        local $args[-1]->{'Web::Dispatch.original_env'};
56        return [
57            200, ['Content-Type' => 'application/perl' ],
58            [::Dumper \@args],
59        ];
60    }
61    sub process_post {
62        my ($self, @args) = @_;
63        local $self->{_dispatcher};
64        local $args[-1]->{'Web::Dispatch.original_env'};
65        return [
66            200, ['Content-Type' => 'application/perl' ],
67            [::Dumper \@args],
68        ];
69    }
70}
71
72ok my $app = t::Web::Simple::SubDispatchArgs->new,
73  'made app';
74
75sub run_request { $app->run_test_request(@_); }
76
77ok my $get_landing = run_request(GET => 'http://localhost/' ),
78  'got landing';
79
80cmp_ok $get_landing->code, '==', 200,
81  '200 on GET';
82
83no strict 'refs';
84
85{
86    my ($self, $env, @noextra) = @{eval($get_landing->content)||[]};
87    die $@ if $@;
88    is scalar(@noextra), 0, 'No extra stuff';
89    is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object';
90    is ref($env), 'HASH', 'Got hashref';
91}
92
93ok my $get_users = run_request(GET => 'http://localhost/user'),
94  'got user';
95
96cmp_ok $get_users->code, '==', 200,
97  '200 on GET';
98
99{
100    my ($self, $env, @noextra) = @{eval $get_users->content};
101    is scalar(@noextra), 0, 'No extra stuff';
102    is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object';
103    is ref($env), 'HASH', 'Got hashref';
104}
105
106ok my $get_user = run_request(GET => 'http://localhost/user/42'),
107  'got user';
108
109cmp_ok $get_user->code, '==', 200,
110  '200 on GET';
111
112{
113    my ($self, $env, @noextra) = @{eval $get_user->content};
114    is scalar(@noextra), 0, 'No extra stuff';
115    is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object';
116    is ref($env), 'HASH', 'Got hashref';
117}
118
119ok my $post_user = run_request(POST => 'http://localhost/user/42', [id => '99'] ),
120  'post user';
121
122cmp_ok $post_user->code, '==', 200,
123  '200 on POST';
124
125{
126    my ($self, $params, $env, @noextra) = @{eval $post_user->content};
127    is scalar(@noextra), 0, 'No extra stuff';
128    is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object';
129    is ref($params), 'HASH', 'Got POST hashref';
130    is $params->{id}, 99, 'got expected value for id';
131    is ref($env), 'HASH', 'Got hashref';
132}
133