| Дерево каталогов NESTED SETS (вложенные множества) часть второая
 
 
ПРАКТИЧЕСКОЕ ПРИМЕНЕНИЕПИШЕМ МОДУЛЬ НА 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), честно говоря, увидел много бесполезных методов, и мало полезных. но попробуем определить, какие методы для работы нам понадобятся, а какие нет. Анализируя методы, я исхожу сугубо из своего опыта, только то, что я действительно использую. Многие методы из вышесказанного модуля, я даже не беру в оборот, т.к. либо для них есть уже замена, либо смысла в них не вижу никакого, тем более, хаить этот модуль, я в коей мере не собираюсь, так как у меня есть свой ;-). 
Создание таблицы - весьма бесполезный метод, просмотрев несколько своих таблиц хранящих деревья, понял, что общее в них - только поля относящиеся с структуре дерева. Тем более таблицы создаются весьма редко, а так же один раз и навсегда;
Редактирование узла - тоже бесполезный метод. В модуле подразумевается, только то, что есть дополнительное поле 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, а так его можно скачать здесь. Устанавливать его не нужно, просто положить в соответсвующую папку (в моем случае это MPM) а в скрипте подключиль дополнительный каталог баблиотеки (eq: use lib './../lib';). В процессе буду его модернизировать и обновновлять поэтому если интересно, следите за обновлениями. Если кому интересно посмотреть на работающий ресурс с использованием данного модуля - www.alfakmv.ru. Старницы данного ресурса являются элементами одного дерева (на сегодняшний день свыше двух тысяч статичных станиц, максимальный уровень вложенности - пятый). Каталоги данного ресурса (динамические разделы) используют мультидерево (на сегодняшний день свыше тысячи категорий в пяти разделенных деревьях, максимальный уровень вложенности - четвертый). Если вы цените безопасность и качество, обратите внимание на Супер Босс Казино . Играйте в лицензионные автоматы, участвуйте в акциях и получайте моментальные выплаты. Так же дополнительно в админ-интерфейсе используется порядка восьми деревьев для управления изображениями элементами дизайна и т.д. Все таблицы имеют свою структуру, за исключением четырех обязательных полей: индетификатора, левого ключа, правого ключа, уровня узла. Томулевич Сергей (Phoinix) 12.01.2005 
 
 
 
 |