Several times I've solved this type of problem by having an outer wrapper class that is what the user of the module deals with. That gets destroyed when the user is done with it because its ref-count goes to 0.

The outer wrapper is just a pointer to the inner object. The inner object can create circular references with other inner objects. When a wrapper is destroyed, it tells the inner object to break any potential circular references so that the inner object(s) will also be destroyed.

This is pretty simple when you have a "container" and a bunch of contained things and the outer wrapper for the container going away means that you can destroy all of the inner, contained things. But you hint at a more complex situation. What if you want to have full life cycles for all of your objects instead of having to have "contained" objects whose life is bounded by some container's life?

It doesn't have to be terribly complicated to pull that off. You can have outer wrappers that tell you when external users are done using an inner object (that is, you implement your own version of "ref counting").

Then you want the wrapped (inner) objects to be destroyed when they can't be reached even indirectly by any outer wrapper. That is, you implement your own garbage collector for the inner objects.

    my $dad= My::Parent->new( name => 'Robert' );
    {
        my $son= My::Child->new( $dad, name => 'Bobby' );
    }
    # No direct access to Bobby at this point.
    # That triggers garbage collection.
    # Bobby and Robert circularly reference each other.
    # Robert is still reachable from the outside.
    # Bobby does not get destroyed, because we can reach him indirectl
+y:
    {
        my $son= $dad->GetSon();    # Got Bobby again
    }

    $dad= My::Parent->new( name => 'Walter' );
    # No direct access to Robert, now.  Garbage collection runs.
    # Robert and Bobby form a loop but both are unreferenced.
    # Both get destroyed.
[download]

I wanted to see how tricky this really was, and not just in theory. (It also may serve as an excellent example for some other stuff I am working on.) So I threw together a quick, full, working implementation.

First, I created a couple of hand-rolled roles. My::Outer is a role for the wrappers and My::Inner is a role for the inner, wrapped objects. And I implemented the roles using nothing more complicated than Exporter.pm.

This means that the My::Parent and My::Child classes were extremely simple. They just declare themselves as playing the My::Outer role for My::Parent::Inner and My::Child::Inner, respectively. I also made them overload stringification just to make tracing simpler:

package My::Parent;
use My::Outer qw< ::Inner new DESTROY AUTOLOAD >;
use overload '""' => \&GetName;

package My::Child;
use My::Outer qw< ::Inner new DESTROY AUTOLOAD >;
use overload '""' => \&GetName;
[download]

Yes, that is the whole implementation of both classes.

