X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FRole%2FAttribute.pm;h=bc0bd1f2c3934509a9182709aa9d6e90da2b7b1f;hb=HEAD;hp=34c0b3daa54ce3d76b11f41ca0bb6a44bc544c51;hpb=bbd059cd6d8708db41702f52b2ce5b978af430e6;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/Role/Attribute.pm b/lib/Moose/Meta/Role/Attribute.pm index 34c0b3d..bc0bd1f 100644 --- 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 to which this attribute belongs, if any. +=item B<< $attr->original_role >> + +Returns the L in which this attribute was first +defined. This may not be the same as the value C 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 (and L). See L for details on reporting bugs. -=head1 AUTHOR - -Dave Rolsky Eautarch@urth.orgE - -=head1 COPYRIGHT AND LICENSE - -Copyright 2006-2010 by Infinity Interactive, Inc. - -L - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - =cut