From: John Napiorkowski Date: Tue, 14 Apr 2015 18:51:09 +0000 (-0500) Subject: fixed bugs in type constraints and cored some extensibility features X-Git-Tag: 5.90089_002~12 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=ec4d72594fb7a701c2f36e85ecf9a680ca1abba2 fixed bugs in type constraints and cored some extensibility features --- diff --git a/Changes b/Changes index 416e2b7..a93c67b 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,6 @@ # This file documents the revision history for Perl extension Catalyst. -5.90089_002 - 2015-04-03 +5.90089_002 - 2015-04-15 - Changed the way we check for presence of Type::Tiny in a test case to be more explicit in the version requirement. Hopefully a fix for reported test fail. @@ -12,10 +12,25 @@ - Additional changes to type constraint detection to between determine when a type constraint for reference types have a measured number of arguments or not. clarify restriction on reference type constraints. + - Several bugs with type constraints and uri_for squashed. More test cases + around all the argument type constraints to tighten scope of action. + - NEW FEATURE: New method in Catalyst::Utils 'inject_component', which is a core + version of the previously external addon 'CatalystX::InjectComponent'. You should + start to convert your existing code which uses the stand alone version, since + going forward only the core version will be supported. + - NEW FEATURE: Concepts from 'CatalystX::RoleApplicator' have been moved to core + so we now have the follow application attributes 'request_class_traits', + 'response_class_traits' and 'stats_class_traits' which allow you to compose + traits for these core Catalyst classes without needing to create subclasses. So + in general any request or response trait on CPAN that used 'CatalystX::RoleApplicator' + should now just work with this core feature. + - Only create a stats object if you are using stats. This is a minor performance + optimization, but there's a small chance it is a breaking change, so please + report any stats related issues. 5.90089_001 - 2015-03-26 - New development branch synched with 5.90085. - - New Feature: Type Constraints on Args/CaptureArgs. Allows you to declare + - NEW FEATURE: Type Constraints on Args/CaptureArgs. Allows you to declare a Moose, MooseX::Types or Type::Tiny named constraint on your Arg or CaptureArg. - When using $c->uri_for (or the derived $c->uri_for_action) and the target diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 8e487f5..27b421e 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -63,7 +63,9 @@ has request => ( is => 'rw', default => sub { my $self = shift; - $self->request_class->new($self->_build_request_constructor_args); + my $class = ref $self; + my $composed_request_class = $class->composed_request_class; + return $composed_request_class->new( $self->_build_request_constructor_args); }, lazy => 1, ); @@ -77,11 +79,19 @@ sub _build_request_constructor_args { \%p; } +sub composed_request_class { + my $class = shift; + return $class->_composed_request_class || + $class->_composed_request_class(Moose::Util::with_traits($class->request_class, @{$class->request_class_traits||[]})); +} + has response => ( is => 'rw', default => sub { my $self = shift; - $self->response_class->new($self->_build_response_constructor_args); + my $class = ref $self; + my $composed_response_class = $class->composed_response_class; + return $composed_response_class->new( $self->_build_response_constructor_args); }, lazy => 1, ); @@ -92,6 +102,12 @@ sub _build_response_constructor_args { }; } +sub composed_response_class { + my $class = shift; + return $class->_composed_response_class || + $class->_composed_response_class(Moose::Util::with_traits($class->response_class, @{$class->response_class_traits||[]})); +} + has namespace => (is => 'rw'); sub depth { scalar @{ shift->stack || [] }; } @@ -120,12 +136,21 @@ __PACKAGE__->mk_classdata($_) for qw/components arguments dispatcher engine log dispatcher_class engine_loader context_class request_class response_class stats_class setup_finished _psgi_app loading_psgi_file run_options _psgi_middleware - _data_handlers _encoding _encode_check finalized_default_middleware/; + _data_handlers _encoding _encode_check finalized_default_middleware + request_class_traits response_class_traits stats_class_traits + _composed_request_class _composed_response_class _composed_stats_class/; __PACKAGE__->dispatcher_class('Catalyst::Dispatcher'); __PACKAGE__->request_class('Catalyst::Request'); __PACKAGE__->response_class('Catalyst::Response'); __PACKAGE__->stats_class('Catalyst::Stats'); + +sub composed_stats_class { + my $class = shift; + return $class->_composed_stats_class || + $class->_composed_stats_class(Moose::Util::with_traits($class->stats_class, @{$class->stats_class_traits||[]})); +} + __PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC); # Remember to update this in Catalyst::Runtime as well! @@ -1487,8 +1512,8 @@ sub uri_for { } if($num_captures) { - unless($expanded_action->match_captures($c, $captures)) { - carp "captures [@{$captures}] do not match the type constraints in actionchain ending with '$action'"; + unless($expanded_action->match_captures_constraints($c, $captures)) { + carp "captures [@{$captures}] do not match the type constraints in actionchain ending with '$expanded_action'"; return; } } @@ -2269,8 +2294,10 @@ sub prepare { $c->response->_context($c); - #surely this is not the most efficient way to do things... - $c->stats($class->stats_class->new)->enable($c->use_stats); + if($c->use_stats) { + $c->stats($class->composed_stats_class->new)->enable; + } + if ( $c->debug || $c->config->{enable_catalyst_header} ) { $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION ); } @@ -2676,10 +2703,26 @@ sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) } Returns or sets the request class. Defaults to L. +=head2 $app->request_class_traits + +An arrayref of Ls which are applied to the request class. + +=head2 $app->composed_request_class + +This is the request class which has been composed with any request_class_traits. + =head2 $c->response_class Returns or sets the response class. Defaults to L. +=head2 $app->response_class_traits + +An arrayref of Ls which are applied to the response class. + +=head2 $app->composed_response_class + +This is the request class which has been composed with any response_class_traits. + =head2 $c->read( [$maxlength] ) Reads a chunk of data from the request body. This method is designed to @@ -2797,6 +2840,15 @@ sub setup_components { $class->components->{ $component } = $class->setup_component($component); } } + + # Inject a component or wrap a stand alone class in an adaptor + #my @configured_comps = grep { not($class->component($_)||'') } + # grep { /^(Model)::|(View)::|(Controller::)/ } + # keys %{$class->config ||+{}}; + + #foreach my $configured_comp(@configured_comps) { + #warn $configured_comp; + #} } =head2 $c->locate_components( $setup_component_config ) @@ -3683,6 +3735,14 @@ by itself. Returns or sets the stats (timing statistics) class. L is used by default. +=head2 $app->stats_class_traits + +A arrayref of Ls that are applied to the stats_class before creating it. + +=head2 $app->composed_stats_class + +this is the stats_class composed with any 'stats_class_traits'. + =head2 $c->use_stats Returns 1 when L<< stats collection|/"-Stats" >> is enabled. diff --git a/lib/Catalyst/Action.pm b/lib/Catalyst/Action.pm index 0a38d75..32d9b99 100644 --- a/lib/Catalyst/Action.pm +++ b/lib/Catalyst/Action.pm @@ -371,28 +371,37 @@ sub match_captures { my @captures = @{$captures||[]}; return 1 unless scalar(@captures); # If none, just say its ok + return $self->has_captures_constraints ? + $self->match_captures_constraints($c, $captures) : 1; - if($self->has_captures_constraints) { - if( - $self->captures_constraints_count == 1 && - ( - $self->captures_constraints->[0]->is_a_type_of('Ref') || - $self->captures_constraints->[0]->is_a_type_of('ClassName') - ) - ) { - return $self->captures_constraints->[0]->check($captures); - } else { - for my $i(0..$#captures) { - $self->captures_constraints->[$i]->check($captures[$i]) || return 0; - } - return 1; - } + return 1; +} + +sub match_captures_constraints { + my ($self, $c, $captures) = @_; + my @captures = @{$captures||[]}; + + # Match is positive if you don't have any. + return 1 unless $self->has_captures_constraints; + + if( + $self->captures_constraints_count == 1 && + ( + $self->captures_constraints->[0]->is_a_type_of('Ref') || + $self->captures_constraints->[0]->is_a_type_of('ClassName') + ) + ) { + return $self->captures_constraints->[0]->check($captures); } else { + for my $i(0..$#captures) { + $self->captures_constraints->[$i]->check($captures[$i]) || return 0; + } return 1; - } - return 1; + } + } + sub compare { my ($a1, $a2) = @_; return $a1->normalized_arg_number <=> $a2->normalized_arg_number; @@ -456,6 +465,11 @@ 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 match_captures_constraints ($c, \@captures); + +Does the \@captures given match any constraints (if any constraints exist). Returns +true if you ask but there are no constraints. + =head2 match_args($c, $args) Does the Args match or not? diff --git a/lib/Catalyst/ActionChain.pm b/lib/Catalyst/ActionChain.pm index 873e3a8..4f72839 100644 --- a/lib/Catalyst/ActionChain.pm +++ b/lib/Catalyst/ActionChain.pm @@ -71,6 +71,17 @@ sub match_captures { } return 1; } +sub match_captures_constraints { + my ($self, $c, $captures) = @_; + my @captures = @{$captures||[]}; + + foreach my $link(@{$self->chain}) { + my @local_captures = splice @captures,0,$link->number_of_captures; + next unless $link->has_captures_constraints; + return unless $link->match_captures_constraints($c, \@local_captures); + } + return 1; +} # the scheme defined at the end of the chain is the one we use # but warn if too many. diff --git a/lib/Catalyst/Delta.pod b/lib/Catalyst/Delta.pod index bbc1a36..e965025 100755 --- a/lib/Catalyst/Delta.pod +++ b/lib/Catalyst/Delta.pod @@ -24,6 +24,11 @@ your arguments to $c->uri_for(...) must match those constraints. See L for more. +=head2 Move CatalystX::InjectComponent into core + +L has a new method 'inject_component' which works the same as the method of +the same name in L. + =head2 VERSION 5.90080+ The biggest change in this release is that UTF8 encoding is now enabled by diff --git a/lib/Catalyst/Upgrading.pod b/lib/Catalyst/Upgrading.pod index e210bbb..5a5a857 100644 --- a/lib/Catalyst/Upgrading.pod +++ b/lib/Catalyst/Upgrading.pod @@ -2,6 +2,25 @@ Catalyst::Upgrading - Instructions for upgrading to the latest Catalyst +=head1 Upgrading to Catalyst 5.90090 + +L has a new method 'inject_component' which works the same as the method of +the same name in L. You should start converting any +use of the non core method in your code as future changes to Catalyst will be +sychronized to the core method first. We reserve the right to cease support +of the non core version should we reach a point in time where it cannot be +properly supported as an external module. Luckily this should be a trivial +search and replace. Change all occurances of: + + CatalystX::InjectComponent->inject(...) + +Into + + Catalyst::Utils::inject_component(...) + +and we expect everything to work the same (we'd consider it not working the same +to be a bug, and please report it.) + =head1 Upgrading to Catalyst 5.90085 In this version of Catalyst we made a small change to Chained Dispatching so diff --git a/lib/Catalyst/Utils.pm b/lib/Catalyst/Utils.pm index 1bccecb..babcfa3 100644 --- a/lib/Catalyst/Utils.pm +++ b/lib/Catalyst/Utils.pm @@ -11,6 +11,7 @@ use Class::Load 'is_class_loaded'; use String::RewritePrefix; use Class::Load (); use namespace::clean; +use Devel::InnerPackage; =head1 NAME @@ -502,7 +503,78 @@ sub apply_registered_middleware { return $new_psgi; } +=head2 inject_component +Used to add components at runtime: + + into The Catalyst package to inject into (e.g. My::App) + component The component package to inject + as An optional moniker to use as the package name for the derived component + +For example: + + Catalyst::Utils::inject_component( into => My::App, component => Other::App::Controller::Apple ) + + The above will create 'My::App::Controller::Other::App::Controller::Apple' + + Catalyst::Utils::inject_component( into => My::App, component => Other::App::Controller::Apple, as => Apple ) + + The above will create 'My::App::Controller::Apple' + + Catalyst::Utils::inject_component( into => $myapp, component => 'MyRootV', as => 'Controller::Root' ); + +Will inject Controller, Model, and View components into your Catalyst application +at setup (run)time. It does this by creating a new package on-the-fly, having that +package extend the given component, and then having Catalyst setup the new component +(via $app->setup_component). + +B This is basically a core version of L. If you were using that +you can now use this safely instead. Going forward changes required to make this work will be +synchronized with the core method. + +=cut + +sub inject_component { + my %given = @_; + my ($into, $component, $as) = @given{qw/into component as/}; + + croak "No Catalyst (package) given" unless $into; + croak "No component (package) given" unless $component; + + Class::Load::load_class($component); + + $as ||= $component; + unless ( $as =~ m/^(?:Controller|Model|View)::/ || $given{skip_mvc_renaming} ) { + my $category; + for (qw/ Controller Model View /) { + if ( $component->isa( "Catalyst::$_" ) ) { + $category = $_; + last; + } + } + croak "Don't know what kind of component \"$component\" is" unless $category; + $as = "${category}::$as"; + } + my $component_package = join '::', $into, $as; + + unless ( Class::Load::is_class_loaded $component_package ) { + eval "package $component_package; use base qw/$component/; 1;" or + croak "Unable to build component package for \"$component_package\": $@"; + (my $file = "$component_package.pm") =~ s{::}{/}g; + $INC{$file} ||= 1; + } + + my $_setup_component = sub { + my $into = shift; + my $component_package = shift; + $into->components->{$component_package} = $into->setup_component( $component_package ); + }; + + $_setup_component->( $into, $component_package ); + for my $inner_component_package ( Devel::InnerPackage::list_packages( $component_package ) ) { + $_setup_component->( $into, $inner_component_package ); + } +} =head1 PSGI Helpers diff --git a/t/Test/Apple.pm b/t/Test/Apple.pm new file mode 100644 index 0000000..c6f354e --- /dev/null +++ b/t/Test/Apple.pm @@ -0,0 +1,14 @@ +package t::Test::Apple; + +use strict; +use warnings; + +use parent qw/Catalyst::Controller/; + +sub default :Path { +} + +sub apple :Local { +} + +1; diff --git a/t/class_traits.t b/t/class_traits.t new file mode 100644 index 0000000..f796323 --- /dev/null +++ b/t/class_traits.t @@ -0,0 +1,44 @@ +use strict; +use warnings; +use Test::More; +use Class::MOP; + +BEGIN { + package TestRole; + use Moose::Role; + + sub a { 'a' } + sub b { 'b' } +} + +{ + package TestApp; + + use Catalyst; + + __PACKAGE__->request_class_traits([qw/TestRole/]); + __PACKAGE__->response_class_traits([qw/TestRole/]); + __PACKAGE__->stats_class_traits([qw/TestRole/]); + + __PACKAGE__->setup; +} + + +foreach my $class_prefix (qw/request response stats/) { + my $method = 'composed_' .$class_prefix. '_class'; + ok( + Class::MOP::class_of(TestApp->$method)->does_role('TestRole'), + "$method does TestRole", + ); +} + +use Catalyst::Test 'TestApp'; + +my ($res, $c) = ctx_request '/'; + +is $c->req->a, 'a'; +is $c->req->b, 'b'; +is $c->res->a, 'a'; +is $c->res->b, 'b'; + +done_testing; diff --git a/t/configured_comps.t b/t/configured_comps.t new file mode 100644 index 0000000..84a5a8e --- /dev/null +++ b/t/configured_comps.t @@ -0,0 +1,76 @@ +use warnings; +use strict; +use HTTP::Request::Common; +use Test::More; + +{ + package Local::Controller::Errors; + + use Moose; + use MooseX::MethodAttributes; + + extends 'Catalyst::Controller'; + + has ['a', 'b'] => (is=>'ro', required=>1); + + sub not_found :Local { pop->res->from_psgi_response(404, [], ['Not Found']) } + + package MyApp::Model::User; + $INC{'MyApp/Model/User.pm'} = __FILE__; + + use base 'Catalyst::Model'; + + our %users = ( + 1 => { name => 'john', age => 46 }, + 2 => { name => 'mary', age => 36 }, + 3 => { name => 'ian', age => 25 }, + 4 => { name => 'visha', age => 18 }, + ); + + sub find { + my ($self, $id) = @_; + my $user = $users{$id} || return; + return bless $user, "MyApp::Model::User::user"; + } + + package MyApp::Controller::Root; + $INC{'MyApp/Controller/Root.pm'} = __FILE__; + + use Moose; + use MooseX::MethodAttributes; + + extends 'Catalyst::Controller'; + + sub user :Local Args(1) { + my ($self, $c, $int) = @_; + my $user = $c->model("User")->find($int); + $c->res->body("name: $user->{name}, age: $user->{age}"); + } + + sub default :Default { + my ($self, $c, $int) = @_; + $c->res->body('default'); + } + + MyApp::Controller::Root->config(namespace=>''); + + package MyApp; + use Catalyst; + + MyApp->config({ + 'Controller::Err' => { + component => 'Local::Controller::Errors' + } + }); + + MyApp->setup; +} + +use Catalyst::Test 'MyApp'; + +{ + my $res = request '/user/1'; + is $res->content, 'name: john, age: 46'; +} + +done_testing; diff --git a/t/inject_component_util.t b/t/inject_component_util.t new file mode 100644 index 0000000..c757d9c --- /dev/null +++ b/t/inject_component_util.t @@ -0,0 +1,41 @@ +use strict; +use warnings; +use Test::More; +use Catalyst::Utils; + +BEGIN { +package Model::Banana; + +use base qw/Catalyst::Model/; + +package TestCatalyst; $INC{'TestCatalyst.pm'} = 1; + +use Catalyst::Runtime '5.70'; + +use Moose; +BEGIN { extends qw/Catalyst/ } + +use Catalyst; + +after 'setup_components' => sub { + my $self = shift; + Catalyst::Utils::inject_component( into => __PACKAGE__, component => 'Model::Banana' ); + Catalyst::Utils::inject_component( into => __PACKAGE__, component => 't::Test::Apple' ); + Catalyst::Utils::inject_component( into => __PACKAGE__, component => 'Model::Banana', as => 'Cherry' ); + Catalyst::Utils::inject_component( into => __PACKAGE__, component => 't::Test::Apple', as => 'Apple' ); +}; + +TestCatalyst->config( 'home' => '.' ); + +TestCatalyst->setup; + +} + +package main; + +use Catalyst::Test qw/TestCatalyst/; + +ok( TestCatalyst->controller( $_ ) ) for qw/ Apple t::Test::Apple /; +ok( TestCatalyst->model( $_ ) ) for qw/ Banana Cherry /; + +done_testing;