CatalystX::Component::Traits - Automatic Trait Loading and Resolution for

    package Catalyst::Model::SomeModel;
    with 'CatalystX::Component::Traits';

    package MyApp::Model::MyModel;
    use parent 'Catalyst::Model::SomeModel';

    package MyApp;

    __PACKAGE__->config('Model::MyModel' => {
        traits => ['SearchedForTrait', '+Fully::Qualified::Trait']
    });

    MyApp::Model::MyModel
    Catalyst::Model::CatModel
    Catalyst::Model
    Catalyst::Component
    Moose::Object

    traits => ['Foo']

    MyApp::TraitFor::Model::CatModel::Foo
    Catalyst::TraitFor::Model::CatModel::Foo

    My::App::Controller::AController
    CatalystX::Something::ControllerBase::SomeController
    Catalyst::Controller
    Catalyst::Model
    Catalyst::Component
    Moose::Object

    traits => ['Foo']

    My::App::TraitFor::Controller::SomeController::Foo
    CatalystX::Something::TraitFor::Controller::SomeController::Foo

    has '+_trait_merge' => (default => 1);

    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/];

    Bar Baz

package CatalystX::Component::Traits;

use namespace::autoclean;
use Moose::Role;
use Carp;
use List::MoreUtils qw/firstidx any uniq/;
use Scalar::Util 'reftype';
with 'MooseX::Traits::Pluggable' => { -excludes => ['_find_trait'] };

our $VERSION   = '0.16';
our $AUTHORITY = 'id:RKITOVER';

# 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) = @_;

    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 ($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';

    my @right_traits = ref($right_traits) ? @$right_traits : $right_traits;
    my @left_traits  = ref($left_traits)  ? @$left_traits  : $left_traits;
    unless ($should_merge) {
        return @right_traits ? \@right_traits : \@left_traits;
    }

    my @to_remove = map { /^-(.*)/ ? $1 : () } @left_traits, @right_traits;
    @left_traits  = grep !/^-/, @left_traits;
    @right_traits = grep !/^-/, @right_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) = @_;

    my @tried; # FIXME - This sux, use load_first_existing_class ?
    for my $trait ($class->_trait_search_order($base, $name)) {
        push @tried, $trait;
        return $trait if eval { Class::MOP::load_class($trait) };
    }

    croak "Could not find a class for trait: $name (tried " . join(',', @tried) . ")";
}

sub _trait_search_order {
    my ($class, $base, $name) = @_;

    my @search_ns = $class->meta->class_precedence_list;

    my $MVCC = qr/(?:Model|View|Controller|Component)/;

    my $possible_parent_idx =
        (firstidx { /^CatalystX?::/ } @search_ns[1 ..  $#search_ns]) + 1;

    my ($parent, $parent_idx, $parent_name, $parent_name_partial);

    for my $try_parent ($possible_parent_idx, 0) {
        $parent_idx = $try_parent;
        $parent     = $search_ns[$parent_idx];

        ($parent_name, $parent_name_partial) =
            $parent =~ /($MVCC(?:Base)? (?: ::)? (.*))/x;

        last if $parent_name_partial; # otherwise root level component
    }

    (my $resolved_parent_name = $parent_name) =~ s/($MVCC)Base\b/$1/;

    my ($parent_part) = $parent =~ /($MVCC) (?:Base)? (?: ::)?/x;

    my @res;

    for my $ns (@search_ns[0 .. $parent_idx]) {
        my $find_part = $parent_part;

        my ($part) = $ns =~ /^(.+?)::$parent_part/;
        push @res, "${part}::${base}For::${resolved_parent_name}::$name";
    }

    @res;
}

# we'll come back to this later...
#    for my $ns (@search_ns[($parent_idx+1) .. $#search_ns]) {
#       my ($part, $rest) = split /::/, $ns, 2;
#
#       # no non-core crap in the Moose:: namespace
#       $part = 'MooseX' if $part eq 'Moose';
#
#       push @res, "${part}::${base}For::${rest}::$name";
#    }
#
#    @res;
#}

1; # End of CatalystX::Component::Traits