#!/usr/bin/perl
use strict;
use warnings;
my @list = (
{id => 6, parent => 2, level => 3, name => '1234' },
{id => 2, parent => 1, level => 2, name => 'bar2' },
{id => 4, parent => 1, level => 2, name => 'asdf' },
{id => 3, parent => 1, level => 2, name => 'blah' },
{id => 1, parent => 0, level => 1, name => 'foo1' },
{id => 10, parent => 0, level => 1, name => '****' },
{id => 9, parent => 10, level => 2, name => 'qwer' },
{id => 5, parent => 2, level => 3, name => 'lev3' },
{id => 7, parent => 5, level => 4, name => 'wxyz' },
);
my $tree = Build_Tree( \@list );
Print_Tree( $tree );
sub Build_Tree {
my $list = shift;
my %tree;
for ( @$list ) {
$tree{$_->{id}}{level} = $_->{level};
$tree{$_->{id}}{name} = $_->{name};
push @{ $tree{$_->{parent}}{children}} , $_->{id};
}
return \%tree;
}
sub Print_Tree {
my $tree = shift;
my %seen;
my @stack = sort { $b <=> $a } @{ $tree->{0}{children} };
while ( @stack ) {
my $id = pop @stack;
if ( $seen{$id} ) {
print ' ' x (($tree->{$id}{level} - 1) * 5), "Circular det
+ection\n";
next;
}
$seen{$id}++;
print ' ' x (($tree->{$id}{level} - 1) * 5), $tree->{$id}{name
+}, "\n";
push @stack , sort {$b <=> $a} @{$tree->{$id}{children}} if ex
+ists $tree->{$id}{children};
}
}
Cheers -