From: Dave Rolsky <autarch@urth.org>
Date: Fri, 25 Dec 2009 16:38:07 +0000 (-0600)
Subject: Refine HasAttributes a bit more so that it only contains the minimum shared behavior... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8860f0f14413d44f94eee530852edd254200a46c;p=gitmo%2FClass-MOP.git

Refine HasAttributes a bit more so that it only contains the minimum shared behavior between CMOP::Class and Moose::Meta::Role
---

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 3142f01..c01401a 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -13,6 +13,7 @@ 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;
@@ -468,6 +469,54 @@ sub rebless_instance_away {
     # this intentionally does nothing, it is just a hook
 }
 
+sub _attach_attribute {
+    my ($self, $attribute) = @_;
+    $attribute->attach_to_class($self);
+}
+
+sub _post_add_attribute {
+    my ( $self, $attribute ) = @_;
+
+    $self->invalidate_meta_instances;
+
+    # invalidate package flag here
+    try {
+        local $SIG{__DIE__};
+        $attribute->install_accessors;
+    }
+    catch {
+        $self->remove_attribute( $attribute->name );
+        die $_;
+    };
+}
+
+sub remove_attribute {
+    my $self = shift;
+
+    my $removed_attribute = $self->SUPER::remove_attribute(@_)
+        or return;
+
+    $self->invalidate_meta_instances;
+
+    $removed_attribute->remove_accessors;
+    $removed_attribute->detach_from_class;
+
+    return$removed_attribute;
+}
+
+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;
+}
+
 sub get_all_attributes {
     my $self = shift;
     my %attrs = map { %{ $self->initialize($_)->_attribute_map } }
diff --git a/lib/Class/MOP/HasAttributes.pm b/lib/Class/MOP/HasAttributes.pm
index f106e6b..e2806da 100644
--- a/lib/Class/MOP/HasAttributes.pm
+++ b/lib/Class/MOP/HasAttributes.pm
@@ -5,7 +5,6 @@ use warnings;
 
 use Carp         'confess';
 use Scalar::Util 'blessed';
-use Try::Tiny;
 
 use base 'Class::MOP::Object';
 
@@ -15,52 +14,32 @@ 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);
+    $self->_attach_attribute($attribute);
 
     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()
-            if $self->can('invalidate_meta_instances');
-    }
-
-    # get our count of previously inserted attributes and
-    # increment by one so this attribute knows its order
+    $self->remove_attribute($attr_name)
+        if $self->has_attribute($attr_name);
+
     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 $_;
-    };
+    # This method is called to allow for installing accessors. Ideally, we'd
+    # use method overriding, but then the subclass would be responsible for
+    # making the attribute, which would end up with lots of code
+    # duplication. Even more ideally, we'd use augment/inner, but this is
+    # Class::MOP!
+    $self->_post_add_attribute($attribute)
+        if $self->can('_post_add_attribute');
 
     return $attribute;
 }
@@ -93,10 +72,6 @@ sub remove_attribute {
     return unless defined $removed_attribute;
 
     delete $self->_attribute_map->{$attribute_name};
-    $self->invalidate_meta_instances()
-        if $self->can('invalidate_meta_instances');
-    $removed_attribute->remove_accessors();
-    $removed_attribute->detach_from_class();
 
     return $removed_attribute;
 }
@@ -106,17 +81,4 @@ sub get_attribute_list {
     keys %{ $self->_attribute_map };
 }
 
-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/010_self_introspection.t b/t/010_self_introspection.t
index f5108b1..ea4bdd5 100644
--- a/t/010_self_introspection.t
+++ b/t/010_self_introspection.t
@@ -80,6 +80,12 @@ my @class_mop_class_methods = qw(
 
         add_before_method_modifier add_after_method_modifier add_around_method_modifier
 
+    _attach_attribute
+    _post_add_attribute
+    remove_attribute
+    find_attribute_by_name
+    get_all_attributes
+
     compute_all_applicable_attributes
     get_attribute_map