DOC.PROTOTYPES.RU

#!/usr/bin/perl
use warnings;
use strict;

# Выборка данных производится как ORDER BY pid DESC, [ORDER] ASC
# сейчас не буду использовать для этого базу данных, а возьму уже как бы выбранный список
my @select = (
#        ID            PID       ORDER          OTHER DATA...
    { id => 14,     pid => 1,   ord => 1,   data => 'other data' },
    { id => 15,     pid => 4,   ord => 1,   data => 'other data' },
    { id => 24,     pid => 4,   ord => 2,   data => 'other data' },
    { id => 23,     pid => 7,   ord => 1,   data => 'other data' },
    { id => 27,     pid => 7,   ord => 2,   data => 'other data' },
    { id => 25,     pid => 7,   ord => 3,   data => 'other data' },
    { id => 17,     pid => 7,   ord => 4,   data => 'other data' },
    { id => 28,     pid => 11,  ord => 1,   data => 'other data' },
    { id => 21,     pid => 11,  ord => 2,   data => 'other data' },
    { id => 5,      pid => 12,  ord => 1,   data => 'other data' },
    { id => 11,     pid => 12,  ord => 2,   data => 'other data' },
    { id => 13,     pid => 12,  ord => 3,   data => 'other data' },
    { id => 10,     pid => 12,  ord => 4,   data => 'other data' },
    { id => 22,     pid => 12,  ord => 5,   data => 'other data' },
    { id => 2,      pid => 13,  ord => 1,   data => 'other data' },
    { id => 6,      pid => 15,  ord => 1,   data => 'other data' },
    { id => 20,     pid => 15,  ord => 2,   data => 'other data' },
    { id => 9,      pid => 15,  ord => 3,   data => 'other data' },
    { id => 7,      pid => 16,  ord => 1,   data => 'other data' },
    { id => 1,      pid => 20,  ord => 1,   data => 'other data' },
    { id => 26,     pid => 20,  ord => 2,   data => 'other data' },
    { id => 8,      pid => 25,  ord => 1,   data => 'other data' },
# Самое главное, что бы root узлы были в самом конце
    { id => 12,     pid => 0,   ord => 1,   data => 'other data' },
    { id => 4,      pid => 0,   ord => 2,   data => 'other data' },
    { id => 3,      pid => 0,   ord => 3,   data => 'other data' },
    { id => 18,     pid => 0,   ord => 4,   data => 'other data' },
    { id => 16,     pid => 0,   ord => 5,   data => 'other data' },
    { id => 19,     pid => 0,   ord => 6,   data => 'other data' },
              );

my %indexes = (); # В этом хеше будем хранить координаты узлов, (key списка, и порядок в списке)
my %lists = ();   # Списки узлов изначально по PID
my $tpid = undef; # Текущий PID списка

foreach my $row (@select) {
    # Неизветсно, какой pid у корневых узлов, может undef, а может 0
    $row->{pid} ||= 'root';
    # Если не определен текущий ID родительского узла, то подставляем его
    $tpid ||= $row->{pid};
    # Устанавливаем уровень узла изначально 1
    $row->{level} = 1;
    # Вставляем наш узел в список PID
    push @{$lists{$row->{pid}}}, $row;
    # Проставляем координату для узла
    $indexes{$row->{id}} = [$row->{pid}, $#{$lists{$row->{pid}}}];
    # Если уже есть сформированный список для ID текущего узла
    if ($lists{$row->{id}}) {
        # Для этого списка проставляем новые координаты, что он присоединится к текущему списку,
        # порядок в новом списке, и уровень увеличиваем на 1
        map {
                $indexes{$_->{id}}->[0] = $row->{pid};
                $indexes{$_->{id}}->[1] += scalar @{$lists{$row->{pid}}};
                $_->{level}++
            } @{$lists{$row->{id}}};
        # Присоединяем подчиненный список к текущему
        push @{$lists{$row->{pid}}}, @{$lists{$row->{id}}};
        # Удаляем его за ненадобностью
        delete $lists{$row->{id}};
    }
    # Если у нас текущий PID не соответствует PID узла, значит список с текущим PID сформирован до конца
    if ($tpid ne $row->{pid}) {
        # Был ли у нас родительский узел до этого момента, если нет, то он сам подцепит этот список
        # когда до него дойдет очередь
        if ($indexes{$tpid}) {
            # Увеличиваем порядок узлов в родительском списке от родительского узла до конца на количество
            # узлов внедряемого списка
            map {
                    $indexes{$_}->[1] += scalar @{$lists{$tpid}}
                } @{$lists{$indexes{$tpid}->[0]}}[$indexes{$tpid}->[1] + 1..$#{$lists{$indexes{$tpid}->[0]}}];
            # проставляем новые координаты для узлов внедряемого списка,
            # и уровень относительно родительского узла
            map {
                    $indexes{$_->{id}}->[0] = $indexes{$tpid}->[0];
                    $indexes{$_->{id}}->[1] += $indexes{$tpid}->[1] + 1;
                    $_->{level} += $lists{$indexes{$tpid}->[0]}->[$indexes{$tpid}->[1]]->{level};
                } @{$lists{$tpid}};
            # Внедряем список относительно координат родительского узла
            splice @{$lists{$indexes{$tpid}->[0]}}, $indexes{$tpid}->[1] + 1, 0, @{$lists{$tpid}};
            # Удаляем список за ненадобностью
            delete $lists{$tpid};
        }
        # Проставляем новый PID
        $tpid = $row->{pid};
    }
}

# Собственно готовый список у нас будет под ключом, который мы указали для корневых узлов.
my @result = @{$lists{root}};

# Посмотрим для проверки
foreach my $row (@result) {
    print $row->{id}, "\t", $row->{pid}, "\t", $row->{ord}, "\t", $row->{level}, "\t", $row->{data}, "\n"
}

1;