Дерево каталогов NESTED SETS (вложенные множества) часть второая


Прислал: Сергей Томулевич [ 24.01.2005 @ 17:18 ]
Раздел:: [ Статьи по Perl ]


ПРАКТИЧЕСКОЕ ПРИМЕНЕНИЕ
ПИШЕМ МОДУЛЬ НА PERL

В предыдущей статье мы рассмотрели теорию управления Nested Sets. Теперь попробуем собрать на её основе модуль Perl для работы.

Для начала, определим, сам объект:

package MyModule::NestedSets;
use strict; use warnings; use Carp;
require Exporter;
our @ISA = qw(Exporter);

sub new {
    my $self = shift;
    $self = {
             id     => 'id',
             left   => 'left_key',
             right  => 'right_key',
             level  => 'level',
             table  => undef,
             DBI    => undef,
            };
    bless $self;
    return $self;
}

Где:

  • $self->{'id'} - имя поля идентификатора узла таблицы;
  • $self->{'left'} - имя поля левого ключа узла таблицы;
  • $self->{'right'} - имя поля правого ключа узла таблицы;
  • $self->{'level'} - имя поля уровня узла таблицы;
  • $self->{'table'} - имя таблицы;
  • $self->{'DBI'} - ссылка на объект DBI модуля - подключение к;

Пока все тривиально и просто, в объекте описаны имена полей и таблицы, в которой хранится наше дерево каталогов.

Теперь нужно определить какие методы мы будем применять к объекту.

  • создание узла;
  • удаление узла;
  • перемещение узла, подразделяющееся на:
    • установка узла в подчинение другому;
    • установка узла рядом с другим (впереди - за ним);
    • изменение уровня узла (выше, ниже на уровень);

Так же, существует реальная потребность в том, что бы хранить несколько деревьев в одной таблице (далее по тексту: "мультидерево"). Например, если существует два и более раздельных каталогов товаров. Для определения того, одно или несколько разных деревьев в таблице добавим в наш объект еще два свойства:

    ...
    $self = {
             ...
             type      => 'N',
             multi     => 'class',
            };
    ...

Где:

  • $self->{'type'} - Флаг определения статуса таблицы (N - одно дерево, M - несколько деревьев);
  • $self->{'multi'} - имя поля идентификатора дерева таблицы;

Объявление объекта можно производить так:

...
use MyModule::NestedSets;
my $nested = new
MyModule::NestedSets;
$nested->{'table'} = 'catalog_category';
$nested->{'type'} = 'M';
$nested->{'DBI'} = $dbh; # $dbh должен быть уже определен как класс DBI
...

Или, дабы упростить объявление:

...
use MyModule::NestedSets;
my $nested = new
MyModule::NestedSets {table=>'catalog_category', type=>'multi', DBI=>$dbh};
...

Но при этом в процедуре - new модуля, нужно дополнительно обработать данные:

sub new {
    my ($self, $common) = @_;
    $self = {
             ...
            };
    $self->{'type'} = $$common{'type'} && $$common{'type'} eq 'multi' ? 'M' : 'N';
    $self->{'left'} = $$common{'left'} || $$common{'left'};
    $self->{'right'} = $$common{'right'} || $$common{'right'};
    $self->{'level'} = $$common{'level'} || $$common{'level'};
    $self->{'multi'} = $$common{'multi'} || $$common{'multi'};
    $self->{'table'} = $$common{'table'} || $$common{'table'};
    $self->{'DBI'} = $$common{'DBI'} || $$common{'DBI'};
    bless $self;
    return $self;
}

Несмотря, на то, что возможно переопределение имен полей таблицы (правый - левый ключ, идентификатор узла и идентификатор дерева), я стараюсь использовать одни и те же имена для всех таблиц, что бы не запутаться, тогда определять, по сути, нужно будет только имя таблицы.

Сама таблица будет выглядеть так:

CREATE TABLE `catalog_category` (
       `id`         int(11) NOT NULL auto_increment,
       `left_key`   int(11) NOT NULL default '0',
       `right_key`  int(11) NOT NULL default '0',
       `level`      int(11) NOT NULL default '1',
       `class`      int(11) NOT NULL default '1',
       `name`       varchar(100),
       ...
       `note`       varchar(100),
PRIMARY KEY (`id`),
KEY `child` (`id`,`left_key`,`right_key`,`class`)
);

Соответственно, если в таблице будет только лишь одно дерево, то поле class - не нужно.

Теперь можно перейти непосредственно к методам нашего объекта:

1. Создание узла

Как показывает практика, иногда требуется создавать узел в начале списка, а иногда - в конце. Причем данный параметр может распространяться как на все дерево, так и непосредственно только на конкретную операцию создания (перемещения). Поэтому добавим еще одно свойство объекта, которое мы будем определять во время его объявления, а так же сделаем возможность указывать данный параметр, во время операции. Изменяем процедуру new модуля:

 

sub new {
    ...
    $self = {
             ...
             order => 'B', # T - (top) начало списка, B - (bottom) конец списка
            };
    ...
    $self->{'order'} = $$common{'order'} && $$common{'order'} eq 'top' ? 'T' : 'B';
    ...
}

Для того, что бы создать узел, нам нужны следующие данные:

  • подчинение (родитель) создаваемого узла;
  • идентификатор дерева, в котором создаем узел (если мультидерево)

Действия, которые мы должны произвести во время создания:

  • определить точку, где мы создаем узел;
  • создание "пустого" промежутка в дереве;
  • вставка нового узла в пустой подготовленный промежуток

sub insert_unit {
# Получаем объект, идентификатор родителя и идентификатор дерева
    my ($self, %common)= @_;
# Инициализируем идентификатор дерева
    my $catalog = $common{'tree'} || 1;
# Инициализируем идентификатор родителя
    my $under = $common{'under'} || 'root';
# Определяем порядок создания (место в списке)
    my $order = $common{'order'} || undef;
# Объявляем локальные переменные

    my ($key, $level);
# Если родитель корень дерева
    if ($under
eq 'root') {
# если вставка в конец списка левый ключ создаваемого выбирается как
# максимальный правый ключ дерева + 1, уровень узла - 1
        if (($order && $order eq 'top') || ($self->{'order'} eq 'T')) {
            $level = 1; $key = 1            
        } else {
            my $sql'SELECT MAX('.$self->{'right'}.') + 1 FROM '.$self->{'table'}.
                ($self->{'type'} eq 'M' ? ' WHERE '.$self->{'multi'}.'= \''.$catalog.'\'' : '');
            my $sth = $self->{'DBI'}->prepare($sql); $sth->execute();
            $key = $sth->fetchrow_arrayref()->[0];
            $sth->finish();
            
$level = 1;
            $key = $key || 1
        }
# Если родитель определен, то левый ключ создаваемого узла будет равным
# правому ключу родительского узла, уровень - родительский + 1

    } else {
        my $sql = 'SELECT '.$self->{'right'}.', '.$self->{'left'}.', '.$self->{'level'}.
                  ($self->{'type'} eq 'M' ? ', '.$self->{'multi'} : '').
                  ' FROM '.$self->{'table'}.' WHERE '.$self->{'id'}.' = \''.$under.'\'';
        my $sth = $self->{'DBI'}->prepare($sql); $sth->execute();
        my
$row = $sth->fetchrow_arrayref(); $sth->finish();
        $key = ($order && $order eq 'top') || ($self->{'order'} eq 'T') ? $$row[1] + 1: $$row[0];
        $level = $$row[2] + 1;
# Если у нас мультидерево, то переопределяем идентификатор дерева
# относительно родительского узла

        $catalog = $$row[3] || undef;
    }
# Обновляем ключи дерева для создания пустого промежутка
    $self->{'DBI'}->do('UPDATE '.$self->{'table'}.' SET '.
        $self->{'right'}.' = '.$self->{'right'}.' + 2, '.
        $self->{'left'}.' = IF('.$self->{'left'}.' >= '.$key.', '.$self->{'left'}.
        ' + 2, '.$self->{'left'}.') WHERE '.$self->{'right'}.' >= '.$key.
        ($self->{'type'} eq 'M' ? ' AND '.$self->{'multi'}.'= \''.$catalog.'\'' : ''));
# Создаем новый узел
    $self->{'DBI'}->do('INSERT INTO '.$self->{'table'}.' SET '.
        $self->{'left'}.' = '.$key.', '.$self->{'right'}.' = '.$key.' + 1, '.
        $self->{'level'}.' = '.$level.
        ($self->{'type'} eq 'M' ? ', '.$self->{'multi'}.'= \''.$catalog.'\'' : ''));
# Получаем идентификатор созданного узла и возвращаем его в качестве результата
    my
$sth = $self->{'DBI'}->prepare('SELECT LAST_INSERT_ID()'); $sth->execute();
    my
$id = $sth->fetchrow_arrayref()->[0];
    
$sth->finish();
    
return $id
}

