Mercurial > pub > Impl

comparison Lib/IMPL/clone.pm @ 175:9057e4b95d10

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
corrected cloning method
author sourcer
date Wed, 05 Oct 2011 00:48:43 +0300
parents d920d2b70230
children 47dac58691ee
comparison
equal deleted inserted replaced
174:d920d2b70230 175:9057e4b95d10
8 { 8 {
9 my %handlers = ( 9 my %handlers = (
10 HASH => sub { 10 HASH => sub {
11 my $class = blessed($_[0]); 11 my $class = blessed($_[0]);
12 12
13 my $new = {}; 13 my $new = $_[1]->{ refaddr($_[0]) } = {};
14 while (my ($key,$val) = each %{$_[0]}) { 14 while (my ($key,$val) = each %{$_[0]}) {
15 $new->{$key} = clone($val,$_[1]); 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($_,$_[1]), @{$_[0]} ], $class ) : [ map clone($_), @{$_[0]} ]; 21
22 my $new = $_[1]->{ refaddr($_[0]) } = [];
23
24 push @$new, clone($_,$_[1]) foreach @{$_[0]};
25
26 $class ? bless( $new, $class ) : $new;
22 }, 27 },
23 SCALAR => sub { 28 SCALAR => sub {
24 my $class = blessed($_[0]); 29 my $class = blessed($_[0]);
25 30
26 my $v = ${$_[0]}; 31 my $v = ${$_[0]};
27 $class ? bless \$v, $class : \$v; 32 $class ? bless \$v, $class : \$v;
28 }, 33 },
29 REF => sub { 34 REF => sub {
30 my $class = blessed($_[0]); 35 my $class = blessed($_[0]);
31 my $v = clone ( ${$_[0]},$_[1] ); 36 my $v;
37 my $new = $_[1]->{ refaddr($_[0]) } = \$v;
38 $v = clone ( ${$_[0]},$_[1] );
32 $class ? bless \$v, $class : \$v; 39 $class ? bless \$v, $class : \$v;
33 40
34 }, 41 },
35 REGEXP => sub { 42 REGEXP => sub {
36 $_[0]; 43 $_[0];
40 sub clone { 47 sub clone {
41 return unless @_; 48 return unless @_;
42 49
43 return $_[0] unless ref $_[0]; 50 return $_[0] unless ref $_[0];
44 51
45 return $_[1]->{refaddr($_[0])} ||= ($handlers{reftype($_[0])} || sub { die "Unknown reftype " . reftype($_[0])} )->($_[0]); 52 return $_[1]->{refaddr($_[0])} || ($handlers{reftype($_[0])} || sub { die "Unknown reftype " . reftype($_[0])} )->(@_);
46 } 53 }
47 54
48 } 55 }
49 56
50 1; 57 1;