Release commit for 5.90128
[catagits/Catalyst-Runtime.git] / lib / Catalyst / Action.pm
CommitLineData
fbcc39ad 1package Catalyst::Action;
2
b2ddf6d7 3=head1 NAME
4
5Catalyst::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 15This class represents a Catalyst Action. You can access the object for the
b2ddf6d7 16currently dispatched action via $c->action. See the L<Catalyst::Dispatcher>
17for more information on how actions are dispatched. Actions are defined in
18L<Catalyst::Controller> subclasses.
19
20=cut
21
059c085b 22use Moose;
59051400 23use Scalar::Util 'looks_like_number', 'blessed';
6d62355b 24use Moose::Util::TypeConstraints ();
241edc9b 25with 'MooseX::Emulate::Class::Accessor::Fast';
05b47f2e 26use namespace::clean -except => 'meta';
241edc9b 27
5fb12dbb 28has class => (is => 'rw');
29has namespace => (is => 'rw');
30has 'reverse' => (is => 'rw');
31has attributes => (is => 'rw');
32has name => (is => 'rw');
33has code => (is => 'rw');
009b5b23 34has private_path => (
35 reader => 'private_path',
36 isa => 'Str',
37 lazy => 1,
38 required => 1,
39 default => sub { '/'.shift->reverse },
40);
059c085b 41
81436df9 42has 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;
1d00b2ff 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 70sub normalized_arg_number {
5dd46e24 71 return $_[0]->number_of_args;
72}
73
74sub comparable_arg_number {
d4e8996f 75 return defined($_[0]->number_of_args) ? $_[0]->number_of_args : ~0;
76}
77
bf4f1643 78has number_of_args_constraints => (
79 is=>'ro',
80 isa=>'Int|Undef',
81 init_arg=>undef,
82 required=>1,
83 lazy=>1,
84 builder=>'_build_number_of_args_constraints');
85
86 sub _build_number_of_args_constraints {
87 my $self = shift;
88 return unless $self->has_args_constraints;
89
d9f0a350 90 # If there is one constraint and its a ref, we need to decide
91 # if this number 'unknown' number or if the ref allows us to
92 # determine a length.
93
94 if(scalar @{$self->args_constraints} == 1) {
95 my $tc = $self->args_constraints->[0];
96 if(
97 $tc->can('is_strictly_a_type_of') &&
98 $tc->is_strictly_a_type_of('Tuple'))
99 {
100 my @parameters = @{ $tc->parameters||[]};
101 if( defined($parameters[-1]) and exists($parameters[-1]->{slurpy})) {
bf4f1643 102 return undef;
d9f0a350 103 } else {
104 return my $total_params = scalar(@parameters);
bf4f1643 105 }
d9f0a350 106 } elsif($tc->is_a_type_of('Ref')) {
107 return undef;
bf4f1643 108 } else {
d9f0a350 109 return 1; # Its a normal 1 arg type constraint.
bf4f1643 110 }
d9f0a350 111 } else {
79fb8f95 112 # We need to loop through and error on ref types. We don't allow a ref type
d9f0a350 113 # in the middle.
114 my $total = 0;
115 foreach my $tc( @{$self->args_constraints}) {
116 if($tc->is_a_type_of('Ref')) {
117 die "$tc is a Ref type constraint. You cannot mix Ref and non Ref type constraints in Args for action ${\$self->reverse}";
118 } else {
119 ++$total;
120 }
121 }
122 return $total;
bf4f1643 123 }
bf4f1643 124 }
125
6d62355b 126has args_constraints => (
127 is=>'ro',
81436df9 128 init_arg=>undef,
6d62355b 129 traits=>['Array'],
130 isa=>'ArrayRef',
131 required=>1,
132 lazy=>1,
133 builder=>'_build_args_constraints',
134 handles => {
135 has_args_constraints => 'count',
bf4f1643 136 args_constraint_count => 'count',
5dd46e24 137 all_args_constraints => 'elements',
6d62355b 138 });
139
140 sub _build_args_constraints {
141 my $self = shift;
142 my @arg_protos = @{$self->attributes->{Args}||[]};
143
144 return [] unless scalar(@arg_protos);
79b7db20 145 return [] unless defined($arg_protos[0]);
146
6d62355b 147 # If there is only one arg and it looks like a number
148 # we assume its 'classic' and the number is the number of
149 # constraints.
150 my @args = ();
151 if(
152 scalar(@arg_protos) == 1 &&
153 looks_like_number($arg_protos[0])
154 ) {
81436df9 155 return \@args;
6d62355b 156 } else {
4a0218ca 157 @args =
bf4f1643 158 map { my @tc = $self->resolve_type_constraint($_); scalar(@tc) ? @tc : die "$_ is not a constraint!" }
337a627a 159 @arg_protos;
6d62355b 160 }
6d62355b 161 return \@args;
162 }
163
bf4f1643 164has number_of_captures_constraints => (
165 is=>'ro',
166 isa=>'Int|Undef',
167 init_arg=>undef,
168 required=>1,
169 lazy=>1,
170 builder=>'_build_number_of_capture_constraints');
171
172 sub _build_number_of_capture_constraints {
173 my $self = shift;
174 return unless $self->has_captures_constraints;
175
d9f0a350 176 # If there is one constraint and its a ref, we need to decide
177 # if this number 'unknown' number or if the ref allows us to
178 # determine a length.
179
180 if(scalar @{$self->captures_constraints} == 1) {
181 my $tc = $self->captures_constraints->[0];
182 if(
183 $tc->can('is_strictly_a_type_of') &&
184 $tc->is_strictly_a_type_of('Tuple'))
185 {
186 my @parameters = @{ $tc->parameters||[]};
187 if( defined($parameters[-1]) and exists($parameters[-1]->{slurpy})) {
188 return undef;
bf4f1643 189 } else {
d9f0a350 190 return my $total_params = scalar(@parameters);
bf4f1643 191 }
d9f0a350 192 } elsif($tc->is_a_type_of('Ref')) {
193 die "You cannot use CaptureArgs($tc) in ${\$self->reverse} because we cannot determined the number of its parameters";
bf4f1643 194 } else {
d9f0a350 195 return 1; # Its a normal 1 arg type constraint.
196 }
197 } else {
79fb8f95 198 # We need to loop through and error on ref types. We don't allow a ref type
d9f0a350 199 # in the middle.
200 my $total = 0;
201 foreach my $tc( @{$self->captures_constraints}) {
202 if($tc->is_a_type_of('Ref')) {
203 die "$tc is a Ref type constraint. You cannot mix Ref and non Ref type constraints in CaptureArgs for action ${\$self->reverse}";
204 } else {
205 ++$total;
206 }
bf4f1643 207 }
d9f0a350 208 return $total;
bf4f1643 209 }
bf4f1643 210 }
211
a82c96cf 212has captures_constraints => (
213 is=>'ro',
214 init_arg=>undef,
215 traits=>['Array'],
216 isa=>'ArrayRef',
217 required=>1,
218 lazy=>1,
219 builder=>'_build_captures_constraints',
220 handles => {
221 has_captures_constraints => 'count',
bf4f1643 222 captures_constraints_count => 'count',
5dd46e24 223 all_captures_constraints => 'elements',
a82c96cf 224 });
225
226 sub _build_captures_constraints {
227 my $self = shift;
228 my @arg_protos = @{$self->attributes->{CaptureArgs}||[]};
229
230 return [] unless scalar(@arg_protos);
79b7db20 231 return [] unless defined($arg_protos[0]);
a82c96cf 232 # If there is only one arg and it looks like a number
233 # we assume its 'classic' and the number is the number of
234 # constraints.
235 my @args = ();
236 if(
237 scalar(@arg_protos) == 1 &&
238 looks_like_number($arg_protos[0])
239 ) {
240 return \@args;
241 } else {
242 @args =
bf4f1643 243 map { my @tc = $self->resolve_type_constraint($_); scalar(@tc) ? @tc : die "$_ is not a constraint!" }
a82c96cf 244 @arg_protos;
245 }
246
247 return \@args;
248 }
249
842180f7 250sub resolve_type_constraint {
251 my ($self, $name) = @_;
59051400 252
253 if(defined($name) && blessed($name) && $name->can('check')) {
254 # Its already a TC, good to go.
255 return $name;
256 }
257
d2995a76 258 # This is broken for when there is more than one constraint
59051400 259 if($name=~m/::/) {
260 eval "use Type::Registry; 1" || die "Can't resolve type constraint $name without installing Type::Tiny";
261 my $tc = Type::Registry->new->foreign_lookup($name);
d2995a76 262 return defined $tc ? $tc : die "'$name' not a full namespace type constraint in ${\$self->private_path}";
59051400 263 }
88e5a8b0 264
d2995a76 265 my @tc = grep { defined $_ } (eval("package ${\$self->class}; $name"));
59051400 266
d2995a76 267 unless(scalar @tc) {
59051400 268 # ok... so its not defined in the package. we need to look at all the roles
269 # and superclasses, look for attributes and figure it out.
270 # Superclasses take precedence;
d2995a76 271
a521afcc 272 my @supers = $self->class->can('meta') ? map { $_->meta } $self->class->meta->superclasses : ();
273 my @roles = $self->class->can('meta') ? $self->class->meta->calculate_all_roles : ();
59051400 274
79fb8f95 275 # So look through all the super and roles in order and return the
59051400 276 # first type constraint found. We should probably find all matching
277 # type constraints and try to do some sort of resolution.
278
279 foreach my $parent (@roles, @supers) {
280 if(my $m = $parent->get_method($self->name)) {
281 if($m->can('attributes')) {
282 my ($key, $value) = map { $_ =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ }
283 grep { $_=~/^Args\(/ or $_=~/^CaptureArgs\(/ }
284 @{$m->attributes};
285 next unless $value eq $name;
286 my @tc = eval "package ${\$parent->name}; $name";
d2995a76 287 if(scalar(@tc)) {
288 return map { ref($_) ? $_ : Moose::Util::TypeConstraints::find_or_parse_type_constraint($_) } @tc;
289 } else {
290 return;
291 }
88e5a8b0 292 }
59051400 293 }
294 }
88e5a8b0 295
a521afcc 296 my $classes = join(',', $self->class, @roles, @supers);
297 die "'$name' not a type constraint in '${\$self->private_path}', Looked in: $classes";
d2995a76 298 }
59051400 299
d2995a76 300 if(scalar(@tc)) {
75ce30d0 301 return map { ref($_) ? $_ : Moose::Util::TypeConstraints::find_or_parse_type_constraint($_) } @tc;
302 } else {
303 return;
304 }
842180f7 305}
306
a82c96cf 307has number_of_captures => (
308 is=>'ro',
309 init_arg=>undef,
310 isa=>'Int',
311 required=>1,
312 lazy=>1,
313 builder=>'_build_number_of_captures');
314
315 sub _build_number_of_captures {
316 my $self = shift;
317 if( ! exists $self->attributes->{CaptureArgs} ) {
318 # If there are no defined capture args, thats considered 0.
319 return 0;
320 } elsif(!defined($self->attributes->{CaptureArgs}[0])) {
321 # If you fail to give a defined value, that's also 0
322 return 0;
323 } elsif(
324 scalar(@{$self->attributes->{CaptureArgs}}) == 1 &&
325 looks_like_number($self->attributes->{CaptureArgs}[0])
326 ) {
327 # 'Old school' numbered captures
328 return $self->attributes->{CaptureArgs}[0];
329 } else {
330 # New hotness named arg constraints
331 return $self->number_of_captures_constraints;
332 }
333 }
334
335
2055d9ad 336use overload (
337
338 # Stringify to reverse for debug output etc.
339 q{""} => sub { shift->{reverse} },
340
341 # Codulate to execute to invoke the encapsulated action coderef
342 '&{}' => sub { my $self = shift; sub { $self->execute(@_); }; },
343
344 # Make general $stuff still work
345 fallback => 1,
346
347);
348
059c085b 349no warnings 'recursion';
350
b2ddf6d7 351sub dispatch { # Execute ourselves against a context
352 my ( $self, $c ) = @_;
049f82e2 353 return $c->execute( $self->class, $self );
b2ddf6d7 354}
fbcc39ad 355
b2ddf6d7 356sub execute {
357 my $self = shift;
059c085b 358 $self->code->(@_);
b2ddf6d7 359}
fbcc39ad 360
b2ddf6d7 361sub match {
60034b8c 362 my ( $self, $c ) = @_;
c1192f1e 363 return $self->match_args($c, $c->req->args);
364}
365
366sub match_args {
367 my ($self, $c, $args) = @_;
368 my @args = @{$args||[]};
81436df9 369
d4e8996f 370 # There there are arg constraints, we must see to it that the constraints
371 # check positive for each arg in the list.
5d198e3f 372 if($self->has_args_constraints) {
4a0218ca 373 # If there is only one type constraint, and its a Ref or subtype of Ref,
374 # That means we expect a reference, so use the full args arrayref.
375 if(
bf4f1643 376 $self->args_constraint_count == 1 &&
a7ab9aa9 377 (
378 $self->args_constraints->[0]->is_a_type_of('Ref') ||
379 $self->args_constraints->[0]->is_a_type_of('ClassName')
380 )
4a0218ca 381 ) {
d9f0a350 382 # Ok, the the type constraint is a ref type, which is allowed to have
383 # any number of args. We need to check the arg length, if one is defined.
384 # If we had a ref type constraint that allowed us to determine the allowed
385 # number of args, we need to match that number. Otherwise if there was an
386 # undetermined number (~0) then we allow all the args. This is more of an
387 # Optimization since Tuple[Int, Int] would fail on 3,4,5 anyway, but this
388 # way we can avoid calling the constraint when the arg length is incorrect.
389 if(
5dd46e24 390 $self->comparable_arg_number == ~0 ||
391 scalar( @args ) == $self->comparable_arg_number
d9f0a350 392 ) {
393 return $self->args_constraints->[0]->check($args);
394 } else {
395 return 0;
396 }
a7ab9aa9 397 # Removing coercion stuff for the first go
398 #if($self->args_constraints->[0]->coercion && $self->attributes->{Coerce}) {
399 # my $coerced = $self->args_constraints->[0]->coerce($c) || return 0;
400 # $c->req->args([$coerced]);
401 # return 1;
402 #}
4a0218ca 403 } else {
a82c96cf 404 # Because of the way chaining works, we can expect args that are totally not
405 # what you'd expect length wise. When they don't match length, thats a fail
5dd46e24 406 return 0 unless scalar( @args ) == $self->comparable_arg_number;
a82c96cf 407
c1192f1e 408 for my $i(0..$#args) {
409 $self->args_constraints->[$i]->check($args[$i]) || return 0;
4a0218ca 410 }
411 return 1;
6d62355b 412 }
6d62355b 413 } else {
d9f0a350 414 # If infinite args with no constraints, we always match
5dd46e24 415 return 1 if $self->comparable_arg_number == ~0;
d9f0a350 416
d4e8996f 417 # Otherwise, we just need to match the number of args.
5dd46e24 418 return scalar( @args ) == $self->comparable_arg_number;
6d62355b 419 }
760d121e 420}
421
a82c96cf 422sub match_captures {
423 my ($self, $c, $captures) = @_;
424 my @captures = @{$captures||[]};
425
426 return 1 unless scalar(@captures); # If none, just say its ok
ec4d7259 427 return $self->has_captures_constraints ?
428 $self->match_captures_constraints($c, $captures) : 1;
a82c96cf 429
ec4d7259 430 return 1;
431}
432
433sub match_captures_constraints {
434 my ($self, $c, $captures) = @_;
435 my @captures = @{$captures||[]};
436
437 # Match is positive if you don't have any.
438 return 1 unless $self->has_captures_constraints;
439
440 if(
441 $self->captures_constraints_count == 1 &&
442 (
443 $self->captures_constraints->[0]->is_a_type_of('Ref') ||
444 $self->captures_constraints->[0]->is_a_type_of('ClassName')
445 )
446 ) {
447 return $self->captures_constraints->[0]->check($captures);
a82c96cf 448 } else {
ec4d7259 449 for my $i(0..$#captures) {
450 $self->captures_constraints->[$i]->check($captures[$i]) || return 0;
451 }
a82c96cf 452 return 1;
ec4d7259 453 }
454
a82c96cf 455}
fbcc39ad 456
ec4d7259 457
05b47f2e 458sub compare {
459 my ($a1, $a2) = @_;
5dd46e24 460 return $a1->comparable_arg_number <=> $a2->comparable_arg_number;
05b47f2e 461}
462
62864794 463sub equals {
464 my ($self, $target) = @_;
465 return $self->private_path eq $target->private_path ? $self : 0;
466}
467
342d2169 468sub scheme {
469 return exists $_[0]->attributes->{Scheme} ? $_[0]->attributes->{Scheme}[0] : undef;
470}
471
ffca3e96 472sub list_extra_info {
473 my $self = shift;
474 return {
356e7503 475 Args => $self->normalized_arg_number,
ffca3e96 476 CaptureArgs => $self->number_of_captures,
477 }
88e5a8b0 478}
3c0da3ec 479
e5ecd5bc 480__PACKAGE__->meta->make_immutable;
481
b2ddf6d7 4821;
fbcc39ad 483
b2ddf6d7 484__END__
4ab87e27 485
fbcc39ad 486=head1 METHODS
487
b5ecfcf0 488=head2 attributes
fbcc39ad 489
4ab87e27 490The sub attributes that are set for this action, like Local, Path, Private
b2ddf6d7 491and so on. This determines how the action is dispatched to.
4ab87e27 492
b5ecfcf0 493=head2 class
b96f127f 494
4d38cb07 495Returns the name of the component where this action is defined.
f9818250 496Derived by calling the L<catalyst_component_name|Catalyst::Component/catalyst_component_name>
fb0c5b21 497method on each component.
4ab87e27 498
b5ecfcf0 499=head2 code
11bd4e3e 500
b2ddf6d7 501Returns a code reference to this action.
4ab87e27 502
b8f669f3 503=head2 dispatch( $c )
4ab87e27 504
18a9655c 505Dispatch this action against a context.
fbcc39ad 506
b8f669f3 507=head2 execute( $controller, $c, @args )
508
509Execute this action's coderef against a given controller with a given
510context and arguments
511
649fd1fa 512=head2 match( $c )
4ab87e27 513
649fd1fa 514Check Args attribute, and makes sure number of args matches the setting.
b2ddf6d7 515Always returns true if Args is omitted.
4082e678 516
760d121e 517=head2 match_captures ($c, $captures)
518
519Can be implemented by action class and action role authors. If the method
520exists, then it will be called with the request context and an array reference
521of the captures for this action.
522
523Returning true from this method causes the chain match to continue, returning
524makes the chain not match (and alternate, less preferred chains will be attempted).
525
ec4d7259 526=head2 match_captures_constraints ($c, \@captures);
527
528Does the \@captures given match any constraints (if any constraints exist). Returns
529true if you ask but there are no constraints.
530
c1192f1e 531=head2 match_args($c, $args)
532
75ce30d0 533Does the Args match or not?
c1192f1e 534
6f0b85d2 535=head2 resolve_type_constraint
536
79fb8f95 537Tries to find a type constraint if you have on on a type constrained method.
760d121e 538
91955398 539=head2 compare
540
cbe555e8 541Compares 2 actions based on the value of the C<Args> attribute, with no C<Args>
542having the highest precedence.
91955398 543
763d179f 544=head2 equals
62864794 545
546 if( $action->equal($other_action) ) { ... }
547
548Returns true if the two actions are equal.
549
b5ecfcf0 550=head2 namespace
fbcc39ad 551
4ab87e27 552Returns the private namespace this action lives in.
553
b5ecfcf0 554=head2 reverse
6b239949 555
4ab87e27 556Returns the private path for this action.
557
009b5b23 558=head2 private_path
559
560Returns absolute private path for this action. Unlike C<reverse>, the
561C<private_path> of an action is always suitable for passing to C<forward>.
562
b5ecfcf0 563=head2 name
fbcc39ad 564
18a9655c 565Returns the sub name of this action.
4ab87e27 566
0cff119a 567=head2 number_of_args
568
d4e8996f 569Returns the number of args this action expects. This is 0 if the action doesn't
570take any arguments and undef if it will take any number of arguments.
571
572=head2 normalized_arg_number
573
5dd46e24 574The number of arguments (starting with zero) that the current action defines, or
575undefined if there is not defined number of args (which is later treated as, "
576as many arguments as you like").
577
578=head2 comparable_arg_number
579
d4e8996f 580For the purposes of comparison we normalize 'number_of_args' so that if it is
581undef we mean ~0 (as many args are we can think of).
0cff119a 582
583=head2 number_of_captures
584
585Returns the number of captures this action expects for L<Chained|Catalyst::DispatchType::Chained> actions.
586
3c0da3ec 587=head2 list_extra_info
588
ffca3e96 589A HashRef of key-values that an action can provide to a debugging screen
3c0da3ec 590
342d2169 591=head2 scheme
592
593Any defined scheme for the action
594
059c085b 595=head2 meta
596
18a9655c 597Provided by Moose.
059c085b 598
2f381252 599=head1 AUTHORS
fbcc39ad 600
2f381252 601Catalyst Contributors, see Catalyst.pm
fbcc39ad 602
603=head1 COPYRIGHT
604
536bee89 605This library is free software. You can redistribute it and/or modify it under
fbcc39ad 606the same terms as Perl itself.
607
85d9fce6 608=cut
81436df9 609
610