#!/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};
    }    
}
[download]