make github the primary repository

[gitmo/Moose.git] / lib / Moose / Meta / Role / Attribute.pm

diff --git a/lib/Moose/Meta/Role/Attribute.pm b/lib/Moose/Meta/Role/Attribute.pm
index 34c0b3d..bc0bd1f 100644 (file)
--- a/lib/Moose/Meta/Role/Attribute.pm
+++ b/lib/Moose/Meta/Role/Attribute.pm
@@ -7,32 +7,40 @@ use Carp 'confess';
 use List::MoreUtils 'all';
 use Scalar::Util 'blessed', 'weaken';
 
-our $VERSION   = '1.00';
-our $AUTHORITY = 'cpan:STEVAN';
-
-use base 'Moose::Meta::Mixin::AttributeCore';
+use base 'Moose::Meta::Mixin::AttributeCore', 'Class::MOP::Object';
 
 __PACKAGE__->meta->add_attribute(
     'metaclass' => (
         reader => 'metaclass',
+        Class::MOP::_definition_context(),
     )
 );
 
 __PACKAGE__->meta->add_attribute(
     'associated_role' => (
         reader => 'associated_role',
+        Class::MOP::_definition_context(),
+    )
+);
+
+__PACKAGE__->meta->add_attribute(
+    '_original_role' => (
+        reader => '_original_role',
+        Class::MOP::_definition_context(),
     )
 );
 
 __PACKAGE__->meta->add_attribute(
     'is' => (
         reader => 'is',
+        Class::MOP::_definition_context(),
     )
 );
 
 __PACKAGE__->meta->add_attribute(
     'original_options' => (
         reader => 'original_options',
+        Class::MOP::_definition_context(),
     )
 );
 
@@ -42,9 +50,12 @@ sub new {
     (defined $name)
         || confess "You must provide a name for the attribute";
 
+    my $role = delete $options{_original_role};
+
     return bless {
         name             => $name,
         original_options => \%options,
+        _original_role   => $role,
         %options,
     }, $class;
 }
@@ -59,9 +70,16 @@ sub attach_to_role {
     weaken( $self->{'associated_role'} = $role );
 }
 
+sub original_role {
+    my $self = shift;
+
+    return $self->_original_role || $self->associated_role;
+}
+
 sub attribute_for_class {
-    my $self      = shift;
-    my $metaclass = shift;
+    my $self = shift;
+
+    my $metaclass = $self->original_role->applied_attribute_metaclass;
 
     return $metaclass->interpolate_class_and_new(
         $self->name => %{ $self->original_options } );
@@ -70,7 +88,13 @@ sub attribute_for_class {
 sub clone {
     my $self = shift;
 
-    return ( ref $self )->new( $self->name, %{ $self->original_options } );
+    my $role = $self->original_role;
+
+    return ( ref $self )->new(
+        $self->name,
+        %{ $self->original_options },
+        _original_role => $role,
+    );
 }
 
 sub is_same_as {
@@ -97,11 +121,11 @@ sub is_same_as {
 
 1;
 
-=pod
+# ABSTRACT: The Moose attribute metaclass for Roles
 
-=head1 NAME
+__END__
 
-Moose::Meta::Role::Attribute - A Moose Attribute metaclass for Roles
+=pod
 
 =head1 DESCRIPTION
 
@@ -130,6 +154,12 @@ Returns the option as passed to the constructor.
 
 Returns the L<Moose::Meta::Role> to which this attribute belongs, if any.
 
+=item B<< $attr->original_role >>
+
+Returns the L<Moose::Meta::Role> in which this attribute was first
+defined. This may not be the same as the value C<associated_role()> in the
+case of composite role, or the case where one role consumes other roles.
+
 =item B<< $attr->original_options >>
 
 Returns a hash reference of options passed to the constructor. This is used
@@ -162,17 +192,4 @@ L<Moose::Meta::Attribute> (and L<Class::MOP::Attribute>).
 
 See L<Moose/BUGS> for details on reporting bugs.
 
-=head1 AUTHOR
-
-Dave Rolsky E<lt>autarch@urth.orgE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2006-2010 by 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