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.reverse)%]">
  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
  22 has class => (is => 'rw');
  23 has namespace => (is => 'rw');
  24 has 'reverse' => (is => 'rw');
  25 has attributes => (is => 'rw');
  26 has name => (is => 'rw');
  27 has code => (is => 'rw');
  28
  29 no Moose;
  30
  31 use overload (
  32
  33     # Stringify to reverse for debug output etc.
  34     q{""} => sub { shift->{reverse} },
  35
  36     # Codulate to execute to invoke the encapsulated action coderef
  37     '&{}' => sub { my $self = shift; sub { $self->execute(@_); }; },
  38
  39     # Make general $stuff still work
  40     fallback => 1,
  41
  42 );
  43
  44
  45
  46 no warnings 'recursion';
  47
  48 #__PACKAGE__->mk_accessors(qw/class namespace reverse attributes name code/);
  49
  50 sub dispatch {    # Execute ourselves against a context
  51     my ( $self, $c ) = @_;
  52     #Moose todo: grrrrrr. this is no good. i don't know enough about it to
  53     # debug it though. why can't we just call the accessor?
  54     #local $c->{namespace} = $self->namespace;
  55     #return $c->execute( $self->class, $self );
  56
  57     #believed to be equivalent:
  58     my $orig = $c->namespace;
  59     $c->namespace($self->namespace);
  60     my $ret = $c->execute( $self->class, $self );
  61     $c->namespace($orig);
  62     return $ret;
  63 }
  64
  65 sub execute {
  66   my $self = shift;
  67   $self->code->(@_);
  68 }
  69
  70 sub match {
  71     my ( $self, $c ) = @_;
  72     #would it be unreasonable to store the number of arguments
  73     #the action has as it's own attribute?
  74     #it would basically eliminate the code below.  ehhh. small fish
  75     return 1 unless exists $self->attributes->{Args};
  76     my $args = $self->attributes->{Args}[0];
  77     return 1 unless defined($args) && length($args);
  78     return scalar( @{ $c->req->args } ) == $args;
  79 }
  80
  81 __PACKAGE__->meta->make_immutable;
  82
  83 1;
  84
  85 __END__
  86
  87 =head1 METHODS
  88
  89 =head2 attributes
  90
  91 The sub attributes that are set for this action, like Local, Path, Private
  92 and so on. This determines how the action is dispatched to.
  93
  94 =head2 class
  95
  96 Returns the class name where this action is defined.
  97
  98 =head2 code
  99
 100 Returns a code reference to this action.
 101
 102 =head2 dispatch( $c )
 103
 104 Dispatch this action against a context
 105
 106 =head2 execute( $controller, $c, @args )
 107
 108 Execute this action's coderef against a given controller with a given
 109 context and arguments
 110
 111 =head2 match( $c )
 112
 113 Check Args attribute, and makes sure number of args matches the setting.
 114 Always returns true if Args is omitted.
 115
 116 =head2 namespace
 117
 118 Returns the private namespace this action lives in.
 119
 120 =head2 reverse
 121
 122 Returns the private path for this action.
 123
 124 =head2 name
 125
 126 returns the sub name of this action.
 127
 128 =head2 meta
 129
 130 Provided by Moose
 131
 132 =head1 AUTHORS
 133
 134 Catalyst Contributors, see Catalyst.pm
 135
 136 =head1 COPYRIGHT
 137
 138 This program is free software, you can redistribute it and/or modify it under
 139 the same terms as Perl itself.
 140
 141 =cut