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