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