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