What you have is an adjacency list representation of a graph, and it looks like you want to find all the connected components of that graph and put them into a list. If that is so, then the second example is ok, since you can get to all the nodes by following the links from 'lineitem'.

If you see a problem with the second example, perhaps you are looking for the strongly connected components of a graph, with each element of a component connected to every other component of the graph.

The easiest way to approach this is to use the perl module Graph:

use Graph::Directed;
$G = new Graph::Directed;

   # ... add vertices, edges

@S = $G->strongly_connected_components;
 
# Returns the strongly connected components @S of the 
# graph $G as a list of anonymous lists of vertices, 
# each anonymous list containing the vertices 
#belonging to one strongly connected component.
[download]

Heh. I used Graph to come up with the HoH. I didn't even think of using Graph to generate the AoA I needed. (The documentation is not that easy to work through if you don't have a good grasp of Graph Theory already ...)

Thank you very much.

------
We are the carpenters and bricklayers of the Information Age.

Then there are Damian modules.... *sigh* ... that's not about being less-lazy -- that's about being on some really good drugs -- you know, there is no spoon. - flyingmoose

#!/usr/bin/perl -w 

use strict;

my $start = {
          'lineitem' => {
                          'invoice' => 1
                        },
          'invoice' => {
                         'lineitem' => 1,
                         'claim' => 1
                       },
          'insurer' => {
                         'claim' => 1
                       },
          'claim' => {
                       'invoice' => 1,
                       'insurer' => 1
                     }
        };


my %seen_set;
my $end = [];


foreach my $k (keys %$start) {
    next if exists $seen_set{$k};
    my %set;
    recur(\%set, $k);
    next unless keys %set;
    push @$end, [keys %set];
    @seen_set{keys %set} = ();    
}

sub recur {
    my ($set, $k) = @_;
    return if exists $seen_set{$k} or exists $set->{$k};
    $set->{$k} = 1;
    recur($set, $_) foreach keys %{$start->{$k}};
}

use Data::Dumper;
print Dumper($end);
[download]

Here's a vulgar-minded approach (no advanced algorithmics or smart intermediary data structures). Also I'm not sure if I understand correctly your idea of "linking" (though the code works for your examples):

for (keys  %$start) {
  my @all = ($_, keys %{$start->{$_}});

  my $processed;

  for my $setref (@$end) {
    my (@found, @not_found);

    for my $item (@all) {
      push @found, grep {$item eq $_} @$setref;
    }

    if (@found) {
      for my $item (@all) {
        push @not_found, $item unless grep {$item eq $_} @found;
      }

      push @$setref, @not_found
        if @not_found;
      $processed++;
    }
  }
  push @$end, [ @all ]
    unless $processed;
}
[download]

Update: Please take into account that the code takes a few shortcuts. It makes no assumptions about the value in inner hashes (in your examples they're all "1"), and it doesn't handle well items linking to themselves (a => {a => 1, b => 1}) in some cases. These issues are easy to fix, though.

Update 2: Nope, it won't work, consider data below, and I don't think there's a solution that doesn't employ "advanced algorithmics" ;)

my $start =
  {
   a => {b => 1},
   c => {d => 2},
   d => {a => 1}
  };
[download]

use Data::Dumper;
my $aoa = [];

for my $key ( keys %$start ) {
    push @$aoa , [ $key , keys %{ $start->{$key} } ];
}
print Dumper($aoa);
[download]

Oh - once you added code to your node, this doesn't make sense any more - see below

That creates 4 copies of the set. I need one copy of the set. (Please see the code I updated my node with. That's what the delete is for.)

------
We are the carpenters and bricklayers of the Information Age.

Then there are Damian modules.... *sigh* ... that's not about being less-lazy -- that's about being on some really good drugs -- you know, there is no spoon. - flyingmoose

dragonchild,
Well after seeing your update, it helped to clear up the problem. You were not going into the second level hash for deletes. I still don't understand why the second example should end up in 1 slot instead of 2, but I think this is right:

my $end = [];

for my $key ( keys %$start ) {
    next if ! exists $start->{$key};
    my @values = ($key , keys %{ $start->{$key} });
    push @$end , \@values;
    Eradicate( @values );
}

sub Eradicate {
    delete @{ $start }{ @_};
    for my $key ( keys %$start ) {
        delete @{ $start->{$key} }{ @_ };
    }
}
print Dumper( $end );
[download]

Cheers - L~R