[Catalyst-commits] r13066 - in
Catalyst-Runtime/5.80/branches/action_roles: lib/Catalyst
t/aggregate t/lib t/lib/Catalyst t/lib/Catalyst/Action
t/lib/Catalyst/ActionRole t/lib/TestApp
t/lib/TestApp/ActionRole t/lib/TestApp/Controller
rafl at dev.catalyst.perl.org
rafl at dev.catalyst.perl.org
Mon Mar 22 12:34:34 GMT 2010
Author: rafl
Date: 2010-03-22 12:34:34 +0000 (Mon, 22 Mar 2010)
New Revision: 13066
Added:
Catalyst-Runtime/5.80/branches/action_roles/t/aggregate/live_component_controller_actionroles.t
Catalyst-Runtime/5.80/branches/action_roles/t/lib/Catalyst/ActionRole/
Catalyst-Runtime/5.80/branches/action_roles/t/lib/Catalyst/ActionRole/Moo.pm
Catalyst-Runtime/5.80/branches/action_roles/t/lib/Catalyst/ActionRole/Zoo.pm
Catalyst-Runtime/5.80/branches/action_roles/t/lib/Moo.pm
Catalyst-Runtime/5.80/branches/action_roles/t/lib/TestApp/ActionRole/
Catalyst-Runtime/5.80/branches/action_roles/t/lib/TestApp/ActionRole/Kooh.pm
Catalyst-Runtime/5.80/branches/action_roles/t/lib/TestApp/ActionRole/Moo.pm
Catalyst-Runtime/5.80/branches/action_roles/t/lib/TestApp/Controller/ActionRoles.pm
Modified:
Catalyst-Runtime/5.80/branches/action_roles/lib/Catalyst/Controller.pm
Catalyst-Runtime/5.80/branches/action_roles/t/lib/Catalyst/Action/TestAfter.pm
Log:
Move Controller::ActionRole's functionality into the core.
Modified: Catalyst-Runtime/5.80/branches/action_roles/lib/Catalyst/Controller.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/action_roles/lib/Catalyst/Controller.pm 2010-03-22 12:33:08 UTC (rev 13065)
+++ Catalyst-Runtime/5.80/branches/action_roles/lib/Catalyst/Controller.pm 2010-03-22 12:34:34 UTC (rev 13066)
@@ -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';
@@ -13,37 +16,61 @@
with 'Catalyst::Component::ApplicationAttribute';
-has path_prefix =>
- (
- is => 'rw',
- isa => 'Str',
- init_arg => 'path',
- predicate => 'has_path_prefix',
- );
+has path_prefix => (
+ is => 'rw',
+ isa => 'Str',
+ init_arg => 'path',
+ predicate => 'has_path_prefix',
+);
-has action_namespace =>
- (
- is => 'rw',
- isa => 'Str',
- init_arg => 'namespace',
- predicate => 'has_action_namespace',
- );
+has action_namespace => (
+ is => 'rw',
+ isa => 'Str',
+ init_arg => 'namespace',
+ predicate => 'has_action_namespace',
+);
-has actions =>
- (
- accessor => '_controller_actions',
- isa => 'HashRef',
- init_arg => undef,
- );
+has actions => (
+ accessor => '_controller_actions',
+ isa => 'HashRef',
+ 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_build => 1,
+ handles => {
+ _action_roles => 'elements',
+ },
+);
+
sub BUILD {
my ($self, $args) = @_;
my $action = delete $args->{action} || {};
my $actions = delete $args->{actions} || {};
my $attr_value = $self->merge_config_hashes($actions, $action);
$self->_controller_actions($attr_value);
+ $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;
+}
=head1 NAME
@@ -71,10 +98,11 @@
#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 {
@@ -248,6 +276,20 @@
}
}
+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 create_action {
my $self = shift;
my %args = @_;
@@ -257,6 +299,12 @@
: $self->_action_class);
Class::MOP::load_class($class);
+ my @roles = (
+ (blessed $self ? $self->_action_roles : ()),
+ @{ $args{attributes}->{Does} || [] },
+ );
+ $class = $self->_apply_action_class_roles($class, @roles) if @roles;
+
my $action_args = $self->config->{action_args};
my %extra_args = (
%{ $action_args->{'*'} || {} },
@@ -422,6 +470,32 @@
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;
Added: Catalyst-Runtime/5.80/branches/action_roles/t/aggregate/live_component_controller_actionroles.t
===================================================================
--- Catalyst-Runtime/5.80/branches/action_roles/t/aggregate/live_component_controller_actionroles.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/action_roles/t/aggregate/live_component_controller_actionroles.t 2010-03-22 12:34:34 UTC (rev 13066)
@@ -0,0 +1,32 @@
+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');
+}
+
+done_testing;
Modified: Catalyst-Runtime/5.80/branches/action_roles/t/lib/Catalyst/Action/TestAfter.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/action_roles/t/lib/Catalyst/Action/TestAfter.pm 2010-03-22 12:33:08 UTC (rev 13065)
+++ Catalyst-Runtime/5.80/branches/action_roles/t/lib/Catalyst/Action/TestAfter.pm 2010-03-22 12:34:34 UTC (rev 13066)
@@ -1,15 +1,12 @@
package Catalyst::Action::TestAfter;
-use strict;
-use warnings;
+use Moose;
-use base qw/Catalyst::Action/;
+extends 'Catalyst::Action';
-sub execute {
- my $self = shift;
- my ( $controller, $c ) = @_;
- $self->next::method( @_ );
- $c->res->header( 'X-Action-After', $c->stash->{after_message} );
-}
+after execute => sub {
+ my ($self, $controller, $ctx) = @_;
+ $ctx->res->header( 'X-Action-After', $ctx->stash->{after_message} );
+};
1;
Added: Catalyst-Runtime/5.80/branches/action_roles/t/lib/Catalyst/ActionRole/Moo.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/action_roles/t/lib/Catalyst/ActionRole/Moo.pm (rev 0)
+++ Catalyst-Runtime/5.80/branches/action_roles/t/lib/Catalyst/ActionRole/Moo.pm 2010-03-22 12:34:34 UTC (rev 13066)
@@ -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;
Added: Catalyst-Runtime/5.80/branches/action_roles/t/lib/Catalyst/ActionRole/Zoo.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/action_roles/t/lib/Catalyst/ActionRole/Zoo.pm (rev 0)
+++ Catalyst-Runtime/5.80/branches/action_roles/t/lib/Catalyst/ActionRole/Zoo.pm 2010-03-22 12:34:34 UTC (rev 13066)
@@ -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;
Added: Catalyst-Runtime/5.80/branches/action_roles/t/lib/Moo.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/action_roles/t/lib/Moo.pm (rev 0)
+++ Catalyst-Runtime/5.80/branches/action_roles/t/lib/Moo.pm 2010-03-22 12:34:34 UTC (rev 13066)
@@ -0,0 +1,12 @@
+package Moo;
+
+use Moose::Role;
+
+use namespace::autoclean;
+
+after execute => sub {
+ my ($self, $controller, $c) = @_;
+ $c->response->body(__PACKAGE__);
+};
+
+1;
Added: Catalyst-Runtime/5.80/branches/action_roles/t/lib/TestApp/ActionRole/Kooh.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/action_roles/t/lib/TestApp/ActionRole/Kooh.pm (rev 0)
+++ Catalyst-Runtime/5.80/branches/action_roles/t/lib/TestApp/ActionRole/Kooh.pm 2010-03-22 12:34:34 UTC (rev 13066)
@@ -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;
Added: Catalyst-Runtime/5.80/branches/action_roles/t/lib/TestApp/ActionRole/Moo.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/action_roles/t/lib/TestApp/ActionRole/Moo.pm (rev 0)
+++ Catalyst-Runtime/5.80/branches/action_roles/t/lib/TestApp/ActionRole/Moo.pm 2010-03-22 12:34:34 UTC (rev 13066)
@@ -0,0 +1,10 @@
+package TestApp::ActionRole::Moo;
+
+use Moose::Role;
+
+after execute => sub {
+ my ($self, $controller, $c) = @_;
+ $c->response->body(__PACKAGE__);
+};
+
+1;
Added: Catalyst-Runtime/5.80/branches/action_roles/t/lib/TestApp/Controller/ActionRoles.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/action_roles/t/lib/TestApp/Controller/ActionRoles.pm (rev 0)
+++ Catalyst-Runtime/5.80/branches/action_roles/t/lib/TestApp/Controller/ActionRoles.pm 2010-03-22 12:34:34 UTC (rev 13066)
@@ -0,0 +1,21 @@
+package TestApp::Controller::ActionRoles;
+
+use Moose;
+
+BEGIN { extends 'Catalyst::Controller' }
+
+__PACKAGE__->config(
+ action_roles => ['~Kooh']
+);
+
+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');
+}
+
+1;
More information about the Catalyst-commits
mailing list