view release on metacpan or  search on metacpan

lib/Class/Cloneable.pm  view on Meta::CPAN

use strict;
use warnings;

use overload ();
use Carp qw(confess);
use Scalar::Util qw(blessed reftype weaken isweak);

our $VERSION = '0.03';

sub clone {
    (UNIVERSAL::isa((caller)[0], 'Class::Cloneable') || 
     UNIVERSAL::isa((caller)[0], 'Class::Cloneable::Util')) 
        || confess "Illegal Operation : This method can only be called by a subclass of Class::Cloneable";        
    my ($to_clone, $cache) = @_;
    (defined($to_clone)) 
        || confess "Insufficient Arguments : Must specify the object to clone";    
    # To start with, non-reference values are
    # not copied, just returned, cache or not
    return $to_clone unless ref($to_clone);
    # now check for an active cache
    unless(defined $cache) {
        # now we check to see what we have,

lib/Class/Cloneable.pm  view on Meta::CPAN

    }
    # if we have it in the cache them return the cached clone
    return $cache->{$to_clone} if exists $cache->{$to_clone};
    # now try it as an object, which will in
    # turn try it as ref if its not an object
    # now store it in case we run into a circular ref
    return $cache->{$to_clone} = cloneObject($to_clone, $cache);    
}

sub cloneObject {
    (UNIVERSAL::isa((caller)[0], 'Class::Cloneable') || 
     UNIVERSAL::isa((caller)[0], 'Class::Cloneable::Util')) 
        || confess "Illegal Operation : This method can only be called by a subclass of Class::Cloneable"; 
    my ($to_clone, $cache) = @_;
    (ref($to_clone) && (ref($cache) && ref($cache) eq 'HASH')) 
        || confess "Insufficient Arguments : Must specify the object to clone and a valid cache";    
    # check to see if we have an Class::Cloneable object,
    # or check to see if its an object, with a clone method    
    if (blessed($to_clone)) {
        # note, we want to be sure to respect any overriding of
        # the clone method with Class::Cloneable objects here
        # otherwise it would be faster to just send it directly

lib/Class/Cloneable.pm  view on Meta::CPAN

                    # we will respect its encapsulation, and not muck with 
                    # its internals. Basically, we assume it does not want
                    # to be cloned                    
                    $to_clone);
    }
    # if all else fails, it is likely a basic ref
    return $cache->{$to_clone} = cloneRef($to_clone, $cache);     
}

sub cloneRef {
    (UNIVERSAL::isa((caller)[0], 'Class::Cloneable') || 
     UNIVERSAL::isa((caller)[0], 'Class::Cloneable::Util')) 
        || confess "Illegal Operation : This method can only be called by a subclass of Class::Cloneable"; 
    my ($to_clone, $cache, $ref_type) = @_;
    (ref($to_clone) && (ref($cache) && ref($cache) eq 'HASH')) 
        || confess "Insufficient Arguments : Must specify the object to clone and a valid cache";        
    $ref_type = ref($to_clone) unless defined $ref_type;
    # check if it is weakened
    my $is_weak;
    $is_weak = 1 if isweak($to_clone);    
    my ($clone, $tied);
    if ($ref_type eq 'HASH') {