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=102572ba4eeb2758f5690c3e7776eedbe880a066;hp=ce587ac95b808879e852fadcbd68431bd31b3a75;hb=81436df99bdb4a0afd7367fb946c5481b483919d;hpb=b8f669f3c51dab87bfe9387dbaac0c07027abcfd diff --git a/lib/Catalyst/Action.pm b/lib/Catalyst/Action.pm index ce587ac..102572b 100644 --- a/lib/Catalyst/Action.pm +++ b/lib/Catalyst/Action.pm @@ -1,9 +1,100 @@ package Catalyst::Action; -use strict; -use base qw/Class::Accessor::Fast/; +=head1 NAME + +Catalyst::Action - Catalyst Action + +=head1 SYNOPSIS + +
-__PACKAGE__->mk_accessors(qw/class namespace reverse attributes name code/); + $c->forward( $action->private_path ); + +=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 + +use Moose; +use Scalar::Util 'looks_like_number'; +use Moose::Util::TypeConstraints (); +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 }, +); + +has number_of_args => ( + is=>'ro', + init_arg=>undef, + isa=>'Int|Undef', + required=>1, + lazy=>1, + builder=>'_build_number_of_args'); + + sub _build_number_of_args { + my $self = shift; + return 0 unless exists $self->attributes->{Args}; + if(!defined($self->attributes->{Args}[0])) { + # When its 'Args' that internal cue for 'unlimited' + return undef; + } elsif(looks_like_number($self->attributes->{Args}[0])) { + # 'old school' numberd args (is allowed to be undef as well) + return $self->attributes->{Args}[0]; + } else { + # new hotness named arg constraints + return $self->number_of_args_constraints; + } + } + +has args_constraints => ( + is=>'ro', + init_arg=>undef, + traits=>['Array'], + isa=>'ArrayRef', + required=>1, + lazy=>1, + builder=>'_build_args_constraints', + handles => { + has_args_constraints => 'count', + number_of_args_constraints => 'count', + }); + + sub _build_args_constraints { + my $self = shift; + my @arg_protos = @{$self->attributes->{Args}||[]}; + + return [] unless scalar(@arg_protos); + # If there is only one arg and it looks like a number + # we assume its 'classic' and the number is the number of + # constraints. + my @args = (); + if( + scalar(@arg_protos) == 1 && + looks_like_number($arg_protos[0]) + ) { + return \@args; + } else { + @args = map { Moose::Util::TypeConstraints::find_or_parse_type_constraint($_) || die "$_ is not a constraint!" } @arg_protos; + } + + return \@args; + } use overload ( @@ -18,69 +109,128 @@ use overload ( ); -=head1 NAME +no warnings 'recursion'; -Catalyst::Action - Catalyst Action +sub dispatch { # Execute ourselves against a context + my ( $self, $c ) = @_; + return $c->execute( $self->class, $self ); +} -=head1 SYNOPSIS +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); + + if($self->has_args_constraints) { + for my $i($#{ $c->req->args }) { + $self->args_constraints->[$i]->check($c->req->args->[$i]) || return 0; + } + return 1; + } else { + return scalar( @{ $c->req->args } ) == $args; + } +} -See L. +sub match_captures { 1 } -=head1 DESCRIPTION +sub compare { + my ($a1, $a2) = @_; + + # Wen there is no declared Args for Local and Path (and Default??) we + # say that means any number of args... If Args exists however we use + # the number of args as determined by inspecting the value of it. -This class represents a Catalyst Action. You can access the object for the -currently dispatched action via $c->action + my $a1_args = exists($a1->attributes->{Args}) ? $a1->number_of_args : ~0; + my $a2_args = exists($a2->attributes->{Args}) ? $a2->number_of_args : ~0; + + # If we did have an Args but it was undefined value (:Args() or :Args), that + # is the cue for 'as many args as you like also... + # + $_ = defined($_) ? $_ : ~0 + for $a1_args, $a2_args; + + return $a1_args <=> $a2_args; +} + +sub number_of_captures { + my ( $self ) = @_; + + return 0 unless exists $self->attributes->{CaptureArgs}; + return $self->attributes->{CaptureArgs}[0] || 0; +} + +sub scheme { + return exists $_[0]->attributes->{Scheme} ? $_[0]->attributes->{Scheme}[0] : undef; +} + +sub list_extra_info { + my $self = shift; + return { + Args => $self->attributes->{Args}[0], + CaptureArgs => $self->number_of_captures, + } +} + +__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 name of the component where this action is defined. +Derived by calling the L +method on each component. =head2 code -Returns a code reference to this action +Returns a code reference to this action. =head2 dispatch( $c ) -Dispatch this action against a context - -=cut - -sub dispatch { # 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 -=cut - -sub execute { - my $self = shift; - $self->{code}->(@_); -} - =head2 match( $c ) Check Args attribute, and makes sure number of args matches the setting. +Always returns true if Args is omitted. -=cut +=head2 match_captures ($c, $captures) -sub match { - my ( $self, $c ) = @_; - return 1 unless exists $self->attributes->{Args}; - return scalar( @{ $c->req->args } ) == $self->attributes->{Args}[0]; -} +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 @@ -90,19 +240,44 @@ 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. -=head1 AUTHOR +=head2 number_of_captures -Matt S. Trout +Returns the number of captures this action expects for L actions. + +=head2 list_extra_info + +A HashRef of key-values that an action can provide to a debugging screen + +=head2 scheme + +Any defined scheme for the action + +=head2 meta + +Provided by Moose. + +=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; +