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