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;