1 package Catalyst::Action;
5 Catalyst::Action - Catalyst Action
9 <form action="[%c.uri_for(c.action)%]">
11 $c->forward( $action->private_path );
15 This class represents a Catalyst Action. You can access the object for the
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.
23 use Scalar::Util 'looks_like_number', 'blessed';
24 use Moose::Util::TypeConstraints ();
25 with 'MooseX::Emulate::Class::Accessor::Fast';
26 use namespace::clean -except => 'meta';
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');
35 reader => 'private_path',
39 default => sub { '/'.shift->reverse },
42 has number_of_args => (
48 builder=>'_build_number_of_args');
50 sub _build_number_of_args {
52 if( ! exists $self->attributes->{Args} ) {
53 # When 'Args' does not exist, that means we want 'any number of args'.
55 } elsif(!defined($self->attributes->{Args}[0])) {
56 # When its 'Args' that internal cue for 'unlimited'
59 scalar(@{$self->attributes->{Args}}) == 1 &&
60 looks_like_number($self->attributes->{Args}[0])
62 # 'Old school' numbered args (is allowed to be undef as well)
63 return $self->attributes->{Args}[0];
65 # New hotness named arg constraints
66 return $self->number_of_args_constraints;
70 sub normalized_arg_number {
71 return defined($_[0]->number_of_args) ? $_[0]->number_of_args : ~0;
74 has number_of_args_constraints => (
80 builder=>'_build_number_of_args_constraints');
82 sub _build_number_of_args_constraints {
84 return unless $self->has_args_constraints;
86 # If there is one constraint and its a ref, we need to decide
87 # if this number 'unknown' number or if the ref allows us to
90 if(scalar @{$self->args_constraints} == 1) {
91 my $tc = $self->args_constraints->[0];
93 $tc->can('is_strictly_a_type_of') &&
94 $tc->is_strictly_a_type_of('Tuple'))
96 my @parameters = @{ $tc->parameters||[]};
97 if( defined($parameters[-1]) and exists($parameters[-1]->{slurpy})) {
100 return my $total_params = scalar(@parameters);
102 } elsif($tc->is_a_type_of('Ref')) {
105 return 1; # Its a normal 1 arg type constraint.
108 # We need to loop through and error on ref types. We don't allow a ref type
111 foreach my $tc( @{$self->args_constraints}) {
112 if($tc->is_a_type_of('Ref')) {
113 die "$tc is a Ref type constraint. You cannot mix Ref and non Ref type constraints in Args for action ${\$self->reverse}";
122 has args_constraints => (
129 builder=>'_build_args_constraints',
131 has_args_constraints => 'count',
132 args_constraint_count => 'count',
135 sub _build_args_constraints {
137 my @arg_protos = @{$self->attributes->{Args}||[]};
139 return [] unless scalar(@arg_protos);
140 return [] unless defined($arg_protos[0]);
142 # If there is only one arg and it looks like a number
143 # we assume its 'classic' and the number is the number of
147 scalar(@arg_protos) == 1 &&
148 looks_like_number($arg_protos[0])
153 map { my @tc = $self->resolve_type_constraint($_); scalar(@tc) ? @tc : die "$_ is not a constraint!" }
159 has number_of_captures_constraints => (
165 builder=>'_build_number_of_capture_constraints');
167 sub _build_number_of_capture_constraints {
169 return unless $self->has_captures_constraints;
171 # If there is one constraint and its a ref, we need to decide
172 # if this number 'unknown' number or if the ref allows us to
173 # determine a length.
175 if(scalar @{$self->captures_constraints} == 1) {
176 my $tc = $self->captures_constraints->[0];
178 $tc->can('is_strictly_a_type_of') &&
179 $tc->is_strictly_a_type_of('Tuple'))
181 my @parameters = @{ $tc->parameters||[]};
182 if( defined($parameters[-1]) and exists($parameters[-1]->{slurpy})) {
185 return my $total_params = scalar(@parameters);
187 } elsif($tc->is_a_type_of('Ref')) {
188 die "You cannot use CaptureArgs($tc) in ${\$self->reverse} because we cannot determined the number of its parameters";
190 return 1; # Its a normal 1 arg type constraint.
193 # We need to loop through and error on ref types. We don't allow a ref type
196 foreach my $tc( @{$self->captures_constraints}) {
197 if($tc->is_a_type_of('Ref')) {
198 die "$tc is a Ref type constraint. You cannot mix Ref and non Ref type constraints in CaptureArgs for action ${\$self->reverse}";
207 has captures_constraints => (
214 builder=>'_build_captures_constraints',
216 has_captures_constraints => 'count',
217 captures_constraints_count => 'count',
220 sub _build_captures_constraints {
222 my @arg_protos = @{$self->attributes->{CaptureArgs}||[]};
224 return [] unless scalar(@arg_protos);
225 return [] unless defined($arg_protos[0]);
226 # If there is only one arg and it looks like a number
227 # we assume its 'classic' and the number is the number of
231 scalar(@arg_protos) == 1 &&
232 looks_like_number($arg_protos[0])
237 map { my @tc = $self->resolve_type_constraint($_); scalar(@tc) ? @tc : die "$_ is not a constraint!" }
244 sub resolve_type_constraint {
245 my ($self, $name) = @_;
247 if(defined($name) && blessed($name) && $name->can('check')) {
248 # Its already a TC, good to go.
252 # This is broken for when there is more than one constraint
254 eval "use Type::Registry; 1" || die "Can't resolve type constraint $name without installing Type::Tiny";
255 my $tc = Type::Registry->new->foreign_lookup($name);
256 return defined $tc ? $tc : die "'$name' not a full namespace type constraint in ${\$self->private_path}";
259 my @tc = grep { defined $_ } (eval("package ${\$self->class}; $name"));
262 # ok... so its not defined in the package. we need to look at all the roles
263 # and superclasses, look for attributes and figure it out.
264 # Superclasses take precedence;
266 my @supers = $self->class->can('meta') ? map { $_->meta } $self->class->meta->superclasses : ();
267 my @roles = $self->class->can('meta') ? $self->class->meta->calculate_all_roles : ();
269 # So look through all the super and roles in order and return the
270 # first type constraint found. We should probably find all matching
271 # type constraints and try to do some sort of resolution.
273 foreach my $parent (@roles, @supers) {
274 if(my $m = $parent->get_method($self->name)) {
275 if($m->can('attributes')) {
276 my ($key, $value) = map { $_ =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ }
277 grep { $_=~/^Args\(/ or $_=~/^CaptureArgs\(/ }
279 next unless $value eq $name;
280 my @tc = eval "package ${\$parent->name}; $name";
282 return map { ref($_) ? $_ : Moose::Util::TypeConstraints::find_or_parse_type_constraint($_) } @tc;
290 my $classes = join(',', $self->class, @roles, @supers);
291 die "'$name' not a type constraint in '${\$self->private_path}', Looked in: $classes";
295 return map { ref($_) ? $_ : Moose::Util::TypeConstraints::find_or_parse_type_constraint($_) } @tc;
301 has number_of_captures => (
307 builder=>'_build_number_of_captures');
309 sub _build_number_of_captures {
311 if( ! exists $self->attributes->{CaptureArgs} ) {
312 # If there are no defined capture args, thats considered 0.
314 } elsif(!defined($self->attributes->{CaptureArgs}[0])) {
315 # If you fail to give a defined value, that's also 0
318 scalar(@{$self->attributes->{CaptureArgs}}) == 1 &&
319 looks_like_number($self->attributes->{CaptureArgs}[0])
321 # 'Old school' numbered captures
322 return $self->attributes->{CaptureArgs}[0];
324 # New hotness named arg constraints
325 return $self->number_of_captures_constraints;
332 # Stringify to reverse for debug output etc.
333 q{""} => sub { shift->{reverse} },
335 # Codulate to execute to invoke the encapsulated action coderef
336 '&{}' => sub { my $self = shift; sub { $self->execute(@_); }; },
338 # Make general $stuff still work
343 no warnings 'recursion';
345 sub dispatch { # Execute ourselves against a context
346 my ( $self, $c ) = @_;
347 return $c->execute( $self->class, $self );
356 my ( $self, $c ) = @_;
357 return $self->match_args($c, $c->req->args);
361 my ($self, $c, $args) = @_;
362 my @args = @{$args||[]};
364 # There there are arg constraints, we must see to it that the constraints
365 # check positive for each arg in the list.
366 if($self->has_args_constraints) {
367 # If there is only one type constraint, and its a Ref or subtype of Ref,
368 # That means we expect a reference, so use the full args arrayref.
370 $self->args_constraint_count == 1 &&
372 $self->args_constraints->[0]->is_a_type_of('Ref') ||
373 $self->args_constraints->[0]->is_a_type_of('ClassName')
376 # Ok, the the type constraint is a ref type, which is allowed to have
377 # any number of args. We need to check the arg length, if one is defined.
378 # If we had a ref type constraint that allowed us to determine the allowed
379 # number of args, we need to match that number. Otherwise if there was an
380 # undetermined number (~0) then we allow all the args. This is more of an
381 # Optimization since Tuple[Int, Int] would fail on 3,4,5 anyway, but this
382 # way we can avoid calling the constraint when the arg length is incorrect.
384 $self->normalized_arg_number == ~0 ||
385 scalar( @args ) == $self->normalized_arg_number
387 return $self->args_constraints->[0]->check($args);
391 # Removing coercion stuff for the first go
392 #if($self->args_constraints->[0]->coercion && $self->attributes->{Coerce}) {
393 # my $coerced = $self->args_constraints->[0]->coerce($c) || return 0;
394 # $c->req->args([$coerced]);
398 # Because of the way chaining works, we can expect args that are totally not
399 # what you'd expect length wise. When they don't match length, thats a fail
400 return 0 unless scalar( @args ) == $self->normalized_arg_number;
402 for my $i(0..$#args) {
403 $self->args_constraints->[$i]->check($args[$i]) || return 0;
408 # If infinite args with no constraints, we always match
409 return 1 if $self->normalized_arg_number == ~0;
411 # Otherwise, we just need to match the number of args.
412 return scalar( @args ) == $self->normalized_arg_number;
417 my ($self, $c, $captures) = @_;
418 my @captures = @{$captures||[]};
420 return 1 unless scalar(@captures); # If none, just say its ok
421 return $self->has_captures_constraints ?
422 $self->match_captures_constraints($c, $captures) : 1;
427 sub match_captures_constraints {
428 my ($self, $c, $captures) = @_;
429 my @captures = @{$captures||[]};
431 # Match is positive if you don't have any.
432 return 1 unless $self->has_captures_constraints;
435 $self->captures_constraints_count == 1 &&
437 $self->captures_constraints->[0]->is_a_type_of('Ref') ||
438 $self->captures_constraints->[0]->is_a_type_of('ClassName')
441 return $self->captures_constraints->[0]->check($captures);
443 for my $i(0..$#captures) {
444 $self->captures_constraints->[$i]->check($captures[$i]) || return 0;
454 return $a1->normalized_arg_number <=> $a2->normalized_arg_number;
458 return exists $_[0]->attributes->{Scheme} ? $_[0]->attributes->{Scheme}[0] : undef;
461 sub list_extra_info {
464 Args => $self->normalized_arg_number,
465 CaptureArgs => $self->number_of_captures,
469 __PACKAGE__->meta->make_immutable;
479 The sub attributes that are set for this action, like Local, Path, Private
480 and so on. This determines how the action is dispatched to.
484 Returns the name of the component where this action is defined.
485 Derived by calling the L<catalyst_component_name|Catalyst::Component/catalyst_component_name>
486 method on each component.
490 Returns a code reference to this action.
492 =head2 dispatch( $c )
494 Dispatch this action against a context.
496 =head2 execute( $controller, $c, @args )
498 Execute this action's coderef against a given controller with a given
499 context and arguments
503 Check Args attribute, and makes sure number of args matches the setting.
504 Always returns true if Args is omitted.
506 =head2 match_captures ($c, $captures)
508 Can be implemented by action class and action role authors. If the method
509 exists, then it will be called with the request context and an array reference
510 of the captures for this action.
512 Returning true from this method causes the chain match to continue, returning
513 makes the chain not match (and alternate, less preferred chains will be attempted).
515 =head2 match_captures_constraints ($c, \@captures);
517 Does the \@captures given match any constraints (if any constraints exist). Returns
518 true if you ask but there are no constraints.
520 =head2 match_args($c, $args)
522 Does the Args match or not?
524 =head2 resolve_type_constraint
526 Tries to find a type constraint if you have on on a type constrained method.
530 Compares 2 actions based on the value of the C<Args> attribute, with no C<Args>
531 having the highest precedence.
535 Returns the private namespace this action lives in.
539 Returns the private path for this action.
543 Returns absolute private path for this action. Unlike C<reverse>, the
544 C<private_path> of an action is always suitable for passing to C<forward>.
548 Returns the sub name of this action.
550 =head2 number_of_args
552 Returns the number of args this action expects. This is 0 if the action doesn't
553 take any arguments and undef if it will take any number of arguments.
555 =head2 normalized_arg_number
557 For the purposes of comparison we normalize 'number_of_args' so that if it is
558 undef we mean ~0 (as many args are we can think of).
560 =head2 number_of_captures
562 Returns the number of captures this action expects for L<Chained|Catalyst::DispatchType::Chained> actions.
564 =head2 list_extra_info
566 A HashRef of key-values that an action can provide to a debugging screen
570 Any defined scheme for the action
578 Catalyst Contributors, see Catalyst.pm
582 This library is free software. You can redistribute it and/or modify it under
583 the same terms as Perl itself.