From: Dave Rolsky <autarch@urth.org>
Date: Mon, 26 Apr 2010 17:24:44 +0000 (-0500)
Subject: Refactor code to get a metaclass object's real class name into a method.
X-Git-Tag: 1.02~11
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cb6f54929db9a33287cd766f07bb86142dfa0fd5;p=gitmo%2FClass-MOP.git

Refactor code to get a metaclass object's real class name into a method.

This eliminates a nasty little bit of duplicated code scattered throughout the code base.

Also need to get Moose to use this.
---

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index c5359d0..f8b5555 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -67,15 +67,10 @@ sub _construct_class_instance {
         return $meta;
     }
 
-    # NOTE:
-    # we need to deal with the possibility
-    # of class immutability here, and then
-    # get the name of the class appropriately
-    $class = (ref($class)
-                    ? ($class->is_immutable
-                        ? $class->_get_mutable_metaclass_name()
-                        : ref($class))
-                    : $class);
+    $class
+        = ref $class
+        ? $class->_real_ref_name
+        : $class;
 
     # now create the metaclass
     my $meta;
@@ -103,6 +98,16 @@ sub _construct_class_instance {
     $meta;
 }
 
+sub _real_ref_name {
+    my $self = shift;
+
+    # NOTE: we need to deal with the possibility of class immutability here,
+    # and then get the name of the class appropriately
+    return $self->is_immutable
+        ? $self->_get_mutable_metaclass_name()
+        : ref $self;
+}
+
 sub _new {
     my $class = shift;
 
@@ -219,14 +224,7 @@ sub _class_metaclass_is_compatible {
     my $super_meta = Class::MOP::get_metaclass_by_name($superclass_name)
         || return 1;
 
-    # NOTE:
-    # we need to deal with the possibility
-    # of class immutability here, and then
-    # get the name of the class appropriately
-    my $super_meta_type
-        = $super_meta->is_immutable
-        ? $super_meta->_get_mutable_metaclass_name()
-        : ref($super_meta);
+    my $super_meta_type = $super_meta->_real_ref_name;
 
     return $self->isa($super_meta_type);
 }
@@ -238,14 +236,7 @@ sub _check_class_metaclass_compatibility {
     if (!$self->_class_metaclass_is_compatible($superclass_name)) {
         my $super_meta = Class::MOP::get_metaclass_by_name($superclass_name);
 
-        # NOTE:
-        # we need to deal with the possibility
-        # of class immutability here, and then
-        # get the name of the class appropriately
-        my $super_meta_type
-            = $super_meta->is_immutable
-            ? $super_meta->_get_mutable_metaclass_name()
-            : ref($super_meta);
+        my $super_meta_type = $super_meta->_real_ref_name;
 
         confess "The metaclass of " . $self->name . " ("
               . (ref($self)) . ")" .  " is not compatible with "
@@ -294,14 +285,7 @@ sub _can_fix_class_metaclass_incompatibility_by_subclassing {
     my $self = shift;
     my ($super_meta) = @_;
 
-    # NOTE:
-    # we need to deal with the possibility
-    # of class immutability here, and then
-    # get the name of the class appropriately
-    my $super_meta_type
-        = $super_meta->is_immutable
-        ? $super_meta->_get_mutable_metaclass_name()
-        : ref($super_meta);
+    my $super_meta_type = $super_meta->_real_ref_name;
 
     return $super_meta_type ne blessed($self)
         && $super_meta->isa(blessed($self));
diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t
index 29cb201..f24118c 100644
--- a/t/010_self_introspection.t
+++ b/t/010_self_introspection.t
@@ -100,8 +100,8 @@ my @class_mop_class_methods = qw(
     is_mutable is_immutable make_mutable make_immutable
     _initialize_immutable _install_inlined_code _inlined_methods
     _add_inlined_method _inline_accessors _inline_constructor
-    _inline_destructor _immutable_options _rebless_as_immutable
-    _rebless_as_mutable _remove_inlined_code
+    _inline_destructor _immutable_options _real_ref_name
+    _rebless_as_immutable _rebless_as_mutable _remove_inlined_code
 
     _immutable_metaclass
     immutable_trait immutable_options