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'.
56 !defined($self->attributes->{Args}[0]) ||
57 $self->attributes->{Args}[0] eq '' ) {
58 # When its 'Args' that internal cue for 'unlimited'
61 scalar(@{$self->attributes->{Args}}) == 1 &&
62 looks_like_number($self->attributes->{Args}[0])
64 # 'Old school' numbered args (is allowed to be undef as well)
65 return $self->attributes->{Args}[0];
67 # New hotness named arg constraints
68 return $self->number_of_args_constraints;
72 sub normalized_arg_number {
73 return defined($_[0]->number_of_args) ? $_[0]->number_of_args : ~0;
76 has number_of_args_constraints => (
82 builder=>'_build_number_of_args_constraints');
84 sub _build_number_of_args_constraints {
86 return unless $self->has_args_constraints;
88 # If there is one constraint and its a ref, we need to decide
89 # if this number 'unknown' number or if the ref allows us to
92 if(scalar @{$self->args_constraints} == 1) {
93 my $tc = $self->args_constraints->[0];
95 $tc->can('is_strictly_a_type_of') &&
96 $tc->is_strictly_a_type_of('Tuple'))
98 my @parameters = @{ $tc->parameters||[]};
99 if( defined($parameters[-1]) and exists($parameters[-1]->{slurpy})) {
102 return my $total_params = scalar(@parameters);
104 } elsif($tc->is_a_type_of('Ref')) {
107 return 1; # Its a normal 1 arg type constraint.
110 # We need to loop through and error on ref types. We don't allow a ref type
113 foreach my $tc( @{$self->args_constraints}) {
114 if($tc->is_a_type_of('Ref')) {
115 die "$tc is a Ref type constraint. You cannot mix Ref and non Ref type constraints in Args for action ${\$self->reverse}";
124 has args_constraints => (
131 builder=>'_build_args_constraints',
133 has_args_constraints => 'count',
134 args_constraint_count => 'count',
137 sub _build_args_constraints {
139 my @arg_protos = @{$self->attributes->{Args}||[]};
141 return [] unless scalar(@arg_protos);
142 return [] unless defined($arg_protos[0]);
143 return [] if ($arg_protos[0] eq '' && scalar(@arg_protos) == 1);
145 # If there is only one arg and it looks like a number
146 # we assume its 'classic' and the number is the number of
150 scalar(@arg_protos) == 1 &&
151 looks_like_number($arg_protos[0])
156 map { my @tc = $self->resolve_type_constraint($_); scalar(@tc) ? @tc : die "$_ is not a constraint!" }
162 has number_of_captures_constraints => (
168 builder=>'_build_number_of_capture_constraints');
170 sub _build_number_of_capture_constraints {
172 return unless $self->has_captures_constraints;
174 # If there is one constraint and its a ref, we need to decide
175 # if this number 'unknown' number or if the ref allows us to
176 # determine a length.
178 if(scalar @{$self->captures_constraints} == 1) {
179 my $tc = $self->captures_constraints->[0];
181 $tc->can('is_strictly_a_type_of') &&
182 $tc->is_strictly_a_type_of('Tuple'))
184 my @parameters = @{ $tc->parameters||[]};
185 if( defined($parameters[-1]) and exists($parameters[-1]->{slurpy})) {
188 return my $total_params = scalar(@parameters);
190 } elsif($tc->is_a_type_of('Ref')) {
191 die "You cannot use CaptureArgs($tc) in ${\$self->reverse} because we cannot determined the number of its parameters";
193 return 1; # Its a normal 1 arg type constraint.
196 # We need to loop through and error on ref types. We don't allow a ref type
199 foreach my $tc( @{$self->captures_constraints}) {
200 if($tc->is_a_type_of('Ref')) {
201 die "$tc is a Ref type constraint. You cannot mix Ref and non Ref type constraints in CaptureArgs for action ${\$self->reverse}";
210 has captures_constraints => (
217 builder=>'_build_captures_constraints',
219 has_captures_constraints => 'count',
220 captures_constraints_count => 'count',
223 sub _build_captures_constraints {
225 my @arg_protos = @{$self->attributes->{CaptureArgs}||[]};
227 return [] unless scalar(@arg_protos);
228 return [] unless defined($arg_protos[0]);
229 # If there is only one arg and it looks like a number
230 # we assume its 'classic' and the number is the number of
234 scalar(@arg_protos) == 1 &&
235 looks_like_number($arg_protos[0])
240 map { my @tc = $self->resolve_type_constraint($_); scalar(@tc) ? @tc : die "$_ is not a constraint!" }
247 sub resolve_type_constraint {
248 my ($self, $name) = @_;
250 if(defined($name) && blessed($name) && $name->can('check')) {
251 # Its already a TC, good to go.
255 # This is broken for when there is more than one constraint
257 eval "use Type::Registry; 1" || die "Can't resolve type constraint $name without installing Type::Tiny";
258 my $tc = Type::Registry->new->foreign_lookup($name);
259 return defined $tc ? $tc : die "'$name' not a full namespace type constraint in ${\$self->private_path}";
262 my @tc = grep { defined $_ } (eval("package ${\$self->class}; $name"));
265 # ok... so its not defined in the package. we need to look at all the roles
266 # and superclasses, look for attributes and figure it out.
267 # Superclasses take precedence;
269 my @supers = $self->class->can('meta') ? map { $_->meta } $self->class->meta->superclasses : ();
270 my @roles = $self->class->can('meta') ? $self->class->meta->calculate_all_roles : ();
272 # So look through all the super and roles in order and return the
273 # first type constraint found. We should probably find all matching
274 # type constraints and try to do some sort of resolution.
276 foreach my $parent (@roles, @supers) {
277 if(my $m = $parent->get_method($self->name)) {
278 if($m->can('attributes')) {
279 my ($key, $value) = map { $_ =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ }
280 grep { $_=~/^Args\(/ or $_=~/^CaptureArgs\(/ }
282 next unless $value eq $name;
283 my @tc = eval "package ${\$parent->name}; $name";
285 return map { ref($_) ? $_ : Moose::Util::TypeConstraints::find_or_parse_type_constraint($_) } @tc;
293 my $classes = join(',', $self->class, @roles, @supers);
294 die "'$name' not a type constraint in '${\$self->private_path}', Looked in: $classes";
298 return map { ref($_) ? $_ : Moose::Util::TypeConstraints::find_or_parse_type_constraint($_) } @tc;
304 has number_of_captures => (
310 builder=>'_build_number_of_captures');
312 sub _build_number_of_captures {
314 if( ! exists $self->attributes->{CaptureArgs} ) {
315 # If there are no defined capture args, thats considered 0.
317 } elsif(!defined($self->attributes->{CaptureArgs}[0])) {
318 # If you fail to give a defined value, that's also 0
321 scalar(@{$self->attributes->{CaptureArgs}}) == 1 &&
322 looks_like_number($self->attributes->{CaptureArgs}[0])
324 # 'Old school' numbered captures
325 return $self->attributes->{CaptureArgs}[0];
327 # New hotness named arg constraints
328 return $self->number_of_captures_constraints;
335 # Stringify to reverse for debug output etc.
336 q{""} => sub { shift->{reverse} },
338 # Codulate to execute to invoke the encapsulated action coderef
339 '&{}' => sub { my $self = shift; sub { $self->execute(@_); }; },
341 # Make general $stuff still work
346 no warnings 'recursion';
348 sub dispatch { # Execute ourselves against a context
349 my ( $self, $c ) = @_;
350 return $c->execute( $self->class, $self );
359 my ( $self, $c ) = @_;
360 return $self->match_args($c, $c->req->args);
364 my ($self, $c, $args) = @_;
365 my @args = @{$args||[]};
367 # There there are arg constraints, we must see to it that the constraints
368 # check positive for each arg in the list.
369 if($self->has_args_constraints) {
370 # If there is only one type constraint, and its a Ref or subtype of Ref,
371 # That means we expect a reference, so use the full args arrayref.
373 $self->args_constraint_count == 1 &&
375 $self->args_constraints->[0]->is_a_type_of('Ref') ||
376 $self->args_constraints->[0]->is_a_type_of('ClassName')
379 # Ok, the the type constraint is a ref type, which is allowed to have
380 # any number of args. We need to check the arg length, if one is defined.
381 # If we had a ref type constraint that allowed us to determine the allowed
382 # number of args, we need to match that number. Otherwise if there was an
383 # undetermined number (~0) then we allow all the args. This is more of an
384 # Optimization since Tuple[Int, Int] would fail on 3,4,5 anyway, but this
385 # way we can avoid calling the constraint when the arg length is incorrect.
387 $self->normalized_arg_number == ~0 ||
388 scalar( @args ) == $self->normalized_arg_number
390 return $self->args_constraints->[0]->check($args);
394 # Removing coercion stuff for the first go
395 #if($self->args_constraints->[0]->coercion && $self->attributes->{Coerce}) {
396 # my $coerced = $self->args_constraints->[0]->coerce($c) || return 0;
397 # $c->req->args([$coerced]);
401 # Because of the way chaining works, we can expect args that are totally not
402 # what you'd expect length wise. When they don't match length, thats a fail
403 return 0 unless scalar( @args ) == $self->normalized_arg_number;
405 for my $i(0..$#args) {
406 $self->args_constraints->[$i]->check($args[$i]) || return 0;
411 # If infinite args with no constraints, we always match
412 return 1 if $self->normalized_arg_number == ~0;
414 # Otherwise, we just need to match the number of args.
415 return scalar( @args ) == $self->normalized_arg_number;
420 my ($self, $c, $captures) = @_;
421 my @captures = @{$captures||[]};
423 return 1 unless scalar(@captures); # If none, just say its ok
424 return $self->has_captures_constraints ?
425 $self->match_captures_constraints($c, $captures) : 1;
430 sub match_captures_constraints {
431 my ($self, $c, $captures) = @_;
432 my @captures = @{$captures||[]};
434 # Match is positive if you don't have any.
435 return 1 unless $self->has_captures_constraints;
438 $self->captures_constraints_count == 1 &&
440 $self->captures_constraints->[0]->is_a_type_of('Ref') ||
441 $self->captures_constraints->[0]->is_a_type_of('ClassName')
444 return $self->captures_constraints->[0]->check($captures);
446 for my $i(0..$#captures) {
447 $self->captures_constraints->[$i]->check($captures[$i]) || return 0;
457 return $a1->normalized_arg_number <=> $a2->normalized_arg_number;
461 return exists $_[0]->attributes->{Scheme} ? $_[0]->attributes->{Scheme}[0] : undef;
464 sub list_extra_info {
467 Args => $self->normalized_arg_number,
468 CaptureArgs => $self->number_of_captures,
472 __PACKAGE__->meta->make_immutable;
482 The sub attributes that are set for this action, like Local, Path, Private
483 and so on. This determines how the action is dispatched to.
487 Returns the name of the component where this action is defined.
488 Derived by calling the L<catalyst_component_name|Catalyst::Component/catalyst_component_name>
489 method on each component.
493 Returns a code reference to this action.
495 =head2 dispatch( $c )
497 Dispatch this action against a context.
499 =head2 execute( $controller, $c, @args )
501 Execute this action's coderef against a given controller with a given
502 context and arguments
506 Check Args attribute, and makes sure number of args matches the setting.
507 Always returns true if Args is omitted.
509 =head2 match_captures ($c, $captures)
511 Can be implemented by action class and action role authors. If the method
512 exists, then it will be called with the request context and an array reference
513 of the captures for this action.
515 Returning true from this method causes the chain match to continue, returning
516 makes the chain not match (and alternate, less preferred chains will be attempted).
518 =head2 match_captures_constraints ($c, \@captures);
520 Does the \@captures given match any constraints (if any constraints exist). Returns
521 true if you ask but there are no constraints.
523 =head2 match_args($c, $args)
525 Does the Args match or not?
527 =head2 resolve_type_constraint
529 Tries to find a type constraint if you have on on a type constrained method.
533 Compares 2 actions based on the value of the C<Args> attribute, with no C<Args>
534 having the highest precedence.
538 Returns the private namespace this action lives in.
542 Returns the private path for this action.
546 Returns absolute private path for this action. Unlike C<reverse>, the
547 C<private_path> of an action is always suitable for passing to C<forward>.
551 Returns the sub name of this action.
553 =head2 number_of_args
555 Returns the number of args this action expects. This is 0 if the action doesn't
556 take any arguments and undef if it will take any number of arguments.
558 =head2 normalized_arg_number
560 For the purposes of comparison we normalize 'number_of_args' so that if it is
561 undef we mean ~0 (as many args are we can think of).
563 =head2 number_of_captures
565 Returns the number of captures this action expects for L<Chained|Catalyst::DispatchType::Chained> actions.
567 =head2 list_extra_info
569 A HashRef of key-values that an action can provide to a debugging screen
573 Any defined scheme for the action
581 Catalyst Contributors, see Catalyst.pm
585 This library is free software. You can redistribute it and/or modify it under
586 the same terms as Perl itself.