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;