#!/usr/bin/env perl
use warnings;
use 5.014;

package BigObj {
	use Moose;
	has 'little_objs' => ( is => 'rw', isa => 'HashRef',
		default => sub { {} } );
	sub add_little_obj {
		my ($self, $little_obj) = @_;
		$little_obj->big_obj($self);
		$self->little_objs->{$little_obj->id} = $little_obj;
	}
	sub get_little_obj {
		my ($self, $id) = @_;
		return $self->little_objs->{$id};
	}
	sub DESTROY { print "DESTROY ",ref(shift),"\n" }
}

package LittleObj {
	use Moose;
	has 'id' => (is => 'rw');
	has 'big_obj' => (is => 'rw', weak_ref=>1);
	sub alter_another_little_object {
		my ($self, $id) = @_;
		$self->big_obj->get_little_obj($id)->do_stuff;
	}
	sub do_stuff { print "I'm doing stuff to: ",shift->id,"\n" }
	sub DESTROY {
		my $self = shift;
		print "DESTROY ",ref($self)," id=",$self->id,"\n" }
}

my $big = BigObj->new();
my $little1 = LittleObj->new(id=>'little1');
my $little2 = LittleObj->new(id=>'little2');
$big->add_little_obj($little1);
$big->add_little_obj($little2);
$little1->alter_another_little_object('little2');

print "Clearing vars...\n";
$little1 = undef;
$little2 = undef;
$big = undef;

END { print "END\n" }

__END__

I'm doing stuff to: little2
Clearing vars...
DESTROY BigObj
DESTROY LittleObj id=little2
DESTROY LittleObj id=little1
END