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__