Commit | Line | Data |
fbcc39ad |
1 | package Catalyst::Action; |
2 | |
b2ddf6d7 |
3 | =head1 NAME |
4 | |
5 | Catalyst::Action - Catalyst Action |
6 | |
7 | =head1 SYNOPSIS |
8 | |
804fb55d |
9 | <form action="[%c.uri_for(c.action)%]"> |
85d9fce6 |
10 | |
009b5b23 |
11 | $c->forward( $action->private_path ); |
12 | |
b2ddf6d7 |
13 | =head1 DESCRIPTION |
14 | |
43c58153 |
15 | This class represents a Catalyst Action. You can access the object for the |
b2ddf6d7 |
16 | currently dispatched action via $c->action. See the L<Catalyst::Dispatcher> |
17 | for more information on how actions are dispatched. Actions are defined in |
18 | L<Catalyst::Controller> subclasses. |
19 | |
20 | =cut |
21 | |
059c085b |
22 | use Moose; |
05b47f2e |
23 | use Scalar::Util 'looks_like_number'; |
6d62355b |
24 | use Moose::Util::TypeConstraints (); |
241edc9b |
25 | with 'MooseX::Emulate::Class::Accessor::Fast'; |
05b47f2e |
26 | use namespace::clean -except => 'meta'; |
241edc9b |
27 | |
5fb12dbb |
28 | has class => (is => 'rw'); |
29 | has namespace => (is => 'rw'); |
30 | has 'reverse' => (is => 'rw'); |
31 | has attributes => (is => 'rw'); |
32 | has name => (is => 'rw'); |
33 | has code => (is => 'rw'); |
009b5b23 |
34 | has private_path => ( |
35 | reader => 'private_path', |
36 | isa => 'Str', |
37 | lazy => 1, |
38 | required => 1, |
39 | default => sub { '/'.shift->reverse }, |
40 | ); |
059c085b |
41 | |
81436df9 |
42 | has number_of_args => ( |
43 | is=>'ro', |
44 | init_arg=>undef, |
45 | isa=>'Int|Undef', |
46 | required=>1, |
47 | lazy=>1, |
48 | builder=>'_build_number_of_args'); |
49 | |
50 | sub _build_number_of_args { |
51 | my $self = shift; |
d4e8996f |
52 | if( ! exists $self->attributes->{Args} ) { |
53 | # When 'Args' does not exist, that means we want 'any number of args'. |
54 | return undef; |
55 | } elsif(!defined($self->attributes->{Args}[0])) { |
81436df9 |
56 | # When its 'Args' that internal cue for 'unlimited' |
57 | return undef; |
4a0218ca |
58 | } elsif( |
59 | scalar(@{$self->attributes->{Args}}) == 1 && |
60 | looks_like_number($self->attributes->{Args}[0]) |
61 | ) { |
a7ab9aa9 |
62 | # 'Old school' numbered args (is allowed to be undef as well) |
81436df9 |
63 | return $self->attributes->{Args}[0]; |
64 | } else { |
d4e8996f |
65 | # New hotness named arg constraints |
81436df9 |
66 | return $self->number_of_args_constraints; |
67 | } |
68 | } |
69 | |
d4e8996f |
70 | sub normalized_arg_number { |
71 | return defined($_[0]->number_of_args) ? $_[0]->number_of_args : ~0; |
72 | } |
73 | |
6d62355b |
74 | has args_constraints => ( |
75 | is=>'ro', |
81436df9 |
76 | init_arg=>undef, |
6d62355b |
77 | traits=>['Array'], |
78 | isa=>'ArrayRef', |
79 | required=>1, |
80 | lazy=>1, |
81 | builder=>'_build_args_constraints', |
82 | handles => { |
83 | has_args_constraints => 'count', |
81436df9 |
84 | number_of_args_constraints => 'count', |
6d62355b |
85 | }); |
86 | |
87 | sub _build_args_constraints { |
88 | my $self = shift; |
89 | my @arg_protos = @{$self->attributes->{Args}||[]}; |
90 | |
91 | return [] unless scalar(@arg_protos); |
92 | # If there is only one arg and it looks like a number |
93 | # we assume its 'classic' and the number is the number of |
94 | # constraints. |
95 | my @args = (); |
96 | if( |
97 | scalar(@arg_protos) == 1 && |
98 | looks_like_number($arg_protos[0]) |
99 | ) { |
81436df9 |
100 | return \@args; |
6d62355b |
101 | } else { |
4a0218ca |
102 | @args = |
842180f7 |
103 | map { $self->resolve_type_constraint($_) || die "$_ is not a constraint!" } |
337a627a |
104 | @arg_protos; |
6d62355b |
105 | } |
106 | |
107 | return \@args; |
108 | } |
109 | |
a82c96cf |
110 | has captures_constraints => ( |
111 | is=>'ro', |
112 | init_arg=>undef, |
113 | traits=>['Array'], |
114 | isa=>'ArrayRef', |
115 | required=>1, |
116 | lazy=>1, |
117 | builder=>'_build_captures_constraints', |
118 | handles => { |
119 | has_captures_constraints => 'count', |
120 | number_of_captures_constraints => 'count', |
121 | }); |
122 | |
123 | sub _build_captures_constraints { |
124 | my $self = shift; |
125 | my @arg_protos = @{$self->attributes->{CaptureArgs}||[]}; |
126 | |
127 | return [] unless scalar(@arg_protos); |
128 | # If there is only one arg and it looks like a number |
129 | # we assume its 'classic' and the number is the number of |
130 | # constraints. |
131 | my @args = (); |
132 | if( |
133 | scalar(@arg_protos) == 1 && |
134 | looks_like_number($arg_protos[0]) |
135 | ) { |
136 | return \@args; |
137 | } else { |
138 | @args = |
139 | map { $self->resolve_type_constraint($_) || die "$_ is not a constraint!" } |
140 | @arg_protos; |
141 | } |
142 | |
143 | return \@args; |
144 | } |
145 | |
842180f7 |
146 | sub resolve_type_constraint { |
147 | my ($self, $name) = @_; |
148 | my $tc = eval "package ${\$self->class}; $name" || undef; |
149 | return $tc || Moose::Util::TypeConstraints::find_or_parse_type_constraint($name); |
150 | } |
151 | |
a82c96cf |
152 | has number_of_captures => ( |
153 | is=>'ro', |
154 | init_arg=>undef, |
155 | isa=>'Int', |
156 | required=>1, |
157 | lazy=>1, |
158 | builder=>'_build_number_of_captures'); |
159 | |
160 | sub _build_number_of_captures { |
161 | my $self = shift; |
162 | if( ! exists $self->attributes->{CaptureArgs} ) { |
163 | # If there are no defined capture args, thats considered 0. |
164 | return 0; |
165 | } elsif(!defined($self->attributes->{CaptureArgs}[0])) { |
166 | # If you fail to give a defined value, that's also 0 |
167 | return 0; |
168 | } elsif( |
169 | scalar(@{$self->attributes->{CaptureArgs}}) == 1 && |
170 | looks_like_number($self->attributes->{CaptureArgs}[0]) |
171 | ) { |
172 | # 'Old school' numbered captures |
173 | return $self->attributes->{CaptureArgs}[0]; |
174 | } else { |
175 | # New hotness named arg constraints |
176 | return $self->number_of_captures_constraints; |
177 | } |
178 | } |
179 | |
180 | |
2055d9ad |
181 | use overload ( |
182 | |
183 | # Stringify to reverse for debug output etc. |
184 | q{""} => sub { shift->{reverse} }, |
185 | |
186 | # Codulate to execute to invoke the encapsulated action coderef |
187 | '&{}' => sub { my $self = shift; sub { $self->execute(@_); }; }, |
188 | |
189 | # Make general $stuff still work |
190 | fallback => 1, |
191 | |
192 | ); |
193 | |
059c085b |
194 | no warnings 'recursion'; |
195 | |
b2ddf6d7 |
196 | sub dispatch { # Execute ourselves against a context |
197 | my ( $self, $c ) = @_; |
049f82e2 |
198 | return $c->execute( $self->class, $self ); |
b2ddf6d7 |
199 | } |
fbcc39ad |
200 | |
b2ddf6d7 |
201 | sub execute { |
202 | my $self = shift; |
059c085b |
203 | $self->code->(@_); |
b2ddf6d7 |
204 | } |
fbcc39ad |
205 | |
b2ddf6d7 |
206 | sub match { |
60034b8c |
207 | my ( $self, $c ) = @_; |
81436df9 |
208 | |
d4e8996f |
209 | # If infinite args, we always match |
210 | return 1 if $self->normalized_arg_number == ~0; |
211 | |
212 | # There there are arg constraints, we must see to it that the constraints |
213 | # check positive for each arg in the list. |
5d198e3f |
214 | if($self->has_args_constraints) { |
4a0218ca |
215 | # If there is only one type constraint, and its a Ref or subtype of Ref, |
216 | # That means we expect a reference, so use the full args arrayref. |
217 | if( |
218 | $self->number_of_args_constraints == 1 && |
a7ab9aa9 |
219 | ( |
220 | $self->args_constraints->[0]->is_a_type_of('Ref') || |
221 | $self->args_constraints->[0]->is_a_type_of('ClassName') |
222 | ) |
4a0218ca |
223 | ) { |
6f0b85d2 |
224 | return 1 if $self->args_constraints->[0]->check($c->req->args); |
a7ab9aa9 |
225 | # Removing coercion stuff for the first go |
226 | #if($self->args_constraints->[0]->coercion && $self->attributes->{Coerce}) { |
227 | # my $coerced = $self->args_constraints->[0]->coerce($c) || return 0; |
228 | # $c->req->args([$coerced]); |
229 | # return 1; |
230 | #} |
4a0218ca |
231 | } else { |
a82c96cf |
232 | # Because of the way chaining works, we can expect args that are totally not |
233 | # what you'd expect length wise. When they don't match length, thats a fail |
234 | return 0 unless scalar( @{ $c->req->args } ) == $self->normalized_arg_number; |
235 | |
e5604544 |
236 | for my $i(0..$#{ $c->req->args }) { |
4a0218ca |
237 | $self->args_constraints->[$i]->check($c->req->args->[$i]) || return 0; |
238 | } |
239 | return 1; |
6d62355b |
240 | } |
6d62355b |
241 | } else { |
d4e8996f |
242 | # Otherwise, we just need to match the number of args. |
243 | return scalar( @{ $c->req->args } ) == $self->normalized_arg_number; |
6d62355b |
244 | } |
760d121e |
245 | } |
246 | |
a82c96cf |
247 | sub match_captures { |
248 | my ($self, $c, $captures) = @_; |
249 | my @captures = @{$captures||[]}; |
250 | |
251 | return 1 unless scalar(@captures); # If none, just say its ok |
252 | |
253 | if($self->has_captures_constraints) { |
254 | if( |
255 | $self->number_of_captures_constraints == 1 && |
256 | ( |
257 | $self->captures_constraints->[0]->is_a_type_of('Ref') || |
258 | $self->captures_constraints->[0]->is_a_type_of('ClassName') |
259 | ) |
260 | ) { |
261 | return 1 if $self->captures_constraints->[0]->check($c->req->args); |
262 | } else { |
263 | for my $i(0..$#captures) { |
264 | $self->captures_constraints->[$i]->check($captures[$i]) || return 0; |
265 | } |
266 | return 1; |
267 | } |
268 | } else { |
269 | return 1; |
270 | } |
271 | return 1; |
272 | } |
fbcc39ad |
273 | |
05b47f2e |
274 | sub compare { |
275 | my ($a1, $a2) = @_; |
d4e8996f |
276 | return $a1->normalized_arg_number <=> $a2->normalized_arg_number; |
05b47f2e |
277 | } |
278 | |
342d2169 |
279 | sub scheme { |
280 | return exists $_[0]->attributes->{Scheme} ? $_[0]->attributes->{Scheme}[0] : undef; |
281 | } |
282 | |
ffca3e96 |
283 | sub list_extra_info { |
284 | my $self = shift; |
285 | return { |
a82c96cf |
286 | Args => $self->normalized_arg_number, |
ffca3e96 |
287 | CaptureArgs => $self->number_of_captures, |
288 | } |
289 | } |
3c0da3ec |
290 | |
e5ecd5bc |
291 | __PACKAGE__->meta->make_immutable; |
292 | |
b2ddf6d7 |
293 | 1; |
fbcc39ad |
294 | |
b2ddf6d7 |
295 | __END__ |
4ab87e27 |
296 | |
fbcc39ad |
297 | =head1 METHODS |
298 | |
b5ecfcf0 |
299 | =head2 attributes |
fbcc39ad |
300 | |
4ab87e27 |
301 | The sub attributes that are set for this action, like Local, Path, Private |
b2ddf6d7 |
302 | and so on. This determines how the action is dispatched to. |
4ab87e27 |
303 | |
b5ecfcf0 |
304 | =head2 class |
b96f127f |
305 | |
4d38cb07 |
306 | Returns the name of the component where this action is defined. |
f9818250 |
307 | Derived by calling the L<catalyst_component_name|Catalyst::Component/catalyst_component_name> |
fb0c5b21 |
308 | method on each component. |
4ab87e27 |
309 | |
b5ecfcf0 |
310 | =head2 code |
11bd4e3e |
311 | |
b2ddf6d7 |
312 | Returns a code reference to this action. |
4ab87e27 |
313 | |
b8f669f3 |
314 | =head2 dispatch( $c ) |
4ab87e27 |
315 | |
18a9655c |
316 | Dispatch this action against a context. |
fbcc39ad |
317 | |
b8f669f3 |
318 | =head2 execute( $controller, $c, @args ) |
319 | |
320 | Execute this action's coderef against a given controller with a given |
321 | context and arguments |
322 | |
649fd1fa |
323 | =head2 match( $c ) |
4ab87e27 |
324 | |
649fd1fa |
325 | Check Args attribute, and makes sure number of args matches the setting. |
b2ddf6d7 |
326 | Always returns true if Args is omitted. |
4082e678 |
327 | |
760d121e |
328 | =head2 match_captures ($c, $captures) |
329 | |
330 | Can be implemented by action class and action role authors. If the method |
331 | exists, then it will be called with the request context and an array reference |
332 | of the captures for this action. |
333 | |
334 | Returning true from this method causes the chain match to continue, returning |
335 | makes the chain not match (and alternate, less preferred chains will be attempted). |
336 | |
6f0b85d2 |
337 | =head2 resolve_type_constraint |
338 | |
339 | Trys to find a type constraint if you have on on a type constrained method. |
760d121e |
340 | |
91955398 |
341 | =head2 compare |
342 | |
cbe555e8 |
343 | Compares 2 actions based on the value of the C<Args> attribute, with no C<Args> |
344 | having the highest precedence. |
91955398 |
345 | |
b5ecfcf0 |
346 | =head2 namespace |
fbcc39ad |
347 | |
4ab87e27 |
348 | Returns the private namespace this action lives in. |
349 | |
b5ecfcf0 |
350 | =head2 reverse |
6b239949 |
351 | |
4ab87e27 |
352 | Returns the private path for this action. |
353 | |
009b5b23 |
354 | =head2 private_path |
355 | |
356 | Returns absolute private path for this action. Unlike C<reverse>, the |
357 | C<private_path> of an action is always suitable for passing to C<forward>. |
358 | |
b5ecfcf0 |
359 | =head2 name |
fbcc39ad |
360 | |
18a9655c |
361 | Returns the sub name of this action. |
4ab87e27 |
362 | |
0cff119a |
363 | =head2 number_of_args |
364 | |
d4e8996f |
365 | Returns the number of args this action expects. This is 0 if the action doesn't |
366 | take any arguments and undef if it will take any number of arguments. |
367 | |
368 | =head2 normalized_arg_number |
369 | |
370 | For the purposes of comparison we normalize 'number_of_args' so that if it is |
371 | undef we mean ~0 (as many args are we can think of). |
0cff119a |
372 | |
373 | =head2 number_of_captures |
374 | |
375 | Returns the number of captures this action expects for L<Chained|Catalyst::DispatchType::Chained> actions. |
376 | |
3c0da3ec |
377 | =head2 list_extra_info |
378 | |
ffca3e96 |
379 | A HashRef of key-values that an action can provide to a debugging screen |
3c0da3ec |
380 | |
342d2169 |
381 | =head2 scheme |
382 | |
383 | Any defined scheme for the action |
384 | |
059c085b |
385 | =head2 meta |
386 | |
18a9655c |
387 | Provided by Moose. |
059c085b |
388 | |
2f381252 |
389 | =head1 AUTHORS |
fbcc39ad |
390 | |
2f381252 |
391 | Catalyst Contributors, see Catalyst.pm |
fbcc39ad |
392 | |
393 | =head1 COPYRIGHT |
394 | |
536bee89 |
395 | This library is free software. You can redistribute it and/or modify it under |
fbcc39ad |
396 | the same terms as Perl itself. |
397 | |
85d9fce6 |
398 | =cut |
81436df9 |
399 | |
400 | |