adding in the code ,... clone is okay,.. not ideal,. but okay

diff --git a/Build.PL b/Build.PL
index fc60d93..77fb9e4 100644 (file)
--- a/Build.PL
+++ b/Build.PL
@@ -6,17 +6,18 @@ my $build = Module::Build->new(
     module_name => 'Class::MOP',
     license => 'perl',
     requires => {
-        'Scalar::Util' => '1.17',
+        'Scalar::Util' => '1.18',
         'Sub::Name'    => '0.02',
         'Carp'         => '0.01',
         'B'            => '0',
+        'Clone'        => '0.18',
     },
     optional => {
     },
     build_requires => {
         'Test::More'      => '0.47',
         'Test::Exception' => '0.21',
-        'File::Spec'      => 0,
+        'File::Spec'      => '0',
     },
     create_makefile_pl => 'traditional',
     recursive_test_files => 1,

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 7b01847..c30f250 100644 (file)
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -155,8 +155,15 @@ Class::MOP::Attribute->meta->add_method('new' => sub {
 });
 
 Class::MOP::Attribute->meta->add_method('clone' => sub {
-    my $self = shift;
-    $self->meta->clone_object($self, @_);    
+    my $self  = shift;
+    my $class = $self->associated_class;
+    $self->detach_from_class() if defined $class;
+    my $clone = $self->meta->clone_object($self, @_);  
+    if (defined $class) {
+        $self->attach_to_class($class);
+        $clone->attach_to_class($class);
+    }
+    return $clone;  
 });
 
 1;

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 7863468..068bbad 100644 (file)
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -6,9 +6,9 @@ use warnings;
 
 use Carp         'confess';
 use Scalar::Util 'blessed', 'reftype';
-use Hash::Util   'lock_keys';
 use Sub::Name    'subname';
 use B            'svref_2object';
+use Clone         ();
 
 our $VERSION = '0.03';
 
@@ -146,78 +146,22 @@ sub clone_object {
     # NOTE:
     # we need to protect the integrity of the 
     # Class::MOP::Class singletons here, they 
-    # should not be cloned
+    # should not be cloned.
     return $instance if $instance->isa('Class::MOP::Class');   
     bless $class->clone_instance($instance, @_) => blessed($instance);
 }
 
-#{
-#    sub _deep_clone {       
-#        my ($object, $cache) = @_;
-#        return $object unless ref($object);
-#        # check for an active cache
-#        return _deep_clone_ref($object, ($cache = {}), 'HASH') if not defined $cache;      
-#        # if we have it in the cache them return the cached clone
-#        return $cache->{$object} if exists $cache->{$object};
-#        # now try it as an object, which will in
-#        # turn try it as ref if its not an object
-#        # and store it in case we run into a circular ref
-#        $cache->{$object} = _deep_clone_object($object, $cache);    
-#    }
-#
-#    sub _deep_clone_object {
-#        my ($object, $cache) = @_;
-#        # check to see if its an object, with a clone method    
-#        # or if we have an object, with no clone method, then
-#        # we will respect its encapsulation, and not muck with 
-#        # its internals. Basically, we assume it does not want
-#        # to be cloned    
-#        return $cache->{$object} = ($object->can('clone') ? $object->clone() : $object) 
-#            if blessed($object);
-#        return $cache->{$object} = _deep_clone_ref($object, $cache);     
-#    }
-#
-#    sub _deep_clone_ref { 
-#        my ($object, $cache, $ref_type) = @_;
-#        $ref_type ||= ref($object);
-#        my ($clone, $tied);
-#        if ($ref_type eq 'HASH') {
-#            $clone = {};
-#            tie %{$clone}, ref $tied if $tied = tied(%{$object});    
-#            %{$clone} = map { ref($_) ? _deep_clone($_, $cache) : $_ } %{$object};
-#        } 
-#        elsif ($ref_type eq 'ARRAY') {
-#            $clone = [];
-#            tie @{$clone}, ref $tied if $tied = tied(@{$object});
-#            @{$clone} = map { ref($_) ? _deep_clone($_, $cache) : $_ } @{$object};
-#        } 
-#        elsif ($ref_type eq 'REF' or $ref_type eq 'SCALAR') {
-#            my $var = "";
-#            $clone = \$var;
-#            tie ${$clone}, ref $tied if $tied = tied(${$object});
-#            ${$clone} = _deep_clone(${$object}, $cache);
-#        } 
-#        else {
-#            # shallow copy reference to code, glob, regex
-#            $clone = $object;
-#        }
-#        # store it in our cache
-#        $cache->{$object} = $clone;
-#        # and return the clone
-#        return $clone;    
-#    }    
-#}
-
 sub clone_instance {
     my ($class, $instance, %params) = @_;
     (blessed($instance))
         || confess "You can only clone instances, \$self is not a blessed instance";
     # NOTE:
-    # this should actually do a deep clone
-    # instead of this cheap hack. I will 
-    # add that in later. 
-    # (use the Class::Cloneable::Util code)
-    my $clone = { %{$instance} }; #_deep_clone($instance); 
+    # This will deep clone, which might
+    # not be what you always want. So 
+    # the best thing is to write a more
+    # controled &clone method locally 
+    # in the class (see Class::MOP)
+    my $clone = Clone::clone($instance); 
     foreach my $attr ($class->compute_all_applicable_attributes()) {
         my $init_arg = $attr->init_arg();
         # try to fetch the init arg from the %params ...        

diff --git a/t/006_new_and_clone_metaclasses.t b/t/006_new_and_clone_metaclasses.t
index 68916b0..6e972d9 100644 (file)
--- a/t/006_new_and_clone_metaclasses.t
+++ b/t/006_new_and_clone_metaclasses.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 32;
+use Test::More tests => 36;
 use Test::Exception;
 
 BEGIN {
@@ -108,3 +108,23 @@ dies_ok {
     $foo_meta->clone_object($meta);
 } '... this dies as expected';  
 
+# test stuff
+
+{
+    package FooBar;
+    use metaclass;
+    
+    FooBar->meta->add_attribute('test');
+}
+
+my $attr = FooBar->meta->get_attribute('test');
+isa_ok($attr, 'Class::MOP::Attribute');
+
+my $attr_clone = $attr->clone();
+isa_ok($attr_clone, 'Class::MOP::Attribute');
+
+isnt($attr, $attr_clone, '... we successfully cloned our attributes');
+is($attr->associated_class, 
+   $attr_clone->associated_class, 
+   '... we successfully did not clone our associated metaclass');
+

diff --git a/t/020_attribute.t b/t/020_attribute.t
index 77e3589..3e255f6 100644 (file)
--- a/t/020_attribute.t
+++ b/t/020_attribute.t
@@ -79,7 +79,7 @@ BEGIN {
     
     my $attr_clone = $attr->clone();
     isa_ok($attr_clone, 'Class::MOP::Attribute');
-    isnt($attr, $attr_clone, '... but they are different instnaces');
+    isnt($attr, $attr_clone, '... but they are different instances');
     
     is_deeply($attr, $attr_clone, '... but they are the same inside');                
 }
@@ -109,7 +109,7 @@ BEGIN {
     
     my $attr_clone = $attr->clone();
     isa_ok($attr_clone, 'Class::MOP::Attribute');
-    isnt($attr, $attr_clone, '... but they are different instnaces');
+    isnt($attr, $attr_clone, '... but they are different instances');
     
     is_deeply($attr, $attr_clone, '... but they are the same inside');       
 }