DOC.PROTOTYPES.RU

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

Perl модуль управления Nested Sets. Вариант 2.


Задача


Да уж, собрал ты катер, что бы кататься по водоемам и наслаждаться жизнью. Поехал на очередное озеро отдохнуть, а тебе говорят, что мол с собаками и катерами вход воспрещен, и вообще у нас озеро вечно замерзшее, вот вам коньки - наслаждайтесь. "Welcome to the Virtual Hosting lake".

Как-то совсем не обратил внимание, что триггеры в MySQL может создавать только SUPER пользователь, что несколько удивляет, но оставим это на совести разработчиков. Триггеры, конечно, хороши, но пока положим их на полку.

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

Итак, что есть и что требуется сделать. У меня есть некий набор объектов и некая "обертка" для работы с базой данных. В эту "обертку" я и буду включать этот модуль, как расширение её функционала. Обертка самописная. Заранее оговорюсь, я не противник DBIx::Class и других готовых решений, я их использую в своей работе и доволен. Вопрос же упирается в Virtual Hosting иже с ним: отсутствие mod_perl и геморрой установки дополнительных модулей. Решение для того же DBIx::Class в разработке, но не очень быстрой ввиду того, что нет надобности, мне и триггеров хватает.

Посему требуется только три процедуры: insert, update и delete. Именно процедуры, которые в свою очередь пронаследуются как методы объекта "обертки". Впрочем, в данной статье, сделаю его практически самодостаточным. Транзакции в этот модуль не включил, ввиду того, что у меня их использование предусматривается на уровень выше, включить их в код самостоятельно, я думаю, не составит труда.

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


Базовые процедуры и переменные


Процедуры подключения к базе данных, естественно, зато есть объект пакета $dbh, которой определяем извне. Так же, для обеспечения универсальности, создадим массив, в котором будем определять для каждой таблицы свой набор полей, отвечающих за структуру дерева, мало ли, кто как захочет их назвать.


Perl код (1)
package MY::NestedSets;
# Все по взрослому, без компромиссов ;-)
use strict;
use warnings;
our $VERSION = '0.0.1';
# Определяем переменные, которые будем использовать внутри пакета
our $dbh = undef;
our $tables = {
                default => {                        # Название таблицы
                    fields  => {                    # Поля таблицы
                        id          => 'id',        #   Собственно ID, мало ли, кто как назовет
                        left_key    => 'left_key',  #   Левый ключ
                        right_key   => 'right_key', #   Правый ключ
                        level       => 'level',     #   Уровень
                        parent_id   => 'parent_id', #   ID родителя
                        tree        => 'tree'       #   идентификатор дерева
                                },
                    multi   => 1,                   # Говорит нам о том, что в таблице несколько деревьев
                            },
               };

sub dbh {
# Первым значением может прийти название пакета или класс пакета, если мы таки умудримся его создать
# поэтому отрезаем его сейчас и потом, у нас таки не класс.
    shift if $_[0] && ($_[0] eq __PACKAGE__ || (ref $_[0] && ref $_[0] eq __PACKAGE__));
    $dbh = $_[0] if $_[0];
    return $dbh;
}

sub set_table_params {
    shift if $_[0] && ($_[0] eq __PACKAGE__ || (ref $_[0] && ref $_[0] eq __PACKAGE__));
# Устанавливаем свои поля для определенной таблицы
    my ($table_name, $params) = @_;
    $tables->{$table_name} = $params;
    return $tables;
}
    

Параллельно буду писать сам скрипт использования, он же тестовый. Итак, юзаем наш модуль и определяем его основные данные.


Perl код (2)
#!/usr/bin/perl
use strict; use warnings;
use lib '../lib';
use MY::NestedSets;
use DBI;
use Data::Dumper;

#--------------------------------------------------------------------------------------------------------
# INIT

my $dbh = DBI->connect('dbi:mysql:database=test;host=localhost;port=3306', 'user', 'pass');
my $table_name = 'test_nested_sets';
my %f = (
        id          => 'ids',
        left_key    => 'lk',
        right_key   => 'rk',
        level       => 'lv',
        parent_id   => 'pi',
        tree        => 'tr',
        );