Вызов данного метода производится так:

...
my $under = ... ; # Определяем родителя
my $tree = ... ;   # Определяем идентификатор дерева
...
use MyModule::NestedSets;
my $nested = new MyModule::NestedSets {table=>'catalog_category', type=>'M', DBI=>$dbh};
my $new_unit = $nested->insert_unit(under=>$under, tree=>$tree, order=>'top');
...

2. Определение узла

Все дальнейшие действия мы производим уже над существующими узлами. В большинстве случаев мы обычно знаем, только лишь идентификатор редактируемого узла, но этих данных мало, поэтому, создадим метод определения узла:

sub select_unit {
# Получаем объект, идентификатор узла
    my $self = shift;
    $self->{'unit'}->{'id'} = shift;
# Производим выборку данных узла*
    my $sql = 'SELECT '.$self->{'left'}.' AS lk, '.
                        $self->{'right'}.' AS rk, '.
                        $self->{'level'}.' AS lv '.
                        ($self->{'type'} eq
'M' ? ', '.$self->{'multi'}.' AS cl' : '').
              ' FROM '.$self->{'table'}.
              ' WHERE '.$self->{'id'}.' = \''.$self->{'unit'}->{'id'}.'\'';
    my $sth = $self->{'DBI'}->prepare($sql); $sth->execute();
    my $row = $sth -> fetchrow_hashref();
    $sth -> finish();
# Если узел существует, то передаем данные в объект
    if ($row) {
        $self->{'unit'}->{'left'} = $row->{'lk'};
        $self->{'unit'}->{'right'} = $row->{'rk'};
        $self->{'unit'}->{'level'} = $row->{'lv'};
        $self->{'unit'}->{'multi'} = $row->{'cl'} if $row->{'cl'};
        return $self
    } else {croak("NestedSets failed: Your cann't select this unit, because unit is not exist!!!")}
}

Хочу обратить внимание на то, что всем полям при выборке мы объявляем псевдонимы, потому как имена полей в таблице могут быт разные. Полученные данные, мы сохраняем в тот же объект $self, поэтому, добавим в описание объекта дополнительные свойства:

sub new {
    ...
    $self = {
             ...
             unit    => {
                         id      => undef,
                         left    => undef,
                         right   => undef,
                         level   => undef,
                         multi   => undef,
                        },
            };
    ...
}

Вызов данного метода производится так:

...
my $unit = ... # Определяем идентификатор узла
...
use MyModule::NestedSets;
my $nested = new
MyModule::NestedSets {table=>'catalog_category', type=>'M', DBI=>$dbh};
$nested->select_unit($unit);
...

3. Удаление узла

Во время удаления узла нам нужны данные только удаляемого узла, для определения которых мы воспользуемся вышеописанной процедурой. Действия, которые мы будем производить:

  • определение данных узла;
  • удаление узла и ему подчиненных;
  • обновление ключей дерева для устранения промежутка

sub delete_unit {
# Получаем данные: объект и идентификатор удаляемого узла
    my ($self, $unit) = @_;
# получаем параметры узла
    if ($unit) {$self = &select_unit($self, $unit)}
    elsif (!$self->{'unit'}->{'id'}) {croak("NestedSets failed: Your must first select unit, for detete it!!!")}
# Определяем смещение ключей после удаления
    my $skew = $self->{'unit'}->{'right'} - $self->{'unit'}->{'left'} + 1;
# Удаляем узел
    $self->{'DBI'}->do('DELETE FROM '.$self->{'table'}.' WHERE '.
                       $self->{'left'}.' >= '.$self->{'unit'}->{'left'}.
                       ' AND '.$self->{'right'}.' <= '.$self->{'unit'}->{'right'}.
                       ($self->{'type'} eq 'M'
                        ' AND '.$self->{'multi'}.'= \''.$self->{'unit'}->{'multi'}.'\'' : '')
                      );
# Обновляем ключи дерева относительно смещения
    $self->{'DBI'}->do('UPDATE '.$self->{'table'}.
                       ' SET '.
                        $self->{'left'}.' = IF('.$self->{'left'}.' > '.$self->{'unit'}->{'left'}.', '.$self->{'left'}.' - '.$skew.', '.$self->{'left'}.'), '.
                        $self->{'right'}.' = '.$self->{'right'}.' - '.$skew.
                       ' WHERE '.
                        $self->{'right'}.' > '.$self->{'unit'}->{'right'}.' AND '.
                        ($self->{'type'} eq 'M'
                         $self->{'multi'}.'= \''.$self->{'unit_select'}->{'multi'}.'\'' : '')
                      );
    return 1
}

Вызов данного метода производится так:

...
my $unit = ... # Определяем идентификатор узла
...
use MyModule::NestedSets;
my $nested = new
MyModule::NestedSets {table=>'catalog_category', type=>'M', DBI=>$dbh};
$nested->delete_unit($unit);
...

или так:

...
my $unit = ... # Определяем идентификатор узла
...
use MyModule::NestedSets;
my $nested = new
MyModule::NestedSets {table=>'catalog_category', type=>'M', DBI=>$dbh};
$nested->select_unit($unit);
$nested->delete_unit;
...

4. Перемещение узла

Любое перемещение узла производится с помощью одних и тех же запросов, и требуют одних и тех же данных, поэтому правильней выделить данное действие в отдельный блок (процедуру). Для перемещения нам нужно взять следующие данные:

  • данные перемещаемого узла;
  • точка перемещения, куда перемещается узел

И произвести следующие действия:

  • определить диапазоны смещения для ключей дерева и перемещаемого узла;
  • определить вид перемещения: "вверх " - "вниз" по дереву;
  • собственно, переместить узел и обновить ключи дерева

