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