use warnings;
use strict;
{
	package Big;
	sub new { my $class = shift; bless {@_}, $class }
	sub new_little {
		my ($self,$id) = @_;
		push @{$self->{little_objs}},
			Little->new(id=>$id, big_obj=>$self);
		return $self;
	}
	sub DESTROY
		{ print "DESTROY ",__PACKAGE__," id=",shift->{id},"\n" }
}
{
	package Little;
	use Scalar::Util qw/weaken/;
	sub new {
		my $class = shift;
		my $self = {@_};
		weaken($self->{big_obj});
		return bless $self, $class;
	}
	sub DESTROY
		{ print "DESTROY ",__PACKAGE__," id=",shift->{id},"\n" }
}

my $big1 = Big->new(id=>"One")->new_little("Hello");
print "Clearing \$big1...\n";
$big1 = undef; # no more references to object should cause GC

my $big2 = Big->new(id=>"Two")->new_little("World");
print "Clearing \$big2...\n";
$big2 = undef;

END { print "END\n" }