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 =head1 DESCRIPTION
  12
  13 This class represents a Catalyst Action. You can access the object for the
  14 currently dispatched action via $c->action. See the L<Catalyst::Dispatcher>
  15 for more information on how actions are dispatched. Actions are defined in
  16 L<Catalyst::Controller> subclasses.
  17
  18 =cut
  19
  20 use Moose;
  21 use Scalar::Util 'looks_like_number';
  22 with 'MooseX::Emulate::Class::Accessor::Fast';
  23 use namespace::clean -except => 'meta';
  24
  25 has class => (is => 'rw');
  26 has namespace => (is => 'rw');
  27 has 'reverse' => (is => 'rw');
  28 has attributes => (is => 'rw');
  29 has name => (is => 'rw');
  30 has code => (is => 'rw');
  31
  32 use overload (
  33
  34     # Stringify to reverse for debug output etc.
  35     q{""} => sub { shift->{reverse} },
  36
  37     # Codulate to execute to invoke the encapsulated action coderef
  38     '&{}' => sub { my $self = shift; sub { $self->execute(@_); }; },
  39
  40     # Which action takes precedence
  41     '<=>' => 'compare',
  42
  43     # Make general $stuff still work
  44     fallback => 1,
  45
  46 );
  47
  48
  49
  50 no warnings 'recursion';
  51
  52 #__PACKAGE__->mk_accessors(qw/class namespace reverse attributes name code/);
  53
  54 sub dispatch {    # Execute ourselves against a context
  55     my ( $self, $c ) = @_;
  56     return $c->execute( $self->class, $self );
  57 }
  58
  59 sub execute {
  60   my $self = shift;
  61   $self->code->(@_);
  62 }
  63
  64 sub match {
  65     my ( $self, $c ) = @_;
  66     #would it be unreasonable to store the number of arguments
  67     #the action has as its own attribute?
  68     #it would basically eliminate the code below.  ehhh. small fish
  69     return 1 unless exists $self->attributes->{Args};
  70     my $args = $self->attributes->{Args}[0];
  71     return 1 unless defined($args) && length($args);
  72     return scalar( @{ $c->req->args } ) == $args;
  73 }
  74
  75 sub compare {
  76     my ($a1, $a2) = @_;
  77
  78     my ($a1_args) = @{ $a1->attributes->{Args} || [] };
  79     my ($a2_args) = @{ $a2->attributes->{Args} || [] };
  80
  81     $_ = looks_like_number($_) ? $_ : ~0
  82         for $a1_args, $a2_args;
  83
  84     return $a1_args <=> $a2_args;
  85 }
  86
  87 __PACKAGE__->meta->make_immutable;
  88
  89 1;
  90
  91 __END__
  92
  93 =head1 METHODS
  94
  95 =head2 attributes
  96
  97 The sub attributes that are set for this action, like Local, Path, Private
  98 and so on. This determines how the action is dispatched to.
  99
 100 =head2 class
 101
 102 Returns the class name where this action is defined.
 103
 104 =head2 code
 105
 106 Returns a code reference to this action.
 107
 108 =head2 dispatch( $c )
 109
 110 Dispatch this action against a context
 111
 112 =head2 execute( $controller, $c, @args )
 113
 114 Execute this action's coderef against a given controller with a given
 115 context and arguments
 116
 117 =head2 match( $c )
 118
 119 Check Args attribute, and makes sure number of args matches the setting.
 120 Always returns true if Args is omitted.
 121
 122 =head2 compare
 123
 124 Compares 2 actions based on the value of the C<Args> attribute, with no C<Args>
 125 having the highest precedence.
 126
 127 =head2 namespace
 128
 129 Returns the private namespace this action lives in.
 130
 131 =head2 reverse
 132
 133 Returns the private path for this action.
 134
 135 =head2 name
 136
 137 returns the sub name of this action.
 138
 139 =head2 meta
 140
 141 Provided by Moose
 142
 143 =head1 AUTHORS
 144
 145 Catalyst Contributors, see Catalyst.pm
 146
 147 =head1 COPYRIGHT
 148
 149 This library is free software. You can redistribute it and/or modify it under
 150 the same terms as Perl itself.
 151
 152 =cut