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=a74eb29f0ef1fa8cf986a784c3cca079a12757a8;hp=0e132f518194f571333b35aa23cd09a2ad30d9ac;hb=f3414019f472b55682ef3af53f761b6db7955887;hpb=649fd1fa74ee22fb2f5220dbdcb25d02427034b2 diff --git a/lib/Catalyst/Action.pm b/lib/Catalyst/Action.pm index 0e132f5..a74eb29 100644 --- a/lib/Catalyst/Action.pm +++ b/lib/Catalyst/Action.pm @@ -1,74 +1,103 @@ package Catalyst::Action; -use strict; -use base qw/Class::Accessor::Fast/; +=head1 NAME -__PACKAGE__->mk_accessors(qw/class namespace reverse attributes name code/); +Catalyst::Action - Catalyst Action -use overload ( +=head1 SYNOPSIS - # Stringify to reverse for debug output etc. - q{""} => sub { shift->{reverse} }, +
- # Codulate to encapsulated action coderef - '&{}' => sub { shift->{code} }, +=head1 DESCRIPTION - # Make general $stuff still work - fallback => 1, +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 -=head1 NAME +use Class::C3; +use Moose; -Catalyst::Action - Catalyst Action +has class => (is => 'rw'); +has namespace => (is => 'rw'); +has 'reverse' => (is => 'rw'); +has attributes => (is => 'rw'); +has name => (is => 'rw'); +has code => (is => 'rw'); -=head1 SYNOPSIS +no Moose; -See L. +no warnings 'recursion'; -=head1 DESCRIPTION +#__PACKAGE__->mk_accessors(qw/class namespace reverse attributes name code/); -This class represents a Catalyst Action. You can access the object for the -currently dispatched action via $c->action +sub dispatch { # Execute ourselves against a context + my ( $self, $c ) = @_; + #Moose todo: grrrrrr. this is no good. i don't know enough about it to + # debug it though. why can't we just call the accessor? + #local $c->{namespace} = $self->namespace; + #return $c->execute( $self->class, $self ); + + #believed to be equivalent: + my $orig = $c->namespace; + $c->namespace($self->namespace); + my $ret = $c->execute( $self->class, $self ); + $c->namespace($orig); + return $ret; +} + +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 it's 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; +} + +__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. +and so on. This determines how the action is dispatched to. =head2 class -Returns the class name of this action +Returns the class name where this action is defined. =head2 code -Returns a code reference to this action +Returns a code reference to this action. -=head2 execute( $c ) +=head2 dispatch( $c ) -Execute this action against a context +Dispatch this action against a context -=cut +=head2 execute( $controller, $c, @args ) -sub execute { # Execute ourselves against a context - my ( $self, $c ) = @_; - local $c->namespace = $self->namespace; - return $c->execute( $self->class, $self ); -} +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. - -=cut - -sub match { - my ( $self, $c ) = @_; - return 1 unless exists $self->attributes->{Args}; - return scalar(@{$c->req->args}) == $self->attributes->{Args}[0]; -} +Always returns true if Args is omitted. =head2 namespace @@ -82,6 +111,10 @@ Returns the private path for this action. returns the sub name of this action. +=head2 meta + +Provided by Moose + =head1 AUTHOR Matt S. Trout @@ -92,5 +125,3 @@ This program is free software, you can redistribute it and/or modify it under the same terms as Perl itself. =cut - -1;