DOC.PROTOTYPES.RU

Главная > Базы данных > Деревья SQL > Nested Sets > практика Perl >

Практика NestedSets - Perl модуль управления деревом 1

Определение

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

Perl код (1)
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;
}
    

Где:

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

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

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

Perl код (2)
...
    $self = {
                ...
                type      => 'N',
                multi     => 'class',
            };
...    
    

Где:

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

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

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

Perl код (3)
...
use MyModule::NestedSets;
    my $nested = new MyModule::NestedSets ( 'table' => 'catalog_category', 'type' => 'multi', 'DBI' => $dbh );
... 
    

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

Perl код (4)
sub new {
    my ($self, %common) = @_;

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

    $self = {
              ...
             };
    $self->{'type'} = $$common{'type'} && $$common{'type'} eq 'multi' ? 'M' : 'N';
    $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;
}

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

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

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;
    }
# Обновляем ключи дерева для создания пустого промежутка
# UPD: IF изменен на CASE для адаптирования под другие SQL диалекты
    $self->{'DBI'}->do('UPDATE '.$self->{'table'}.' SET '.
        $self->{'right'}.' = '.$self->{'right'}.' + 2, '.
        $self->{'left'}.' = CASE WHEN '.$self->{'left'}.' >= '.$key.' THEN '.$self->{'left'}.
        ' + 2 ELSE '.$self->{'left'}.' END 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.'\'' : ''));
# Получаем идентификатор созданного узла и возвращаем его в качестве результата
# UPD: LAST_INSERT_ID изменен на обычный запрос т.к. существует только в MySQL
    my $sth = $self->{'DBI'}->prepare('SELECT MAX('.$self->{'id'}.') 
                                       FROM '.$self->{'table'}.
                                       ($self->{'type'} eq 'M' ? 
                                             ' WHERE '.$self->{'multi'}.'='.$catalog.')' : '')); 
    $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'}.' = CASE WHEN '.$self->{'left'}.' > '.$self->{'unit'}->{'left'}.
                           ' THEN '.$self->{'left'}.' - '.$skew.' ELSE '.$self->{'left'}.' END, '.
                       $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'}.' = CASE WHEN '.$self->{'right'}.' <= '.$data->{'right'}.' THEN '.
                             $self->{'left'}.' + '.$skew_edit.' ELSE CASE WHEN '.$self->{'left'}.' > '.$data->{'right'}.' THEN '.
                              $self->{'left'}.' - '.$skew_tree.' ELSE '.$self->{'left'}.' END END, '.
                            $self->{'level'}.' = CASE WHEN '.$self->{'right'}.' <= '.$data->{'right'}.' THEN '.
                             $self->{'level'}.' + '.$skew_level.' ELSE '.$self->{'level'}.' END, '.
                            $self->{'right'}.' = CASE WHEN '.$self->{'right'}.' <= '.$data->{'right'}.' THEN '.
                             $self->{'right'}.' + '.$skew_edit.' ELSE CASE WHEN '.$self->{'right'}.' <= '.$data->{'near'}.' THEN '.
                              $self->{'right'}.' - '.$skew_tree.' ELSE '.$self->{'right'}.' END END 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'}.' = CASE WHEN '.$self->{'left'}.' >= '.$data->{'left'}.' THEN '.
                             $self->{'right'}.' + '.$skew_edit.' ELSE CASE WHEN '.$self->{'right'}.' < '.$data->{'left'}.' THEN '.
                              $self->{'right'}.' + '.$skew_tree.' ELSE '.$self->{'right'}.' END END, '.
                            $self->{'level'}.' = CASE WHEN '.$self->{'left'}.' >= '.$data->{'left'}.' THEN '.
                             $self->{'level'}.' + '.$skew_level.' ELSE '.$self->{'level'}.' END, '.
                            $self->{'left'}.' = CASE WHEN '.$self->{'left'}.' >= '.$data->{'left'}.' THEN '.
                             $self->{'left'}.' + '.$skew_edit.' ELSE CASE WHEN '.$self->{'left'}.' > '.$data->{'near'}.' THEN '.
                              $self->{'left'}.' + '.$skew_tree.' ELSE '.$self->{'left'}.' END END WHERE '.
                            $self->{'right'}.' > '.$data->{'near'}.' AND '.
                            $self->{'left'}.' < '.$data->{'right'}.
                            ($self->{'type'} eq 'M' ? ' AND '.$self->{'multi'}.'= \''.$data->{'multi'}.'\'' : '')
                      );
    }
    return 1
}

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

Где:

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

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

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

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

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

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. Перемещение узла - рядом с другим

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

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

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. Изменение уровня узла

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

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

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

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), честно говоря, увидел много бесполезных методов, и мало полезных. но попробуем определить, какие методы для работы нам понадобятся, а какие нет. Анализируя методы, я исхожу сугубо из своего опыта, только то, что я действительно использую. Многие методы из вышесказанного модуля, я даже не беру в оборот, т.к. либо для них есть уже замена, либо смысла в них не вижу никакого, тем более, хаить этот модуль, я в коей мере не собираюсь, так как у меня есть свой ;-).

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. Проверка целостности дерева

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

Код:

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';). В процессе буду его модернизировать и обновновлять поэтому если интересно, следите за обновлениями.

Сергей Томулевич aka Phoinix (12.01.2005, ред. 01.05.2010 г.)
Copyright © 2011 Сергей Томулевич