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