sub _move_unit {
# Получаем данные: объект и данные для перемещения
    my ($self, $data) = @_;
# Проверяем возможность перемещения*
    if ($data->{'near'} >= $data->{'left'} && $data->{'near'} <= $data->{'right'}) {return 0}
# Определяем смещение ключей перемещаемого узла и смещение уровня
    my $skew_tree = $data->{'right'} - $data->{'left'} + 1;
    my $skew_level = $data->{'level_new'} - $data->{'level'};
# Если перемещаем вверх по дереву
    if ($data->{'right'} < $data->{'near'}) {
# Определяем смещение ключей для дерева
        my $skew_edit = $data->{'near'} - $data->{'left'} + 1 - $skew_tree;
# Переносим узел и одновременно обновляем дерево
        $self->{'DBI'}->do('UPDATE '.$self->{'table'}.
                           ' SET '.
                            $self->{'left'}.' = IF('.$self->{'right'}.' <= '.$data->{'right'}.', '.
                             $self->{'left'}.' + '.$skew_edit.', IF('.$self->{'left'}.' > '.$data->{'right'}.', '.
                              $self->{'left'}.' - '.$skew_tree.', '.$self->{'left'}.')), '.
                            $self->{'level'}.' = IF('.$self->{'right'}.' <= '.$data->{'right'}.', '.
                             $self->{'level'}.' + '.$skew_level.', '.$self->{'level'}.'), '.
                            $self->{'right'}.' = IF('.$self->{'right'}.' <= '.$data->{'right'}.', '.
                             $self->{'right'}.' + '.$skew_edit.', IF('.$self->{'right'}.' <= '.$data->{'near'}.', '.
                              $self->{'right'}.' - '.$skew_tree.', '.$self->{'right'}.')) WHERE '.
                            $self->{'right'}.' > '.$data->{'left'}.' AND '.
                            $self->{'left'}.' <= '.$data->{'near'}.
                            ($self->{'type'} eq 'M' ? ' AND '.$self->{'multi'}.'= \''.$data->{'multi'}.'\'' : '')
                          );
# Если перемещаем вниз по дереву
    } else {
# Определяем смещение ключей для дерева
        my $skew_edit = $data->{'near'} - $data->{'left'} + 1;
# Переносим узел и одновременно обновляем дерево
        $self->{'DBI'}->do('UPDATE '.$self->{'table'}.
                           ' SET '.
                            $self->{'right'}.' = IF('.$self->{'left'}.' >= '.$data->{'left'}.', '.
                             $self->{'right'}.' + '.$skew_edit.', IF('.$self->{'right'}.' < '.$data->{'left'}.', '.
                              $self->{'right'}.' + '.$skew_tree.', '.$self->{'right'}.')), '.
                            $self->{'level'}.' = IF('.$self->{'left'}.' >= '.$data->{'left'}.', '.
                             $self->{'level'}.' + '.$skew_level.', '.$self->{'level'}.'), '.
                            $self->{'left'}.' = IF('.$self->{'left'}.' >= '.$data->{'left'}.', '.
                             $self->{'left'}.' + '.$skew_edit.', IF('.$self->{'left'}.' > '.$data->{'near'}.', '.
                              $self->{'left'}.' + '.$skew_tree.', '.$self->{'left'}.')) WHERE '.
                            $self->{'right'}.' > '.$data->{'near'}.' AND '.
                            $self->{'left'}.' < '.$data->{'right'}.
                            ($self->{'type'} eq 'M'' AND '.
$self->{'multi'}.'= \''.$data->{'multi'}.'\'' : '')
                      );
    }
    return 1
}

* Примечание: Мы не можем переместить узел "в себя" поэтому сделали соответсвующую проверку

Где:

  • $data->{'left'} - левый ключ перемещаемого узла;
  • $data->{'right'} - правый ключ перемещаемого узла;
  • $data->{'level'} - уровень перемещаемого узла;
  • $data->{'multi'} - идентификатор дерева перемещаемого узла (если мультидеревья);
  • $data->{'level_new'} - уровень - куда перемещается узел;
  • $data->{'near'} - "точка перемещения" будущий левый ключ перемещаемого узла, уменьшенный на единицу;

Имя процедуры начинается, с "_" и это не случайно, так как этот метод не будет вызываться из скрипта, а использоваться как внутренняя процедура модуля.

В итоге, чтобы переместить узел, нам требуется сформировать переменную $data (ссылка на хеш) и передать её в процедуру _move_unit.

4.1. Перемещение узла в подчинение другому

Для того, что бы переместить узел в подчинение другому, нам нужно взять следующие данные:

  • параметры перемещаемого узла;
  • параметры родительского узла (куда перемещаем) ;
  • параметр перемещения узла - в начало или конец подчиненного списка перемещать.

И произвести следующие действия:

  • определить параметры перемещаемого узла (если они еще не определены);
  • определить параметры родительского узла;
  • передать полученные данные процедуре _move_unit

sub set_unit_under {
# Получаем данные: объект, перемещаемый узел, место перемещения, порядок перемещения
    my ($self, %common)= @_;
# перемещаемый узел
    my $unit = $common{'unit'} || undef;
# место перемещения

    my $under = $common{'under'} || undef;
# порядок перемещения (top - в начало, иначе - в конец списка)
    my $order = $common{'order'} || undef;
# объявляем переменную, которую будем передавать процедуре перемещения
    my $data;
# определяем данные перемещаемого узла
    if ($unit) {$self = &select_unit($self, $unit)}
    elsif (!$self->{'unit'}->{'id'}) {croak("NestedSets failed: Your must first select unit, for moving it!!!")}
# если место перемещения - корень дерева
    if (!$under || $under
eq 'none' || $under eq 'root') {
# если порядок перемещения - начало списка
        if (($order
&& $order eq 'top') || $self->{'order'} eq 'T') {
            $data->{'near'} = 0;
            $data->{'level_new'} = 1
        } else {
# иначе выбираем максимальное значение ключа дерева
            my $sql'SELECT MAX('.$self->{'right'}.') AS num FROM '.$self->{'table'}.
                      ($self->{'type'} eq 'M'
                       ' WHERE '.$self->{'multi'}.'='.$self->{'unit'}->{'multi'} : '');
            my $sth = $self->{'DBI'}->prepare($sql); $sth->execute();
            my $row = $sth->fetchrow_hashref();
            $sth->finish();
            if ($row) {$data->{'near'} = $$row{'num'}; $data->{'level_new'} = 1}
            else {croak("NestedSets failed: The place of moving is not determined, check up his!!!")}
        }
# иначе получаем данные места перемещения
    } else {
        my $sql = 'SELECT '.
                 $self->{'left'}.' AS lk, '.
                 $self->{'right'}.' AS rk, '.
                 $self->{'level'}.' AS lv FROM '.$self->{'table'}.
               ' WHERE '.$self->{'id'}.' = \''.$under.'\''.
                ($self->{'type'} eq 'M'
                  ' AND '.$self->{'multi'}.'= \''.$self->{'unit'}->{'multi'}.'\'' : '');
        my $sth = $self->{'DBI'}->prepare($sql); $sth->execute();
        my $row = $sth->fetchrow_hashref(); $sth->finish();
# в зависимости от порядка перемещения берем либо правый, либо левый ключ
        if ($row && (($order && $order eq 'top') || $self->{'order'} eq 'T')) {
            $data->{'near'} = $$row{'lk'};
            $data->{'level_new'} = $$row{'lv'} + 1
        } elsif ($row) {
            $data->{'near'} = $$row{'rk'} - 1;
            $data->{'level_new'} = $$row{'lv'} + 1
        } else {croak("NestedSets failed: The place of moving is not determined, check up his!!!")}
    }
# перебрасываем из объекта данные о перемещаемом узле
    $data->{'left'} = $self->{'unit'}->{'left'};
    $data->{'right'} = $self->{'unit'}->{'right'};
    $data->{'level'} = $self->{'unit'}->{'level'};
    $data->{'multi'} = $self->{'unit'}->{'multi'} || undef;
    $self->{'unit'} = undef;
# перемещаем узел
    &_move_unit($self, $data);
    return 1
}

Вызов данного метода производится так:

...
my $unit = ... # Определяем идентификатор узла
my $under = ... # Определяем нового родителя
...
use MyModule::NestedSets;
my $nested = new
MyModule::NestedSets {table=>'catalog_category', type=>'M', DBI=>$dbh};
$nested->set_unit_under(unit=>$unit, under=>$under, order=>'top');
...

или так:

