Mercurial > pub > Impl
view Lib/IMPL/clone.pm @ 381:ced5937ff21a
Custom getters/setters support method names in theirs definitions
Initial support for localizable labels in DOM schemas
author | cin |
---|---|
date | Wed, 22 Jan 2014 16:56:10 +0400 |
parents | 4d0e1962161c |
children |
line wrap: on
line source
package IMPL::clone; use Scalar::Util qw(blessed reftype refaddr); use base qw(Exporter); our @EXPORT_OK = qw(&clone); { my %handlers = ( HASH => sub { my $class = blessed($_[0]); my $new = $_[1]->{ refaddr($_[0]) } = {}; while (my ($key,$val) = each %{$_[0]}) { $new->{$key} = clone($val,$_[1]); } $class ? bless $new, $class : $new; }, ARRAY => sub { my $class = blessed($_[0]); my $new = $_[1]->{ refaddr($_[0]) } = []; push @$new, clone($_,$_[1]) foreach @{$_[0]}; $class ? bless( $new, $class ) : $new; }, SCALAR => sub { my $class = blessed($_[0]); my $v = ${$_[0]}; $class ? bless \$v, $class : \$v; }, REF => sub { my $class = blessed($_[0]); my $v; my $new = $_[1]->{ refaddr($_[0]) } = \$v; $v = clone ( ${$_[0]},$_[1] ); $class ? bless \$v, $class : \$v; }, REGEXP => sub { $_[0]; } ); sub clone { return unless @_; return $_[0] unless ref $_[0]; return $_[1]->{refaddr($_[0])} || (UNIVERSAL::can($_[0],'_clone') || $handlers{reftype($_[0])} || sub { die "Unknown reftype " . reftype($_[0])} )->(@_); } } 1;