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     return 0 unless exists $self->attributes->{Args};
  53     if(!defined($self->attributes->{Args}[0])) {
  54       # When its 'Args' that internal cue for 'unlimited'
  55       return undef;
  56     } elsif(looks_like_number($self->attributes->{Args}[0])) {
  57       # 'old school' numberd args (is allowed to be undef as well)
  58       return $self->attributes->{Args}[0];
  59     } else {
  60       # new hotness named arg constraints
  61       return $self->number_of_args_constraints;
  62     }
  63   }
  64
  65 has args_constraints => (
  66   is=>'ro',
  67   init_arg=>undef,
  68   traits=>['Array'],
  69   isa=>'ArrayRef',
  70   required=>1,
  71   lazy=>1,
  72   builder=>'_build_args_constraints',
  73   handles => {
  74     has_args_constraints => 'count',
  75     number_of_args_constraints => 'count',
  76   });
  77
  78   sub _build_args_constraints {
  79     my $self = shift;
  80     my @arg_protos = @{$self->attributes->{Args}||[]};
  81
  82     return [] unless scalar(@arg_protos);
  83     # If there is only one arg and it looks like a number
  84     # we assume its 'classic' and the number is the number of
  85     # constraints.
  86     my @args = ();
  87     if(
  88       scalar(@arg_protos) == 1 &&
  89       looks_like_number($arg_protos[0])
  90     ) {
  91       return \@args;
  92     } else {
  93       @args = map { Moose::Util::TypeConstraints::find_or_parse_type_constraint($_) || die "$_ is not a constraint!" } @arg_protos;
  94     }
  95
  96     return \@args;
  97   }
  98
  99 use overload (
 100
 101     # Stringify to reverse for debug output etc.
 102     q{""} => sub { shift->{reverse} },
 103
 104     # Codulate to execute to invoke the encapsulated action coderef
 105     '&{}' => sub { my $self = shift; sub { $self->execute(@_); }; },
 106
 107     # Make general $stuff still work
 108     fallback => 1,
 109
 110 );
 111
 112 no warnings 'recursion';
 113
 114 sub dispatch {    # Execute ourselves against a context
 115     my ( $self, $c ) = @_;
 116     return $c->execute( $self->class, $self );
 117 }
 118
 119 sub execute {
 120   my $self = shift;
 121   $self->code->(@_);
 122 }
 123
 124 sub match {
 125     my ( $self, $c ) = @_;
 126     #would it be unreasonable to store the number of arguments
 127     #the action has as its own attribute?
 128     #it would basically eliminate the code below.  ehhh. small fish
 129     return 1 unless exists $self->attributes->{Args};
 130     my $args = $self->attributes->{Args}[0];
 131     return 1 unless defined($args) && length($args);
 132
 133     if($self->has_args_constraints) {
 134       for my $i($#{ $c->req->args }) {
 135         $self->args_constraints->[$i]->check($c->req->args->[$i]) || return 0;
 136       }
 137       return 1;
 138     } else {
 139       return scalar( @{ $c->req->args } ) == $args;
 140     }
 141 }
 142
 143 sub match_captures { 1 }
 144
 145 sub compare {
 146     my ($a1, $a2) = @_;
 147
 148     # Wen there is no declared Args for Local and Path (and Default??) we
 149     # say that means any number of args...  If Args exists however we use
 150     # the number of args as determined by inspecting the value of it.
 151
 152     my $a1_args = exists($a1->attributes->{Args}) ? $a1->number_of_args : ~0;
 153     my $a2_args = exists($a2->attributes->{Args}) ? $a2->number_of_args : ~0;
 154
 155     # If we did have an Args but it was undefined value (:Args() or :Args), that
 156     # is the cue for 'as many args as you like also...
 157     #
 158     $_ = defined($_) ? $_ : ~0
 159         for $a1_args, $a2_args;
 160
 161     return $a1_args <=> $a2_args;
 162 }
 163
 164 sub number_of_captures {
 165     my ( $self ) = @_;
 166
 167     return 0 unless exists $self->attributes->{CaptureArgs};
 168     return $self->attributes->{CaptureArgs}[0] || 0;
 169 }
 170
 171 sub scheme {
 172   return exists $_[0]->attributes->{Scheme} ? $_[0]->attributes->{Scheme}[0] : undef;
 173 }
 174
 175 sub list_extra_info {
 176   my $self = shift;
 177   return {
 178     Args => $self->attributes->{Args}[0],
 179     CaptureArgs => $self->number_of_captures,
 180   }
 181 }
 182
 183 __PACKAGE__->meta->make_immutable;
 184
 185 1;
 186
 187 __END__
 188
 189 =head1 METHODS
 190
 191 =head2 attributes
 192
 193 The sub attributes that are set for this action, like Local, Path, Private
 194 and so on. This determines how the action is dispatched to.
 195
 196 =head2 class
 197
 198 Returns the name of the component where this action is defined.
 199 Derived by calling the L<catalyst_component_name|Catalyst::Component/catalyst_component_name>
 200 method on each component.
 201
 202 =head2 code
 203
 204 Returns a code reference to this action.
 205
 206 =head2 dispatch( $c )
 207
 208 Dispatch this action against a context.
 209
 210 =head2 execute( $controller, $c, @args )
 211
 212 Execute this action's coderef against a given controller with a given
 213 context and arguments
 214
 215 =head2 match( $c )
 216
 217 Check Args attribute, and makes sure number of args matches the setting.
 218 Always returns true if Args is omitted.
 219
 220 =head2 match_captures ($c, $captures)
 221
 222 Can be implemented by action class and action role authors. If the method
 223 exists, then it will be called with the request context and an array reference
 224 of the captures for this action.
 225
 226 Returning true from this method causes the chain match to continue, returning
 227 makes the chain not match (and alternate, less preferred chains will be attempted).
 228
 229
 230 =head2 compare
 231
 232 Compares 2 actions based on the value of the C<Args> attribute, with no C<Args>
 233 having the highest precedence.
 234
 235 =head2 namespace
 236
 237 Returns the private namespace this action lives in.
 238
 239 =head2 reverse
 240
 241 Returns the private path for this action.
 242
 243 =head2 private_path
 244
 245 Returns absolute private path for this action. Unlike C<reverse>, the
 246 C<private_path> of an action is always suitable for passing to C<forward>.
 247
 248 =head2 name
 249
 250 Returns the sub name of this action.
 251
 252 =head2 number_of_args
 253
 254 Returns the number of args this action expects. This is 0 if the action doesn't take any arguments and undef if it will take any number of arguments.
 255
 256 =head2 number_of_captures
 257
 258 Returns the number of captures this action expects for L<Chained|Catalyst::DispatchType::Chained> actions.
 259
 260 =head2 list_extra_info
 261
 262 A HashRef of key-values that an action can provide to a debugging screen
 263
 264 =head2 scheme
 265
 266 Any defined scheme for the action
 267
 268 =head2 meta
 269
 270 Provided by Moose.
 271
 272 =head1 AUTHORS
 273
 274 Catalyst Contributors, see Catalyst.pm
 275
 276 =head1 COPYRIGHT
 277
 278 This library is free software. You can redistribute it and/or modify it under
 279 the same terms as Perl itself.
 280
 281 =cut
 282
 283