diff Lib/IMPL/clone.pm @ 174:d920d2b70230

minor changes
author sergey
date Tue, 04 Oct 2011 17:55:38 +0400
parents aaab45153411
children 9057e4b95d10
line wrap: on
line diff
--- a/Lib/IMPL/clone.pm	Wed Sep 14 18:59:01 2011 +0400
+++ b/Lib/IMPL/clone.pm	Tue Oct 04 17:55:38 2011 +0400
@@ -1,6 +1,6 @@
 package IMPL::clone;
 
-use Scalar::Util qw(blessed reftype);
+use Scalar::Util qw(blessed reftype refaddr);
 
 use base qw(Exporter);
 our @EXPORT_OK = qw(&clone);
@@ -12,13 +12,13 @@
 			
 			my $new = {};
 			while (my ($key,$val) = each %{$_[0]}) {
-				$new->{$key} = clone($val);
+				$new->{$key} = clone($val,$_[1]);
 			}
 			$class ? bless $new, $class : $new;
 		},
 		ARRAY => sub {
 			my $class = blessed($_[0]);
-			$class ? bless( [ map clone($_), @{$_[0]} ], $class ) : [ map clone($_), @{$_[0]} ];
+			$class ? bless( [ map clone($_,$_[1]), @{$_[0]} ], $class ) : [ map clone($_), @{$_[0]} ];
 		},
 		SCALAR => sub {
 			my $class = blessed($_[0]);
@@ -28,7 +28,7 @@
 		},
 		REF => sub {
 			my $class = blessed($_[0]);
-			my $v = clone ( ${$_[0]} );
+			my $v = clone ( ${$_[0]},$_[1] );
 			$class ? bless \$v, $class : \$v;
 			
 		},
@@ -36,13 +36,15 @@
 			$_[0];
 		}
 	);
+	
 	sub clone {
 		return unless @_;
 		
 		return $_[0] unless ref $_[0];
 		
-		return ($handlers{reftype($_[0])} || sub { die "Unknown reftype " . reftype($_[0])} )->($_[0]);
+		return $_[1]->{refaddr($_[0])} ||= ($handlers{reftype($_[0])} || sub { die "Unknown reftype " . reftype($_[0])} )->($_[0]);
 	}
+	
 }
 
 1;