The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package MouseX::Traits;
use Mouse::Role;

our $VERSION   = '0.1102';

has '_trait_namespace' => (
    init_arg => undef,
    isa      => 'Str',
    is       => 'bare',
);

my $transform_trait = sub {
    my ($class, $name) = @_;
    return $1 if $name =~ /^[+](.+)$/;

    my $namespace = $class->meta->find_attribute_by_name('_trait_namespace');
    my $base;
    if($namespace->has_default){
        $base = $namespace->default;
        if(ref $base eq 'CODE'){
            $base = $base->();
        }
    }

    return $name unless defined $base;
    return join '::', $base, $name;
};


my $anon_serial = 0;

sub with_traits {
    my ($class, @traits) = @_;

    $class->does(__PACKAGE__)
        or Carp::confess("We can't interact with traits for a class ($class) "
                       . "that does not do MouseX::Traits");

    my $meta = $class->meta;
    if (@traits) {
        # resolve traits
        @traits = map {
            my $orig = $_;
            if(!ref $orig){
                my $transformed = $transform_trait->($class, $orig);
                Mouse::Util::load_class($transformed);
            }
            else {
                $orig;
            }
        } @traits;

        $meta = $meta->create(
            'MouseX::Traits::__ANON__::' . ++$anon_serial,
            superclasses => [ $class ],
            roles        => \@traits,
            cache        => 1,
        );
    }

    return $meta->name;
}

sub new_with_traits {
    my $class = shift;

    my $args   = $class->BUILDARGS(@_);
    my $traits = delete $args->{traits} || [];

    my $new_class = $class->with_traits(ref $traits ? @$traits : $traits );
    return $new_class->meta->new_object($args);
}

no Mouse::Role;
1;

__END__

=head1 NAME

MouseX::Traits - automatically apply roles at object creation time

=head1 SYNOPSIS

Given some roles:

  package Role;
  use Mouse::Role;
  has foo => ( is => 'ro', isa => 'Int' required => 1 );

And a class:

  package Class;
  use Mouse;
  with 'MouseX::Traits';

Apply the roles to the class at C<new> time:

  my $class = Class->with_traits('Role')->new( foo => 42 );

Then use your customized class:

  $class->isa('Class'); # true
  $class->does('Role'); # true
  $class->foo; # 42

=head1 DESCRIPTION

Often you want to create components that can be added to a class
arbitrarily.  This module makes it easy for the end user to use these
components.  Instead of requiring the user to create a named class
with the desired roles applied, or apply roles to the instance
one-by-one, he can just create a new class from yours with
C<with_traits>, and then instantiate that.

There is also C<new_with_traits>, which exists for compatibility
reasons.  It accepts a C<traits> parameter, creates a new class with
those traits, and then insantiates it.

   Class->new_with_traits( traits => [qw/Foo Bar/], foo => 42, bar => 1 )

returns exactly the same object as

   Class->with_traits(qw/Foo Bar/)->new( foo => 42, bar => 1 )

would.  But you can also store the result of C<with_traits>, and call
other methods:

   my $c = Class->with_traits(qw/Foo Bar/);
   $c->new( foo => 42 );
   $c->whatever( foo => 1234 );

And so on.

=head1 METHODS

=over 4

=item B<< $class->with_traits( @traits ) >>

Return a new class with the traits applied.  Use like:

=item B<< $class->new_with_traits(%args, traits => \@traits) >>

C<new_with_traits> can also take a hashref, e.g.:

  my $instance = $class->new_with_traits({ traits => \@traits, foo => 'bar' });

=back

=head1 ATTRIBUTES YOUR CLASS GETS

This role will add the following attributes to the consuming class.

=head2 _trait_namespace

You can override the value of this attribute with C<default> to
automatically prepend a namespace to the supplied traits.  (This can
be overridden by prefixing the trait name with C<+>.)

Example:

  package Another::Trait;
  use Mouse::Role;
  has 'bar' => (
      is       => 'ro',
      isa      => 'Str',
      required => 1,
  );

  package Another::Class;
  use Mouse;
  with 'MouseX::Traits';
  has '+_trait_namespace' => ( default => 'Another' );

  my $instance = Another::Class->new_with_traits(
      traits => ['Trait'], # "Another::Trait", not "Trait"
      bar    => 'bar',
  );
  $instance->does('Trait')          # false
  $instance->does('Another::Trait') # true

  my $instance2 = Another::Class->new_with_traits(
      traits => ['+Trait'], # "Trait", not "Another::Trait"
  );
  $instance2->does('Trait')          # true
  $instance2->does('Another::Trait') # false

=head1 AUTHOR

Fuji, Goro (gfx) E<lt>gfuji(at)cpan.orgE<gt>

=head1 ORIGINAL AUTHORS and CONTRIBUTORS

The MouseX::Traits is originated from MooseX::Traits, which is
written and maintained by:

Jonathan Rockway C<< <jrockway@cpan.org> >>

Stevan Little C<< <stevan.little@iinteractive.com> >>

Tomas Doran C<< <bobtfish@bobtfish.net> >>

Matt S. Trout C<< <mst@shadowcatsystems.co.uk> >>

Jesse Luehrs C<< <doy at tozt dot net> >>

Shawn Moore C<< <sartak@bestpractical.com> >>

Florian Ragwitz C<< <rafl@debian.org> >>

Chris Prather C<< <chris@prather.org> >>

Yuval Kogman C<< <nothingmuch@woobling.org> >>

=head1 COPYRIGHT AND LICENSE

Copyright 2008-2010 Infinity Interactive, Inc.

L<http://www.iinteractive.com>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut