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=ca4996ab4e22edb414945f682ea7539f48e76530;hp=d360d68891d82546c91b7a18af6a5f1f2aab4880;hb=337a627ae26fbde968dce5feb4c81fe44f4f517d;hpb=ffca3e960f527321fa30c5ffdfe6ffd2a984af59 diff --git a/lib/Catalyst/Action.pm b/lib/Catalyst/Action.pm index d360d68..ca4996a 100644 --- a/lib/Catalyst/Action.pm +++ b/lib/Catalyst/Action.pm @@ -21,6 +21,7 @@ L subclasses. use Moose; use Scalar::Util 'looks_like_number'; +use Moose::Util::TypeConstraints (); with 'MooseX::Emulate::Class::Accessor::Fast'; use namespace::clean -except => 'meta'; @@ -38,6 +39,74 @@ has private_path => ( 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; + if( ! exists $self->attributes->{Args} ) { + # When 'Args' does not exist, that means we want 'any number of args'. + return undef; + } elsif(!defined($self->attributes->{Args}[0])) { + # When its 'Args' that internal cue for 'unlimited' + return undef; + } elsif( + scalar(@{$self->attributes->{Args}}) == 1 && + 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; + } + } + +sub normalized_arg_number { + return defined($_[0]->number_of_args) ? $_[0]->number_of_args : ~0; +} + +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 ( # Stringify to reverse for debug output etc. @@ -51,8 +120,6 @@ use overload ( ); - - no warnings 'recursion'; sub dispatch { # Execute ourselves against a context @@ -67,33 +134,37 @@ sub execute { 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; + + # If infinite args, we always match + return 1 if $self->normalized_arg_number == ~0; + + # There there are arg constraints, we must see to it that the constraints + # check positive for each arg in the list. + if($self->has_args_constraints) { + # If there is only one type constraint, and its a Ref or subtype of Ref, + # That means we expect a reference, so use the full args arrayref. + if( + $self->number_of_args_constraints == 1 && + $self->args_constraints->[0]->is_a_type_of('Ref') + ) { + return $self->args_constraints->[0]->check($c->req->args); + } else { + for my $i($#{ $c->req->args }) { + $self->args_constraints->[$i]->check($c->req->args->[$i]) || return 0; + } + return 1; + } + } else { + # Otherwise, we just need to match the number of args. + return scalar( @{ $c->req->args } ) == $self->normalized_arg_number; + } } sub match_captures { 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]; + return $a1->normalized_arg_number <=> $a2->normalized_arg_number; } sub number_of_captures { @@ -103,6 +174,10 @@ sub number_of_captures { 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 { @@ -127,7 +202,7 @@ and so on. This determines how the action is dispatched to. =head2 class Returns the name of the component where this action is defined. -Derived by calling the L +Derived by calling the L method on each component. =head2 code @@ -182,7 +257,13 @@ 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. +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 normalized_arg_number + +For the purposes of comparison we normalize 'number_of_args' so that if it is +undef we mean ~0 (as many args are we can think of). =head2 number_of_captures @@ -192,6 +273,10 @@ Returns the number of captures this action expects for L