From: John Napiorkowski Date: Mon, 24 Aug 2015 14:54:21 +0000 (-0500) Subject: test cases for type constraints in roles and superclasses X-Git-Tag: 5.90100~3 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=59051400675390bde280ae6dc6cf500c7bd340cf test cases for type constraints in roles and superclasses --- diff --git a/Changes b/Changes index 92d65c0..64693c0 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,10 @@ # This file documents the revision history for Perl extension Catalyst. +5.90099 - 2015-08-XX + - Document using namespace::autoclean with controllers that have actions + with type constraints. + - Look for type constraints in super classes and consumed roles. + 5.90098 - 2015-08-11 - Fix for RT#106373 (Issue when you try to install and also have an old verion of Test::Mechanize::WWW::Catalyst) diff --git a/lib/Catalyst/Action.pm b/lib/Catalyst/Action.pm index 32d9b99..d5f1502 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'; @@ -243,7 +243,46 @@ 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(defined($name) && blessed($name) && $name->can('check')) { + # Its already a TC, good to go. + return $name; + } + + 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}"; + } + + my @tc = eval "package ${\$self->class}; $name" or do { + # 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 + # 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"; + return @tc if @tc; + } + } + } + + die "'$name' not a type constraint in ${\$self->private_path}"; + }; + if($tc[0]) { return map { ref($_) ? $_ : Moose::Util::TypeConstraints::find_or_parse_type_constraint($_) } @tc; } else { diff --git a/lib/Catalyst/RouteMatching.pod b/lib/Catalyst/RouteMatching.pod index e5f567c..54dc51d 100644 --- a/lib/Catalyst/RouteMatching.pod +++ b/lib/Catalyst/RouteMatching.pod @@ -152,6 +152,115 @@ A tutorial on how to make custom type libraries is outside the scope of this doc recommend looking at the copious documentation in L or in L if you prefer that system. The author recommends L if you are unsure which to use. +=head3 Type constraint namespace. + +By default we assume the namespace which defines the type constraint is in the package +which contains the action declaring the arg or capture arg. However if you do not wish +to import type constraints into you package, you may use a fully qualified namespace for +your type constraint. If you do this you must install L which defines the +code used to lookup and normalize the various types of Type constraint libraries. + +Example: + + package MyApp::Example; + + use Moose; + use MooseX::MethodAttributes; + + extends 'Catalyst::Controller'; + + sub an_int_ns :Local Args(MyApp::Types::Int) { + my ($self, $c, $int) = @_; + $c->res->body('an_int (withrole)'); + } + +Would basically work the same as: + + package MyApp::Example; + + use Moose; + use MooseX::MethodAttributes; + use MyApp::Types 'Int'; + + extends 'Catalyst::Controller'; + + sub an_int_ns :Local Args(Int) { + my ($self, $c, $int) = @_; + $c->res->body('an_int (withrole)'); + } + +=head3 namespace::autoclean + +If you want to use L in your controllers you must 'except' imported +type constraints since the code that resolves type constraints in args / capture args +run after the cleaning. For example: + + package MyApp::Controller::Autoclean; + + use Moose; + use MooseX::MethodAttributes; + use namespace::autoclean -except => 'Int'; + use MyApp::Types qw/Int/; + + extends 'Catalyst::Controller'; + + sub an_int :Local Args(Int) { + my ($self, $c, $int) = @_; + $c->res->body('an_int (autoclean)'); + } + +=head3 Using roles and base controller with type constraints + +If your controller is using a base class or a role that has an action with a type constraint +you should declare your use of the type constraint in that role or base controller in the +same way as you do in main controllers. Catalyst will try to find the package with declares +the type constraint first by looking in any roles and then in superclasses. It will use the +first package that defines the type constraint. For example: + + package MyApp::Role; + + use Moose::Role; + use MooseX::MethodAttributes::Role; + use MyApp::Types qw/Int/; + + sub an_int :Local Args(Int) { + my ($self, $c, $int) = @_; + $c->res->body('an_int (withrole)'); + } + + sub an_int_ns :Local Args(MyApp::Types::Int) { + my ($self, $c, $int) = @_; + $c->res->body('an_int (withrole)'); + } + + package MyApp::BaseController; + + use Moose; + use MooseX::MethodAttributes; + use MyApp::Types qw/Int/; + + extends 'Catalyst::Controller'; + + sub from_parent :Local Args(Int) { + my ($self, $c, $id) = @_; + $c->res->body('from_parent $id'); + } + + package MyApp::Controller::WithRole; + + use Moose; + use MooseX::MethodAttributes; + + extends 'MyApp::BaseController'; + + with 'MyApp::Role'; + +If you have complex controller hierarchy, we +do not at this time attempt to look for all packages with a match type constraint, but instead +take the first one found. In the future we may add code that attempts to insure a sane use +of subclasses with type constraints but right now there are no clear use cases so report issues +and interests. + =head3 Match order when more than one Action matches a path. As previously described, L will match 'the longest path', which generally means diff --git a/t/arg_constraints.t b/t/arg_constraints.t index 5ef97e5..c1e3733 100644 --- a/t/arg_constraints.t +++ b/t/arg_constraints.t @@ -203,7 +203,7 @@ BEGIN { use Moose; use MooseX::MethodAttributes; - use namespace::autoclean; + use namespace::autoclean -except => 'Int'; use MyApp::Types qw/Int/; @@ -228,13 +228,32 @@ BEGIN { $c->res->body('an_int (withrole)'); } + sub an_int_ns :Local Args(MyApp::Types::Int) { + my ($self, $c, $int) = @_; + $c->res->body('an_int (withrole)'); + } + + package MyApp::BaseController; + $INC{'MyApp/BaseController.pm'} = __FILE__; + + use Moose; + use MooseX::MethodAttributes; + use MyApp::Types qw/Int/; + + extends 'Catalyst::Controller'; + + sub from_parent :Local Args(Int) { + my ($self, $c, $id) = @_; + $c->res->body("from_parent $id"); + } + package MyApp::Controller::WithRole; $INC{'MyApp/Controller/WithRole.pm'} = __FILE__; use Moose; use MooseX::MethodAttributes; - extends 'Catalyst::Controller'; + extends 'MyApp::BaseController'; with 'MyApp::Role'; @@ -463,16 +482,6 @@ SKIP: { is $res->content, 'default', "request '/stringy_enum/a'"; } -{ - my $res = request '/autoclean/an_int/1'; - is $res->content, 'an_int (autoclean)'; -} - -{ - my $res = request '/withrole/an_int/1'; - is $res->content, 'an_int (withrole)'; -} - =over | /chain_base/*/*/*/*/*/* | /chain_base (1) @@ -560,4 +569,28 @@ SKIP: { } +{ + my $res = request '/autoclean/an_int/1'; + is $res->content, 'an_int (autoclean)'; +} + +{ + my $res = request '/withrole/an_int_ns/S'; + is $res->content, 'default'; +} + +{ + my $res = request '/withrole/an_int_ns/111'; + is $res->content, 'an_int (withrole)'; +} + +{ + my $res = request '/withrole/an_int/1'; + is $res->content, 'an_int (withrole)'; +} + +{ + my $res = request '/withrole/from_parent/1'; + is $res->content, 'from_parent 1'; +} done_testing;