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 with 'MooseX::Emulate::Class::Accessor::Fast';
  25 use namespace::clean -except => 'meta';
  26
  27 has class => (is => 'rw');
  28 has namespace => (is => 'rw');
  29 has 'reverse' => (is => 'rw');
  30 has attributes => (is => 'rw');
  31 has name => (is => 'rw');
  32 has code => (is => 'rw');
  33 has private_path => (
  34   reader => 'private_path',
  35   isa => 'Str',
  36   lazy => 1,
  37   required => 1,
  38   default => sub { '/'.shift->reverse },
  39 );
  40
  41 use overload (
  42
  43     # Stringify to reverse for debug output etc.
  44     q{""} => sub { shift->{reverse} },
  45
  46     # Codulate to execute to invoke the encapsulated action coderef
  47     '&{}' => sub { my $self = shift; sub { $self->execute(@_); }; },
  48
  49     # Make general $stuff still work
  50     fallback => 1,
  51
  52 );
  53
  54
  55
  56 no warnings 'recursion';
  57
  58 sub dispatch {    # Execute ourselves against a context
  59     my ( $self, $c ) = @_;
  60     return $c->execute( $self->class, $self );
  61 }
  62
  63 sub execute {
  64   my $self = shift;
  65   $self->code->(@_);
  66 }
  67
  68 sub match {
  69     my ( $self, $c ) = @_;
  70     #would it be unreasonable to store the number of arguments
  71     #the action has as its own attribute?
  72     #it would basically eliminate the code below.  ehhh. small fish
  73     return 1 unless exists $self->attributes->{Args};
  74     my $args = $self->attributes->{Args}[0];
  75     return 1 unless defined($args) && length($args);
  76     return scalar( @{ $c->req->args } ) == $args;
  77 }
  78
  79 sub match_captures { 1 }
  80
  81 sub compare {
  82     my ($a1, $a2) = @_;
  83
  84     my ($a1_args) = @{ $a1->attributes->{Args} || [] };
  85     my ($a2_args) = @{ $a2->attributes->{Args} || [] };
  86
  87     $_ = looks_like_number($_) ? $_ : ~0
  88         for $a1_args, $a2_args;
  89
  90     return $a1_args <=> $a2_args;
  91 }
  92
  93 sub number_of_args {
  94     my ( $self ) = @_;
  95     return 0 unless exists $self->attributes->{Args};
  96     return $self->attributes->{Args}[0];
  97 }
  98
  99 sub number_of_captures {
 100     my ( $self ) = @_;
 101
 102     return 0 unless exists $self->attributes->{CaptureArgs};
 103     return $self->attributes->{CaptureArgs}[0] || 0;
 104 }
 105
 106 sub scheme {
 107   return exists $_[0]->attributes->{Scheme} ? $_[0]->attributes->{Scheme}[0] : undef;
 108 }
 109
 110 sub list_extra_info {
 111   my $self = shift;
 112   return {
 113     Args => exists $self->attributes->{Args} ? $self->attributes->{Args}[0] : undef,
 114     CaptureArgs => $self->number_of_captures,
 115   }
 116 }
 117
 118 __PACKAGE__->meta->make_immutable;
 119
 120 1;
 121
 122 __END__
 123
 124 =head1 METHODS
 125
 126 =head2 attributes
 127
 128 The sub attributes that are set for this action, like Local, Path, Private
 129 and so on. This determines how the action is dispatched to.
 130
 131 =head2 class
 132
 133 Returns the name of the component where this action is defined.
 134 Derived by calling the L<catalyst_component_name|Catalyst::Component/catalyst_component_name>
 135 method on each component.
 136
 137 =head2 code
 138
 139 Returns a code reference to this action.
 140
 141 =head2 dispatch( $c )
 142
 143 Dispatch this action against a context.
 144
 145 =head2 execute( $controller, $c, @args )
 146
 147 Execute this action's coderef against a given controller with a given
 148 context and arguments
 149
 150 =head2 match( $c )
 151
 152 Check Args attribute, and makes sure number of args matches the setting.
 153 Always returns true if Args is omitted.
 154
 155 =head2 match_captures ($c, $captures)
 156
 157 Can be implemented by action class and action role authors. If the method
 158 exists, then it will be called with the request context and an array reference
 159 of the captures for this action.
 160
 161 Returning true from this method causes the chain match to continue, returning
 162 makes the chain not match (and alternate, less preferred chains will be attempted).
 163
 164
 165 =head2 compare
 166
 167 Compares 2 actions based on the value of the C<Args> attribute, with no C<Args>
 168 having the highest precedence.
 169
 170 =head2 namespace
 171
 172 Returns the private namespace this action lives in.
 173
 174 =head2 reverse
 175
 176 Returns the private path for this action.
 177
 178 =head2 private_path
 179
 180 Returns absolute private path for this action. Unlike C<reverse>, the
 181 C<private_path> of an action is always suitable for passing to C<forward>.
 182
 183 =head2 name
 184
 185 Returns the sub name of this action.
 186
 187 =head2 number_of_args
 188
 189 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.
 190
 191 =head2 number_of_captures
 192
 193 Returns the number of captures this action expects for L<Chained|Catalyst::DispatchType::Chained> actions.
 194
 195 =head2 list_extra_info
 196
 197 A HashRef of key-values that an action can provide to a debugging screen
 198
 199 =head2 scheme
 200
 201 Any defined scheme for the action
 202
 203 =head2 meta
 204
 205 Provided by Moose.
 206
 207 =head1 AUTHORS
 208
 209 Catalyst Contributors, see Catalyst.pm
 210
 211 =head1 COPYRIGHT
 212
 213 This library is free software. You can redistribute it and/or modify it under
 214 the same terms as Perl itself.
 215
 216 =cut