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=b5b2f4888de119881ef993d993328ac1440133b5;hp=6c9e9a1e386e92c68a5dd8753ea8f3ba0203da0c;hb=051a69b9ac0e94a03b8e95ee3fdf8e989b635725;hpb=0bf7ab7160f4f2fd0f00cd3d53ac311e9ad50241 diff --git a/lib/Catalyst/Action.pm b/lib/Catalyst/Action.pm index 6c9e9a1..b5b2f48 100644 --- a/lib/Catalyst/Action.pm +++ b/lib/Catalyst/Action.pm @@ -1,27 +1,42 @@ package Catalyst::Action; -use strict; -use base qw/Class::Accessor::Fast/; - - =head1 NAME Catalyst::Action - Catalyst Action =head1 SYNOPSIS -
+ + + $c->forward( $action->private_path ); =head1 DESCRIPTION -This class represents a Catalyst Action. You can access the object for the +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'); +has private_path => ( + reader => 'private_path', + isa => 'Str', + lazy => 1, + required => 1, + default => sub { '/'.shift->reverse }, +); use overload ( @@ -36,6 +51,10 @@ use overload ( ); + + +no warnings 'recursion'; + sub dispatch { # Execute ourselves against a context my ( $self, $c ) = @_; return $c->execute( $self->class, $self ); @@ -43,17 +62,79 @@ sub dispatch { # Execute ourselves against a context sub execute { my $self = shift; - $self->{code}->(@_); + $self->code->(@_); +} + +sub match_captures { + my ( $self, $c, $captures ) = @_; + ## It would seem that now that we can match captures, we could remove a lot + ## of the capture_args to args mapping all around. I gave it a go, but was + ## not trival, contact jnap on irc for what I tried if you want to try. + ## return $self->_match_has_expected_capture_args($captures) && + return $self->_match_has_expected_http_method($c->req->method); } sub match { - my ( $self, $c ) = @_; - 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; + my ( $self, $c ) = @_; + return $self->_match_has_expected_args($c->req->args) && + $self->_match_has_expected_http_method($c->req->method); } +sub _match_has_expected_args { + my ($self, $req_args) = @_; + return 1 unless exists $self->attributes->{Args}; + my $args = $self->attributes->{Args}[0]; + return 1 unless defined($args) && length($args); + return scalar( @{$req_args} ) == $args; +} + +#sub _match_has_expected_capture_args { +# my ($self, $req_args) = @_; +# return 1 unless exists $self->attributes->{CaptureArgs}; +# my $args = $self->attributes->{CaptureArgs}[0]; +# return 1 unless defined($args) && length($args); +# return scalar( @{$req_args} ) == $args; +#} + +sub _match_has_expected_http_method { + my ($self, $method) = @_; + my @methods = @{ $self->attributes->{Method} || [] }; + if(scalar @methods) { + my $result = scalar(grep { lc($_) eq lc($method) } @methods) ? 1:0; + return $result; + } else { + ## No HTTP Methods to check + return 1; + } +} + +sub compare { + my ($a1, $a2) = @_; + + my ($a1_args) = @{ $a1->attributes->{Args} || [] }; + my ($a2_args) = @{ $a2->attributes->{Args} || [] }; + + $_ = looks_like_number($_) ? $_ : ~0 + for $a1_args, $a2_args; + + return $a1_args <=> $a2_args; +} + +sub number_of_args { + my ( $self ) = @_; + return 0 unless exists $self->attributes->{Args}; + return $self->attributes->{Args}[0]; +} + +sub number_of_captures { + my ( $self ) = @_; + + return 0 unless exists $self->attributes->{CaptureArgs}; + return $self->attributes->{CaptureArgs}[0] || 0; +} + +__PACKAGE__->meta->make_immutable; + 1; __END__ @@ -67,7 +148,9 @@ and so on. This determines how the action is dispatched to. =head2 class -Returns the class name where this action is defined. +Returns the name of the component where this action is defined. +Derived by calling the L +method on each component. =head2 code @@ -75,7 +158,7 @@ Returns a code reference to this action. =head2 dispatch( $c ) -Dispatch this action against a context +Dispatch this action against a context. =head2 execute( $controller, $c, @args ) @@ -87,6 +170,21 @@ context and arguments Check Args attribute, and makes sure number of args matches the setting. Always returns true if Args is omitted. +=head2 match_captures ($c, $captures) + +Can be implemented by action class and action role authors. If the method +exists, then it will be called with the request context and an array reference +of the captures for this action. + +Returning true from this method causes the chain match to continue, returning +makes the chain not match (and alternate, less preferred chains will be attempted). + + +=head2 compare + +Compares 2 actions based on the value of the C attribute, with no C +having the highest precedence. + =head2 namespace Returns the private namespace this action lives in. @@ -95,9 +193,26 @@ Returns the private namespace this action lives in. Returns the private path for this action. +=head2 private_path + +Returns absolute private path for this action. Unlike C, the +C of an action is always suitable for passing to C. + =head2 name -returns the sub name of this action. +Returns the sub name of this action. + +=head2 number_of_args + +Returns the number of args this action expects. This is 0 if the action doesn't take any arguments and undef if it will take any number of arguments. + +=head2 number_of_captures + +Returns the number of captures this action expects for L actions. + +=head2 meta + +Provided by Moose. =head1 AUTHORS @@ -105,7 +220,7 @@ 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