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;