http://www.perlmonks.org?node_id=319780
djantzen has asked for the wisdom of the Perl Monks concerning the following question:

I've run into a problem with perl's reference count-based garbage collection that I cannot figure out. What I've got is a directed graph that fails to be destroyed prior to the global destruction phase that occurs when the interpreter exits. The problem arises (AFAICT) only when doing a depth first search through the graph. Since this is the backend to a mod_perl-based CGI, clearly I need timely destruction of the objects and cannot rely on the interpreter's exit. At this point I think it's something due to the way perl handles lexical pads in recursive method calls, but I don't get why. I've distilled the problem down by borrowing TheDamian's graph code from Object Oriented Perl pgs 108-14 and adding my DFS routine and some debugging stuff. The code should run as is, although the full version requires Data::Structure::Util. My bleeding brain thanks you.

use strict; use warnings; # Uncomment if you have this. #use Data::Structure::Util(qw/has_circular_ref circular_off/); # BEGIN NETWORK CLASS package Network; sub new { my ($class) = @_; bless { _nodes => [] }, $class; } sub node { my ($self, $index) = @_; return $self->{_nodes}[$index]; } sub add_node { my ($self) = @_; push @{$self->{_nodes}}, Node->new(); } # CAUSE OF THE TROUBLE sub DFS { my ($self, $node, $sub) = @_; my ($explored, $do_search); $do_search = sub { my ($node) = @_; $sub->($node); $explored->{$node->{_id}}++; foreach my $link (@{$node->{_outlinks}}) { $do_search->($link->{_to}) unless ($explored->{$link->{_id}}); } }; $do_search->($node); } sub transitive_closure_DFS { my ($self, $node) = @_; my $nodes = []; my $search = sub { push @$nodes, $_[0] }; $self->DFS($node, $search); return $nodes; } sub DESTROY { my ($self) = @_; print "DESTROYING $self\n"; foreach my $node (@{$self->{_nodes}}) { $node->delete_links(); } } # BEGIN NODE CLASS package Node; { my $_nodecount = 0; sub _nextID { return ++$_nodecount } } sub new { my ($class) = @_; bless { _id => _nextID(), _outlinks => [] }, $class; } sub add_link_to { my ($self, $target) = @_; push @{$self->{_outlinks}}, Link->new($target); } sub delete_links { my ($self) = @_; delete $self->{_outlinks}; } sub DESTROY { my ($self) = @_; print "DESTROYING $self $self->{_id}\n"; } # BEGIN LINK CLASS package Link; { my $_linkcount = 0; sub _nextID { return ++$_linkcount } } sub new { my ($class, $target) = @_; bless { _id => _nextID(), _to => $target }, $class; } sub delete_node { my ($self) = @_; delete $self->{_to}; } sub DESTROY { my ($self) = @_; print "DESTROYING $self $self->{_id}\n"; $self->delete_node(); # EVEN THIS DOESN'T KILL THE REMAINING NODES } package main; sub build_graph { my $network = Network->new(); for (0..2) { $network->add_node(); } $network->node(0)->add_link_to($network->node(1)); $network->node(0)->add_link_to($network->node(2)); $network->node(1)->add_link_to($network->node(2)); $network->node(2)->add_link_to($network->node(1)); my $neighbors = $network->transitive_closure_DFS($network->node(0) +); print "Neighbors\n"; print " $_ ID $_->{_id}\n" for (@$neighbors); # Uncomment if you have the module # circular_off($network); # THIS DOES NOT AFFECT BEHAVIOR, WHY? } print "BUILDING GRAPH\n"; build_graph(); print "SHOULD BE THE LAST THING PRINTED, HOWEVER ...\n"; __END__

This yields:

BUILDING GRAPH Neighbors Node=HASH(0x104fbc) ID 1 Node=HASH(0xfc450) ID 3 Node=HASH(0xfc414) ID 2 DESTROYING Network=HASH(0xfc04c) DESTROYING Link=HASH(0xfc498) 2 DESTROYING Link=HASH(0xfc438) 1 DESTROYING Link=HASH(0xfc4c8) 3 DESTROYING Link=HASH(0xfc4f8) 4 SHOULD BE THE LAST THING PRINTED, HOWEVER ... DESTROYING Node=HASH(0xfc414) 2 DESTROYING Node=HASH(0x104fbc) 1 DESTROYING Node=HASH(0xfc450) 3

Further reading here


"The dead do not recognize context" -- Kai, Lexx