From: Jesse Luehrs <doy@tozt.net>
Date: Fri, 13 May 2011 16:34:10 +0000 (-0500)
Subject: more complete clone implementation
X-Git-Tag: 2.0100~99
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=69bdb51f93b7c5d271f54a38638413eb715fed55;p=gitmo%2FMoose.git

more complete clone implementation
---

diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm
index de37d54..172ac23 100644
--- a/lib/Class/MOP/Instance.pm
+++ b/lib/Class/MOP/Instance.pm
@@ -4,7 +4,7 @@ package Class::MOP::Instance;
 use strict;
 use warnings;
 
-use Scalar::Util 'weaken', 'blessed';
+use Scalar::Util 'isweak', 'weaken', 'blessed';
 
 use base 'Class::MOP::Object';
 
@@ -77,12 +77,20 @@ sub create_instance {
 sub clone_instance {
     my ($self, $instance) = @_;
 
-    my $clone = bless {}, $self->_class_name;
+    my $clone = $self->create_instance;
     for my $attr ($self->get_all_attributes) {
-        $attr->set_value($clone, $attr->get_raw_value($instance))
-            if $attr->has_value($instance);
+        next unless $attr->has_value($instance);
+        for my $slot ($attr->slots) {
+            my $val = $self->get_slot_value($instance, $slot);
+            $self->set_slot_value($clone, $slot, $val);
+            $self->weaken_slot_value($clone, $slot)
+                if $self->slot_value_is_weak($instance, $slot);
+        }
     }
 
+    $self->_set_mop_slot($clone, $self->_get_mop_slot($instance))
+        if $self->_has_mop_slot($instance);
+
     return $clone;
 }
 
@@ -149,6 +157,11 @@ sub weaken_slot_value {
     weaken $instance->{$slot_name};
 }
 
+sub slot_value_is_weak {
+    my ($self, $instance, $slot_name) = @_;
+    isweak $instance->{$slot_name};
+}
+
 sub strengthen_slot_value {
     my ($self, $instance, $slot_name) = @_;
     $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));
@@ -171,6 +184,11 @@ sub _get_mop_slot {
     $self->get_slot_value($instance, $RESERVED_MOP_SLOT);
 }
 
+sub _has_mop_slot {
+    my ($self, $instance) = @_;
+    $self->is_slot_initialized($instance, $RESERVED_MOP_SLOT);
+}
+
 sub _set_mop_slot {
     my ($self, $instance, $value) = @_;
     $self->set_slot_value($instance, $RESERVED_MOP_SLOT, $value);