Mercurial > pub > Impl

comparison Lib/IMPL/clone.pm @ 194:4d0e1962161c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Replaced tabs with spaces IMPL::Web::View - fixed document model, new features (control classes, document constructor parameters)
author cin
date Tue, 10 Apr 2012 20:08:29 +0400
parents 47dac58691ee
children
comparison
equal deleted inserted replaced
193:8e8401c0aea4 194:4d0e1962161c
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 {
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 = $_[1]->{ refaddr($_[0]) } = {}; 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 21
22 my $new = $_[1]->{ refaddr($_[0]) } = []; 22 my $new = $_[1]->{ refaddr($_[0]) } = [];
23 23
24 push @$new, clone($_,$_[1]) foreach @{$_[0]}; 24 push @$new, clone($_,$_[1]) foreach @{$_[0]};
25 25
26 $class ? bless( $new, $class ) : $new; 26 $class ? bless( $new, $class ) : $new;
27 }, 27 },
28 SCALAR => sub { 28 SCALAR => sub {
29 my $class = blessed($_[0]); 29 my $class = blessed($_[0]);
30 30
31 my $v = ${$_[0]}; 31 my $v = ${$_[0]};
32 $class ? bless \$v, $class : \$v; 32 $class ? bless \$v, $class : \$v;
33 }, 33 },
34 REF => sub { 34 REF => sub {
35 my $class = blessed($_[0]); 35 my $class = blessed($_[0]);
36 my $v; 36 my $v;
37 my $new = $_[1]->{ refaddr($_[0]) } = \$v; 37 my $new = $_[1]->{ refaddr($_[0]) } = \$v;
38 $v = clone ( ${$_[0]},$_[1] ); 38 $v = clone ( ${$_[0]},$_[1] );
39 $class ? bless \$v, $class : \$v; 39 $class ? bless \$v, $class : \$v;
40 40
41 }, 41 },
42 REGEXP => sub { 42 REGEXP => sub {
43 $_[0]; 43 $_[0];
44 } 44 }
45 ); 45 );
46 46
47 sub clone { 47 sub clone {
48 return unless @_; 48 return unless @_;
49 49
50 return $_[0] unless ref $_[0]; 50 return $_[0] unless ref $_[0];
51 51
52 return $_[1]->{refaddr($_[0])} || (UNIVERSAL::can($_[0],'_clone') || $handlers{reftype($_[0])} || sub { die "Unknown reftype " . reftype($_[0])} )->(@_); 52 return $_[1]->{refaddr($_[0])} || (UNIVERSAL::can($_[0],'_clone') || $handlers{reftype($_[0])} || sub { die "Unknown reftype " . reftype($_[0])} )->(@_);
53 } 53 }
54 54
55 } 55 }
56 56
57 1; 57 1;