Mercurial > pub > Impl
diff Lib/IMPL/clone.pm @ 173:aaab45153411
minor bugfixes
author | sourcer |
---|---|
date | Wed, 14 Sep 2011 18:59:01 +0400 |
parents | |
children | d920d2b70230 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/clone.pm Wed Sep 14 18:59:01 2011 +0400 @@ -0,0 +1,48 @@ +package IMPL::clone; + +use Scalar::Util qw(blessed reftype); + +use base qw(Exporter); +our @EXPORT_OK = qw(&clone); + +{ + my %handlers = ( + HASH => sub { + my $class = blessed($_[0]); + + my $new = {}; + while (my ($key,$val) = each %{$_[0]}) { + $new->{$key} = clone($val); + } + $class ? bless $new, $class : $new; + }, + ARRAY => sub { + my $class = blessed($_[0]); + $class ? bless( [ map clone($_), @{$_[0]} ], $class ) : [ map clone($_), @{$_[0]} ]; + }, + SCALAR => sub { + my $class = blessed($_[0]); + + my $v = ${$_[0]}; + $class ? bless \$v, $class : \$v; + }, + REF => sub { + my $class = blessed($_[0]); + my $v = clone ( ${$_[0]} ); + $class ? bless \$v, $class : \$v; + + }, + REGEXP => sub { + $_[0]; + } + ); + sub clone { + return unless @_; + + return $_[0] unless ref $_[0]; + + return ($handlers{reftype($_[0])} || sub { die "Unknown reftype " . reftype($_[0])} )->($_[0]); + } +} + +1;