From: Florian Ragwitz Date: Mon, 22 Mar 2010 12:34:34 +0000 (+0000) Subject: Move Controller::ActionRole's functionality into the core. X-Git-Tag: 5.90013~2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=eff6001994ab7558c366fa5f9e5aa8c2de69ac4a Move Controller::ActionRole's functionality into the core. --- diff --git a/Changes b/Changes index a82ecfb..e96cf3e 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,8 @@ # This file documents the revision history for Perl extension Catalyst. + New features: + - Merge Catalyst::Controller::ActionRole into Catalyst::Controller. + Bug fixes: - Fix warnings in some matching cases for Action methods with Args(), when using Catalyst::DispatchType::Chained diff --git a/lib/Catalyst/Controller.pm b/lib/Catalyst/Controller.pm index fb6df0d..bb4ce8b 100644 --- a/lib/Catalyst/Controller.pm +++ b/lib/Catalyst/Controller.pm @@ -1,7 +1,10 @@ package Catalyst::Controller; use Moose; +use Class::MOP; +use String::RewritePrefix; use Moose::Util qw/find_meta/; +use List::Util qw/first/; use List::MoreUtils qw/uniq/; use namespace::clean -except => 'meta'; @@ -33,6 +36,27 @@ has actions => ( init_arg => undef, ); +has _action_role_args => ( + traits => [qw(Array)], + isa => 'ArrayRef[Str]', + init_arg => 'action_roles', + default => sub { [] }, + handles => { + _action_role_args => 'elements', + }, +); + +has _action_roles => ( + traits => [qw(Array)], + isa => 'ArrayRef[RoleName]', + init_arg => undef, + lazy => 1, + builder => '_build__action_roles', + handles => { + _action_roles => 'elements', + }, +); + has action_args => (is => 'ro'); # ->config(actions => { '*' => ... @@ -53,6 +77,14 @@ sub BUILD { # trigger lazy builder $self->_all_actions_attributes; + $self->_action_roles; +} + +sub _build__action_roles { + my $self = shift; + my @roles = $self->_expand_role_shortname($self->_action_role_args); + Class::MOP::load_class($_) for @roles; + return \@roles; } sub _build__all_actions_attributes { @@ -85,10 +117,11 @@ for more info about how Catalyst dispatches to actions. #I think both of these could be attributes. doesn't really seem like they need #to ble class data. i think that attributes +default would work just fine -__PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class/; +__PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class _action_role_prefix/; __PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] ); __PACKAGE__->_action_class('Catalyst::Action'); +__PACKAGE__->_action_role_prefix([ 'Catalyst::ActionRole::' ]); sub _DISPATCH : Private { @@ -261,6 +294,20 @@ sub register_action_methods { } } +sub _apply_action_class_roles { + my ($self, $class, @roles) = @_; + + Class::MOP::load_class($_) for @roles; + my $meta = Moose::Meta::Class->initialize($class)->create_anon_class( + superclasses => [$class], + roles => \@roles, + cache => 1, + ); + $meta->add_method(meta => sub { $meta }); + + return $meta->name; +} + sub action_class { my $self = shift; my %args = @_; @@ -278,6 +325,16 @@ sub create_action { my %args = @_; my $class = $self->action_class(%args); + + load_class($class); + Moose->init_meta(for_class => $class) + unless Class::MOP::does_metaclass_exist($class); + + unless ($args{name} =~ /^_(DISPATCH|BEGIN|AUTO|ACTION|END)$/) { + my @roles = $self->gather_action_roles(%args); + $class = $self->_apply_action_class_roles($class, @roles) if @roles; + } + my $action_args = ( ref($self) ? $self->action_args @@ -292,6 +349,15 @@ sub create_action { return $class->new({ %extra_args, %args }); } +sub gather_action_roles { + my ($self, %args) = @_; + + return ( + (blessed $self ? $self->_action_roles : ()), + @{ $args{attributes}->{Does} || [] }, + ); +} + sub _parse_attrs { my ( $self, $c, $name, @attrs ) = @_; @@ -457,6 +523,32 @@ sub _parse_MyAction_attr { return ( 'ActionClass', $value ); } +sub _parse_Does_attr { + my ($self, $app, $name, $value) = @_; + return Does => $self->_expand_role_shortname($value); +} + +sub _expand_role_shortname { + my ($self, @shortnames) = @_; + my $app = $self->_application; + + my $prefix = $self->can('_action_role_prefix') ? $self->_action_role_prefix : ['Catalyst::ActionRole::']; + my @prefixes = (qq{${app}::ActionRole::}, @$prefix); + + return String::RewritePrefix->rewrite( + { '' => sub { + my $loaded = Class::MOP::load_first_existing_class( + map { "$_$_[0]" } @prefixes + ); + return first { $loaded =~ /^$_/ } + sort { length $b <=> length $a } @prefixes; + }, + '~' => $prefixes[0], + '+' => '' }, + @shortnames, + ); +} + __PACKAGE__->meta->make_immutable; 1; @@ -574,6 +666,10 @@ action class to use. Called with a hash of data to be use for construction of a new Catalyst::Action (or appropriate sub/alternative class) object. +=head2 $self->gather_action_roles(\%action_args) + +Gathers the list of roles to apply to an action with the given %action_args. + =head2 $self->_application =head2 $self->_app diff --git a/t/aggregate/live_component_controller_actionroles.t b/t/aggregate/live_component_controller_actionroles.t new file mode 100644 index 0000000..0bf1b0c --- /dev/null +++ b/t/aggregate/live_component_controller_actionroles.t @@ -0,0 +1,36 @@ +use strict; +use warnings; +use Test::More; + +use FindBin; +use lib "$FindBin::Bin/../lib"; + +use Catalyst::Test 'TestApp'; + +my %roles = ( + foo => 'TestApp::ActionRole::Moo', + bar => 'TestApp::ActionRole::Moo', + baz => 'Moo', + quux => 'Catalyst::ActionRole::Zoo', +); + +while (my ($path, $role) = each %roles) { + my $resp = request("/actionroles/${path}"); + ok($resp->is_success); + is($resp->content, $role); + is($resp->header('X-Affe'), 'Tiger'); +} + +{ + my $resp = request("/actionroles/corge"); + ok($resp->is_success); + is($resp->content, 'TestApp::ActionRole::Moo'); + is($resp->header('X-Affe'), 'Tiger'); + is($resp->header('X-Action-After'), 'moo'); +} +{ + my $resp = request("/actionroles/frew"); + ok($resp->is_success); + is($resp->content, 'hello', 'action_args are honored with ActionRoles'); + } +done_testing; diff --git a/t/lib/Catalyst/Action/TestAfter.pm b/t/lib/Catalyst/Action/TestAfter.pm index 199ea25..2139a8b 100644 --- a/t/lib/Catalyst/Action/TestAfter.pm +++ b/t/lib/Catalyst/Action/TestAfter.pm @@ -3,7 +3,8 @@ package Catalyst::Action::TestAfter; use strict; use warnings; -use base qw/Catalyst::Action/; +use base qw/Catalyst::Action/; # N.B. Keep as a non-moose class, this also + # tests metaclass initialization works as expected sub execute { my $self = shift; diff --git a/t/lib/Catalyst/ActionRole/Moo.pm b/t/lib/Catalyst/ActionRole/Moo.pm new file mode 100644 index 0000000..3d4aa51 --- /dev/null +++ b/t/lib/Catalyst/ActionRole/Moo.pm @@ -0,0 +1,12 @@ +package Catalyst::ActionRole::Moo; + +use Moose::Role; + +use namespace::autoclean; + +after execute => sub { + my ($self, $controller, $c) = @_; + $c->response->body(__PACKAGE__); +}; + +1; diff --git a/t/lib/Catalyst/ActionRole/Zoo.pm b/t/lib/Catalyst/ActionRole/Zoo.pm new file mode 100644 index 0000000..d4f0c9f --- /dev/null +++ b/t/lib/Catalyst/ActionRole/Zoo.pm @@ -0,0 +1,12 @@ +package Catalyst::ActionRole::Zoo; + +use Moose::Role; + +use namespace::autoclean; + +after execute => sub { + my ($self, $controller, $c) = @_; + $c->response->body(__PACKAGE__); +}; + +1; diff --git a/t/lib/Moo.pm b/t/lib/Moo.pm new file mode 100644 index 0000000..c28806a --- /dev/null +++ b/t/lib/Moo.pm @@ -0,0 +1,12 @@ +package Moo; + +use Moose::Role; + +use namespace::autoclean; + +after execute => sub { + my ($self, $controller, $c) = @_; + $c->response->body(__PACKAGE__); +}; + +1; diff --git a/t/lib/TestApp/ActionRole/Boo.pm b/t/lib/TestApp/ActionRole/Boo.pm new file mode 100644 index 0000000..f55f9fe --- /dev/null +++ b/t/lib/TestApp/ActionRole/Boo.pm @@ -0,0 +1,16 @@ +package TestApp::ActionRole::Boo; + +use Moose::Role; + +has boo => ( + is => 'ro', + required => 1, +); + +around execute => sub { + my ($orig, $self, $controller, $ctx, @rest) = @_; + $ctx->stash(action_boo => $self->boo); + return $self->$orig($controller, $ctx, @rest); +}; + +1; diff --git a/t/lib/TestApp/ActionRole/Kooh.pm b/t/lib/TestApp/ActionRole/Kooh.pm new file mode 100644 index 0000000..fc82bf2 --- /dev/null +++ b/t/lib/TestApp/ActionRole/Kooh.pm @@ -0,0 +1,12 @@ +package TestApp::ActionRole::Kooh; + +use Moose::Role; + +use namespace::autoclean; + +after execute => sub { + my ($self, $controller, $c) = @_; + $c->response->header('X-Affe' => 'Tiger'); +}; + +1; diff --git a/t/lib/TestApp/ActionRole/Moo.pm b/t/lib/TestApp/ActionRole/Moo.pm new file mode 100644 index 0000000..d0fd290 --- /dev/null +++ b/t/lib/TestApp/ActionRole/Moo.pm @@ -0,0 +1,10 @@ +package TestApp::ActionRole::Moo; + +use Moose::Role; + +after execute => sub { + my ($self, $controller, $c) = @_; + $c->response->body(__PACKAGE__); +}; + +1; diff --git a/t/lib/TestApp/Controller/ActionRoles.pm b/t/lib/TestApp/Controller/ActionRoles.pm new file mode 100644 index 0000000..37c24f9 --- /dev/null +++ b/t/lib/TestApp/Controller/ActionRoles.pm @@ -0,0 +1,30 @@ +package TestApp::Controller::ActionRoles; + +use Moose; + +BEGIN { extends 'Catalyst::Controller' } + +__PACKAGE__->config( + action_roles => ['~Kooh'], + action_args => { + frew => { boo => 'hello' }, + }, +); + +sub foo : Local Does('Moo') {} +sub bar : Local Does('~Moo') {} +sub baz : Local Does('+Moo') {} +sub quux : Local Does('Zoo') {} + +sub corge : Local Does('Moo') ActionClass('TestAfter') { + my ($self, $ctx) = @_; + $ctx->stash(after_message => 'moo'); +} + +sub frew : Local Does('Boo') { + my ($self, $ctx) = @_; + my $boo = $ctx->stash->{action_boo}; + $ctx->response->body($boo); +} + +1;