$dbh->do("DROP TABLE `$table_name`;");
my $query = "CREATE TABLE `$table_name` (
    `$f{id}`        int(11) NOT NULL auto_increment,
    `$f{left_key}`  int(11) NOT NULL default '0',
    `$f{right_key}` int(11) NOT NULL default '0',
    `$f{level}`     int(11) NOT NULL default '0',
    `$f{parent_id}` int(11) NOT NULL default '0',
    `$f{tree}`      int(11) NOT NULL default '1',
    `field1`    VARCHAR(100),
    PRIMARY KEY  (`$f{id}`)
) ENGINE=MyISAM;";
$dbh->do($query);

MY::NestedSets->dbh($dbh);
MY::NestedSets->set_table_params($table_name => {fields => \%f, multi => 1});
...
    


Вставка узла


Логика работы такая же, как и у триггера.


Perl код (3)
sub insert {
# Распределяем входящие данные по местам, ну и соответственно проверяем, всего ли нам хватает
    shift if $_[0] && ($_[0] eq __PACKAGE__ || (ref $_[0] && ref $_[0] eq __PACKAGE__));
    my ($table_name, $new) = @_;
    return {success => 0, error => 'Bad income data!'} unless $dbh && $table_name && $new && ref $new && ref $new eq 'HASH';
# Находим, что за таблица и берем её дополнительные атрибуты и синонимы полей
    my $table = $tables->{$table_name} || $tables->{default};
    my $f = $table->{fields};
    my $result_flags = {is_last_unit => undef};
# Определяем начальные данные ключей дерева
    $new->{$f->{left_key}} ||= 0;
    $new->{$f->{right_key}} = undef;
    $new->{$f->{level}} = undef;
    $new->{$f->{parent_id}} ||= 0;
# Определяем ключи, если у нас задан или изменен родительский узел
    if ($new->{$f->{parent_id}}) {
        my $sql = 'SELECT '.
                        ($table->{multi} ? $f->{tree}.' AS tree, ' : '').
                        $f->{right_key}.' AS left_key, '.
                        $f->{level}.' + 1 AS level '.
                 ' FROM '.$table_name.
                 ' WHERE '.$f->{id}.' = '.$new->{$f->{parent_id}};
# Что бы было понятно, это запрос (в квадратных скобках не обязательное выражение):
#   SELECT [tree AS tree,] right_key AS left_key, level + 1 AS level FROM $table_name WHERE id = $parent_id;
        my $sth = $dbh->prepare($sql); $sth->execute || return {success => 0, error => $dbh->errstr};
        my $row = $sth->fetchrow_hashref();
        $sth->finish;
# Родительский узел найден, значит переопределяем значния ключей
        if ($row) {
            $new->{$f->{tree}} = $row->{tree} || undef;
            $new->{$f->{left_key}} = $row->{left_key};
            $new->{$f->{level}} = $row->{level};
        } else {
# Родительский узел не найден, значит, parent_id - левый, сбрасываем его
            $new->{$f->{parent_id}} = 0;
            $new->{$f->{level}} = 0;
        }
    }
# Определяем ключи если у нас задан левый ключ, но при этом, родительский узел не указан, либо не найден
    if (!$new->{$f->{parent_id}} && $new->{$f->{left_key}}) {
# Это важно! параметр $tree нужен обязательно если мультидеревья
        return {success => 0, error => 'No tree value!'} unless $new->{$f->{tree}} && $table->{multi};
# Сначала я хотел использовать SQL::Abstract, но он мне не понравился, описывать сложные запросы сложнее и дольше
# Находим, узел по левому или правому ключу
        my $sql = 'SELECT '.
                        $f->{id}.' AS id, '.
                        $f->{left_key}.' AS left_key, '.
                        $f->{right_key}.' AS right_key, '.
                        $f->{level}.' AS level, '.
                        $f->{parent_id}.' AS parent_id '.
                 ' FROM '.$table_name.
                 ' WHERE '.
                 ($table->{multi} ? $f->{tree}.' = '.$new->{$f->{tree}}.' AND ' : '').
                 '('.$f->{left_key}.' = '.$new->{$f->{left_key}}.' OR '.
                 $f->{right_key}.' = '.$new->{$f->{left_key}}.') LIMIT 1';
# Запрос читабельно:
#   SELECT
#       id          AS id,
#       left_key    AS left_key,
#       right_key   AS right_key,
#       level       AS level,
#       parent_id   AS parent_id
#   FROM $table_name
#   WHERE
#     [ tree = $tree AND ]
#       (left_key = $left_key OR right_key = $left_key)
#   LIMIT 1;
        my $sth = $dbh->prepare($sql); $sth->execute || return {success => 0, error => $dbh->errstr};
        my $row = $sth->fetchrow_hashref();
        $sth->finish;
# Узел нашли по левому ключу, следовательно, новый узел у нас будет стоять перед найденным
        if ($row && $row->{left_key} == $new->{$f->{left_key}}) {
            $new->{$f->{parent_id}} = $row->{parent_id};
            $new->{$f->{level}} = $row->{level};
# Узел нашли по правому ключу, следовательно, новый узел у нас будет стоять под найденным
        } elsif ($row) {
            $new->{$f->{parent_id}} = $row->{id};
            $new->{$f->{level}} = $row->{level} + 1;
        } else {
# Опять такая-то лажа, указали совершенно левые данные. Хорошо бы ругнуться, но пока игнорируем эти косяки,
# так как можем справится сами и без этих данных
            $new->{$f->{left_key}} = undef;
        }
    }
# Собственно, получить точку вставки мы не смогли, или же просто она была не указана.
# Будем вставлять в конец дерева, поэтому обновления существующих узлов не требуется, посему сделаем соответствующий флаг:
    unless ($new->{$f->{left_key}}) {
        $result_flags->{is_last_unit} = 1;
# Это опять же важно! параметр $tree нужен обязательно если мультидеревья.
# Вообще, можно было проверить это и самом начале, но этот параметр не обязателен, если мы указали parent_id,
# тогда значение ключа tree определяем по нему.
        return {success => 0, error => 'No tree value!'} unless $new->{$f->{tree}} && $table->{multi};
# Тут все просто, определяем максимальный правый ключ и радуемся
        my $sql = 'SELECT MAX('.$f->{right_key}.') + 1 AS left_key
            FROM '.$table_name.
            ($table->{multi} ? ' WHERE '.$f->{tree}.' = '.$new->{$f->{tree}} : '');
# Запрос читабельно:
#   SELECT MAX(right_key) + 1 AS left_key,
#   FROM $table_name
# [ WHERE tree = $tree ];
        my $sth = $dbh->prepare($sql); $sth->execute || return {success => 0, error => $dbh->errstr};
        my $row = $sth->fetchrow_hashref();
        $sth->finish;
# Но радость может быть не полной, так как узлов может и не быть вообще
        $new->{$f->{left_key}} = $row->{left_key} || 1;
        $new->{$f->{parent_id}} = 0;
        $new->{$f->{level}} = 0;
    }
# Ну вот, с местоназначением мы определились, можно делать разрыв ключей в дереве:
    unless ($result_flags->{is_last_unit}) {
        my $query = 'UPDATE '.$table_name.
                       ' SET '.$f->{left_key}.' = CASE
                                    WHEN '.$f->{left_key}.' >= '.$new->{$f->{left_key}}.'
                                    THEN '.$f->{left_key}.' + 2 ELSE '.$f->{left_key}.' END,
                            '.$f->{right_key}.' = '.$f->{right_key}.' + 2
                     WHERE '.
                     ($table->{multi} ? $f->{tree}.' = '.$new->{$f->{tree}}.' AND ' : '').
                      $f->{right_key}.' >= '.$new->{$f->{left_key}};
# Запрос читабельно:
#   UPDATE $table_name
#       SET
#           left_key = CASE WHEN left_key >= $left_key 
#                           THEN left_key + 2 
#                           ELSE left_key
#                      END,
#           right_key = right_key + 2
#       WHERE [ tree = $tree AND ] right_key >= $left_key;
        $dbh->do($query) || return {success => 0, error => $dbh->errstr};
    }
# Теперь, собственно, зачем мы сюда пришли:
# Правый ключ вычисляем
    $new->{$f->{right_key}} = $new->{$f->{left_key}} + 1;
# Проставляем ключики
    $new->{$f->{tree}} = $new->{$f->{tree}} if $table->{multi};
# Надо бы поля в определенном порядке выводить
    my @fields = keys %{$new};
# тут как бе квотируем не числовые и пустые строки и запихиваем в порядке @fields
# и да, их таки надо проверить до того как они сюда попали, хотя бы на предмет наличия двойных кавычек
    my @values = map {defined $new->{$_} && $new->{$_} =~ /^\d+$/ ? $new->{$_} : '"'.$new->{$_}.'"'} @fields;
# Собственно INSERT
    my $query = 'INSERT INTO '.$table_name.' ('.( join ',', @fields ).') VALUES ('.( join ',', @values ).')';
    $dbh->do($query) || return {success => 0, error => $dbh->errstr};
# А вот что возвращать - вопрос отдельный, вернуть вставленную строку без выборки мы, увы, не можем,
# так как в таблице могут быть умолчательные значения полей, а мы их в INSERT не указали.
# Сделаем таки SELECT
    my $sql = 'SELECT * FROM '.$table_name.' ORDER BY '.$f->{id}.' DESC LIMIT 1';
    my $sth = $dbh->prepare($sql); $sth->execute || return {success => 0, error => $dbh->errstr};
    my $row = $sth->fetchrow_hashref;
    $sth->finish;
    return {success => 1, row => $row};
}
    

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

