Move Controller::ActionRole's functionality into the core.

diff --git a/Changes b/Changes
index a82ecfb..e96cf3e 100644 (file)
--- 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 (file)
--- 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 (file)
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 (file)
--- 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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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;