From: Dave Rolsky <autarch@urth.org>
Date: Wed, 16 Dec 2009 20:24:14 +0000 (-0600)
Subject: Moved attribute management to CMOP::HasAttributes.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b71bd1cded366fe62f4a44471908dd57a8686077;p=gitmo%2FClass-MOP.git

Moved attribute management to CMOP::HasAttributes.

Next step is to make Moose::Meta::Role work inherit from this class.
---

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 2f6263e..2bd684e 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -12,6 +12,7 @@ use Carp          'confess';
 use Scalar::Util  'weaken', 'reftype', 'blessed';
 use Try::Tiny;
 
+use Class::MOP::HasAttributes;
 use Class::MOP::HasMethods;
 use Class::MOP::Class;
 use Class::MOP::Attribute;
@@ -200,6 +201,36 @@ Class::MOP::HasMethods->meta->add_attribute(
 );
 
 ## --------------------------------------------------------
+## Class::MOP::HasMethods
+
+Class::MOP::HasAttributes->meta->add_attribute(
+    Class::MOP::Attribute->new('attributes' => (
+        reader   => {
+            # NOTE: we need to do this in order
+            # for the instance meta-object to
+            # not fall into meta-circular death
+            #
+            # we just alias the original method
+            # rather than re-produce it here
+            '_attribute_map' => \&Class::MOP::HasAttributes::_attribute_map
+        },
+        default  => sub { {} }
+    ))
+);
+
+Class::MOP::HasAttributes->meta->add_attribute(
+    Class::MOP::Attribute->new('attribute_metaclass' => (
+        reader   => {
+            # NOTE:
+            # we just alias the original method
+            # rather than re-produce it here
+            'attribute_metaclass' => \&Class::MOP::HasAttributes::attribute_metaclass
+        },
+        default  => 'Class::MOP::Attribute',
+    ))
+);
+
+## --------------------------------------------------------
 ## Class::MOP::Package
 
 Class::MOP::Package->meta->add_attribute(
@@ -278,21 +309,6 @@ Class::MOP::Module->meta->add_attribute(
 ## Class::MOP::Class
 
 Class::MOP::Class->meta->add_attribute(
-    Class::MOP::Attribute->new('attributes' => (
-        reader   => {
-            # NOTE: we need to do this in order
-            # for the instance meta-object to
-            # not fall into meta-circular death
-            #
-            # we just alias the original method
-            # rather than re-produce it here
-            '_attribute_map' => \&Class::MOP::Class::_attribute_map
-        },
-        default  => sub { {} }
-    ))
-);
-
-Class::MOP::Class->meta->add_attribute(
     Class::MOP::Attribute->new('superclasses' => (
         accessor => {
             # NOTE:
@@ -306,18 +322,6 @@ Class::MOP::Class->meta->add_attribute(
 );
 
 Class::MOP::Class->meta->add_attribute(
-    Class::MOP::Attribute->new('attribute_metaclass' => (
-        reader   => {
-            # NOTE:
-            # we just alias the original method
-            # rather than re-produce it here
-            'attribute_metaclass' => \&Class::MOP::Class::attribute_metaclass
-        },
-        default  => 'Class::MOP::Attribute',
-    ))
-);
-
-Class::MOP::Class->meta->add_attribute(
     Class::MOP::Attribute->new('instance_metaclass' => (
         reader   => {
             # NOTE: we need to do this in order
@@ -693,6 +697,7 @@ $_->meta->make_immutable(
     constructor_name    => undef,
     inline_accessors => 0,
 ) for qw/
+    Class::MOP::HasAttributes
     Class::MOP::HasMethods
 /;
 
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index a486d02..43eb8cd 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -13,13 +13,12 @@ use Carp         'confess';
 use Scalar::Util 'blessed', 'reftype', 'weaken';
 use Sub::Name    'subname';
 use Devel::GlobalDestruction 'in_global_destruction';
-use Try::Tiny;
 
 our $VERSION   = '0.95';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
-use base 'Class::MOP::Module';
+use base 'Class::MOP::Module', 'Class::MOP::HasAttributes';
 
 # Creation
 
@@ -329,8 +328,6 @@ sub create {
 # all these attribute readers will be bootstrapped
 # away in the Class::MOP bootstrap section
 
-sub _attribute_map           { $_[0]->{'attributes'}                  }
-sub attribute_metaclass      { $_[0]->{'attribute_metaclass'}         }
 sub instance_metaclass       { $_[0]->{'instance_metaclass'}          }
 sub immutable_trait          { $_[0]->{'immutable_trait'}             }
 sub constructor_class        { $_[0]->{'constructor_class'}           }
@@ -699,55 +696,6 @@ sub find_next_method_by_name {
     return;
 }
 
-## Attributes
-
-sub add_attribute {
-    my $self      = shift;
-    # either we have an attribute object already
-    # or we need to create one from the args provided
-    my $attribute = blessed($_[0]) ? $_[0] : $self->attribute_metaclass->new(@_);
-    # make sure it is derived from the correct type though
-    ($attribute->isa('Class::MOP::Attribute'))
-        || confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";
-
-    # first we attach our new attribute
-    # because it might need certain information
-    # about the class which it is attached to
-    $attribute->attach_to_class($self);
-
-    my $attr_name = $attribute->name;
-
-    # then we remove attributes of a conflicting
-    # name here so that we can properly detach
-    # the old attr object, and remove any
-    # accessors it would have generated
-    if ( $self->has_attribute($attr_name) ) {
-        $self->remove_attribute($attr_name);
-    } else {
-        $self->invalidate_meta_instances();
-    }
-    
-    # get our count of previously inserted attributes and
-    # increment by one so this attribute knows its order
-    my $order = (scalar keys %{$self->_attribute_map});
-    $attribute->_set_insertion_order($order);
-
-    # then onto installing the new accessors
-    $self->_attribute_map->{$attr_name} = $attribute;
-
-    # invalidate package flag here
-    try {
-        local $SIG{__DIE__};
-        $attribute->install_accessors();
-    }
-    catch {
-        $self->remove_attribute($attr_name);
-        die $_;
-    };
-
-    return $attribute;
-}
-
 sub update_meta_instance_dependencies {
     my $self = shift;
 
@@ -764,9 +712,10 @@ sub add_meta_instance_dependencies {
     my @attrs = $self->get_all_attributes();
 
     my %seen;
-    my @classes = grep { not $seen{$_->name}++ } map { $_->associated_class } @attrs;
+    my @classes = grep { not $seen{ $_->name }++ }
+        map { $_->associated_class } @attrs;
 
-    foreach my $class ( @classes ) { 
+    foreach my $class (@classes) {
         $class->add_dependent_meta_instance($self);
     }
 
@@ -777,7 +726,7 @@ sub remove_meta_instance_dependencies {
     my $self = shift;
 
     if ( my $classes = delete $self->{meta_instance_dependencies} ) {
-        foreach my $class ( @$classes ) {
+        foreach my $class (@$classes) {
             $class->remove_dependent_meta_instance($self);
         }
 
@@ -796,12 +745,14 @@ sub add_dependent_meta_instance {
 sub remove_dependent_meta_instance {
     my ( $self, $metaclass ) = @_;
     my $name = $metaclass->name;
-    @$_ = grep { $_->name ne $name } @$_ for $self->{dependent_meta_instances};
+    @$_ = grep { $_->name ne $name } @$_
+        for $self->{dependent_meta_instances};
 }
 
 sub invalidate_meta_instances {
     my $self = shift;
-    $_->invalidate_meta_instance() for $self, @{ $self->{dependent_meta_instances} };
+    $_->invalidate_meta_instance()
+        for $self, @{ $self->{dependent_meta_instances} };
 }
 
 sub invalidate_meta_instance {
@@ -809,59 +760,6 @@ sub invalidate_meta_instance {
     undef $self->{_meta_instance};
 }
 
-sub has_attribute {
-    my ($self, $attribute_name) = @_;
-    (defined $attribute_name)
-        || confess "You must define an attribute name";
-    exists $self->_attribute_map->{$attribute_name};
-}
-
-sub get_attribute {
-    my ($self, $attribute_name) = @_;
-    (defined $attribute_name)
-        || confess "You must define an attribute name";
-    return $self->_attribute_map->{$attribute_name}
-    # NOTE:
-    # this will return undef anyway, so no need ...
-    #    if $self->has_attribute($attribute_name);
-    #return;
-}
-
-sub remove_attribute {
-    my ($self, $attribute_name) = @_;
-    (defined $attribute_name)
-        || confess "You must define an attribute name";
-    my $removed_attribute = $self->_attribute_map->{$attribute_name};
-    return unless defined $removed_attribute;
-    delete $self->_attribute_map->{$attribute_name};
-    $self->invalidate_meta_instances();
-    $removed_attribute->remove_accessors();
-    $removed_attribute->detach_from_class();
-    return $removed_attribute;
-}
-
-sub get_attribute_list {
-    my $self = shift;
-    keys %{$self->_attribute_map};
-}
-
-sub get_all_attributes {
-    my $self = shift;
-    my %attrs = map { %{ $self->initialize($_)->_attribute_map } } reverse $self->linearized_isa;
-    return values %attrs;
-}
-
-sub find_attribute_by_name {
-    my ($self, $attr_name) = @_;
-    foreach my $class ($self->linearized_isa) {
-        # fetch the meta-class ...
-        my $meta = $self->initialize($class);
-        return $meta->get_attribute($attr_name)
-            if $meta->has_attribute($attr_name);
-    }
-    return;
-}
-
 # check if we can reinitialize
 sub is_pristine {
     my $self = shift;
diff --git a/lib/Class/MOP/HasAttributes.pm b/lib/Class/MOP/HasAttributes.pm
new file mode 100644
index 0000000..45c6021
--- /dev/null
+++ b/lib/Class/MOP/HasAttributes.pm
@@ -0,0 +1,127 @@
+package Class::MOP::HasAttributes;
+
+use strict;
+use warnings;
+
+use Carp         'confess';
+use Scalar::Util 'blessed';
+use Try::Tiny;
+
+use base 'Class::MOP::Object';
+
+sub _attribute_map      { $_[0]->{'attributes'} }
+sub attribute_metaclass { $_[0]->{'attribute_metaclass'} }
+
+sub add_attribute {
+    my $self = shift;
+
+    # either we have an attribute object already
+    # or we need to create one from the args provided
+    my $attribute
+        = blessed( $_[0] ) ? $_[0] : $self->attribute_metaclass->new(@_);
+
+    # make sure it is derived from the correct type though
+    ( $attribute->isa('Class::MOP::Attribute') )
+        || confess
+        "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";
+
+    # first we attach our new attribute
+    # because it might need certain information
+    # about the class which it is attached to
+    $attribute->attach_to_class($self);
+
+    my $attr_name = $attribute->name;
+
+    # then we remove attributes of a conflicting
+    # name here so that we can properly detach
+    # the old attr object, and remove any
+    # accessors it would have generated
+    if ( $self->has_attribute($attr_name) ) {
+        $self->remove_attribute($attr_name);
+    }
+    else {
+        $self->invalidate_meta_instances();
+    }
+
+    # get our count of previously inserted attributes and
+    # increment by one so this attribute knows its order
+    my $order = ( scalar keys %{ $self->_attribute_map } );
+    $attribute->_set_insertion_order($order);
+
+    # then onto installing the new accessors
+    $self->_attribute_map->{$attr_name} = $attribute;
+
+    # invalidate package flag here
+    try {
+        local $SIG{__DIE__};
+        $attribute->install_accessors();
+    }
+    catch {
+        $self->remove_attribute($attr_name);
+        die $_;
+    };
+
+    return $attribute;
+}
+
+sub has_attribute {
+    my ( $self, $attribute_name ) = @_;
+
+    ( defined $attribute_name )
+        || confess "You must define an attribute name";
+
+    exists $self->_attribute_map->{$attribute_name};
+}
+
+sub get_attribute {
+    my ( $self, $attribute_name ) = @_;
+
+    ( defined $attribute_name )
+        || confess "You must define an attribute name";
+
+    return $self->_attribute_map->{$attribute_name};
+}
+
+sub remove_attribute {
+    my ( $self, $attribute_name ) = @_;
+
+    ( defined $attribute_name )
+        || confess "You must define an attribute name";
+
+    my $removed_attribute = $self->_attribute_map->{$attribute_name};
+    return unless defined $removed_attribute;
+
+    delete $self->_attribute_map->{$attribute_name};
+    $self->invalidate_meta_instances();
+    $removed_attribute->remove_accessors();
+    $removed_attribute->detach_from_class();
+
+    return $removed_attribute;
+}
+
+sub get_attribute_list {
+    my $self = shift;
+    keys %{ $self->_attribute_map };
+}
+
+sub get_all_attributes {
+    my $self = shift;
+    my %attrs = map { %{ $self->initialize($_)->_attribute_map } }
+        reverse $self->linearized_isa;
+    return values %attrs;
+}
+
+sub find_attribute_by_name {
+    my ( $self, $attr_name ) = @_;
+
+    foreach my $class ( $self->linearized_isa ) {
+        # fetch the meta-class ...
+        my $meta = $self->initialize($class);
+        return $meta->get_attribute($attr_name)
+            if $meta->has_attribute($attr_name);
+    }
+
+    return;
+}
+
+1;
diff --git a/t/000_load.t b/t/000_load.t
index 4abe47a..2bc17cc 100644
--- a/t/000_load.t
+++ b/t/000_load.t
@@ -5,6 +5,7 @@ use Test::More;
 
 BEGIN {
     use_ok('Class::MOP');
+    use_ok('Class::MOP::HasAttributes');
     use_ok('Class::MOP::HasMethods');
     use_ok('Class::MOP::Package');
     use_ok('Class::MOP::Module');
@@ -30,6 +31,7 @@ my %METAS = (
     'Class::MOP::Method::Accessor'  => Class::MOP::Method::Accessor->meta,
     'Class::MOP::Method::Constructor' =>
         Class::MOP::Method::Constructor->meta,
+    'Class::MOP::HasAttributes'   => Class::MOP::HasAttributes->meta,
     'Class::MOP::HasMethods'      => Class::MOP::HasMethods->meta,
     'Class::MOP::Package'         => Class::MOP::Package->meta,
     'Class::MOP::Module'          => Class::MOP::Module->meta,
@@ -72,6 +74,7 @@ is_deeply(
         Class::MOP::Class->meta,
         Class::MOP::Class::Immutable::Class::MOP::Class->meta,
         Class::MOP::class_of('Class::MOP::Class::Immutable::Trait'),
+        Class::MOP::HasAttributes->meta,
         Class::MOP::HasMethods->meta,
         Class::MOP::Instance->meta,
         Class::MOP::Method->meta,
@@ -95,6 +98,7 @@ is_deeply(
             Class::MOP::Class
             Class::MOP::Class::Immutable::Class::MOP::Class
             Class::MOP::Class::Immutable::Trait
+            Class::MOP::HasAttributes
             Class::MOP::HasMethods
             Class::MOP::Instance
             Class::MOP::Method
diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t
index 72b1fbd..f5108b1 100644
--- a/t/010_self_introspection.t
+++ b/t/010_self_introspection.t
@@ -72,8 +72,6 @@ my @class_mop_class_methods = qw(
     add_dependent_meta_instance remove_dependent_meta_instance
     invalidate_meta_instances invalidate_meta_instance
 
-    attribute_metaclass
-
     superclasses subclasses direct_subclasses class_precedence_list
     linearized_isa _superclasses_updated
 
@@ -82,9 +80,7 @@ my @class_mop_class_methods = qw(
 
         add_before_method_modifier add_after_method_modifier add_around_method_modifier
 
-    has_attribute get_attribute add_attribute remove_attribute
-    get_attribute_list _attribute_map get_all_attributes compute_all_applicable_attributes find_attribute_by_name
-
+    compute_all_applicable_attributes
     get_attribute_map
 
     is_mutable is_immutable make_mutable make_immutable
@@ -168,8 +164,6 @@ my @class_mop_module_attributes = (
 
 my @class_mop_class_attributes = (
     'superclasses',
-    'attributes',
-    'attribute_metaclass',
     'instance_metaclass',
     'immutable_trait',
     'constructor_name',
@@ -271,35 +265,35 @@ is($class_mop_package_meta->find_attribute_by_name('method_metaclass')->default,
   '... Class::MOP::Package method_metaclass\'s a default is Class::MOP:::Method');
 
 
-# ... class
+# ... class, but inherited from HasAttributes
 
-ok($class_mop_class_meta->get_attribute('attributes')->has_reader, '... Class::MOP::Class attributes has a reader');
-is_deeply($class_mop_class_meta->get_attribute('attributes')->reader,
-   { '_attribute_map' => \&Class::MOP::Class::_attribute_map },
+ok($class_mop_class_meta->find_attribute_by_name('attributes')->has_reader, '... Class::MOP::Class attributes has a reader');
+is_deeply($class_mop_class_meta->find_attribute_by_name('attributes')->reader,
+   { '_attribute_map' => \&Class::MOP::HasAttributes::_attribute_map },
    '... Class::MOP::Class attributes\'s a reader is &_attribute_map');
 
-ok($class_mop_class_meta->get_attribute('attributes')->has_init_arg, '... Class::MOP::Class attributes has a init_arg');
-is($class_mop_class_meta->get_attribute('attributes')->init_arg,
+ok($class_mop_class_meta->find_attribute_by_name('attributes')->has_init_arg, '... Class::MOP::Class attributes has a init_arg');
+is($class_mop_class_meta->find_attribute_by_name('attributes')->init_arg,
   'attributes',
   '... Class::MOP::Class attributes\'s a init_arg is attributes');
 
-ok($class_mop_class_meta->get_attribute('attributes')->has_default, '... Class::MOP::Class attributes has a default');
-is_deeply($class_mop_class_meta->get_attribute('attributes')->default('Foo'),
+ok($class_mop_class_meta->find_attribute_by_name('attributes')->has_default, '... Class::MOP::Class attributes has a default');
+is_deeply($class_mop_class_meta->find_attribute_by_name('attributes')->default('Foo'),
          {},
          '... Class::MOP::Class attributes\'s a default of {}');
 
-ok($class_mop_class_meta->get_attribute('attribute_metaclass')->has_reader, '... Class::MOP::Class attribute_metaclass has a reader');
-is_deeply($class_mop_class_meta->get_attribute('attribute_metaclass')->reader,
-   { 'attribute_metaclass' => \&Class::MOP::Class::attribute_metaclass },
+ok($class_mop_class_meta->find_attribute_by_name('attribute_metaclass')->has_reader, '... Class::MOP::Class attribute_metaclass has a reader');
+is_deeply($class_mop_class_meta->find_attribute_by_name('attribute_metaclass')->reader,
+   { 'attribute_metaclass' => \&Class::MOP::HasAttributes::attribute_metaclass },
   '... Class::MOP::Class attribute_metaclass\'s a reader is &attribute_metaclass');
 
-ok($class_mop_class_meta->get_attribute('attribute_metaclass')->has_init_arg, '... Class::MOP::Class attribute_metaclass has a init_arg');
-is($class_mop_class_meta->get_attribute('attribute_metaclass')->init_arg,
+ok($class_mop_class_meta->find_attribute_by_name('attribute_metaclass')->has_init_arg, '... Class::MOP::Class attribute_metaclass has a init_arg');
+is($class_mop_class_meta->find_attribute_by_name('attribute_metaclass')->init_arg,
    'attribute_metaclass',
    '... Class::MOP::Class attribute_metaclass\'s a init_arg is attribute_metaclass');
 
-ok($class_mop_class_meta->get_attribute('attribute_metaclass')->has_default, '... Class::MOP::Class attribute_metaclass has a default');
-is($class_mop_class_meta->get_attribute('attribute_metaclass')->default,
+ok($class_mop_class_meta->find_attribute_by_name('attribute_metaclass')->has_default, '... Class::MOP::Class attribute_metaclass has a default');
+is($class_mop_class_meta->find_attribute_by_name('attribute_metaclass')->default,
   'Class::MOP::Attribute',
   '... Class::MOP::Class attribute_metaclass\'s a default is Class::MOP:::Attribute');
 
@@ -315,7 +309,7 @@ is(${$class_mop_class_meta->get_package_symbol('$VERSION')},
 
 is_deeply(
     [ $class_mop_class_meta->superclasses ],
-    [ qw/Class::MOP::Module/ ],
+    [ qw/Class::MOP::Module Class::MOP::HasAttributes/ ],
     '... Class::MOP::Class->superclasses == [ Class::MOP::Module ]');
 
 is_deeply(
@@ -326,6 +320,8 @@ is_deeply(
         Class::MOP::Package
         Class::MOP::HasMethods
         Class::MOP::Object
+        Class::MOP::HasAttributes
+        Class::MOP::Object
     / ],
     '... Class::MOP::Class->class_precedence_list == [ Class::MOP::Class Class::MOP::Module Class::MOP::Package ]');