Mercurial > pub > Impl

comparison lib/IMPL/clone.pm @ 407:c6e90e02dd17 ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
1 package IMPL::clone;
2
3 use Scalar::Util qw(blessed reftype refaddr);
4
5 use base qw(Exporter);
6 our @EXPORT_OK = qw(&clone);
7
8 {
9 my %handlers = (
10 HASH => sub {
11 my $class = blessed($_[0]);
12
13 my $new = $_[1]->{ refaddr($_[0]) } = {};
14 while (my ($key,$val) = each %{$_[0]}) {
15 $new->{$key} = clone($val,$_[1]);
16 }
17 $class ? bless $new, $class : $new;
18 },
19 ARRAY => sub {
20 my $class = blessed($_[0]);
21
22 my $new = $_[1]->{ refaddr($_[0]) } = [];
23
24 push @$new, clone($_,$_[1]) foreach @{$_[0]};
25
26 $class ? bless( $new, $class ) : $new;
27 },
28 SCALAR => sub {
29 my $class = blessed($_[0]);
30
31 my $v = ${$_[0]};
32 $class ? bless \$v, $class : \$v;
33 },
34 REF => sub {
35 my $class = blessed($_[0]);
36 my $v;
37 my $new = $_[1]->{ refaddr($_[0]) } = \$v;
38 $v = clone ( ${$_[0]},$_[1] );
39 $class ? bless \$v, $class : \$v;
40
41 },
42 REGEXP => sub {
43 $_[0];
44 }
45 );
46
47 sub clone {
48 return unless @_;
49
50 return $_[0] unless ref $_[0];
51
52 return $_[1]->{refaddr($_[0])} || (UNIVERSAL::can($_[0],'_clone') || $handlers{reftype($_[0])} || sub { die "Unknown reftype " . reftype($_[0])} )->(@_);
53 }
54
55 }
56
57 1;