# A thread-safe inside-out object class
package SafeObject;
use strict;
use warnings;
use Scalar::Util qw( refaddr weaken );

our $VERSION = 0.001;

# Global object tracking and constructor

my %REGISTRY;

# Object property storage and accessor

my %NAME;

sub name {
    my ($self, $value) = @_;
    
    # store a value if one is provided
    my $id = refaddr $self;
    if ( defined $value ) { $NAME{ $id } = $value; }
    
    return $NAME{ $id };
}

# Constructor and destructor 

sub new { 
    my $class = shift;
    my $self = bless {}, $class;

    # store a weak reference in the registry
    my $id = refaddr $self;
    weaken ( $REGISTRY{ $id } = $self );
    
    return $self;
}

sub DESTROY {
    my $self = shift;
    my $id = refaddr $self;
    
    # clean up memory used for the object
    delete $NAME{ $id };
    delete $REGISTRY{ $id };

    return;
}

# Cloning routine called for new threads

sub CLONE {
    # So we can see this called in a Windows fork()
    warn "# Notice: Cloning data in new thread\n";
    
    # fix-up all object ids in the new thread
    # (note: %REGISTRY change in the middle, so don't use "each")
    for my $old_id ( keys %REGISTRY ) {  
        
        # look under old_id to find the new, cloned reference
        my $object = $REGISTRY{ $old_id };
        my $new_id = refaddr $object;

        # relocate data
        $NAME{ $new_id } = $NAME{ $old_id };
        delete $NAME{ $old_id };

        # update the weak reference to the new, cloned object
        weaken ( $REGISTRY{ $new_id } = $REGISTRY{ $old_id } );
        delete $REGISTRY{ $old_id };
    }
    
    return;
}

1; # package must return true