Merge upstream

Changes

@@ -2,6 +2,12 @@ Revision history for CatalystX-Component-Traits
 
    - More verbose error when traits cannot be found, including full search path.
 
+0.07  2009-07-26 15:11:55
+    - fix incompatibility with perl 5.8
+
+0.06  2009-07-20 21:44:13
+    - configurable trait merging support
+
 0.05  2009-07-17 23:46:43
     - Correctly pass the application class into component constructors
 

Makefile.PL

@@ -12,6 +12,7 @@ requires 'MooseX::Traits::Pluggable' => '0.06';
 requires 'namespace::autoclean';
 requires 'Moose::Autobox';
 requires 'List::MoreUtils';
+requires 'Scalar::Util';
 
 auto_provides;
 auto_install;

lib/CatalystX/Component/Traits.pm

@@ -4,7 +4,8 @@ use namespace::autoclean;
 use Moose::Role;
 use Moose::Autobox;
 use Carp;
-use List::MoreUtils 'firstidx';
+use List::MoreUtils qw/firstidx any uniq/;
+use Scalar::Util 'reftype';
 with 'MooseX::Traits::Pluggable' => { excludes => ['_find_trait'] };
 
 =head1 NAME
@@ -14,11 +15,11 @@ Catalyst Components
 
 =head1 VERSION
 
-Version 0.05
+Version 0.07
 
 =cut
 
-our $VERSION   = '0.05';
+our $VERSION   = '0.07';
 our $AUTHORITY = 'id:RKITOVER';
 
 =head1 SYNOPSIS
@@ -89,25 +90,102 @@ Search order for C<Foo> will be:
 
 The C<Base> after (M|V|C) is automatically removed.
 
+=head1 TRAIT MERGING
+
+Traits from component class config and app config are automatically merged if
+you set the C<_trait_merge> attribute default, e.g.:
+
+    has '+_trait_merge' => (default => 1);
+
+You can remove component class config traits by prefixing their names with a
+C<-> in the app config traits.
+
+For example:
+
+    package Catalyst::Model::Foo;
+    has '+_trait_merge' => (default => 1);
+    __PACKAGE__->config->{traits} = [qw/Foo Bar/];
+
+    package MyApp;
+    __PACKAGE__->config->{'Model::Foo'}{traits} = [qw/-Foo Baz/];
+
+Will load the traits:
+
+    Bar Baz
+
 =cut
 