Применение:


Perl код (4)
...
my $tree = 1;
#-----------------------------------------------------------------------------------------------------------------------
# INSERT
    # Запись без координат
    my $insert = MY::NestedSets->insert($table_name, {field1 => 'row1-'.$tree, tr => $tree});
        warn Dumper $insert;
    # Запись с родителем
    $insert = MY::NestedSets->insert($table_name, {field1 => 'row2-'.$tree, pi => $insert->{row}->{ids}, tr => $tree});
        warn Dumper $insert;
    # Записи с left_key
    $insert = MY::NestedSets->insert($table_name, {field1 => 'row3-'.$tree, lk => 1, tr => $tree});
        warn Dumper $insert;
    $insert = MY::NestedSets->insert($table_name, {field1 => 'row4-'.$tree, lk => 4, tr => $tree});
        warn Dumper $insert;
    # Неправильные параметры
    $insert = MY::NestedSets->insert($table_name, {field1 => 'row5-'.$tree, pi => 1000, tr => $tree});
        warn Dumper $insert;
    $insert = MY::NestedSets->insert($table_name, {field1 => 'row6-'.$tree, lk => 100, tr => $tree});
        warn Dumper $insert;
...
    


Изменение узла


Кроме изменения непосредственно структуры дерева (если надо), еще будут применяться и изменения других полей, по надобности.


