Mercurial > pub > Impl

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
minor changes
author sergey
date Tue, 04 Oct 2011 17:55:38 +0400
parents aaab45153411
children 9057e4b95d10
comparison
equal deleted inserted replaced
173:aaab45153411 174:d920d2b70230
1 package IMPL::clone; 1 package IMPL::clone;
2 2
3 use Scalar::Util qw(blessed reftype); 3 use Scalar::Util qw(blessed reftype refaddr);
4 4
5 use base qw(Exporter); 5 use base qw(Exporter);
6 our @EXPORT_OK = qw(&clone); 6 our @EXPORT_OK = qw(&clone);
7 7
8 { 8 {
10 HASH => sub { 10 HASH => sub {
11 my $class = blessed($_[0]); 11 my $class = blessed($_[0]);
12 12
13 my $new = {}; 13 my $new = {};
14 while (my ($key,$val) = each %{$_[0]}) { 14 while (my ($key,$val) = each %{$_[0]}) {
15 $new->{$key} = clone($val); 15 $new->{$key} = clone($val,$_[1]);
16 } 16 }
17 $class ? bless $new, $class : $new; 17 $class ? bless $new, $class : $new;
18 }, 18 },
19 ARRAY => sub { 19 ARRAY => sub {
20 my $class = blessed($_[0]); 20 my $class = blessed($_[0]);
21 $class ? bless( [ map clone($_), @{$_[0]} ], $class ) : [ map clone($_), @{$_[0]} ]; 21 $class ? bless( [ map clone($_,$_[1]), @{$_[0]} ], $class ) : [ map clone($_), @{$_[0]} ];
22 }, 22 },
23 SCALAR => sub { 23 SCALAR => sub {
24 my $class = blessed($_[0]); 24 my $class = blessed($_[0]);
25 25
26 my $v = ${$_[0]}; 26 my $v = ${$_[0]};
27 $class ? bless \$v, $class : \$v; 27 $class ? bless \$v, $class : \$v;
28 }, 28 },
29 REF => sub { 29 REF => sub {
30 my $class = blessed($_[0]); 30 my $class = blessed($_[0]);
31 my $v = clone ( ${$_[0]} ); 31 my $v = clone ( ${$_[0]},$_[1] );
32 $class ? bless \$v, $class : \$v; 32 $class ? bless \$v, $class : \$v;
33 33
34 }, 34 },
35 REGEXP => sub { 35 REGEXP => sub {
36 $_[0]; 36 $_[0];
37 } 37 }
38 ); 38 );
39
39 sub clone { 40 sub clone {
40 return unless @_; 41 return unless @_;
41 42
42 return $_[0] unless ref $_[0]; 43 return $_[0] unless ref $_[0];
43 44
44 return ($handlers{reftype($_[0])} || sub { die "Unknown reftype " . reftype($_[0])} )->($_[0]); 45 return $_[1]->{refaddr($_[0])} ||= ($handlers{reftype($_[0])} || sub { die "Unknown reftype " . reftype($_[0])} )->($_[0]);
45 } 46 }
47
46 } 48 }
47 49
48 1; 50 1;