#!/usr/local/bin/perl

use threads;

use Time::HiRes qw/usleep/;

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

sub thread_sub {
	my( $class ) = @_;
	usleep 400_000;
	threads->self->detach;
}

1;

package Class;

use threads::shared;

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

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

sub CLONE {
	my $this = shift; # not applicable
	lock( %MY_CXT );
	while( my( $k, $v ) = each %MY_CXT ) {
		$v->{'refcnt'} ++;
		print "CLONE: id $k, refcnt $v->{'refcnt'}\n";
	}
}

sub DESTROY {
	my $this = shift;
	my $shared = $this->{'shared'};
	$shared->{'refcnt'} --;
	print "DESTROY: id $this->{'id'}, refcnt $shared->{'refcnt'}\n";
	if( $shared->{'refcnt'} <= 0 ) {
		lock( %MY_CXT );
		delete $MY_CXT{$this->{'id'}};
	}
}

1;