...
my $unit = ... # Определяем идентификатор узла
my $under = ... # Определяем нового родителя
...
use MyModule::NestedSets;
my $nested = new
MyModule::NestedSets {table=>'catalog_category', type=>'M', DBI=>$dbh};
$nested->select_unit($unit);
$nested->set_unit_under(under=>$under, order=>'top');
...

4.2. Перемещение узла - рядом с другим

Для того, что бы переместить узел в подчинение другому, нам нужно взять следующие данные:

  • параметры перемещаемого узла;
  • параметры узла рядом с каким собираемся размещать;
  • параметр перемещения узла - до или после узла переместить.

И произвести следующие действия:

  • определить параметры перемещаемого узла (если они еще не определены);
  • определить рядом с каким собираемся размещать;
  • передать полученные данные процедуре _move_unit

sub set_unit_near {
# Получаем данные: объект, перемещаемый узел, место перемещения, порядок перемещения
    my ($self, %common)= @_;
# перемещаемый узел
    my $unit = $common{'unit'} || undef;
# место перемещения

    my $near = $common{'near'} || undef;
# порядок перемещения (top - в начало, иначе - в конец списка)
    my $order = $common{'order'} || undef;
# объявляем переменную, которую будем передавать процедуре перемещения
    my $data;
# определяем данные перемещаемого узла
    if ($unit) {$self = &select_unit($self, $unit)}
    elsif (!$self->{'unit'}->{'id'}) {croak("NestedSets failed: Your must first select unit, for moving it!!!")}
# определяем данные места перемещения - узла, рядом с которым
# будет располагаться перемещаемый узел

    my $sql = 'SELECT '.
                  $self->{'left'}.' AS lk, '.
                  $self->{'right'}.' AS rk, '.
                  $self->{'level'}.' AS lv FROM '.$self->{'table'}.
              ' WHERE '.$self->{'id'}.' = \''.$near.'\''.
                  ($self->{'type'} eq 'M' ?
                   ' AND '.$self->{'multi'}.'= \''.$self->{'unit'}->{'multi'}.'\'' : '');
    my $sth = $self->{'DBI'}->prepare($sql); $sth->execute();
    my $row = $sth->fetchrow_hashref();
    $sth->finish();
# в зависимости от порядка перемещения берем либо правый, либо левый ключ
    if ($row
&& $order && $order eq 'before') {
        $data->{'near'} = $$row{'lk'} - 1;
        $data->{'level_new'} = $$row{'lv'}
    } elsif ($row) {
        $data->{'near'} = $$row{'rk'};
        $data->{'level_new'} = $$row{'lv'}
    } else {croak("NestedSets failed: The place of moving is not determined, check up his!!!")}
# перебрасываем из объекта данные о перемещаемом узле
    $data->{'left'} = $self->{'unit'}->{'left'};
    $data->{'right'} = $self->{'unit'}->{'right'};
    $data->{'level'} = $self->{'unit'}->{'level'};
    $data->{'multi'} = $self->{'unit'}->{'multi'} || undef;
    $self->{'unit'} = undef;
# перемещаем узел
    &_move_unit($self, $data);
    return 1
}

Вызов данного метода производится так:

...
my $unit = ... # Определяем идентификатор узла
my $near = ... # Определяем место (узел) перемещения
...
use MyModule::NestedSets;
my $nested = new
MyModule::NestedSets {table=>'catalog_category', type=>'M', DBI=>$dbh};
$nested->set_unit_near(unit=>$unit, near=>$near, order=>'before');
...

или так:

...
my $unit = ... # Определяем идентификатор узла
my $near = ... # Определяем место (узел) перемещения
...
use MyModule::NestedSets;
my $nested = new MyModule::NestedSets {table=>'catalog_category', type=>'M', DBI=>$dbh};
$nested->select_unit($unit);
$nested->set_unit_near(near=>$near, order=>'before');
...

4.3. Изменение уровня узла

Перемещение узла на уровень вверх - не особо сложная процедура: нужно просто определить родительский узел, и установить перемещаемый узел рядом, на одном уровне. Перемещение на уровень вниз по дереву - так же несложно, для того, что бы это сделать нужно определить, соседний узел (я использую вышестоящий по списку), и переместить узел в его подчинение. Это, правда, совсем не значит, что нам нужно будет использовать два предыдущих метода. Наша задача - определить, в первом случае - правый ключ родителя и его уровень, во втором - тот же правый ключ соседнего узла и его уровень (правда, при этом, мы будем использовать значения на единицу меньшие), итак:

Для того, что бы переместить узел на уровень вверх - вниз нужны следующие данные:

  • параметры перемещаемого узла;
  • параметр перемещения узла - уровень вверх или уровень вниз.
  • порядок перемещения - в начало или конец списка

И произвести следующие действия:

  • определить параметры перемещаемого узла (если они еще не определены);
  • определить параметры родительского или соседнего узла, в зависимости от параметра перемещения;
  • передать полученные данные процедуре _move_unit

sub set_unit_level {
# Получаем данные: объект, перемещаемый узел, место перемещения, порядок перемещения
    my ($self, %common)= @_;
# перемещаемый узел
    my $unit = $common{'unit'} || undef;
# место перемещения

    my $move = $common{'move'} || undef;
    return 0 unless $move;
# порядок перемещения (top - в начало, иначе - в конец списка)
    my $order = $common{'order'} || undef;
# объявляем переменную, которую будем передавать процедуре перемещения
    my $data;
# определяем данные перемещаемого узла
    if ($unit) {$self = &select_unit($self, $unit)}
    elsif (!$self->{'unit'}->{'id'}) {croak("NestedSets failed: Your must first select unit, for moving it!!!")}
# если на уровень вверх
    if ($move eq 'up') {
# определяем данные места перемещения - узла, рядом с которым
# будет располагаться перемещаемый узел

        my $sql = 'SELECT '.
                      $self->{'right'}.' AS rk, '.
                      $self->{'level'}.' AS lv FROM '. $self->{'table'}.
                  ' WHERE '.
                      $self->{'left'}.' < '.$self->{'unit'}->{'left'}.' AND '.
                      $self->{'right'}.' > '.$self->{'unit'}->{'right'}.' AND '.
                      $self->{'level'}.' = '.$self->{'unit'}->{'level'}.' - 1 '.
                      ($self->{'type'} eq 'M' ?
                       ' AND '.$self->{'multi'}.'= \''.$self->{'unit'}->{'multi'}.'\'' : '');
        my $sth = $self -> {'DBI'} -> prepare($sql); $sth -> execute();
        my $row = $sth -> fetchrow_hashref();
        $sth -> finish();
        if ($row) {
            $data->{'near'} = $$row{'rk'};
            $data->{'level_new'} = $$row{'lv'}
        } else {return 0}
# если на уровень вниз
    } elsif ($move eq 'down') {
# определяем данные места перемещения - узла, новый родитель
        my $sql = 'SELECT '.
                      $self->{'right'}.' AS rk, '.
                      $self->{'left'}.' AS lk, '.
                      $self->{'level'}.' AS lv FROM '.$self->{'table'}.
                  ' WHERE '.
                      $self->{'right'}.' = '.$self->{'unit'}->{'left'}.' - 1'.
                      ($self->{'type'} eq 'M' ?
                       ' AND '.$self->{'multi'}.'= \''.$self->{'unit'}->{'multi'}.'\'' : '');
        my $sth = $self -> {'DBI'} -> prepare($sql); $sth -> execute();
        my $row = $sth -> fetchrow_hashref();
        $sth -> finish();
        if ($row && (($order && $order eq 'top') || $self->{'order'} eq 'T')) {
            $data->{'near'} = $$row{'lk'};
            $data->{'level_new'} = $$row{'lv'} + 1
        } elsif ($row) {
            $data->{'near'} = $$row{'rk'} - 1;
            $data->{'level_new'} = $$row{'lv'} + 1
        } else {return 0}
    } else {return 0}
# перебрасываем из объекта данные о перемещаемом узле
    $data->{'left'} = $self->{'unit'}->{'left'};
    $data->{'right'} = $self->{'unit'}->{'right'};
    $data->{'level'} = $self->{'unit'}->{'level'};
    $data->{'multi'} = $self->{'unit'}->{'multi'} || undef;
    $self->{'unit'} = undef;
# перемещаем узел
    &_move_unit($self, $data);
    return 1
}

