Mercurial > pub > Impl
comparison Lib/IMPL/clone.pm @ 173:aaab45153411
minor bugfixes
author | sourcer |
---|---|
date | Wed, 14 Sep 2011 18:59:01 +0400 |
parents | |
children | d920d2b70230 |
comparison
equal
deleted
inserted
replaced
172:068acfe903c3 | 173:aaab45153411 |
---|---|
1 package IMPL::clone; | |
2 | |
3 use Scalar::Util qw(blessed reftype); | |
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 = {}; | |
14 while (my ($key,$val) = each %{$_[0]}) { | |
15 $new->{$key} = clone($val); | |
16 } | |
17 $class ? bless $new, $class : $new; | |
18 }, | |
19 ARRAY => sub { | |
20 my $class = blessed($_[0]); | |
21 $class ? bless( [ map clone($_), @{$_[0]} ], $class ) : [ map clone($_), @{$_[0]} ]; | |
22 }, | |
23 SCALAR => sub { | |
24 my $class = blessed($_[0]); | |
25 | |
26 my $v = ${$_[0]}; | |
27 $class ? bless \$v, $class : \$v; | |
28 }, | |
29 REF => sub { | |
30 my $class = blessed($_[0]); | |
31 my $v = clone ( ${$_[0]} ); | |
32 $class ? bless \$v, $class : \$v; | |
33 | |
34 }, | |
35 REGEXP => sub { | |
36 $_[0]; | |
37 } | |
38 ); | |
39 sub clone { | |
40 return unless @_; | |
41 | |
42 return $_[0] unless ref $_[0]; | |
43 | |
44 return ($handlers{reftype($_[0])} || sub { die "Unknown reftype " . reftype($_[0])} )->($_[0]); | |
45 } | |
46 } | |
47 | |
48 1; |