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 instance => (is=>'ro', required=>0, predicate=>'has_instance');
30 has namespace => (is => 'rw');
31 has 'reverse' => (is => 'rw');
32 has attributes => (is => 'rw');
33 has name => (is => 'rw');
34 has code => (is => 'rw');
36 reader => 'private_path',
40 default => sub { '/'.shift->reverse },
43 has number_of_args => (
49 builder=>'_build_number_of_args');
51 sub _build_number_of_args {
53 if( ! exists $self->attributes->{Args} ) {
54 # When 'Args' does not exist, that means we want 'any number of args'.
56 } elsif(!defined($self->attributes->{Args}[0])) {
57 # When its 'Args' that internal cue for 'unlimited'
60 scalar(@{$self->attributes->{Args}}) == 1 &&
61 looks_like_number($self->attributes->{Args}[0])
63 # 'Old school' numbered args (is allowed to be undef as well)
64 return $self->attributes->{Args}[0];
66 # New hotness named arg constraints
67 return $self->number_of_args_constraints;
71 sub normalized_arg_number {
72 return $_[0]->number_of_args;
75 sub comparable_arg_number {
76 return defined($_[0]->number_of_args) ? $_[0]->number_of_args : ~0;
79 has number_of_args_constraints => (
85 builder=>'_build_number_of_args_constraints');
87 sub _build_number_of_args_constraints {
89 return unless $self->has_args_constraints;
91 # If there is one constraint and its a ref, we need to decide
92 # if this number 'unknown' number or if the ref allows us to
95 if(scalar @{$self->args_constraints} == 1) {
96 my $tc = $self->args_constraints->[0];
98 $tc->can('is_strictly_a_type_of') &&
99 $tc->is_strictly_a_type_of('Tuple'))
101 my @parameters = @{ $tc->parameters||[] };
102 my $final = $parameters[-1];
103 if ( defined $final ) {
104 if ( blessed $final ) {
105 # modern form of slurpy
106 if ($final->can('is_strictly_a_type_of') && $final->is_strictly_a_type_of('Slurpy')) {
112 if (ref $final eq 'HASH' && $final->{slurpy}) {
117 return scalar @parameters;
118 } elsif($tc->is_a_type_of('Ref')) {
121 return 1; # Its a normal 1 arg type constraint.
124 # We need to loop through and error on ref types. We don't allow a ref type
127 foreach my $tc( @{$self->args_constraints}) {
128 if($tc->is_a_type_of('Ref')) {
129 die "$tc is a Ref type constraint. You cannot mix Ref and non Ref type constraints in Args for action ${\$self->reverse}";
138 has args_constraints => (
145 builder=>'_build_args_constraints',
147 has_args_constraints => 'count',
148 args_constraint_count => 'count',
149 all_args_constraints => 'elements',
152 sub _build_args_constraints {
154 my @arg_protos = @{$self->attributes->{Args}||[]};
156 return [] unless scalar(@arg_protos);
157 return [] unless defined($arg_protos[0]);
159 # If there is only one arg and it looks like a number
160 # we assume its 'classic' and the number is the number of
164 scalar(@arg_protos) == 1 &&
165 looks_like_number($arg_protos[0])
170 map { my @tc = $self->resolve_type_constraint($_); scalar(@tc) ? @tc : die "$_ is not a constraint!" }
176 has number_of_captures_constraints => (
182 builder=>'_build_number_of_capture_constraints');
184 sub _build_number_of_capture_constraints {
186 return unless $self->has_captures_constraints;
188 # If there is one constraint and its a ref, we need to decide
189 # if this number 'unknown' number or if the ref allows us to
190 # determine a length.
192 if(scalar @{$self->captures_constraints} == 1) {
193 my $tc = $self->captures_constraints->[0];
195 $tc->can('is_strictly_a_type_of') &&
196 $tc->is_strictly_a_type_of('Tuple'))
198 my @parameters = @{ $tc->parameters||[]};
199 if( defined($parameters[-1]) and exists($parameters[-1]->{slurpy})) {
202 return my $total_params = scalar(@parameters);
204 } elsif($tc->is_a_type_of('Ref')) {
205 die "You cannot use CaptureArgs($tc) in ${\$self->reverse} because we cannot determined the number of its parameters";
207 return 1; # Its a normal 1 arg type constraint.
210 # We need to loop through and error on ref types. We don't allow a ref type
213 foreach my $tc( @{$self->captures_constraints}) {
214 if($tc->is_a_type_of('Ref')) {
215 die "$tc is a Ref type constraint. You cannot mix Ref and non Ref type constraints in CaptureArgs for action ${\$self->reverse}";
224 has captures_constraints => (
231 builder=>'_build_captures_constraints',
233 has_captures_constraints => 'count',
234 captures_constraints_count => 'count',
235 all_captures_constraints => 'elements',
238 sub _build_captures_constraints {
240 my @arg_protos = @{$self->attributes->{CaptureArgs}||[]};
242 return [] unless scalar(@arg_protos);
243 return [] unless defined($arg_protos[0]);
244 # If there is only one arg and it looks like a number
245 # we assume its 'classic' and the number is the number of
249 scalar(@arg_protos) == 1 &&
250 looks_like_number($arg_protos[0])
255 map { my @tc = $self->resolve_type_constraint($_); scalar(@tc) ? @tc : die "$_ is not a constraint!" }
262 sub resolve_type_constraint {
263 my ($self, $name) = @_;
265 if(defined($name) && blessed($name) && $name->can('check')) {
266 # Its already a TC, good to go.
270 # This is broken for when there is more than one constraint
272 eval "use Type::Registry; 1" || die "Can't resolve type constraint $name without installing Type::Tiny";
273 my $tc = Type::Registry->new->foreign_lookup($name);
274 return defined $tc ? $tc : die "'$name' not a full namespace type constraint in ${\$self->private_path}";
277 my @tc = grep { defined $_ } (eval("package ${\$self->class}; $name"));
280 # ok... so its not defined in the package. we need to look at all the roles
281 # and superclasses, look for attributes and figure it out.
282 # Superclasses take precedence;
284 my @supers = $self->class->can('meta') ? map { $_->meta } $self->class->meta->superclasses : ();
285 my @roles = $self->class->can('meta') ? $self->class->meta->calculate_all_roles : ();
287 # So look through all the super and roles in order and return the
288 # first type constraint found. We should probably find all matching
289 # type constraints and try to do some sort of resolution.
291 foreach my $parent (@roles, @supers) {
292 if(my $m = $parent->get_method($self->name)) {
293 if($m->can('attributes')) {
294 my ($key, $value) = map { $_ =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ }
295 grep { $_=~/^Args\(/ or $_=~/^CaptureArgs\(/ }
297 next unless $value eq $name;
298 my @tc = eval "package ${\$parent->name}; $name";
300 return map { ref($_) ? $_ : Moose::Util::TypeConstraints::find_or_parse_type_constraint($_) } @tc;
308 my $classes = join(',', $self->class, @roles, @supers);
309 die "'$name' not a type constraint in '${\$self->private_path}', Looked in: $classes";
313 return map { ref($_) ? $_ : Moose::Util::TypeConstraints::find_or_parse_type_constraint($_) } @tc;
319 has number_of_captures => (
325 builder=>'_build_number_of_captures');
327 sub _build_number_of_captures {
329 if( ! exists $self->attributes->{CaptureArgs} ) {
330 # If there are no defined capture args, thats considered 0.
332 } elsif(!defined($self->attributes->{CaptureArgs}[0])) {
333 # If you fail to give a defined value, that's also 0
336 scalar(@{$self->attributes->{CaptureArgs}}) == 1 &&
337 looks_like_number($self->attributes->{CaptureArgs}[0])
339 # 'Old school' numbered captures
340 return $self->attributes->{CaptureArgs}[0];
342 # New hotness named arg constraints
343 return $self->number_of_captures_constraints;
350 # Stringify to reverse for debug output etc.
351 q{""} => sub { shift->{reverse} },
353 # Codulate to execute to invoke the encapsulated action coderef
354 '&{}' => sub { my $self = shift; sub { $self->execute(@_); }; },
356 # Make general $stuff still work
361 no warnings 'recursion';
363 sub dispatch { # Execute ourselves against a context
364 my ( $self, $c ) = @_;
365 if($self->has_instance) {
366 return $c->execute( $self->instance, $self );
368 return $c->execute( $self->class, $self );
378 my ( $self, $c ) = @_;
379 return $self->match_args($c, $c->req->args);
383 my ($self, $c, $args) = @_;
384 my @args = @{$args||[]};
386 # There there are arg constraints, we must see to it that the constraints
387 # check positive for each arg in the list.
388 if($self->has_args_constraints) {
389 # If there is only one type constraint, and its a Ref or subtype of Ref,
390 # That means we expect a reference, so use the full args arrayref.
392 $self->args_constraint_count == 1 &&
394 $self->args_constraints->[0]->is_a_type_of('Ref') ||
395 $self->args_constraints->[0]->is_a_type_of('ClassName')
398 # Ok, the the type constraint is a ref type, which is allowed to have
399 # any number of args. We need to check the arg length, if one is defined.
400 # If we had a ref type constraint that allowed us to determine the allowed
401 # number of args, we need to match that number. Otherwise if there was an
402 # undetermined number (~0) then we allow all the args. This is more of an
403 # Optimization since Tuple[Int, Int] would fail on 3,4,5 anyway, but this
404 # way we can avoid calling the constraint when the arg length is incorrect.
406 $self->comparable_arg_number == ~0 ||
407 scalar( @args ) == $self->comparable_arg_number
409 return $self->args_constraints->[0]->check($args);
413 # Removing coercion stuff for the first go
414 #if($self->args_constraints->[0]->coercion && $self->attributes->{Coerce}) {
415 # my $coerced = $self->args_constraints->[0]->coerce($c) || return 0;
416 # $c->req->args([$coerced]);
420 # Because of the way chaining works, we can expect args that are totally not
421 # what you'd expect length wise. When they don't match length, thats a fail
422 return 0 unless scalar( @args ) == $self->comparable_arg_number;
424 for my $i(0..$#args) {
425 $self->args_constraints->[$i]->check($args[$i]) || return 0;
430 # If infinite args with no constraints, we always match
431 return 1 if $self->comparable_arg_number == ~0;
433 # Otherwise, we just need to match the number of args.
434 return scalar( @args ) == $self->comparable_arg_number;
439 my ($self, $c, $captures) = @_;
440 my @captures = @{$captures||[]};
442 return 1 unless scalar(@captures); # If none, just say its ok
443 return $self->has_captures_constraints ?
444 $self->match_captures_constraints($c, $captures) : 1;
449 sub match_captures_constraints {
450 my ($self, $c, $captures) = @_;
451 my @captures = @{$captures||[]};
453 # Match is positive if you don't have any.
454 return 1 unless $self->has_captures_constraints;
457 $self->captures_constraints_count == 1 &&
459 $self->captures_constraints->[0]->is_a_type_of('Ref') ||
460 $self->captures_constraints->[0]->is_a_type_of('ClassName')
463 return $self->captures_constraints->[0]->check($captures);
465 for my $i(0..$#captures) {
466 $self->captures_constraints->[$i]->check($captures[$i]) || return 0;
476 return $a1->comparable_arg_number <=> $a2->comparable_arg_number;
480 my ($self, $target) = @_;
481 return $self->private_path eq $target->private_path ? $self : 0;
485 return exists $_[0]->attributes->{Scheme} ? $_[0]->attributes->{Scheme}[0] : undef;
488 sub list_extra_info {
491 Args => $self->normalized_arg_number,
492 CaptureArgs => $self->number_of_captures,
496 __PACKAGE__->meta->make_immutable;
506 The sub attributes that are set for this action, like Local, Path, Private
507 and so on. This determines how the action is dispatched to.
511 Returns the name of the component where this action is defined.
512 Derived by calling the L<catalyst_component_name|Catalyst::Component/catalyst_component_name>
513 method on each component.
517 Returns a code reference to this action.
519 =head2 dispatch( $c )
521 Dispatch this action against a context.
523 =head2 execute( $controller, $c, @args )
525 Execute this action's coderef against a given controller with a given
526 context and arguments
530 Check Args attribute, and makes sure number of args matches the setting.
531 Always returns true if Args is omitted.
533 =head2 match_captures ($c, $captures)
535 Can be implemented by action class and action role authors. If the method
536 exists, then it will be called with the request context and an array reference
537 of the captures for this action.
539 Returning true from this method causes the chain match to continue, returning
540 makes the chain not match (and alternate, less preferred chains will be attempted).
542 =head2 match_captures_constraints ($c, \@captures);
544 Does the \@captures given match any constraints (if any constraints exist). Returns
545 true if you ask but there are no constraints.
547 =head2 match_args($c, $args)
549 Does the Args match or not?
551 =head2 resolve_type_constraint
553 Tries to find a type constraint if you have on on a type constrained method.
557 Compares 2 actions based on the value of the C<Args> attribute, with no C<Args>
558 having the highest precedence.
562 if( $action->equal($other_action) ) { ... }
564 Returns true if the two actions are equal.
568 Returns the private namespace this action lives in.
572 Returns the private path for this action.
576 Returns absolute private path for this action. Unlike C<reverse>, the
577 C<private_path> of an action is always suitable for passing to C<forward>.
581 Returns the sub name of this action.
583 =head2 number_of_args
585 Returns the number of args this action expects. This is 0 if the action doesn't
586 take any arguments and undef if it will take any number of arguments.
588 =head2 normalized_arg_number
590 The number of arguments (starting with zero) that the current action defines, or
591 undefined if there is not defined number of args (which is later treated as, "
592 as many arguments as you like").
594 =head2 comparable_arg_number
596 For the purposes of comparison we normalize 'number_of_args' so that if it is
597 undef we mean ~0 (as many args are we can think of).
599 =head2 number_of_captures
601 Returns the number of captures this action expects for L<Chained|Catalyst::DispatchType::Chained> actions.
603 =head2 list_extra_info
605 A HashRef of key-values that an action can provide to a debugging screen
609 Any defined scheme for the action
617 Catalyst Contributors, see Catalyst.pm
621 This library is free software. You can redistribute it and/or modify it under
622 the same terms as Perl itself.