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