X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FAction.pm;h=0eb99424eed9222274f112c9504d47736aee0bb1;hp=0002ef7e230e67ddd47bd5158486738a03fe105d;hb=05b47f2e6357bc7f1622e6b2cf730ad5bbeb993f;hpb=6a0648863b2a3a4a745dc701d422b954cadc05b0 diff --git a/lib/Catalyst/Action.pm b/lib/Catalyst/Action.pm index 0002ef7..0eb9942 100644 --- a/lib/Catalyst/Action.pm +++ b/lib/Catalyst/Action.pm @@ -1,66 +1,152 @@ package Catalyst::Action; -use strict; -use base qw/Class::Accessor::Fast/; +=head1 NAME + +Catalyst::Action - Catalyst Action + +=head1 SYNOPSIS + +
+ +=head1 DESCRIPTION + +This class represents a Catalyst Action. You can access the object for the +currently dispatched action via $c->action. See the L +for more information on how actions are dispatched. Actions are defined in +L subclasses. + +=cut -__PACKAGE__->mk_accessors(qw/class namespace reverse attributes name code/); +use Moose; +use Scalar::Util 'looks_like_number'; +with 'MooseX::Emulate::Class::Accessor::Fast'; +use namespace::clean -except => 'meta'; + +has class => (is => 'rw'); +has namespace => (is => 'rw'); +has 'reverse' => (is => 'rw'); +has attributes => (is => 'rw'); +has name => (is => 'rw'); +has code => (is => 'rw'); use overload ( # Stringify to reverse for debug output etc. q{""} => sub { shift->{reverse} }, - # Codulate to encapsulated action coderef - '&{}' => sub { shift->{code} }, + # Codulate to execute to invoke the encapsulated action coderef + '&{}' => sub { my $self = shift; sub { $self->execute(@_); }; }, + + # Which action takes precedence + 'cmp' => 'compare', + '<=>' => 'compare', # Make general $stuff still work fallback => 1, ); -=head1 NAME -Catalyst::Action - Catalyst Action -=head1 SYNOPSIS +no warnings 'recursion'; -See L. +#__PACKAGE__->mk_accessors(qw/class namespace reverse attributes name code/); -=head1 DESCRIPTION +sub dispatch { # Execute ourselves against a context + my ( $self, $c ) = @_; + return $c->execute( $self->class, $self ); +} + +sub execute { + my $self = shift; + $self->code->(@_); +} + +sub match { + my ( $self, $c ) = @_; + #would it be unreasonable to store the number of arguments + #the action has as its own attribute? + #it would basically eliminate the code below. ehhh. small fish + return 1 unless exists $self->attributes->{Args}; + my $args = $self->attributes->{Args}[0]; + return 1 unless defined($args) && length($args); + return scalar( @{ $c->req->args } ) == $args; +} + +sub sort_order { + my $self = shift; + + my ($args) = @{ $self->attributes->{Args} || [] }; + + return $args if looks_like_number($args); + + return ~0; +} + +sub compare { + my ($a1, $a2) = @_; + + return $a1->sort_order <=> $a2->sort_order; +} + +__PACKAGE__->meta->make_immutable; + +1; + +__END__ =head1 METHODS =head2 attributes +The sub attributes that are set for this action, like Local, Path, Private +and so on. This determines how the action is dispatched to. + =head2 class +Returns the class name where this action is defined. + =head2 code -=head2 execute +Returns a code reference to this action. -=cut +=head2 dispatch( $c ) -sub execute { # Execute ourselves against a context - my ( $self, $c ) = @_; - local $c->namespace = $self->namespace; - return $c->execute( $self->class, $self ); -} +Dispatch this action against a context + +=head2 execute( $controller, $c, @args ) + +Execute this action's coderef against a given controller with a given +context and arguments + +=head2 match( $c ) + +Check Args attribute, and makes sure number of args matches the setting. +Always returns true if Args is omitted. =head2 namespace +Returns the private namespace this action lives in. + =head2 reverse +Returns the private path for this action. + =head2 name -=head1 AUTHOR +returns the sub name of this action. + +=head2 meta + +Provided by Moose -Matt S. Trout +=head1 AUTHORS + +Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT -This program is free software, you can redistribute it and/or modify it under +This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut - -1;