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=3497e21ec59bb1678efa1816cf4965a86a7f5c9c;hp=32d9b99f9096f19f099771762f64ea8d8764b975;hb=1d00b2ffb8806bd0a8190ee8580a85895e48f8e4;hpb=ec4d72594fb7a701c2f36e85ecf9a680ca1abba2 diff --git a/lib/Catalyst/Action.pm b/lib/Catalyst/Action.pm index 32d9b99..3497e21 100644 --- a/lib/Catalyst/Action.pm +++ b/lib/Catalyst/Action.pm @@ -20,7 +20,7 @@ L subclasses. =cut use Moose; -use Scalar::Util 'looks_like_number'; +use Scalar::Util 'looks_like_number', 'blessed'; use Moose::Util::TypeConstraints (); with 'MooseX::Emulate::Class::Accessor::Fast'; use namespace::clean -except => 'meta'; @@ -105,7 +105,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}) { @@ -190,7 +190,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}) { @@ -243,8 +243,55 @@ has captures_constraints => ( sub resolve_type_constraint { my ($self, $name) = @_; - my @tc = eval "package ${\$self->class}; $name" or die "'$name' not a type constraint in ${\$self->private_path}"; - if($tc[0]) { + + if(defined($name) && blessed($name) && $name->can('check')) { + # Its already a TC, good to go. + 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 full namespace type constraint in ${\$self->private_path}"; + } + + my @tc = grep { defined $_ } (eval("package ${\$self->class}; $name")); + + 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 = $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. + + foreach my $parent (@roles, @supers) { + if(my $m = $parent->get_method($self->name)) { + if($m->can('attributes')) { + my ($key, $value) = map { $_ =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ } + grep { $_=~/^Args\(/ or $_=~/^CaptureArgs\(/ } + @{$m->attributes}; + next unless $value eq $name; + my @tc = eval "package ${\$parent->name}; $name"; + 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"; + } + + if(scalar(@tc)) { return map { ref($_) ? $_ : Moose::Util::TypeConstraints::find_or_parse_type_constraint($_) } @tc; } else { return; @@ -476,7 +523,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