Вызов данного метода производится так:

...
my $unit = ... # Определяем идентификатор узла
...
use MyModule::NestedSets;
my $nested = new
MyModule::NestedSets {table=>'catalog_category', type=>'M', DBI=>$dbh};
$nested->set_unit_level(unit=>$unit, move=>'up', order=>'top');
...

или так:

...
my $unit = ... # Определяем идентификатор узла
...
use MyModule::NestedSets;
my $nested = new MyModule::NestedSets {table=>'catalog_category', type=>'M', DBI=>$dbh};
$nested->select_unit($unit);
$nested->set_unit_level(move=>'down', order=>'top');
...

4.4. Изменение порядка узла

Не смотря на то, что у нас есть метод перемещения узла в точку, рядом с другим. Часто требуется простое перемещение узла по порядку вверх или вниз. Используя вышесказаный метод, нам будет нужно определить этот соседний узел, что приводит к лишним операциям, поэтому целесообразно описать отдельную процедуру для управления порядком, в пределах одного подчинения. Данные, которые нам понадобятся:

  • параметры перемещаемого узла;
  • параметры перемещения (вверх - вниз)

Действия, точно такие же как и в предыдущих методах.

sub set_unit_order {
# Получаем данные: объект, перемещаемый узел, порядок перемещения
    my ($self, %common)= @_;
# перемещаемый узел
    my $unit = $common{'unit'} || undef;
# место перемещения
    my $move = $common{'move'} || undef;
    return 0 unless $move;
# объявляем переменную, которую будем передавать процедуре перемещения
    my $data;
# определяем данные перемещаемого узла
    if ($unit) {$self = &select_unit($self, $unit)}
    elsif (!$self->{'unit'}->{'id'}) {croak("NestedSets failed: Your must first select unit, for moving it!!!")}
# определяем данные места перемещения - узла, за которым
# будет располагаться перемещаемый узел

    if ($move eq 'up') {
        my $sql = 'SELECT '.
                    $self->{'left'}.' AS lk '.
                  ' FROM '.$self->{'table'}.
                  ' WHERE '.
                    $self->{'right'}.' = '.$self->{'unit'}->{'left'}.' - 1 '.
                    ($self->{'type'} eq 'M' ?
                     ' AND '.$self->{'multi'}.'= \''.$self->{'unit'}->{'multi'}.'\'' : '');
        my $sth = $self -> {'DBI'} -> prepare($sql); $sth -> execute();
        my $row = $sth -> fetchrow_hashref();
        $sth -> finish();
        if ($row) {$data->{'near'} = $$row{'lk'} - 1} else {return 0}
    } elsif ($move eq 'down') {
        my $sql = 'SELECT '.
                    $self->{'right'}.' AS rk '.
                  ' FROM '.$self->{'table'}.
                  ' WHERE '.
                    $self->{'left'}.' = '.$self->{'unit'}->{'right'}.' + 1'.
                    ($self->{'type'} eq 'M' ?
                     ' AND '.$self->{'multi'}.'= \''.$self->{'unit'}->{'multi'}.'\'' : '');
        my $sth = $self->{'DBI'}->prepare($sql); $sth->execute();
        my $row = $sth->fetchrow_hashref();
        $sth -> finish();
        if ($row) {$data->{'near'} = $$row{'rk'}} else {return 0}
    }
# перебрасываем из объекта данные о перемещаемом узле
    $data->{'left'} = $self->{'unit'}->{'left'};
    $data->{'right'} = $self->{'unit'}->{'right'};
    $data->{'level'} = $self->{'unit'}->{'level'};
# Так как работаем в перделах одного подчинения, то уровень не меняется
    $data->{'level_new'} = $self->{'unit'}->{'level'};
    $data->{'multi'} = $self->{'unit'}->{'multi'} || undef;
    $self->{'unit'} = undef;
# перемещаем узел
    &_move_unit($self, $data);
    return 1
}

Вызов данного метода, как всегда:

...
my $unit = ... # Определяем идентификатор узла
...
use MyModule::NestedSets;
my $nested = new
MyModule::NestedSets {table=>'catalog_category', type=>'M', DBI=>$dbh};
$nested->set_unit_order(unit=>$unit, move=>'up');
...

или так:

...
my $unit = ... # Определяем идентификатор узла
...
use MyModule::NestedSets;
my $nested = new MyModule::NestedSets {table=>'catalog_category', type=>'M', DBI=>$dbh};
$nested->select_unit($unit);
$nested->set_unit_order(move=>'down');
...

5. Вернемся к созданию объекта

В процессе, написания модуля, мы правили несколько раз процедуру new, теперь стоит посмотреть, что из нее получилось:

sub new {
# Получаем ссылку на переменную и входные параметры
    my ($self, $common) = @_;
# Описываем переменную, как ссылку на хеш хешей
    $self = {
             id    => 'id',        # имя поля таблицы - идентификатор
             left  => 'left_key',  # имя поля таблицы - левый ключ
             right => 'right_key', # имя поля таблицы - правый ключ
             level => 'level',     # имя поля таблицы - уровень
             multi => 'class',     # имя поля таблицы - идентификатор дерева
             table => undef,       # имя таблицы
             DBI   => undef,       # подключение к базе данных
             type  => 'N',         # мультидерево или нет
             order => 'B',         # порядок вставки, перемещения
             unit  => {            # текущий (выбранный) элемент
                       id    => undef,   # идентификатор элемента
                       left  => undef,   # левый ключ элемента
                       right => undef,   # правый ключ элемента
                       level => undef,   # уровень элемента
                       multi => undef,   # идентификатор дерева элемента
                      },
            };
# Обработка входных параметров
    $self->{'type'} = $$common{'type'} && $$common{'type'} eq 'multi' ? 'M' : 'N';
    $self->{'order'} = $$common{'order'} && $$common{'order'} eq 'top' ? 'T' : 'B';
    $self->{'left'} = $$common{'left'} if $$common{'left'};
    $self->{'right'} = $$common{'right'} if $$common{'right'};
    $self->{'level'} = $$common{'level'} if $$common{'level'};
    $self->{'multi'} = $$common{'multi'} if $$common{'multi'};
    $self->{'table'} = $$common{'table'} if $$common{'table'};
    $self->{'DBI'} = $$common{'DBI'} if $$common{'DBI'};
# "благословление" объекта на работу ;-)
    bless $self;
    return $self;
}

6. Тюнинг

