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' numberd 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         ($self->args_constraints->[0]->is_a_type_of('Ref') || $self->args_constraints->[0]->is_a_type_of('ClassName'))
 155       ) {
 156         return 1 if $self->args_constraints->[0]->check($c->req->args);
 157         if($self->args_constraints->[0]->coercion && $self->attributes->{Coerce}) {
 158           my $coerced = $self->args_constraints->[0]->coerce($c) || return 0;
 159           $c->req->args([$coerced]);
 160           return 1;
 161         }
 162       } else {
 163         for my $i(0..$#{ $c->req->args }) {
 164           $self->args_constraints->[$i]->check($c->req->args->[$i]) || return 0;
 165         }
 166         return 1;
 167       }
 168     } else {
 169       # Otherwise, we just need to match the number of args.
 170       return scalar( @{ $c->req->args } ) == $self->normalized_arg_number;
 171     }
 172 }
 173
 174 sub match_captures { 1 }
 175
 176 sub compare {
 177     my ($a1, $a2) = @_;
 178     return $a1->normalized_arg_number <=> $a2->normalized_arg_number;
 179 }
 180
 181 sub number_of_captures {
 182     my ( $self ) = @_;
 183
 184     return 0 unless exists $self->attributes->{CaptureArgs};
 185     return $self->attributes->{CaptureArgs}[0] || 0;
 186 }
 187
 188 sub scheme {
 189   return exists $_[0]->attributes->{Scheme} ? $_[0]->attributes->{Scheme}[0] : undef;
 190 }
 191
 192 sub list_extra_info {
 193   my $self = shift;
 194   return {
 195     Args => $self->attributes->{Args}[0],
 196     CaptureArgs => $self->number_of_captures,
 197   }
 198 }
 199
 200 __PACKAGE__->meta->make_immutable;
 201
 202 1;
 203
 204 __END__
 205
 206 =head1 METHODS
 207
 208 =head2 attributes
 209
 210 The sub attributes that are set for this action, like Local, Path, Private
 211 and so on. This determines how the action is dispatched to.
 212
 213 =head2 class
 214
 215 Returns the name of the component where this action is defined.
 216 Derived by calling the L<catalyst_component_name|Catalyst::Component/catalyst_component_name>
 217 method on each component.
 218
 219 =head2 code
 220
 221 Returns a code reference to this action.
 222
 223 =head2 dispatch( $c )
 224
 225 Dispatch this action against a context.
 226
 227 =head2 execute( $controller, $c, @args )
 228
 229 Execute this action's coderef against a given controller with a given
 230 context and arguments
 231
 232 =head2 match( $c )
 233
 234 Check Args attribute, and makes sure number of args matches the setting.
 235 Always returns true if Args is omitted.
 236
 237 =head2 match_captures ($c, $captures)
 238
 239 Can be implemented by action class and action role authors. If the method
 240 exists, then it will be called with the request context and an array reference
 241 of the captures for this action.
 242
 243 Returning true from this method causes the chain match to continue, returning
 244 makes the chain not match (and alternate, less preferred chains will be attempted).
 245
 246 =head2 resolve_type_constraint
 247
 248 Trys to find a type constraint if you have on on a type constrained method.
 249
 250 =head2 compare
 251
 252 Compares 2 actions based on the value of the C<Args> attribute, with no C<Args>
 253 having the highest precedence.
 254
 255 =head2 namespace
 256
 257 Returns the private namespace this action lives in.
 258
 259 =head2 reverse
 260
 261 Returns the private path for this action.
 262
 263 =head2 private_path
 264
 265 Returns absolute private path for this action. Unlike C<reverse>, the
 266 C<private_path> of an action is always suitable for passing to C<forward>.
 267
 268 =head2 name
 269
 270 Returns the sub name of this action.
 271
 272 =head2 number_of_args
 273
 274 Returns the number of args this action expects. This is 0 if the action doesn't
 275 take any arguments and undef if it will take any number of arguments.
 276
 277 =head2 normalized_arg_number
 278
 279 For the purposes of comparison we normalize 'number_of_args' so that if it is
 280 undef we mean ~0 (as many args are we can think of).
 281
 282 =head2 number_of_captures
 283
 284 Returns the number of captures this action expects for L<Chained|Catalyst::DispatchType::Chained> actions.
 285
 286 =head2 list_extra_info
 287
 288 A HashRef of key-values that an action can provide to a debugging screen
 289
 290 =head2 scheme
 291
 292 Any defined scheme for the action
 293
 294 =head2 meta
 295
 296 Provided by Moose.
 297
 298 =head1 AUTHORS
 299
 300 Catalyst Contributors, see Catalyst.pm
 301
 302 =head1 COPYRIGHT
 303
 304 This library is free software. You can redistribute it and/or modify it under
 305 the same terms as Perl itself.
 306
 307 =cut
 308
 309