Perl код (5)
sub update {
# Распределяем входящие данные по местам, ну и, соответственно, проверяем, всего ли нам хватает
    shift if $_[0] && ($_[0] eq __PACKAGE__ || (ref $_[0] && ref $_[0] eq __PACKAGE__));
    my ($table_name, $new) = @_;
    return {success => 0, error => 'Bad income data!'} unless $dbh && $table_name && $new && ref $new && ref $new eq 'HASH';
# Находим, что за таблица и берем её дополнительные атрибуты и синонимы полей
    my $table = $tables->{$table_name} || $tables->{default};
    my $f = $table->{fields};
    return {success => 0, error => 'Bad income data!'} unless $new->{$f->{id}};
# Убираем поля, которые менять самостоятельно нельзя
    delete $new->{$f->{right_key}};
    delete $new->{$f->{tree}};
    delete $new->{$f->{level}};
    my $tmp_left_key = $new->{$f->{left_key}};
    my $result_flags = {it_is_moving => undef};
# Дальше дилемма. Что бы принять изменения, нам нужно иметь исходные данные
# В данном случае, мы не знаем какие у нас были исходные данные, и какие поля реально менялись,
# поэтому делаем выборку нашего изменяемого узла
    my $sql = 'SELECT * FROM '.$table_name.' WHERE '.$f->{id}.' = '.$new->{$f->{id}};
    my $sth = $dbh->prepare($sql); $sth->execute || return {success => 0, error => $dbh->errstr};
    my $old = $sth->fetchrow_hashref;
    $sth->finish;
    return {success => 0, error => 'No old unit!'} unless $old;
# Вычисляем новую координаты узла
# Определяем ключи если у нас изменен родительский узел
    if (defined $new->{$f->{parent_id}} && $new->{$f->{parent_id}} != $old->{$f->{parent_id}}) {
        if ($new->{$f->{parent_id}} > 0) {
            my $sql = 'SELECT '.
                            ($table->{multi} ? $f->{tree}.' AS tree, ' : '').
                            $f->{right_key}.' AS left_key, '.
                            $f->{level}.' + 1 AS level '.
                     ' FROM '.$table_name.
                     ' WHERE '.$f->{id}.' = '.$new->{$f->{parent_id}};
# Что бы было понятно, это запрос (в квадратных скобках не обязательное выражение):
#   SELECT [tree AS tree,] right_key AS left_key, level + 1 AS level FROM $table_name WHERE id = $parent_id;
            my $sth = $dbh->prepare($sql); $sth->execute || return {success => 0, error => $dbh->errstr};
            my $row = $sth->fetchrow_hashref();
            $sth->finish;
# Родительский узел найден, значит переопределяем значения ключей
            if ($row) {
                $new->{$f->{tree}} = $row->{tree} if $table->{multi};
                $new->{$f->{left_key}} = $row->{left_key};
                $new->{$f->{level}} = $row->{level};
                $result_flags->{it_is_moving} = 1;
            } else {
# Родительский узел не найден, значит, parent_id - левый, сбрасываем его
                $new->{$f->{parent_id}} = $old->{$f->{parent_id}};
            }
        } else {
# Переносим на самый верхний уровень
# Тут все просто, определяем максимальный правый ключ и радуемся
            my $sql = 'SELECT MAX('.$f->{right_key}.') + 1 AS left_key
                FROM '.$table_name.
                ($table->{multi} ? ' WHERE '.$f->{tree}.' = '.$old->{$f->{tree}} : '');
# Запрос читабельно:
#   SELECT MAX(right_key) + 1 AS left_key,
#   FROM $table_name
# [ WHERE tree = $tree ];
            my $sth = $dbh->prepare($sql); $sth->execute || return {success => 0, error => $dbh->errstr};
            my $row = $sth->fetchrow_hashref();
            $sth->finish;
            $new->{$f->{left_key}} = $row->{left_key};
            $new->{$f->{parent_id}} = 0;
            $new->{$f->{level}} = 0;
        }
    }
# Определяем ключи если у нас задан левый ключ но при этом родительский узел не указал, либо не найден
    if ($tmp_left_key && $new->{$f->{left_key}} &&  # left_key был указан
         $new->{$f->{left_key}} == $tmp_left_key && # parent_id не менялся
         $tmp_left_key != $old->{$f->{left_key}}) { # left_key изменился
# Сначала я хотел использовать SQL::Abstract, но он мне не понравился, описывать сложные запросы сложнее и дольше
# Находим, узел по левому или правому ключу
        my $sql = 'SELECT '.
                        $f->{id}.' AS id, '.
                        $f->{left_key}.' AS left_key, '.
                        $f->{right_key}.' AS right_key, '.
                        $f->{level}.' AS level, '.
                        $f->{parent_id}.' AS parent_id '.
                 ' FROM '.$table_name.
                 ' WHERE '.
                 ($table->{multi} ? $f->{tree}.' = '.$old->{$f->{tree}}.' AND ' : '').
                 '('.$f->{left_key}.' = '.$new->{$f->{left_key}}.' OR '.
                 $f->{right_key}.' = '.$new->{$f->{left_key}}.') LIMIT 1';
# Запрос читабельно:
#   SELECT
#       id          AS id,
#       left_key    AS left_key,
#       right_key   AS right_key,
#       level       AS level,
#       parent_id   AS parent_id
#   FROM $table_name
#   WHERE
#     [ tree = $tree AND ]
#       (left_key = $left_key OR right_key = $left_key)
#   LIMIT 1;
        my $sth = $dbh->prepare($sql); $sth->execute || return {success => 0, error => $dbh->errstr};
        my $row = $sth->fetchrow_hashref();
        $sth->finish;
# Узел нашли по левому ключу, следовательно, новый узел у нас будет стоять перед найденным
        if ($row && $row->{left_key} == $new->{$f->{left_key}}) {
            $new->{$f->{parent_id}} = $row->{parent_id};
            $new->{$f->{level}} = $row->{level};
# Узел нашли по правому ключу, следовательно, новый узел у нас будет стоять под найденным
        } elsif ($row) {
            $new->{$f->{parent_id}} = $row->{id};
            $new->{$f->{level}} = $row->{level} + 1;
        } else {
# Опять такая-то лажа, указали совершенно левые данные. Хотя есть вариант, что ставим узел самым первым,
# тогда, это не ошибка. Но в других случаях, просто игнорируем перемещение
            $new->{$f->{left_key}} = $new->{$f->{left_key}} && $new->{$f->{left_key}} == 1 ? 1 : $old->{$f->{left_key}};
        }
    }
# Теперь, когда мы знаем, какой у нас левый ключ, мы можем проверить, а не во внутрь ли мы отправляем
    if ($new->{$f->{left_key}} > $old->{$f->{left_key}} && $new->{$f->{left_key}} < $old->{$f->{right_key}}) {
        return {success => 0, error => 'Can not move unit inside'};
    }
# С координатами разобрались, единственно, Смотрим, а есть ли у нас вообще изменения по дереву
    if ($new->{$f->{left_key}} && $new->{$f->{left_key}} != $old->{$f->{left_key}}) {
# Определяем смещения уровня и дерева
        my $skew_level = $new->{$f->{level}} - $old->{$f->{level}};
        my $skew_tree = $old->{$f->{right_key}} - $old->{$f->{left_key}} + 1;
# Перемещение вниз по дереву
        if ($new->{$f->{left_key}} > $old->{$f->{left_key}}) {
            my $skew_edit = $new->{$f->{left_key}} - $old->{$f->{left_key}} - $skew_tree;
            my $query = 'UPDATE '.$table_name.
                           ' SET '.$f->{left_key}.' = CASE WHEN '.$f->{right_key}.' <= '.$old->{$f->{right_key}}.'
                                     THEN '.$f->{left_key}.' + '.$skew_edit.'
                                     ELSE CASE WHEN '.$f->{left_key}.' > '.$old->{$f->{right_key}}.'
                                               THEN '.$f->{left_key}.' - '.$skew_tree.'
                                               ELSE '.$f->{left_key}.'
                                          END
                               END,
                    '.$f->{level}.' =  CASE WHEN '.$f->{right_key}.' <= '.$old->{$f->{right_key}}.'
                                    THEN '.$f->{level}.' + '.$skew_level.'
                                    ELSE '.$f->{level}.'
                               END,
                    '.$f->{right_key}.' = CASE WHEN '.$f->{right_key}.' <= '.$old->{$f->{right_key}}.'
                                     THEN '.$f->{right_key}.' + '.$skew_edit.'
                                     ELSE CASE WHEN '.$f->{right_key}.' < '.$new->{$f->{left_key}}.'
                                               THEN '.$f->{right_key}.' - '.$skew_tree.'
                                               ELSE '.$f->{right_key}.'
                                          END
                                END
                WHERE
                    '.($table->{multi} ? $f->{tree}.' = '.$old->{$f->{tree}}.' AND ' : '').
                     $f->{right_key}.' > '.$old->{$f->{left_key}}.' AND '.
                     $f->{left_key}.' < '.$new->{$f->{left_key}}.';';
            $dbh->do($query) || return {success => 0, error => $dbh->errstr};
            $new->{$f->{left_key}} = $new->{$f->{left_key}} - $skew_tree;
        } else {
# Перемещение вверх по дереву
            my $skew_edit = $new->{$f->{left_key}} - $old->{$f->{left_key}};
            my $query = 'UPDATE '.$table_name.'
                SET
                    '.$f->{right_key}.' = CASE WHEN '.$f->{left_key}.' >= '.$old->{$f->{left_key}}.'
                                     THEN '.$f->{right_key}.' + '.$skew_edit.'
                                     ELSE CASE WHEN '.$f->{right_key}.' < '.$old->{$f->{left_key}}.'
                                               THEN '.$f->{right_key}.' + '.$skew_tree.'
                                               ELSE '.$f->{right_key}.'
                                          END
                                END,
                    '.$f->{level}.' =   CASE WHEN '.$f->{left_key}.' >= '.$old->{$f->{left_key}}.'
                                     THEN '.$f->{level}.' + '.$skew_level.'
                                     ELSE '.$f->{level}.'
                                END,
                    '.$f->{left_key}.' =  CASE WHEN '.$f->{left_key}.' >= '.$old->{$f->{left_key}}.'
                                     THEN '.$f->{left_key}.' + '.$skew_edit.'
                                     ELSE CASE WHEN '.$f->{left_key}.' >= '.$new->{$f->{left_key}}.'
                                               THEN '.$f->{left_key}.' + '.$skew_tree.'
                                               ELSE '.$f->{left_key}.'
                                          END
                                END
                WHERE
                    '.($table->{multi} ? $f->{tree}.' = '.$old->{$f->{tree}}.' AND ' : '').
                    $f->{right_key}.' >= '.$new->{$f->{left_key}}.' AND '.
                    $f->{left_key}.' < '.$old->{$f->{right_key}}.';';
            $dbh->do($query) || return {success => 0, error => $dbh->errstr};
        }
    }
# Для начала, оставим в $new только те поля которые реально изменились, и которые вообще у нас есть:
    my @sets = ();
    foreach my $key (keys %{$new}) {
        # Такого поля вообще нет
        delete $new->{$key}, next unless exists $old->{$key};
        # Поле с контентом и не менялось
        delete $new->{$key}, next if $old->{$key} && $new->{$key} && $new->{$key} eq $old->{$key};
        # Поле без контента и не менялось
        delete $new->{$key}, next if !$old->{$key} && !$new->{$key};
        # ID менять не будем, но удалим на всякий случай
        delete $new->{$key}, next if $key eq $f->{id};
# то же самое, проверки значения нет
        push @sets, $key . ' = '. (defined $new->{$key} && $new->{$key} =~ /^\d+$/ ? $new->{$key} : '"'.$new->{$key}.'"');
    }
# Обновлем измененные поля
    my $query = 'UPDATE '.$table_name.
                   ' SET '.(join ', ', @sets).
                   ' WHERE '.$f->{id}.' = '.$old->{$f->{id}};
    $dbh->do($query) || return {success => 0, error => $dbh->errstr};
# Опять же запрашиваем строку поcле UPDATE, мало ли какие триггеры что наобновляли
    $sql = 'SELECT * FROM '.$table_name.' WHERE '.$f->{id}.' = '.$old->{$f->{id}}.' LIMIT 1';
    $sth = $dbh->prepare($sql); $sth->execute || return {success => 0, error => $dbh->errstr};
    my $row = $sth->fetchrow_hashref;
    $sth->finish;
    return {success => 1, row => $row};
}
    

