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=fd4aa1cc0315b0d160bcd2328d52a424d97a61b6;hp=d5f15021ca893bbf269debbe2cbb4ba19e90c437;hb=5dd46e24eedec447bdfbc4061ed683b5a17a7b0c;hpb=59051400675390bde280ae6dc6cf500c7bd340cf diff --git a/lib/Catalyst/Action.pm b/lib/Catalyst/Action.pm index d5f1502..fd4aa1c 100644 --- a/lib/Catalyst/Action.pm +++ b/lib/Catalyst/Action.pm @@ -68,6 +68,10 @@ has number_of_args => ( } sub normalized_arg_number { + return $_[0]->number_of_args; +} + +sub comparable_arg_number { return defined($_[0]->number_of_args) ? $_[0]->number_of_args : ~0; } @@ -105,7 +109,7 @@ has number_of_args_constraints => ( return 1; # Its a normal 1 arg type constraint. } } else { - # We need to loop thru and error on ref types. We don't allow a ref type + # We need to loop through and error on ref types. We don't allow a ref type # in the middle. my $total = 0; foreach my $tc( @{$self->args_constraints}) { @@ -130,6 +134,7 @@ has args_constraints => ( handles => { has_args_constraints => 'count', args_constraint_count => 'count', + all_args_constraints => 'elements', }); sub _build_args_constraints { @@ -190,7 +195,7 @@ has number_of_captures_constraints => ( return 1; # Its a normal 1 arg type constraint. } } else { - # We need to loop thru and error on ref types. We don't allow a ref type + # We need to loop through and error on ref types. We don't allow a ref type # in the middle. my $total = 0; foreach my $tc( @{$self->captures_constraints}) { @@ -215,6 +220,7 @@ has captures_constraints => ( handles => { has_captures_constraints => 'count', captures_constraints_count => 'count', + all_captures_constraints => 'elements', }); sub _build_captures_constraints { @@ -249,21 +255,24 @@ sub resolve_type_constraint { return $name; } + # This is broken for when there is more than one constraint if($name=~m/::/) { eval "use Type::Registry; 1" || die "Can't resolve type constraint $name without installing Type::Tiny"; my $tc = Type::Registry->new->foreign_lookup($name); - return defined $tc ? $tc : die "'$name' not a type constraint in ${\$self->private_path}"; + return defined $tc ? $tc : die "'$name' not a full namespace type constraint in ${\$self->private_path}"; } + + my @tc = grep { defined $_ } (eval("package ${\$self->class}; $name")); - my @tc = eval "package ${\$self->class}; $name" or do { + unless(scalar @tc) { # ok... so its not defined in the package. we need to look at all the roles # and superclasses, look for attributes and figure it out. # Superclasses take precedence; - # - my @supers = map { $_->meta } $self->class->meta->superclasses; - my @roles = $self->class->meta->calculate_all_roles; - # So look thru all the super and roles in order and return the + my @supers = $self->class->can('meta') ? map { $_->meta } $self->class->meta->superclasses : (); + my @roles = $self->class->can('meta') ? $self->class->meta->calculate_all_roles : (); + + # So look through all the super and roles in order and return the # first type constraint found. We should probably find all matching # type constraints and try to do some sort of resolution. @@ -275,15 +284,20 @@ sub resolve_type_constraint { @{$m->attributes}; next unless $value eq $name; my @tc = eval "package ${\$parent->name}; $name"; - return @tc if @tc; - } + if(scalar(@tc)) { + return map { ref($_) ? $_ : Moose::Util::TypeConstraints::find_or_parse_type_constraint($_) } @tc; + } else { + return; + } + } } } + + my $classes = join(',', $self->class, @roles, @supers); + die "'$name' not a type constraint in '${\$self->private_path}', Looked in: $classes"; + } - die "'$name' not a type constraint in ${\$self->private_path}"; - }; - - if($tc[0]) { + if(scalar(@tc)) { return map { ref($_) ? $_ : Moose::Util::TypeConstraints::find_or_parse_type_constraint($_) } @tc; } else { return; @@ -373,8 +387,8 @@ sub match_args { # Optimization since Tuple[Int, Int] would fail on 3,4,5 anyway, but this # way we can avoid calling the constraint when the arg length is incorrect. if( - $self->normalized_arg_number == ~0 || - scalar( @args ) == $self->normalized_arg_number + $self->comparable_arg_number == ~0 || + scalar( @args ) == $self->comparable_arg_number ) { return $self->args_constraints->[0]->check($args); } else { @@ -389,7 +403,7 @@ sub match_args { } else { # Because of the way chaining works, we can expect args that are totally not # what you'd expect length wise. When they don't match length, thats a fail - return 0 unless scalar( @args ) == $self->normalized_arg_number; + return 0 unless scalar( @args ) == $self->comparable_arg_number; for my $i(0..$#args) { $self->args_constraints->[$i]->check($args[$i]) || return 0; @@ -398,10 +412,10 @@ sub match_args { } } else { # If infinite args with no constraints, we always match - return 1 if $self->normalized_arg_number == ~0; + return 1 if $self->comparable_arg_number == ~0; # Otherwise, we just need to match the number of args. - return scalar( @args ) == $self->normalized_arg_number; + return scalar( @args ) == $self->comparable_arg_number; } } @@ -443,7 +457,7 @@ sub match_captures_constraints { sub compare { my ($a1, $a2) = @_; - return $a1->normalized_arg_number <=> $a2->normalized_arg_number; + return $a1->comparable_arg_number <=> $a2->comparable_arg_number; } sub scheme { @@ -515,7 +529,7 @@ Does the Args match or not? =head2 resolve_type_constraint -Trys to find a type constraint if you have on on a type constrained method. +Tries to find a type constraint if you have on on a type constrained method. =head2 compare @@ -546,6 +560,12 @@ take any arguments and undef if it will take any number of arguments. =head2 normalized_arg_number +The number of arguments (starting with zero) that the current action defines, or +undefined if there is not defined number of args (which is later treated as, " +as many arguments as you like"). + +=head2 comparable_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).