#!/usr/local/bin/perl

use threads;

use Time::HiRes qw/usleep/;

while( 1 ) {
	my $class = Class->new();
	threads->create( \&thread_sub, $class, 0 );
	usleep 200_000;
}

sub thread_sub {
	my( $class, $level ) = @_;
	print "THREAD ", threads->self->tid, ", $level running\n";
	threads->create( \&thread_sub, $class, $level + 1 ) unless $level;
	usleep 400_000;
	print "THREAD ", threads->self->tid, ", $level finished\n";
	threads->self->detach;
}

1;

package Class;

use threads::shared;

our %MY_CXT : shared = ();
our $CXT_ID : shared = 0;

sub new {
	my $class = shift;
	my $this = {};
	$this->{'shared'} = &share( {} ),
	$this->{'shared'}{'refcnt'} = 1;
	$this->{'shared'}{'tid'} = threads->self->tid;
	$this->{'shared'}{'clone'} = 1;
	lock( %MY_CXT );
	$this->{'id'} = ++ $CXT_ID;
	$MY_CXT{$this->{'id'}} = $this->{'shared'};
	bless $this, $class;
}

sub CLONE {
	lock( %MY_CXT );
	while( my( $k, $v ) = each %MY_CXT ) {
		# do not CLONE anymore when it's destroyed in the main thread
		$v->{'refcnt'} ++ if $v->{'clone'};
		print "CLONE: id $k, refcnt $v->{'refcnt'}\n";
	}
}

sub DESTROY {
	my $this = shift;
	my $shared = $this->{'shared'};
	if( $shared->{'tid'} == threads->self->tid ) {
		# disable futher CLONEs
		$shared->{'clone'} = 0;
		# refcnt must decrement twice ?
		$shared->{'refcnt'} --;
	}
	$shared->{'refcnt'} --;
	print "DESTROY: id $this->{'id'}, refcnt $shared->{'refcnt'}\n";
	if( $shared->{'refcnt'} <= 0 ) {
		lock( %MY_CXT );
		# should not happen
		warn "already destroyed!!!" unless $MY_CXT{$this->{'id'}};
		delete $MY_CXT{$this->{'id'}};
	}
}

1;