-has '_trait_namespace' => (is => 'ro', default => '+Trait');
+# override MX::Traits attribute
+has '_trait_namespace' => (
+    init_arg => undef,
+    isa      => 'Str',
+    (Moose->VERSION >= 0.84 ) ? (is => 'bare') : (),
+    default  => '+Trait',
+);
+
+has '_trait_merge' => (
+    init_arg => undef,
+    isa      => 'Str',
+    (Moose->VERSION >= 0.84 ) ? (is => 'bare') : (),
+    default  => 0,
+);
 
 sub COMPONENT {
     my ($class, $app, $args) = @_;
 
-    $args = $class->merge_config_hashes($class->config, $args);
+    my %class_config = %{ $class->config };
+    my %app_config   = %$args;
+
+    my $traits = $class->_merge_traits(
+	delete $class_config{traits},
+	delete $app_config{traits},
+    );
+
+    $args = $class->merge_config_hashes(\%class_config, \%app_config);
 
-    if (my $traits = delete $args->{traits}) {
-	    return $class->new_with_traits( $app, {
-	        traits => $traits,
-	        %$args
-	    });
+    if ($traits) {
+	return $class->new_with_traits($app, {
+	    traits => $traits,
+	    %$args
+	});
     }
 
     return $class->new($app, $args);
 }
 
+sub _merge_traits {
+    my $class        = shift;
+    my $left_traits  = shift || [];
+    my $right_traits = shift || [];
+
+    my $should_merge =
+	eval { $class->meta->find_attribute_by_name('_trait_merge')->default };
+    $should_merge = $should_merge->()
+	if ref($should_merge) && reftype($should_merge) eq 'CODE';
+
+    unless ($should_merge) {
+	return $right_traits || $left_traits;
+    }
+
+    my (@left_traits, @right_traits, @to_remove);
+
+    for my $trait (@$right_traits) {
+	if ($trait =~ /^-(.*)/) {
+	    push @to_remove, $1;
+	} else {
+	    push @right_traits, $trait;
+	}
+    }
+    @left_traits = @$left_traits;
+
+    my @traits = grep {
+	my $trait = $_;
+	not any { $trait eq $_ } @to_remove;
+    } (@left_traits, @right_traits);
+
+    return [ uniq @traits ];
+}
+
 sub _find_trait {
     my ($class, $base, $name) = @_;
 
@@ -163,7 +241,11 @@ sub _trait_search_order {
 
 =head1 AUTHOR
 
-Rafael Kitover, C<< <rkitover at cpan.org> >>
+Rafael Kitover, C<< <rkitover@cpan.org> >>
+
+=head1 CONTRIBUTORS
+
+Tomas Doran, C<< <bobtfish@bobtfish.net> >>
 
 =head1 BUGS
 

t/01-basic.t

@@ -1,24 +1,25 @@
 use strict;
 use warnings;
-use Test::More tests => 6;
+use Test::More tests => 7;
 use Catalyst::Utils;
 
 {
     package Catalyst::Controller::SomeController;
     use Moose;
     extends 'Catalyst::Controller';
     with 'CatalystX::Component::Traits';
+    has '+_trait_merge' => (default => 1);
 
     package Catalyst::TraitFor::Controller::SomeController::Foo;
     use Moose::Role;
     has 'foo' => (is => 'ro');
 
     package MyApp::Controller::MyController;
-    use base 'Catalyst::Controller::SomeController';
-    use Scalar::Util qw/blessed/;
+    use Moose;
+    extends 'Catalyst::Controller::SomeController';
 
     __PACKAGE__->config(
-        traits => ['Foo', 'Bar'],
+        traits => ['Foo', 'Bar', 'Baz'],
         foo => 'bar'
     );
 
@@ -31,10 +32,29 @@ use Catalyst::Utils;
     use Moose::Role;
     has 'bar' => (is => 'ro');
 
+    package MyApp::TraitFor::Controller::SomeController::Baz;
+    use Moose::Role;
+    has 'baz' => (is => 'ro');
+
+    package MyApp::TraitFor::Controller::SomeController::Quux;
+    use Moose::Role;
+    has 'quux' => (is => 'ro');
+
     package MyApp;
     use Moose;
-
     extends 'Catalyst';
+
+    __PACKAGE__->config->{'Controller::MyController'}{traits} =
+        ['-Baz', 'Quux'];
+
+    $INC{'MyApp/Controller/MyController.pm'} = 1;
+    __PACKAGE__->setup;
+
+# this is necessary for perl 5.8
+# I have no idea why
+# please kill it
+    __PACKAGE__->components->{'MyApp::Controller::MyController'} =
+        __PACKAGE__->setup_component('MyApp::Controller::MyController');
 }
 
 my $app_class = 'MyApp';
@@ -50,11 +70,16 @@ ok(($instance->does('Catalyst::TraitFor::Controller::SomeController::Foo')),
 ok(($instance->does('MyApp::TraitFor::Controller::SomeController::Bar')),
     'instance had app ns trait loaded from component config');
 
-is $instance->foo, 'bar',
+is eval { $instance->foo }, 'bar',
     'trait initialized from component config works';
 
-is $instance->bar, 'baz',
+is eval { $instance->bar }, 'baz',
     'trait initialized from app config works';
 
 is $instance->find_app_class, 'MyApp', 'Can find app class passing instance';
 
+is_deeply(
+    MyApp->controller('MyController')->_traits,
+    [qw/Foo Bar Quux/],
+    'traits merged correctly'
+);