Mercurial > pub > Impl
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;