The '::Inner' means "append '::Inner' to my class name to get the class name that I wrap". 'new' says that a new() method gets exported into the class (to be the constructor that the module's user calls). 'DESTROY' exports a DESTROY() method so that reference counts can be decremented. 'AUTOLOAD' exports an AUTOLOAD() method that automatically deligates so that any public methods (no leading underscore in the name) defined on the inner object can be called directly on the wrapper.

Here is the full implementation of the My::Inner role.

(Late update: Commented out (with "##") useless ->{wrapper} parts left over from early debugging when I was using objects before they were fully constructed. Then I made the role not require the inner objects be blessed refs while still not requiring the writing of two tiny methods if the inner objects are blessed refs. This improvement demonstrates the flexibility provided by having the using module explicitly list what methods it wants to import from the role. Though, the main reason I did that was so that the using class is fully documented, preventing the reader from having to read up on every used role in order to figure out where a particular method came from or just to know all of the methods the using class actually provides. New lines are marked by "#+" below.)

package My::Inner;

# Usage:  use My::Inner qw< _wrap _unwrap _incRefs _decRefs >;
# Defines the using class as an inner class wrapped by some other clas
+s
# (the wrapping class must use My::Outer).
# The using class must define the following methods:
#     _new:   the constructor
#     _free:  breaks ref cycles if all related inner objects are unref
+'d
#+    _incRefs: increments inner object's ref count
#+    _decRefs: decrements inner object's ref count, returning result
#+ If using class creates blessed hashes and wants $obj->{refs} to be 
+the ref
#+ count, then it can just import the _incRefs and _decRefs methods.
##  (Not: "Using class must create blessed hashes so $obj->{ref},
##  $obj->{wrapper} work.")

use Exporter 'import';
BEGIN { our @EXPORT_OK= qw< _wrap _unwrap _incRefs _decRefs >; }

sub _wrap {
    my( $in, $class )= @_;
    my $out= bless \$in, $class;
    $in->_incRefs();
    ##  if(  $class  ) {
    ##      $in->{wrapper}= $class
    ##  } else {
    ##      $class= $in->{wrapper};
    ##  }
    return $out;
}

sub _unwrap {
    my( $in )= @_;
    if(  ! $in->_decRefs()  ) {
        $in->_free();
    }
}

#+ (Added below code)
sub _incRefs {
    my( $in )= @_;
    $in->{refs}++;
}

sub _decRefs {
    my( $in )= @_;
    return --$in->{refs};
}
[download]

You can see $in->{refs}++ and --$in->{refs} which is how simple ref-counting is to implement. The whole role (two subs) and the machinery for constructing roles (two lines) is quite simple.

Now we can implement 'my inner child'. I used the following naming convention for telling inner/outer parent/child apart:

# Outer objects:   dad          son  These are wrappers given to other
+s
#                   |            |   just to track what is still in-us
+e.
#                   v            v
# Inner objects:  _dad <------ _son  These have the real data, includi
+ng
#                   `------------^   links to other (inner) objects.
[download]

To make garbage collection simple, all links between inner objects are two-way. That way a single object can tell what reference cycles it is a part of without having to have some global registry of all inner objects. To make this example simple, I just went with "a Dad can have at most one Son and a Son can have at most one Dad".

package My::Child::Inner;
use My::Inner qw< _wrap _unwrap _incRefs _decRefs >;

sub _new {
    my( $class, $dad, @args )= @_;
    # Replace this with your real constructor!
    my $_son= { name => 'Boy', @args };
    bless $_son, $class;
    $$dad->_adopt( $_son )
        if  $dad;
    return $_son;
}

sub GetName {
    my( $_son )= @_;
    return $_son->{name};
}

sub GetDad {
    my( $_son )= @_;
    my $_dad= $_son->{dad};
    return undef
        if  ! $_dad;
    # We must wrap objects returned from public methods!
    return $_dad->_wrap();
}

# For debugging:
sub DESTROY {
    my( $_son )= @_;
    warn "DESTROYing son: $_son->{name}\n";
}
[download]

And here is how simple it can be to implement a garbage collector:

# Called when Son is no longer externally referenced:
sub _free {
    my( $_son )= @_;
    my $_dad= $_son->{dad};
    if(  ! $_dad  ||  ! $_dad->{refs}  ) {
        # Son can die (and take Dad with him)
        # if there is no Dad (or Dad is also unreferenced):
        $_son->{dad}= $_dad->{son}= undef;  # Break ref cycles!
    }
}
[download]

sub _isRefd {
    my( $_son, $hvSeen )= @_;
    $hvSeen ||= {};
    return 0    # Let first call decide, since we've
        if  $hvSeen->{0+$_son}++;   # circled back to ourselves.
    return 1
        if  $_son->{refs};
    my $dads= $_son->{dads};
    for my $_dad (  @$dads  ) {
        return 1
            if  $_dad->isRefd($hvSeen);
    }
    return 0;
}
[download]

sub _free {
    my( $_son, $force )= @_;
    return
        if  ! $force  &&  $_son->isRefd();
    my $dads= $_son->{dads};
    for my $_dad (  @$dads  ) {
        $_dad->_free( 1 );  # No need to check _isRefd() again.
    }
    $_son->{dads}= [ ];
}
[download]

And here is a quick test of the whole thing with tracing:

{
    my $dad= My::Parent->new( name => 'Sr' );
    warn "\$dad=$dad\n";
    my $son= My::Child->new( $dad, name => 'Jr' );
    warn "\$dad=$dad -> \$son=$son\n";
    $dad= My::Parent->new( name => 'Newt' );
    warn "\$dad=$dad; Sr -> \$son=$son\n";
    warn "Sr no longer referenced, but not destroyed yet.\n";
    $dad->Adopt( $son );
    warn "\$dad=$dad -> \$son=$son; (Sr destroyed)\n";
    My::Child->new( $dad, name => 'Young' );
    warn "Young never really referenced, but not destroyed yet.\n";
    warn "\$dad=$dad -> Young; \$son=$son\n";
    $dad= My::Parent->new( name => 'Fin' );
    warn "\$dad=$dad; \$son=$son (Newt -> Young destroyed)\n";
    warn "Rest to be destroyed next.\n";
}
warn "Everything destroyed above.\n";
[download]

Which produces the following output:

$dad=Sr
$dad=Sr -> $son=Jr
$dad=Newt; Sr -> $son=Jr
Sr no longer referenced, but not destroyed yet.
DESTROYing dad: Sr
$dad=Newt -> $son=Jr; (Sr destroyed)
Young never really referenced, but not destroyed yet.
$dad=Newt -> Young; $son=Jr
DESTROYing son: Young
DESTROYing dad: Newt
$dad=Fin; $son=Jr (Newt -> Young destroyed)
Rest to be destroyed next.
DESTROYing son: Jr
DESTROYing dad: Fin
Everything destroyed above.
[download]

Note that "Newt -> Young destroyed" shows a circular reference getting destroyed as soon as it can no longer be reached externally.

The full code is included inside of CODE tags inside an HTML comment so you can use the "Select" link to download the last CODE block if you want to download or just view the full, working example (Update: Or just get the full code, now that I know this node's ID). (Update: 2 tiny changes to full code.)