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 thru 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 thru 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.
253 eval "use Type::Registry; 1" || die "Can't resolve type constraint $name without installing Type::Tiny";
254 my $tc = Type::Registry->new->foreign_lookup($name);
255 return defined $tc ? $tc : die "'$name' not a type constraint in ${\$self->private_path}";
258 my @tc = eval "package ${\$self->class}; $name" or do {
259 # ok... so its not defined in the package. we need to look at all the roles
260 # and superclasses, look for attributes and figure it out.
261 # Superclasses take precedence;
263 my @supers = $self->class->can('meta') ? map { $_->meta } $self->class->meta->superclasses : ();
264 my @roles = $self->class->can('meta') ? $self->class->meta->calculate_all_roles : ();
266 # So look thru all the super and roles in order and return the
267 # first type constraint found. We should probably find all matching
268 # type constraints and try to do some sort of resolution.
270 warn "--> Hunting for TC $name in controller hierarchy\n" if $ENV{CATALYST_CONSTRAINTS_DEBUG};
272 foreach my $parent (@roles, @supers) {
273 warn " Looking for TC $name in ${\$parent->name}\n" if $ENV{CATALYST_CONSTRAINTS_DEBUG};
274 if(my $m = $parent->get_method($self->name)) {
275 if($m->can('attributes')) {
276 warn " method $m has attributes\n" if $ENV{CATALYST_CONSTRAINTS_DEBUG};
277 my ($key, $value) = map { $_ =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ }
278 grep { $_=~/^Args\(/ or $_=~/^CaptureArgs\(/ }
280 warn " about to evaluate any found attrs\n" if $ENV{CATALYST_CONSTRAINTS_DEBUG};
281 next unless $value eq $name;
282 warn " found attr info $key and $value\n" if $ENV{CATALYST_CONSTRAINTS_DEBUG};
283 my @tc = eval "package ${\$parent->name}; $name";
284 return @tc if scalar(@tc);
286 warn " method $m does not have method attributes\n" if $ENV{CATALYST_CONSTRAINTS_DEBUG};
291 my $classes = join(',', $self->class, @roles, @supers);
292 die "'$name' not a type constraint in '${\$self->private_path}', Looked in: $classes";
296 return map { ref($_) ? $_ : Moose::Util::TypeConstraints::find_or_parse_type_constraint($_) } @tc;
302 has number_of_captures => (
308 builder=>'_build_number_of_captures');
310 sub _build_number_of_captures {
312 if( ! exists $self->attributes->{CaptureArgs} ) {
313 # If there are no defined capture args, thats considered 0.
315 } elsif(!defined($self->attributes->{CaptureArgs}[0])) {
316 # If you fail to give a defined value, that's also 0
319 scalar(@{$self->attributes->{CaptureArgs}}) == 1 &&
320 looks_like_number($self->attributes->{CaptureArgs}[0])
322 # 'Old school' numbered captures
323 return $self->attributes->{CaptureArgs}[0];
325 # New hotness named arg constraints
326 return $self->number_of_captures_constraints;
333 # Stringify to reverse for debug output etc.
334 q{""} => sub { shift->{reverse} },
336 # Codulate to execute to invoke the encapsulated action coderef
337 '&{}' => sub { my $self = shift; sub { $self->execute(@_); }; },
339 # Make general $stuff still work
344 no warnings 'recursion';
346 sub dispatch { # Execute ourselves against a context
347 my ( $self, $c ) = @_;
348 return $c->execute( $self->class, $self );
357 my ( $self, $c ) = @_;
358 return $self->match_args($c, $c->req->args);
362 my ($self, $c, $args) = @_;
363 my @args = @{$args||[]};
365 # There there are arg constraints, we must see to it that the constraints
366 # check positive for each arg in the list.
367 if($self->has_args_constraints) {
368 # If there is only one type constraint, and its a Ref or subtype of Ref,
369 # That means we expect a reference, so use the full args arrayref.
371 $self->args_constraint_count == 1 &&
373 $self->args_constraints->[0]->is_a_type_of('Ref') ||
374 $self->args_constraints->[0]->is_a_type_of('ClassName')
377 # Ok, the the type constraint is a ref type, which is allowed to have
378 # any number of args. We need to check the arg length, if one is defined.
379 # If we had a ref type constraint that allowed us to determine the allowed
380 # number of args, we need to match that number. Otherwise if there was an
381 # undetermined number (~0) then we allow all the args. This is more of an
382 # Optimization since Tuple[Int, Int] would fail on 3,4,5 anyway, but this
383 # way we can avoid calling the constraint when the arg length is incorrect.
385 $self->normalized_arg_number == ~0 ||
386 scalar( @args ) == $self->normalized_arg_number
388 return $self->args_constraints->[0]->check($args);
392 # Removing coercion stuff for the first go
393 #if($self->args_constraints->[0]->coercion && $self->attributes->{Coerce}) {
394 # my $coerced = $self->args_constraints->[0]->coerce($c) || return 0;
395 # $c->req->args([$coerced]);
399 # Because of the way chaining works, we can expect args that are totally not
400 # what you'd expect length wise. When they don't match length, thats a fail
401 return 0 unless scalar( @args ) == $self->normalized_arg_number;
403 for my $i(0..$#args) {
404 $self->args_constraints->[$i]->check($args[$i]) || return 0;
409 # If infinite args with no constraints, we always match
410 return 1 if $self->normalized_arg_number == ~0;
412 # Otherwise, we just need to match the number of args.
413 return scalar( @args ) == $self->normalized_arg_number;
418 my ($self, $c, $captures) = @_;
419 my @captures = @{$captures||[]};
421 return 1 unless scalar(@captures); # If none, just say its ok
422 return $self->has_captures_constraints ?
423 $self->match_captures_constraints($c, $captures) : 1;
428 sub match_captures_constraints {
429 my ($self, $c, $captures) = @_;
430 my @captures = @{$captures||[]};
432 # Match is positive if you don't have any.
433 return 1 unless $self->has_captures_constraints;
436 $self->captures_constraints_count == 1 &&
438 $self->captures_constraints->[0]->is_a_type_of('Ref') ||
439 $self->captures_constraints->[0]->is_a_type_of('ClassName')
442 return $self->captures_constraints->[0]->check($captures);
444 for my $i(0..$#captures) {
445 $self->captures_constraints->[$i]->check($captures[$i]) || return 0;
455 return $a1->normalized_arg_number <=> $a2->normalized_arg_number;
459 return exists $_[0]->attributes->{Scheme} ? $_[0]->attributes->{Scheme}[0] : undef;
462 sub list_extra_info {
465 Args => $self->normalized_arg_number,
466 CaptureArgs => $self->number_of_captures,
470 __PACKAGE__->meta->make_immutable;
480 The sub attributes that are set for this action, like Local, Path, Private
481 and so on. This determines how the action is dispatched to.
485 Returns the name of the component where this action is defined.
486 Derived by calling the L<catalyst_component_name|Catalyst::Component/catalyst_component_name>
487 method on each component.
491 Returns a code reference to this action.
493 =head2 dispatch( $c )
495 Dispatch this action against a context.
497 =head2 execute( $controller, $c, @args )
499 Execute this action's coderef against a given controller with a given
500 context and arguments
504 Check Args attribute, and makes sure number of args matches the setting.
505 Always returns true if Args is omitted.
507 =head2 match_captures ($c, $captures)
509 Can be implemented by action class and action role authors. If the method
510 exists, then it will be called with the request context and an array reference
511 of the captures for this action.
513 Returning true from this method causes the chain match to continue, returning
514 makes the chain not match (and alternate, less preferred chains will be attempted).
516 =head2 match_captures_constraints ($c, \@captures);
518 Does the \@captures given match any constraints (if any constraints exist). Returns
519 true if you ask but there are no constraints.
521 =head2 match_args($c, $args)
523 Does the Args match or not?
525 =head2 resolve_type_constraint
527 Trys to find a type constraint if you have on on a type constrained method.
531 Compares 2 actions based on the value of the C<Args> attribute, with no C<Args>
532 having the highest precedence.
536 Returns the private namespace this action lives in.
540 Returns the private path for this action.
544 Returns absolute private path for this action. Unlike C<reverse>, the
545 C<private_path> of an action is always suitable for passing to C<forward>.
549 Returns the sub name of this action.
551 =head2 number_of_args
553 Returns the number of args this action expects. This is 0 if the action doesn't
554 take any arguments and undef if it will take any number of arguments.
556 =head2 normalized_arg_number
558 For the purposes of comparison we normalize 'number_of_args' so that if it is
559 undef we mean ~0 (as many args are we can think of).
561 =head2 number_of_captures
563 Returns the number of captures this action expects for L<Chained|Catalyst::DispatchType::Chained> actions.
565 =head2 list_extra_info
567 A HashRef of key-values that an action can provide to a debugging screen
571 Any defined scheme for the action
579 Catalyst Contributors, see Catalyst.pm
583 This library is free software. You can redistribute it and/or modify it under
584 the same terms as Perl itself.