Те же приоритеты что и во время вставки. Ну и еще то, что ходящие данные так же не проверяются на валидность, имейте ввиду.

Использование:


Perl код (6)
#-----------------------------------------------------------------------------------------------------------------------
# UPDATE
    
    # Перемещение вниз по дереву
    my $update = MY::NestedSets->update($table_name, {field1 => 'row-u-1-'.$tree, ids => 1, lk => 10, tr => $tree});
        warn Dumper $update;
    # Перемещение вверх по дереву
    $update = MY::NestedSets->update($table_name, {field1 => 'row-u-4-'.$tree, ids => 6, lk => 1, tr => $tree});
        warn Dumper $update;
    # Меняем родителя
    $update = MY::NestedSets->update($table_name, {field1 => 'row-u-8-'.$tree, ids => 2, pi => 5, tr => $tree});
        warn Dumper $update;
    


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


Сразу код, комментарии внутри:


Perl код (7)
sub delete {
# Распределяем входящие данные по местам, ну и соответственно проверяем, всего ли нам хватает
    shift if $_[0] && ($_[0] eq __PACKAGE__ || (ref $_[0] && ref $_[0] eq __PACKAGE__));
    my ($table_name, $id, $flag) = @_;
    return {success => 0, error => 'Bad income data!'} unless $dbh && $table_name && $id;
# Находим, что за таблица и берем её дополнительные атрибуты и синонимы полей
    my $table = $tables->{$table_name} || $tables->{default};
    my $f = $table->{fields};
# Так как мы не ограничены как в триггерах в количестве и объеме передаваемых параметров,
# реализация удаления будет двойная: удаление ветки целиком и удаление одного узла дерева
# по умолчанию, удаляем всю ветку
    $flag = {cascade => 'cascade', one => 'one'}->{$flag || 'cascade'} || 'cascade';
# Выбираем удаляемый узел, причем нам потребуется только 3 поля: tree, left_key и right_key
# Хотя мы можем его передать как параметр, но мало ли что, могли же до этого изменить ключи,
# а дерево от этого рассыплется.
    my $sql = 'SELECT '.
            ($table->{multi} ? $f->{tree}.' AS tree, ' : '').
            $f->{parent_id}.' AS parent_id, '.
            $f->{level}.' AS level, '.
            $f->{left_key}.' AS left_key, '.
            $f->{right_key}.' AS right_key '.
             ' FROM '.$table_name.
             ' WHERE '.$f->{id}.' = '.$id;
    my $sth = $dbh->prepare($sql); $sth->execute || return {success => 0, error => $dbh->errstr};
    my $old = $sth->fetchrow_hashref();
    $sth->finish;
    return {success => 0, error => 'No old unit!'} unless $old;
    if ($flag eq 'cascade') {
# Удаляем ветку
        my $query = 'DELETE FROM '.$table_name.
                   ' WHERE '.
                        ($table->{multi} ? $f->{tree}.' = '.$old->{tree}.' AND ' : '').
                        $f->{left_key}.' >= '.$old->{left_key}.' AND '.
                        $f->{right_key}.' <= '.$old->{right_key};
        $dbh->do($query) || return {success => 0, error => $dbh->errstr};
# Убираем разрыв в ключах:
        my $skew_tree = $old->{right_key} - $old->{left_key} + 1;
        $query = 'UPDATE '.$table_name.
                    ' SET '.$f->{left_key}.' = CASE WHEN '.$f->{left_key}.' > '.$old->{left_key}.'
                                                    THEN '.$f->{left_key}.' - '.$skew_tree.'
                                                    ELSE '.$f->{left_key}.'
                                               END, '.
                            $f->{right_key}.' = '.$f->{right_key}.' - '.$skew_tree.
                    ' WHERE '.
                        ($table->{multi} ? $f->{tree}.' = '.$old->{tree}.' AND ' : '').
                        $f->{right_key}.' > '.$old->{right_key}.';';
# Запрос в читаемом виде:
#   UPDATE $table_name
#       SET left_key = CASE WHEN left_key > OLD.left_key
#                           THEN left_key - $skew_tree
#                           ELSE left_key
#                      END,
#           right_key = right_key - $skew_tree
#       WHERE
#         [ tree = OLD.tree AND ]
#           right_key > OLD.right_key;
        $dbh->do($query) || return {success => 0, error => $dbh->errstr};
    } else {
# Удаляем узел
        my $query = 'DELETE FROM '.$table_name.' WHERE '.$f->{id}.' = '.$id.' LIMIT 1'; # мало ли
        $dbh->do($query) || return {success => 0, error => $dbh->errstr};
# Удаляем разрыв и перестраиваем подчиненную ветку
        $query = 'UPDATE '.$table_name.
                    ' SET '.$f->{left_key}.' = CASE WHEN '.$f->{left_key}.' < '.$old->{left_key}.'
                                                    THEN '.$f->{left_key}.'
                                                    ELSE CASE WHEN '.$f->{right_key}.' < '.$old->{right_key}.'
                                                              THEN '.$f->{left_key}.' - 1 
                                                              ELSE '.$f->{left_key}.' - 2
                                                         END
                                               END,'.
                            $f->{parent_id}.' = CASE WHEN '.$f->{right_key}.' < '.$old->{right_key}.
                                                          ' AND '.$f->{level}.' = '.$old->{level}.' + 1
                                                     THEN '.$old->{parent_id}.'
                                                     ELSE '.$f->{parent_id}.'
                                                END, '.
                            $f->{level}.' = CASE WHEN '.$f->{right_key}.' < '.$old->{right_key}.'
                                                 THEN '.$f->{level}.' - 1
                                                 ELSE '.$f->{level}.'
                                            END, '.
                            $f->{right_key}.' = CASE WHEN '.$f->{right_key}.' < '.$old->{right_key}.'
                                                     THEN '.$f->{right_key}.' - 1 
                                                     ELSE '.$f->{right_key}.' - 2
                                                END
                      WHERE '.
                            ($table->{multi} ? $f->{tree}.' = '.$old->{tree}.' AND ' : '').
                           '('.$f->{right_key}.' > '.$old->{right_key}.' OR
                            ('.$f->{left_key}.' > '.$old->{left_key}.' AND '.$f->{right_key}.' < '.$old->{right_key}.'));';
# Запрос в читаемом виде:
#   UPDATE $table_name
#        SET left_key = CASE WHEN left_key < OLD.left_key
#                            THEN left_key
#                            ELSE CASE WHEN right_key < OLD.right_key
#                                      THEN left_key - 1 
#                                      ELSE left_key - 2
#                                 END
#                       END,
#            parent_id = CASE WHEN right_key < OLD.right_key AND `level` = OLD.level + 1
#                           THEN OLD.parent_id
#                           ELSE parent_id
#                        END,
#            `level` = CASE WHEN right_key < OLD.right_key
#                           THEN `level` - 1 
#                           ELSE `level`
#                      END,
#            right_key = CASE WHEN right_key < OLD.right_key
#                             THEN right_key - 1 
#                             ELSE right_key - 2
#                        END
#        WHERE
#         [ tree = OLD.tree AND ]
#           (right_key > OLD.right_key OR
#           (left_key > OLD.left_key AND right_key < OLD.right_key));
        $dbh->do($query) || return {success => 0, error => $dbh->errstr};
    }
    return {sucess => 1};
}
    

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

Применение:


Perl код (8)
    my $delete = MY::NestedSets->delete($table_name, 2);
    $delete = MY::NestedSets->delete($table_name, 3, 'one');
    $delete = MY::NestedSets->delete($table_name, 4);
    

Собственно и все. Протереть фланелевой тряпочкой, что бы блестело, и в путь.

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