lib/Catalyst/Action.pm

   1 package Catalyst::Action;
   2
   3 =head1 NAME
   4
   5 Catalyst::Action - Catalyst Action
   6
   7 =head1 SYNOPSIS
   8
   9     <form action="[%c.uri_for(c.action)%]">
  10
  11     $c->forward( $action->private_path );
  12
  13 =head1 DESCRIPTION
  14
  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.
  19
  20 =cut
  21
  22 use Moose;
  23 use Scalar::Util 'looks_like_number';
  24 use Moose::Util::TypeConstraints ();
  25 with 'MooseX::Emulate::Class::Accessor::Fast';
  26 use namespace::clean -except => 'meta';
  27
  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');
  34 has private_path => (
  35   reader => 'private_path',
  36   isa => 'Str',
  37   lazy => 1,
  38   required => 1,
  39   default => sub { '/'.shift->reverse },
  40 );
  41
  42 has 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;
  52     if( ! exists $self->attributes->{Args} ) {
  53       # When 'Args' does not exist, that means we want 'any number of args'.
  54       return undef;
  55     } elsif(!defined($self->attributes->{Args}[0])) {
  56       # When its 'Args' that internal cue for 'unlimited'
  57       return undef;
  58     } elsif(
  59       scalar(@{$self->attributes->{Args}}) == 1 &&
  60       looks_like_number($self->attributes->{Args}[0])
  61     ) {
  62       # 'Old school' numbered args (is allowed to be undef as well)
  63       return $self->attributes->{Args}[0];
  64     } else {
  65       # New hotness named arg constraints
  66       return $self->number_of_args_constraints;
  67     }
  68   }
  69
  70 sub normalized_arg_number {
  71   return defined($_[0]->number_of_args) ? $_[0]->number_of_args : ~0;
  72 }
  73
  74 has args_constraints => (
  75   is=>'ro',
  76   init_arg=>undef,
  77   traits=>['Array'],
  78   isa=>'ArrayRef',
  79   required=>1,
  80   lazy=>1,
  81   builder=>'_build_args_constraints',
  82   handles => {
  83     has_args_constraints => 'count',
  84     number_of_args_constraints => 'count',
  85   });
  86
  87   sub _build_args_constraints {
  88     my $self = shift;
  89     my @arg_protos = @{$self->attributes->{Args}||[]};
  90
  91     return [] unless scalar(@arg_protos);
  92     # If there is only one arg and it looks like a number
  93     # we assume its 'classic' and the number is the number of
  94     # constraints.
  95     my @args = ();
  96     if(
  97       scalar(@arg_protos) == 1 &&
  98       looks_like_number($arg_protos[0])
  99     ) {
 100       return \@args;
 101     } else {
 102       @args =
 103         map {  $self->resolve_type_constraint($_) || die "$_ is not a constraint!" }
 104         @arg_protos;
 105     }
 106
 107     return \@args;
 108   }
 109
 110 sub resolve_type_constraint {
 111   my ($self, $name) = @_;
 112   my $tc = eval "package ${\$self->class}; $name" || undef;
 113   return $tc || Moose::Util::TypeConstraints::find_or_parse_type_constraint($name);
 114 }
 115
 116 use overload (
 117
 118     # Stringify to reverse for debug output etc.
 119     q{""} => sub { shift->{reverse} },
 120
 121     # Codulate to execute to invoke the encapsulated action coderef
 122     '&{}' => sub { my $self = shift; sub { $self->execute(@_); }; },
 123
 124     # Make general $stuff still work
 125     fallback => 1,
 126
 127 );
 128
 129 no warnings 'recursion';
 130
 131 sub dispatch {    # Execute ourselves against a context
 132     my ( $self, $c ) = @_;
 133     return $c->execute( $self->class, $self );
 134 }
 135
 136 sub execute {
 137   my $self = shift;
 138   $self->code->(@_);
 139 }
 140
 141 sub match {
 142     my ( $self, $c ) = @_;
 143
 144     # If infinite args, we always match
 145     return 1 if $self->normalized_arg_number == ~0;
 146
 147     # There there are arg constraints, we must see to it that the constraints
 148     # check positive for each arg in the list.
 149     if($self->has_args_constraints) {
 150       # If there is only one type constraint, and its a Ref or subtype of Ref,
 151       # That means we expect a reference, so use the full args arrayref.
 152       if(
 153         $self->number_of_args_constraints == 1 &&
 154         (
 155           $self->args_constraints->[0]->is_a_type_of('Ref') ||
 156           $self->args_constraints->[0]->is_a_type_of('ClassName')
 157         )
 158       ) {
 159         return 1 if $self->args_constraints->[0]->check($c->req->args);
 160         # Removing coercion stuff for the first go
 161         #if($self->args_constraints->[0]->coercion && $self->attributes->{Coerce}) {
 162         #  my $coerced = $self->args_constraints->[0]->coerce($c) || return 0;
 163         #  $c->req->args([$coerced]);
 164         #  return 1;
 165         #}
 166       } else {
 167         for my $i(0..$#{ $c->req->args }) {
 168           $self->args_constraints->[$i]->check($c->req->args->[$i]) || return 0;
 169         }
 170         return 1;
 171       }
 172     } else {
 173       # Otherwise, we just need to match the number of args.
 174       return scalar( @{ $c->req->args } ) == $self->normalized_arg_number;
 175     }
 176 }
 177
 178 sub match_captures { 1 }
 179
 180 sub compare {
 181     my ($a1, $a2) = @_;
 182     return $a1->normalized_arg_number <=> $a2->normalized_arg_number;
 183 }
 184
 185 sub number_of_captures {
 186     my ( $self ) = @_;
 187
 188     return 0 unless exists $self->attributes->{CaptureArgs};
 189     return $self->attributes->{CaptureArgs}[0] || 0;
 190 }
 191
 192 sub scheme {
 193   return exists $_[0]->attributes->{Scheme} ? $_[0]->attributes->{Scheme}[0] : undef;
 194 }
 195
 196 sub list_extra_info {
 197   my $self = shift;
 198   return {
 199     Args => $self->attributes->{Args}[0],
 200     CaptureArgs => $self->number_of_captures,
 201   }
 202 }
 203
 204 __PACKAGE__->meta->make_immutable;
 205
 206 1;
 207
 208 __END__
 209
 210 =head1 METHODS
 211
 212 =head2 attributes
 213
 214 The sub attributes that are set for this action, like Local, Path, Private
 215 and so on. This determines how the action is dispatched to.
 216
 217 =head2 class
 218
 219 Returns the name of the component where this action is defined.
 220 Derived by calling the L<catalyst_component_name|Catalyst::Component/catalyst_component_name>
 221 method on each component.
 222
 223 =head2 code
 224
 225 Returns a code reference to this action.
 226
 227 =head2 dispatch( $c )
 228
 229 Dispatch this action against a context.
 230
 231 =head2 execute( $controller, $c, @args )
 232
 233 Execute this action's coderef against a given controller with a given
 234 context and arguments
 235
 236 =head2 match( $c )
 237
 238 Check Args attribute, and makes sure number of args matches the setting.
 239 Always returns true if Args is omitted.
 240
 241 =head2 match_captures ($c, $captures)
 242
 243 Can be implemented by action class and action role authors. If the method
 244 exists, then it will be called with the request context and an array reference
 245 of the captures for this action.
 246
 247 Returning true from this method causes the chain match to continue, returning
 248 makes the chain not match (and alternate, less preferred chains will be attempted).
 249
 250 =head2 resolve_type_constraint
 251
 252 Trys to find a type constraint if you have on on a type constrained method.
 253
 254 =head2 compare
 255
 256 Compares 2 actions based on the value of the C<Args> attribute, with no C<Args>
 257 having the highest precedence.
 258
 259 =head2 namespace
 260
 261 Returns the private namespace this action lives in.
 262
 263 =head2 reverse
 264
 265 Returns the private path for this action.
 266
 267 =head2 private_path
 268
 269 Returns absolute private path for this action. Unlike C<reverse>, the
 270 C<private_path> of an action is always suitable for passing to C<forward>.
 271
 272 =head2 name
 273
 274 Returns the sub name of this action.
 275
 276 =head2 number_of_args
 277
 278 Returns the number of args this action expects. This is 0 if the action doesn't
 279 take any arguments and undef if it will take any number of arguments.
 280
 281 =head2 normalized_arg_number
 282
 283 For the purposes of comparison we normalize 'number_of_args' so that if it is
 284 undef we mean ~0 (as many args are we can think of).
 285
 286 =head2 number_of_captures
 287
 288 Returns the number of captures this action expects for L<Chained|Catalyst::DispatchType::Chained> actions.
 289
 290 =head2 list_extra_info
 291
 292 A HashRef of key-values that an action can provide to a debugging screen
 293
 294 =head2 scheme
 295
 296 Any defined scheme for the action
 297
 298 =head2 meta
 299
 300 Provided by Moose.
 301
 302 =head1 AUTHORS
 303
 304 Catalyst Contributors, see Catalyst.pm
 305
 306 =head1 COPYRIGHT
 307
 308 This library is free software. You can redistribute it and/or modify it under
 309 the same terms as Perl itself.
 310
 311 =cut
 312
 313