Итак, мы рассмотрели все опрерации управления деревом. Но раз уж модуль у нас управляет, то неплохо бы было научить его пользоваться деревьями. Просматривая модуль DBIx::Tree::NestedSet ( CPAN ( http://webscript.ru///search.cpan.org/%7Edjcp/DBIx-Tree-NestedSet-0.16/lib/DBIx/Tree/NestedSet.pm )), честно говоря, увидел много бесполезных методов, и мало полезных. но попробуем определить, какие методы для работы нам понадобятся, а какие нет. Анализируя методы, я исхожу сугубо из своего опыта, только то, что я действительно использую. Многие методы из вышесказанного модуля, я даже не беру в оборот, т.к. либо для них есть уже замена, либо смысла в них не вижу никакого, тем более, хаить этот модуль, я в коей мере не собираюсь, так как у меня есть свой ;-).

  • Создание таблицы - весьма бесполезный метод, просмотрев несколько своих таблиц хранящих деревья, понял, что общее в них - только поля относящиеся с структуре дерева. Тем более таблицы создаются весьма редко, а так же один раз и навсегда;
  • Редактирование узла - тоже бесполезный метод. В модуле подразумевается, только то, что есть дополнительное поле name, и все, соответсвенно и редактировать можем мы только его (у меня, как минимум, всегда есть поле note);
  • Выборка данных отдельного узла - весьма сомнительный метод, если мы знаем идентификатор узла, то выбрать данные, дело одного простейшего запроса, но особо ленивые могут для себя описать и его;
  • Выборка родительской ветки (родительского узла) - вот этот метод нужен. Определить родительский узел для текущего узла можно в один запрос, но не совсем простой, и собирать его каждый раз в скрипте - не самое любимое мое занятие. Но остается определить какие данные модуль будет нам возвращать:
    • список идентификаторов узлов родительской ветки - возвращается обычный массив который подставляется в простой запрос:
      'SELECT * FROM catalog_category WHERE id IN('.join("','",@array).') ORDER BY left_key'
    • результат запроса в виде обычного массива, элементы которого - ссылки на хеши и данными об узле;
  • Выборка подчиненных узлов - этот метод тоже нужен, причем, как выборка узлов непосредственного подчинения (на уровень ниже), так и всех подчиненных ветвей. Возвращаемые данные - такие же как и при выборке родительской ветки.
  • Статус дерева, она же проверка - можно включить этот метод, на всякий случай (хотя я не помню, когда у меня "рушилась" целостность дерева из-за этого модуля);

6.1. Родительская ветка, родительский узел

6.1.1. Возврат идентификаторов родительской ветки:

Смысл один, либо мы дерем только родителя, либо всю родительскую ветку целиком:

sub get_parent_id {
# Получаем данные: объект, параметры
    my ($self, %common)= @_;
# перемещаемый узел
    my $unit = $common{'unit'} || undef;
# что возвращаем
    my $branch = $common{'branch'} || undef;
# объявляем переменную, массив идентификаторов
    my @data;
# определяем данные узла
    if ($unit) {$self = &select_unit($self, $unit)}
    elsif (!$self->{'unit'}->{'id'}) {croak("NestedSets failed: Your must first select unit, for using it!!!")}
# определяем, есть ли подчиненные узлы
    unless ($self->{'unit'}->{'level'} > 1) {return ['root']}
# Производим выборку ветви
    my $sql = 'SELECT '.$self->{'id'}.' FROM '.$self->{'table'}.
              ' WHERE '.
                $self->{'left'}.' < '.$self->{'unit'}->{'left'}.' AND '.
                $self->{'right'}.' > '.$self->{'unit'}->{'right'}.
# Если мультидерево, ограничение
                ($self->{'type'} eq 'M' ?
                 ' AND '.$self->{'multi'}.' = \''.$self->{'unit'}->{'multi'}.'\'' : '').
# Вся ветвь или непосредственный родитель
               ($branch && $branch eq 'all' ?
                ' ORDER BY '.$self->{'left'} :
                ' ORDER BY '.$self->{'left'}.' DESC LIMIT 1');
    my $sth = $self->{'DBI'}->prepare($sql); $sth->execute();
# Формируем массив
    while (my @row = $sth->fetchrow_array()) {push @data, $row[0]}
    $sth->finish();
# Возвращаем массив
    return \@data
}

Хочу обратить внимание, что в разпросе используется оператор LIMIT, что может привести к некоторому ограничению использования определенных SQL баз данных. Так же при отсутсвии родительских узлов возвращается ссылка на массив с одним элементом (['root']) для того, что бы не возникало ошибки, во время выборки родителей узла находящегося в корне.

Вызов данного метода:

...
my $unit = ... # Определяем идентификатор узла
...
use MyModule::NestedSets;
my $nested = new MyModule::NestedSets {table=>'catalog_category', type=>'M', DBI=>$dbh};
my $parents = $nested->get_parent_id(unit=>$unit, branch=>'all');
...

Так же хочу обратить внимание, что возвращается не массив, а только ссылка на него, если мы хотим получить сразу массив, то можно просто его сразу разименовать (хотя, честно говоря, смысла в этом - никакого):

...
my @parents = @{$nested->get_parent_id(unit=>$unit, branch=>'all')};
...

6.1.2. Возврат родительской ветки в виде массива:

Этот метод вызывает у меня лично противоречивые чувства, так как он может вернуть относительно большой объем данных (что может привести не рациональному использованию памяти), но с другой стороны полностью берет на себя работу с базой. В общем - на любителя. Итак, в каком виде должны вернуться данные - обычный массив элементы которого ссылки на хеш массивы для каждого узла дерева. Почему обычный массив - да что бы не "париться" с сортировкой хеша, так как сортировка у нас всегда производится по левому ключу узла, то особых сложностей с ней возникнуть не должно. Так же немаловажным является то, какие данные будут выбираться: естественно - данные структуры дерева (идентификатор, ключи, уровень), а так же дополнительные поля таблицы. Изначально, я дополнительные поля таблицы передавал в виде массива, но часто бывает так, что требуется указать псевдомимы для полей или призвести какие либо действия над ними, поэтому я предаю дополнительные поля, как часть запроса находящуюся между оператором SELECT и FROM.

sub get_parent_in_array {
# Получаем данные: объект, перемещаемый узел, место перемещения, порядок перемещения
    my ($self, %common)= @_;
# перемещаемый узел
    my $unit = $common{'unit'} || undef;
# что возвращаем
    my $branch = $common{'branch'} || undef;
# дополнительные поля запроса
    my $field = $common{'field'} || undef;
# если выбираем все поля
    $field = $self->{'table'}.'.*' if $field =~ /\*/;
# объявляем переменную, массив идентификаторов
    my @data;
# определяем данные узла
    if ($unit) {$self = &select_unit($self, $unit)}
    elsif (!$self->{'unit'}->{'id'}) {croak("NestedSets failed: Your must first select unit, for using it!!!")}
# определяем, есть ли подчиненные узлы
    unless ($self->{'unit'}->{'level'} > 1) {return [{id=>'root'}]}
# Производим выборку ветви
    my $sql = 'SELECT '.$self->{'id'}.', '.$self->{'left'}.', '.$self->{'right'}.', '.$self->{'level'}.
                ($field ? ', '.$field : '').
              ' FROM '.$self->{'table'}.
              ' WHERE '.
                $self->{'left'}.' < '.$self->{'unit'}->{'left'}.' AND '.
                $self->{'right'}.' > '.$self->{'unit'}->{'right'}.
# Если мультидерево, ограничение
                ($self->{'type'} eq 'M' ?
                 ' AND '.$self->{'multi'}.' = \''.$self->{'unit'}->{'multi'}.'\'' : '').
# Вся ветвь или непосредственный родитель
              ($branch && $branch eq 'all' ?
               ' ORDER BY '.$self->{'left'} :
               ' ORDER BY '.$self->{'level'}.' DESC LIMIT 1');
    my $sth = $self->{'DBI'}->prepare($sql); $sth->execute();
    while (my $row = $sth->fetchrow_hashref()) {push @data, $row}
    $sth->finish();
# возвращаем массив
    return \@data
}

Как видим этот метод тоже не особо отличается от предыдущего, правда, данные возвращаются в ином виде:

@array = (
          {field1 => 'value1_1',
           field2 => 'value1_2',
           field3 => 'value1_3',
           ...},
          {field1 => 'value2_1',
           field2 => 'value2_2',
           field3 => 'value2_3',
           ...},
          {field1 => 'value3_1',
           field2 => 'value3_2',
           field3 => 'value3_3',
           ...},
           ...
         )

Вызов метода, как всегда:

...
my $unit = ... # Определяем идентификатор узла
...
use MyModule::NestedSets;
my $nested = new MyModule::NestedSets {table=>'catalog_category', type=>'M', DBI=>$dbh};
my $parents = $nested->get_parent_in_array(unit=>$unit, branch=>'all', field=>'name AS name_field, note');
...

6.2. Подчиненые узлы

Выборка подчиненных узлов кардинально ничем не отличается от выборки родительских. Основное отличие только лишь в том, что добавляется еще одно дополнительное условие относительно уровней узлов, а так же отсутсвием оператора LIMIT, так как подчиенных узлов на уровне может быть несколько, когда родительских - только один. Поэтому, особенно описывать и нечего.

6.2.1. Возврат идентификаторов подчиненных узлов:

Код:

sub get_child_id {
# Получаем данные: объект, перемещаемый узел, место перемещения, порядок перемещения
    my ($self, %common)= @_;
# перемещаемый узел
    my $unit = $common{'unit'} || undef;
# что выбираем
    my $branch = $common{'branch'} || undef;
# объявляем переменную, массив идентификаторов
    my @data;
# определяем данные узла
    if ($unit) {$self = &select_unit($self, $unit)}
    elsif (!$self->{'unit'}->{'id'}) {$unit = 'root'; $self->{'unit'}->{'level'} = '0'}
# определяем, есть ли подчиненные узлы
    unless ($unit eq 'root' || $self->{'unit'}->{'right'} - $self->{'unit'}->{'left'} > 1) {return ['none']}
# Производим выборку ветви
    my $sql = 'SELECT '.$self->{'id'}.' FROM '.$self->{'table'}.
              ' WHERE '.
                $self->{'left'}.' > '.$self->{'unit'}->{'left'}.' AND '.
                $self->{'right'}.' < '.$self->{'unit'}->{'right'}.
# Если мультидерево, ограничение
                ($self->{'type'} eq 'M' ?
                 ' AND '.$self->{'multi'}.' = \''.$self->{'unit'}->{'multi'}.'\'' : '').
# Вся ветвь или непосредственный родитель
              ($branch && $branch eq 'all' ?
               ' ORDER BY '.$self->{'left'} :
               ' AND '.$self->{'level'}.' = \''.$self->{'unit'}->{'level'}.' + 1 ORDER BY '.$self->{'left'});
    my $sth = $self->{'DBI'}->prepare($sql); $sth->execute();
    while (my @row = $sth->fetchrow_array()) {push @data, $row[0]}
    $sth->finish();
# возвращаем массив
    return \@data
}

Вызов:

...
my $unit = ... # Определяем идентификатор узла
...
use MyModule::NestedSets;
my $nested = new MyModule::NestedSets {table=>'catalog_category', type=>'M', DBI=>$dbh};
my $child = $nested->get_child_id(unit=>$unit, branch=>'all');
...

6.2.2. Возврат подчиненных узлов в виде массива:

Код:

sub get_child_in_array {
# Получаем данные: объект, перемещаемый узел, место перемещения, порядок перемещения
    my ($self, %common)= @_;
# перемещаемый узел
    my $unit = $common{'unit'} || undef;
# что выбираем
    my $branch = $common{'branch'} || undef;
# дополнительные поля запроса
    my $field = $common{'field'} || undef;
# если выбираем все поля
    $field = $self->{'table'}.'.*' if $field =~ /\*/;
# объявляем переменную, массив идентификаторов
    my @data;
# определяем данные узла
    if ($unit) {$self = &select_unit($self, $unit)}
    elsif (!$self->{'unit'}->{'id'}) {$unit = 'root'; $self->{'unit'}->{'level'} = '0'}
# определяем, есть ли подчиненные узлы
    unless ($unit eq 'root' || $self->{'unit'}->{'right'} - $self->{'unit'}->{'left'} > 1) {return [{id=>'none'}]}
# Производим выборку ветви
    my $sql = 'SELECT '.$self->{'id'}.', '.$self->{'left'}.', '.$self->{'right'}.', '.$self->{'level'}.
                ($field ? ', '.$field : '').
              ' FROM '.$self->{'table'}.
              ' WHERE '.
                $self->{'left'}.' > '.$self->{'unit'}->{'left'}.' AND '.
                $self->{'right'}.' < '.$self->{'unit'}->{'right'}.
# Если мультидерево, ограничение
                ($self->{'type'} eq 'M' ?
                 ' AND '.$self->{'multi'}.' = \''.$self->{'unit'}->{'multi'}.'\'' : '').
# Вся ветвь или непосредственный родитель
              ($branch && $branch eq 'all' ?
               ' ORDER BY '.$self->{'left'} :
               ' AND '.$self->{'level'}.' = \''.$self->{'unit'}->{'level'}.' + 1 ORDER BY '.$self->{'left'});
    my $sth = $self->{'DBI'}->prepare($sql); $sth->execute();
    while (my $row = $sth->fetchrow_hashref()) {push @data, $row}
    $sth->finish();
# возвращаем массив
    return \@data
}

Вызов:

...
my $unit = ... # Определяем идентификатор узла
...
use MyModule::NestedSets;
my $nested = new MyModule::NestedSets {table=>'catalog_category', type=>'M', DBI=>$dbh};
my $child = $nested->get_parent_in_array(unit=>$unit, branch=>'all', field=>'name AS name_field, note');
...

7. Проверка целостности дерева

Так как структура дерева использует неявное подчинение, существует вариант того что дерево может "разлететься", потерять организацию. Для этого используем проверки описанные в первой статье:

  • Левый ключ ВСЕГДА меньше правого;
  • Наименьший левый ключ ВСЕГДА равен 1;
  • Наибольший правый ключ ВСЕГДА равен двойному числу узлов;
  • Разница между правым и левым ключом ВСЕГДА нечетное число;
  • Если уровень узла нечетное число то тогда левый ключ ВСЕГДА нечетное число, то же самое и для четных чисел;
  • Ключи ВСЕГДА уникальны, вне зависимости от того правый он или левый;

Код:

sub check_tree {
# Получаем данные: объект
    my ($self, $repair) = @_;
# Результат проверки
    my %data;
# Левый ключ ВСЕГДА меньше правого
    my $sql = 'SELECT '.($self->{'type'} eq 'M' ?
                         $self->{'multi'}.' AS multi' : 'COUNT('.$self->{'id'}.') AS num').
              ' FROM '.$self->{'table'}.
              ' WHERE '.$self->{'left'}.' >= '.$self->{'right'}.
              ($self->{'type'} eq 'M' ? ' GROUP BY '.$self->{'multi'} : '');
    my $sth = $self->{'DBI'}->prepare($sql); $sth->execute();
    while (my $row = $sth->fetchrow_hashref()) {
        if ($self->{'type'} eq 'M') {$data{$$row{'multi'}} = 1}
        elsif ($$row{'num'} && $$row{'num'} > 0) {$data{'check'} = 'no'}
    }
    $sth->finish();
# Наименьший левый ключ ВСЕГДА равен 1
# Наибольший правый ключ ВСЕГДА равен двойному числу узлов

    $sql = 'SELECT '.($self->{'type'} eq 'M' ? $self->{'multi'}.' AS multi, ' : '').
               ' COUNT('.$self->{'id'}.') AS num, '.
               ' MIN('.$self->{'left'}.') AS lk, '.
               ' MAX('.$self->{'right'}.') AS rk'.
           ' FROM '.$self->{'table'}.
           ($self->{'type'} eq 'M' ? ' GROUP BY '.$self->{'multi'} : '');
    $sth = $self->{'DBI'}->prepare($sql); $sth->execute();
    while (my $row = $sth->fetchrow_hashref()) {
        unless ($$row{'lk'} == 1 && $$row{'rk'} / $$row{'num'} == 2) {
            if ($self->{'type'} eq 'M') {$data{$$row{'multi'}} = 1} else {$data{'check'} = 'no'}
        }
    }
    $sth->finish();
# Разница между правым и левым ключом ВСЕГДА нечетное число
    $sql = 'SELECT '.($self->{'type'} eq 'M' ?
                      $self->{'multi'}.' AS multi, ''COUNT('.$self->{'id'}.') AS num, ').
               ' MOD(('.$self->{'right'}.' - '.$self->{'left'}.'), 2) AS os'.
           ' FROM '.$self->{'table'}.
           ' GROUP BY '.$self->{'id'}.
           ' HAVING os = 0';
    $sth = $self->{'DBI'}->prepare($sql); $sth->execute();
    while (my $row = $sth->fetchrow_hashref()) {
        if ($self->{'type'} eq 'M') {$data{$$row{'multi'}} = 1}
        elsif ($$row{'num'} && $$row{'num'} > 0) {$data{'check'} = 'no'}
    }
    $sth->finish();
# Если уровень узла нечетное число то тогда левый ключ ВСЕГДА нечетное число,
# то же самое и для четных чисел

    $sql = 'SELECT '.($self->{'type'} eq 'M' ?
                      $self->{'multi'}.' AS multi, ' : 'COUNT('.$self->{'id'}.') AS num, ').
               ' MOD(('.$self->{'left'}.' - '.$self->{'level'}.' + 2), 2) AS os'.
           ' FROM '.$self->{'table'}.
           ' GROUP BY '.$self->{'id'}.
           ' HAVING os = 1';
    $sth = $self->{'DBI'}->prepare($sql); $sth->execute();
    while (my $row = $sth->fetchrow_hashref()) {
        if ($self->{'type'} eq 'M') {$data{$$row{'multi'}} = 1}
        elsif ($$row{'num'} && $$row{'num'} > 0) {$data{'check'} = 'no'}
    }
    $sth->finish();
# Ключи ВСЕГДА уникальны, вне зависимости от того правый он или левый
    if ($self->{'type'} eq 'M') {
        my $sql = 'SELECT '.$self->{'multi'}.' AS multi'.
                  ' FROM '.$self->{'table'}.
                  ' GROUP BY '.$self->{'multi'};
        my $sth = $self->{'DBI'}->prepare($sql); $sth->execute();
        while (my $multi = $sth->fetchrow_hashref()) {
            my $sql = 'SELECT '.$self->{'left'}.' AS lk, '.$self->{'right'}.' AS rk'.
                      ' FROM '.$self->{'table'}.
                      ' WHERE '.$self->{'multi'}.' = '.$$multi{'multi'};
            my $sth = $self->{'DBI'}->prepare($sql); $sth->execute();
            my %check;
            while (my $row = $sth->fetchrow_hashref()) {
                if ($check{$$row{'lk'}}) {$data{$$multi{'multi'}} = 1} else {$check{$$row{'lk'}} = 1}
                if ($check{$$row{'rk'}}) {$data{$$multi{'multi'}} = 1} else {$check{$$row{'rk'}} = 1}
            }
            $sth->finish();
        }
        $sth->finish();
    } else {
        my $sql = 'SELECT '.$self->{'left'}.' AS lk, '.$self->{'right'}.' AS rk'.
                  ' FROM '.$self->{'table'};
        my $sth = $self->{'DBI'}->prepare($sql); $sth->execute();
        my %check;
        while (my $row = $sth->fetchrow_hashref()) {
            if ($check{$$row{'lk'}}) {$data{'check'} = 'no'} else {$check{$$row{'lk'}} = 1}
            if ($check{$$row{'rk'}}) {$data{'check'} = 'no'} else {$check{$$row{'rk'}} = 1}
        }
        $sth->finish();
    }
# Проверяем, найдены ли ошибки
    my $result = 'No error';
    if (%data && $repair eq 'repair') {$result = &repair_tree($self, %data)}
    elsif (%data && $repair ne 'repair') {$result = 'Found error! Not repaired!'}
    return $result
}

В процессе этого метода формируется хеш %data в котором перечислены либо идентификаторы деревьев (если мультидерево), либо один элемент для инициализации. Последняя проверка на уникальнось ключей, не такая, как описано в статье. Дело в том, что при использовании мультидеревьев а так же при большом количестве узлов, получается большая нагрузка на базу данных, что не совсем правильно.

В конце процедуры мы ссылаемся на другую процедуру repair_tree. Так как ручное исправление целостности дерева - дело неблагодарное, и муторное; а чаще всего сводится к простейшему обнулению структуры, напишем отдельную процедуру, в которой попытаемся, хотя бы частично её восстановить.

8. Принудительное восстановление дерева

Восстановление структуры дерева - простое "обнуление", во время которого, все узлы устанавливаются на первый уровень в соответствии со своими идентификаторами.

sub repair_tree {
# Получаем данные
    my ($self, %multi) = @_;
# Обработка дерева
    if ($self->{'type'} eq 'M') {
        foreach my $class (keys %multi) {
            $self->{'DBI'}->do('SET @count1 := -1');
            $self->{'DBI'}->do('SET @count2 := 0');
            $self->{'DBI'}->do('UPDATE '.$self->{'table'}.
                ' SET '.$self->{'left'}.' = @count1 := @count1 + 2, '.
                        $self->{'right'}.' = @count2 := @count2 + 2, '.
                        $self->{'level'}.' = 1'.
                ' WHERE '.$self->{'multi'}.' = \''.$class.'\''.
                ' ORDER BY '.$self->{'id'})
        }
    } else {
        $self->{'DBI'}->do('SET @count1 := -1');
        $self->{'DBI'}->do('SET @count2 := 0');
        $self->{'DBI'}->do('UPDATE '.$self->{'table'}.
            ' SET '.$self->{'left'}.' = @count1 := @count1 + 2, '.
                    $self->{'right'}.' = @count2 := @count2 + 2, '.
                    $self->{'level'}.' = 1'.
            ' ORDER BY '.$self->{'id'})
    }
    return 'Repair OK!';
}

9. Заключение

В итоге получился модуль, который позволяет максимально упростить работу с деревьями Nested Sets. Сам модуль ближайшее время выложу на CPAN, а так его можно скачать здесь ( http://webscript.ru///www.asit.ru/%7Efiles/lib/NestedSets.zip ). Устанавливать его не нужно, просто положить в соответсвующую папку (в моем случае это MPM) а в скрипте подключиль дополнительный каталог баблиотеки (eq: use lib './../lib';). В процессе буду его модернизировать и обновновлять поэтому если интересно, следите за обновлениями.

Если кому интересно посмотреть на работающий ресурс с использованием данного модуля - www.alfakmv.ru ( http://webscript.ru///www.alfakmv.ru ). Старницы данного ресурса являются элементами одного дерева (на сегодняшний день свыше двух тысяч статичных станиц, максимальный уровень вложенности - пятый). Каталоги данного ресурса (динамические разделы) используют мультидерево (на сегодняшний день свыше тысячи категорий в пяти разделенных деревьях, максимальный уровень вложенности - четвертый). Так же дополнительно в админ-интерфейсе используется порядка восьми деревьев для управления изображениями элементами дизайна и т.д. Все таблицы имеют свою структуру, за исключением четырех обязательных полей: индетификатора, левого ключа, правого ключа, уровня узла.

Томулевич Сергей (Phoinix) 12.01.2005