svn merge -r 10899:10927 http://dev.catalyst.perl.org/repos/Catalyst/Catalyst-Runtime/5.80/branches/pass_component_names
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';
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 = $@ ) {
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 );
=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
__PACKAGE__->mk_classdata('_plugins');
__PACKAGE__->mk_classdata('_config');
+has _component_name => ( is => 'ro' );
+
sub BUILDARGS {
my $class = shift;
my $args = {};
}
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 {
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)
}
}
- 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;
};
@methods,
map {
$meta->find_method_by_name($_)
- || confess( 'Action "'
+ || confess( 'Action "'
. $_
. '" is not available from controller '
. ( ref $self ) )
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);
--- /dev/null
+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');
+}
+
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(@_);
}
--- /dev/null
+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;
+