#! /usr/bin/perl
use warnings;
use strict;

{   package BigObjs;
    use Moose;

    has 'little_objs' => (is => 'rw', isa => 'HashRef', default => sub { {} });

    sub get_little_obj {
        my ($s, $id) = @_;
        return $s->little_objs->{$id};
    }

    sub add_little_obj {
        my ($s, $little_obj) = @_;
        $little_obj->big_obj($s);
        $s->little_objs->{$little_obj->id} = $little_obj;
    }
}

{   package LittleObjs;
    use Moose;

    has id      => (is => 'rw');
    has data    => (is => 'rw');
    has big_obj => (is => 'rw', weak_ref => 1);

    sub alter_another_little_object {
        my ($s, $id) = @_;
        my $other_little_object = $s->big_obj->get_little_obj($id);
        $other_little_object->do_stuff;
    }

    sub do_stuff {
        my $s = shift;
        print "I'm doing stuff to: " . $s->id . "\n";
    }
}

my $big = BigObjs->new();
my $little1 = LittleObjs->new(id => 'little1', data => 'foo');
my $little2 = LittleObjs->new(id => 'little2', data => 'bar');

$big->add_little_obj($little1);
$big->add_little_obj($little2);

$little1->alter_another_little_object('little2');

warn "Done\n";