sub demangle { my $r = shift; my %illegal; @illegal{%$r} = (); my @chains; LOOP: while (my($k,$v) = each %$r) { for my $c (@chains) { if ($c->[-1] eq $k) { # append to end of chain push @$c, $v; next LOOP; }; if ($c->[0] eq $v) { # prepend to start of chain unshift @$c, $k; next LOOP; } } push @chains, [$k, $v]; # create new chain } # fix circular replacements for my $c (@chains) { if ($c->[0] eq $c->[-1]) { # we have a circle my $new_key; do { $new_key = join '', map { ('a'..'z')[rand 26] } 1..8; } while exists $illegal{$new_key}; $illegal{$new_key}++; unshift @$c, $new_key; push @$c, $new_key; } } my @order; while (@chains) { push @order, { map { $_->[-2] => pop @$_ } @chains }; @chains = grep @$_ > 1, @chains; } return @order; }