handle infinite args
[catagits/Catalyst-Runtime.git] / t / arg_constraints.t
1 use warnings;
2 use strict;
3
4 BEGIN {
5   use Test::More;
6   eval "use Types::Standard; 1;" || do {
7     plan skip_all => "Trouble loading Types::Standard => $@";
8   };
9
10   package MyApp::Types;
11   $INC{'MyApp/Types.pm'} = __FILE__;
12
13   use strict;
14   use warnings;
15  
16   use Type::Utils -all;
17   use Types::Standard -types;
18   use Type::Library
19    -base,
20    -declare => qw( UserId User ContextLike );
21
22   extends "Types::Standard"; 
23
24   class_type User, { class => "MyApp::Model::User::user" };
25   duck_type ContextLike, [qw/model/];
26
27   declare UserId,
28    as Int,
29    where { $_ < 5 };
30
31   # Tests using this are skipped pending deeper thought
32   coerce User,
33    from ContextLike,
34      via { $_->model('User')->find( $_->req->args->[0] ) };
35 }
36
37 {
38   package MyApp::Model::User;
39   $INC{'MyApp/Model/User.pm'} = __FILE__;
40
41   use base 'Catalyst::Model';
42
43   our %users = (
44     1 => { name => 'john', age => 46 },
45     2 => { name => 'mary', age => 36 },
46     3 => { name => 'ian', age => 25 },
47     4 => { name => 'visha', age => 18 },
48   );
49
50   sub find {
51     my ($self, $id) = @_;
52     my $user = $users{$id} || return;
53     return bless $user, "MyApp::Model::User::user";
54   }
55
56   package MyApp::Controller::Root;
57   $INC{'MyApp/Controller/Root.pm'} = __FILE__;
58
59   use Moose;
60   use MooseX::MethodAttributes;
61   use MyApp::Types qw/Tuple Int Str StrMatch ArrayRef UserId User/;
62
63   extends 'Catalyst::Controller';
64
65   sub user :Local Args(UserId) {
66     my ($self, $c, $int) = @_;
67     my $user = $c->model("User")->find($int);
68     $c->res->body("name: $user->{name}, age: $user->{age}");
69   }
70
71   # Tests using this are current skipped pending coercion rethink
72   sub user_object :Local Args(User) Coerce(1) {
73     my ($self, $c, $user) = @_;
74     $c->res->body("name: $user->{name}, age: $user->{age}");
75   }
76
77   sub an_int :Local Args(Int) {
78     my ($self, $c, $int) = @_;
79     $c->res->body('an_int');
80   }
81
82   sub two_ints :Local Args(Int,Int) {
83     my ($self, $c, $int) = @_;
84     $c->res->body('two_ints');
85   }
86
87   sub many_ints :Local Args(ArrayRef[Int]) {
88     my ($self, $c, $int) = @_;
89     $c->res->body('many_ints');
90   }
91
92   sub tuple :Local Args(Tuple[Str,Int]) {
93     my ($self, $c, $str, $int) = @_;
94     $c->res->body('tuple');
95   }
96
97   sub match :Local Args(StrMatch[qr{\d\d-\d\d-\d\d}]) {
98     my ($self, $c, $int) = @_;
99     $c->res->body('match');
100   }
101
102   sub any_priority :Path('priority_test') Args(1) { $_[1]->res->body('any_priority') }
103
104   sub int_priority :Path('priority_test') Args(Int) { $_[1]->res->body('int_priority') }
105
106   sub chain_base :Chained(/) CaptureArgs(1) { }
107
108     sub any_priority_chain :GET Chained(chain_base) PathPart('') Args(1) { $_[1]->res->body('any_priority_chain') }
109
110     sub int_priority_chain :Chained(chain_base) PathPart('') Args(Int) { $_[1]->res->body('int_priority_chain') }
111
112     sub link_any :Chained(chain_base) PathPart('') CaptureArgs(1) { }
113
114       sub any_priority_link_any :Chained(link_any) PathPart('') Args(1) { $_[1]->res->body('any_priority_link_any') }
115
116       sub int_priority_link_any :Chained(link_any) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link_any') }
117     
118     sub link_int :Chained(chain_base) PathPart('') CaptureArgs(Int) { }
119
120       sub any_priority_link :Chained(link_int) PathPart('') Args(1) { $_[1]->res->body('any_priority_link') }
121
122       sub int_priority_link :Chained(link_int) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link') }
123
124     sub link_int_int :Chained(chain_base) PathPart('') CaptureArgs(Int,Int) { }
125
126       sub any_priority_link2 :Chained(link_int_int) PathPart('') Args(1) { $_[1]->res->body('any_priority_link2') }
127
128       sub int_priority_link2 :Chained(link_int_int) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link2') }
129
130     sub link_tuple :Chained(chain_base) PathPart('') CaptureArgs(Tuple[Int,Int,Int]) { }
131
132       sub any_priority_link3 :Chained(link_tuple) PathPart('') Args(1) { $_[1]->res->body('any_priority_link3') }
133
134       sub int_priority_link3 :Chained(link_tuple) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link3') }
135
136       sub link2_int :Chained(link_tuple) PathPart('') CaptureArgs(UserId) { }
137
138         sub finally2 :GET Chained(link2_int) PathPart('') Args { $_[1]->res->body('finally2') }
139         sub finally :GET Chained(link2_int) PathPart('') Args(Int) { $_[1]->res->body('finally') }
140
141   sub default :Default {
142     my ($self, $c, $int) = @_;
143     $c->res->body('default');
144   }
145
146   MyApp::Controller::Root->config(namespace=>'');
147
148   package MyApp;
149   use Catalyst;
150
151   MyApp->setup;
152 }
153
154 use Catalyst::Test 'MyApp';
155
156 {
157   my $res = request '/an_int/1';
158   is $res->content, 'an_int';
159 }
160
161 {
162   my $res = request '/an_int/aa';
163   is $res->content, 'default';
164 }
165
166 {
167   my $res = request '/many_ints/1';
168   is $res->content, 'many_ints';
169 }
170
171 {
172   my $res = request '/many_ints/1/2';
173   is $res->content, 'many_ints';
174 }
175
176 {
177   my $res = request '/many_ints/1/2/3';
178   is $res->content, 'many_ints';
179 }
180
181 {
182   my $res = request '/priority_test/1';
183   is $res->content, 'int_priority';
184 }
185
186 {
187   my $res = request '/priority_test/a';
188   is $res->content, 'any_priority';
189 }
190
191 {
192   my $res = request '/match/11-22-33';
193   is $res->content, 'match';
194 }
195
196 {
197   my $res = request '/match/aaa';
198   is $res->content, 'default';
199 }
200
201 {
202   my $res = request '/user/2';
203   is $res->content, 'name: mary, age: 36';
204 }
205
206 {
207   my $res = request '/user/20';
208   is $res->content, 'default';
209 }
210
211
212 SKIP: {
213   skip "coercion support needs more thought", 1;
214   my $res = request '/user_object/20';
215   is $res->content, 'default';
216 }
217
218 SKIP: {
219   skip "coercion support needs more thought", 1;
220   my $res = request '/user_object/2';
221   is $res->content, 'name: mary, age: 36';
222 }
223
224 {
225   my $res = request '/chain_base/capture/arg';
226   is $res->content, 'any_priority_chain';
227 }
228
229 {
230   my $res = request '/chain_base/cap1/100/arg';
231   is $res->content, 'any_priority_link';
232 }
233
234 {
235   my $res = request '/chain_base/cap1/101/102';
236   is $res->content, 'int_priority_link';
237 }
238
239 {
240   my $res = request '/chain_base/capture/100';
241   is $res->content, 'int_priority_chain', 'got expected';
242 }
243
244 {
245   my $res = request '/chain_base/cap1/a/arg';
246   is $res->content, 'any_priority_link_any';
247 }
248
249 {
250   my $res = request '/chain_base/cap1/a/102';
251   is $res->content, 'int_priority_link_any';
252 }
253
254 {
255   my $res = request '/two_ints/1/2';
256   is $res->content, 'two_ints';
257 }
258
259 {
260   my $res = request '/two_ints/aa/111';
261   is $res->content, 'default';
262 }
263
264 {
265   my $res = request '/tuple/aaa/aaa';
266   is $res->content, 'default';
267 }
268
269 {
270   my $res = request '/tuple/aaa/111';
271   is $res->content, 'tuple';
272 }
273
274 {
275   my $res = request '/many_ints/1/2/a';
276   is $res->content, 'default';
277 }
278
279 {
280   my $res = request '/chain_base/100/100/100/100';
281   is $res->content, 'int_priority_link2';
282 }
283
284 {
285   my $res = request '/chain_base/100/ss/100/100';
286   is $res->content, 'default';
287 }
288
289 {
290   my $res = request '/chain_base/100/100/100/100/100';
291   is $res->content, 'int_priority_link3';
292 }
293
294 {
295   my $res = request '/chain_base/100/ss/100/100/100';
296   is $res->content, 'default';
297 }
298
299 {
300   my $res = request '/chain_base/1/2/3/3/3/6';
301   is $res->content, 'finally';
302 }
303
304 {
305   my $res = request '/chain_base/1/2/3/3/3/a';
306   is $res->content, 'finally2';
307 }
308
309 {
310   my $res = request '/chain_base/1/2/3/3/3/6/7/8/9';
311   is $res->content, 'finally2';
312 }
313
314 =over
315
316 | /chain_base/*/*/*/*/*/*                                     | /chain_base (1)                                             |
317 |                                                             | -> /link_tuple (Tuple[Int,Int,Int])                         |
318 |                                                             | -> /link2_int (UserId)                                      |
319 |                                                             | => GET /finally (Int)  
320 =cut
321
322 {
323   # URI testing
324   my ($res, $c) = ctx_request '/';
325   ok my $url1 = $c->uri_for($c->controller('Root')->action_for('finally'), [1,2,3,4,5],6);
326   warn $url1;
327
328   ok my $url2 = $c->uri_for($c->controller('Root')->action_for('finally'), [1,2,3,4,5,6]);
329   warn $url2;
330 }
331
332 done_testing;