[Catalyst-commits] r11018 - in Catalyst-Runtime/5.80/trunk: . lib
lib/Catalyst t/aggregate t/lib/TestApp/Action
t/lib/TestApp/Controller
t0m at dev.catalyst.perl.org
t0m at dev.catalyst.perl.org
Sat Aug 1 00:39:39 GMT 2009
Author: t0m
Date: 2009-08-01 00:39:39 +0000 (Sat, 01 Aug 2009)
New Revision: 11018
Added:
Catalyst-Runtime/5.80/trunk/t/aggregate/live_component_controller_anon.t
Catalyst-Runtime/5.80/trunk/t/lib/TestApp/Controller/Anon.pm
Modified:
Catalyst-Runtime/5.80/trunk/Makefile.PL
Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm
Catalyst-Runtime/5.80/trunk/lib/Catalyst/Action.pm
Catalyst-Runtime/5.80/trunk/lib/Catalyst/Component.pm
Catalyst-Runtime/5.80/trunk/lib/Catalyst/Controller.pm
Catalyst-Runtime/5.80/trunk/t/lib/TestApp/Action/TestMyAction.pm
Log:
Merge branch pass_component_names:
svn merge -r 10899:10927 http://dev.catalyst.perl.org/repos/Catalyst/Catalyst-Runtime/5.80/branches/pass_component_names
Modified: Catalyst-Runtime/5.80/trunk/Makefile.PL
===================================================================
--- Catalyst-Runtime/5.80/trunk/Makefile.PL 2009-08-01 00:20:43 UTC (rev 11017)
+++ Catalyst-Runtime/5.80/trunk/Makefile.PL 2009-08-01 00:39:39 UTC (rev 11018)
@@ -11,7 +11,7 @@
requires 'MooseX::Emulate::Class::Accessor::Fast' => '0.00801';
requires 'Class::MOP' => '0.83';
requires 'Moose' => '0.78';
-requires 'MooseX::MethodAttributes::Inheritable' => '0.12';
+requires 'MooseX::MethodAttributes::Inheritable' => '0.14';
requires 'Carp';
requires 'Class::C3::Adopt::NEXT' => '0.07';
requires 'CGI::Simple::Cookie';
Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/Action.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/Action.pm 2009-08-01 00:20:43 UTC (rev 11017)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/Action.pm 2009-08-01 00:39:39 UTC (rev 11018)
@@ -55,8 +55,6 @@
no warnings 'recursion';
-#__PACKAGE__->mk_accessors(qw/class namespace reverse attributes name code/);
-
sub dispatch { # Execute ourselves against a context
my ( $self, $c ) = @_;
return $c->execute( $self->class, $self );
@@ -105,7 +103,9 @@
=head2 class
-Returns the class name where this action is defined.
+Returns the name of the component where this action is defined.
+Derived by calling the L<Catalyst::Component/_component_name|_component_name>
+method on each component.
=head2 code
Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/Component.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/Component.pm 2009-08-01 00:20:43 UTC (rev 11017)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/Component.pm 2009-08-01 00:39:39 UTC (rev 11018)
@@ -60,6 +60,8 @@
__PACKAGE__->mk_classdata('_plugins');
__PACKAGE__->mk_classdata('_config');
+has _component_name => ( is => 'ro' );
+
sub BUILDARGS {
my $class = shift;
my $args = {};
@@ -85,19 +87,18 @@
}
sub COMPONENT {
- my ( $self, $c ) = @_;
+ my ( $class, $c ) = @_;
# Temporary fix, some components does not pass context to constructor
my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
- if( my $next = $self->next::can ){
- my $class = blessed $self || $self;
+ if ( my $next = $class->next::can ) {
my ($next_package) = Class::MOP::get_code_info($next);
warn "There is a COMPONENT method resolving after Catalyst::Component in ${next_package}.\n";
warn "This behavior can no longer be supported, and so your application is probably broken.\n";
warn "Your linearized isa hierarchy is: " . join(', ', @{ mro::get_linear_isa($class) }) . "\n";
warn "Please see perldoc Catalyst::Upgrading for more information about this issue.\n";
}
- return $self->new($c, $arguments);
+ return $class->new($c, $arguments);
}
sub config {
@@ -171,6 +172,15 @@
return $class->new($app, $args);
}
+=head2 _component_name
+
+The name of the component within an application. This is used to
+pass the component's name to actions generated (becoming
+C<< $action->class >>). This is needed so that the L</COMPONENT> method can
+return an instance of a different class (e.g. a L<Class::MOP> anonymous class),
+(as finding the component name by C<< ref($self) >> will not work correctly in
+such cases).
+
=head2 $c->config
=head2 $c->config($hashref)
Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/Controller.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/Controller.pm 2009-08-01 00:20:43 UTC (rev 11017)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/Controller.pm 2009-08-01 00:39:39 UTC (rev 11018)
@@ -156,7 +156,7 @@
}
}
- my $namespace = Catalyst::Utils::class2prefix(ref($self) || $self, $case_s) || '';
+ my $namespace = Catalyst::Utils::class2prefix(ref($self) ? $self->_component_name : $self, $case_s) || '';
$self->$orig($namespace) if ref($self);
return $namespace;
};
@@ -190,7 +190,7 @@
@methods,
map {
$meta->find_method_by_name($_)
- || confess( 'Action "'
+ || confess( 'Action "'
. $_
. '" is not available from controller '
. ( ref $self ) )
@@ -207,7 +207,7 @@
sub register_action_methods {
my ( $self, $c, @methods ) = @_;
- my $class = ref $self || $self;
+ my $class = blessed($self) ? $self->_component_name : $self;
#this is still not correct for some reason.
my $namespace = $self->action_namespace($c);
Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm 2009-08-01 00:20:43 UTC (rev 11017)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm 2009-08-01 00:39:39 UTC (rev 11018)
@@ -2215,7 +2215,10 @@
my $suffix = Catalyst::Utils::class2classsuffix( $component );
my $config = $class->config->{ $suffix } || {};
-
+ $config->{_component_name} = $component; # Put this in args here, rather
+ # than in COMPONENT as there
+ # are lots of custom COMPONENT
+ # methods..
my $instance = eval { $component->COMPONENT( $class, $config ); };
if ( my $error = $@ ) {
Copied: Catalyst-Runtime/5.80/trunk/t/aggregate/live_component_controller_anon.t (from rev 10927, Catalyst-Runtime/5.80/branches/pass_component_names/t/aggregate/live_component_controller_anon.t)
===================================================================
--- Catalyst-Runtime/5.80/trunk/t/aggregate/live_component_controller_anon.t (rev 0)
+++ Catalyst-Runtime/5.80/trunk/t/aggregate/live_component_controller_anon.t 2009-08-01 00:39:39 UTC (rev 11018)
@@ -0,0 +1,24 @@
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+use Test::More tests => 6;
+use Catalyst::Test 'TestApp';
+
+{
+ my $response = request('http://localhost/anon/test');
+ ok($response->is_success);
+ is($response->header('X-Component-Name-Action'),
+ 'TestApp::Controller::Anon', 'Action can see correct _component_name');
+ isnt($response->header('X-Component-Instance-Name-Action'),
+ 'TestApp::Controller::Anon', 'ref($controller) ne _component_name');
+ is($response->header('X-Component-Name-Controller'),
+ 'TestApp::Controller::Anon', 'Controller can see correct _component_name');
+ is($response->header('X-Class-In-Action'),
+ 'TestApp::Controller::Anon', '$action->class is _component_name');
+ is($response->header('X-Anon-Trait-Applied'),
+ '1', 'Anon controller class has trait applied correctly');
+}
+
Modified: Catalyst-Runtime/5.80/trunk/t/lib/TestApp/Action/TestMyAction.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/t/lib/TestApp/Action/TestMyAction.pm 2009-08-01 00:20:43 UTC (rev 11017)
+++ Catalyst-Runtime/5.80/trunk/t/lib/TestApp/Action/TestMyAction.pm 2009-08-01 00:39:39 UTC (rev 11018)
@@ -9,6 +9,9 @@
my $self = shift;
my ( $controller, $c, $test ) = @_;
$c->res->header( 'X-TestAppActionTestMyAction', 'MyAction works' );
+ $c->res->header( 'X-Component-Name-Action', $controller->_component_name);
+ $c->res->header( 'X-Component-Instance-Name-Action', ref($controller));
+ $c->res->header( 'X-Class-In-Action', $self->class);
$self->next::method(@_);
}
Copied: Catalyst-Runtime/5.80/trunk/t/lib/TestApp/Controller/Anon.pm (from rev 10927, Catalyst-Runtime/5.80/branches/pass_component_names/t/lib/TestApp/Controller/Anon.pm)
===================================================================
--- Catalyst-Runtime/5.80/trunk/t/lib/TestApp/Controller/Anon.pm (rev 0)
+++ Catalyst-Runtime/5.80/trunk/t/lib/TestApp/Controller/Anon.pm 2009-08-01 00:39:39 UTC (rev 11018)
@@ -0,0 +1,40 @@
+package Anon::Trait;
+use Moose::Role -traits => 'MethodAttributes'; # Needed for role composition to work correctly with anon classes.
+
+after test => sub {
+ my ($self, $c) = @_;
+ $c->res->header('X-Anon-Trait-Applied', 1);
+};
+
+no Moose::Role;
+
+package TestApp::Controller::Anon;
+use Moose;
+use Moose::Util qw/find_meta/;
+use namespace::clean -except => 'meta';
+BEGIN { extends 'Catalyst::Controller' };
+
+sub COMPONENT { # Don't do this yourself, use CatalystX::Component::Traits!
+ my ($class, $app, $args) = @_;
+
+ my $meta = $class->meta->create_anon_class(
+ superclasses => [ $class->meta->name ],
+ roles => ['Anon::Trait'],
+ cache => 1,
+ );
+ # Special move as the methodattributes trait has changed our metaclass..
+ $meta = find_meta($meta->name);
+
+ $meta->add_method('meta' => sub { $meta });
+ $class = $meta->name;
+ $class->new($app, $args);
+}
+
+sub test : Local ActionClass('+TestApp::Action::TestMyAction') {
+ my ($self, $c) = @_;
+ $c->res->header('X-Component-Name-Controller', $self->_component_name);
+ $c->res->body('It works');
+}
+
+__PACKAGE__->meta->make_immutable;
+
More information about the Catalyst-commits
mailing list