Задача
Да уж, собрал ты катер, что бы кататься по водоемам и наслаждаться жизнью. Поехал на очередное озеро отдохнуть, а тебе говорят, что мол с собаками и катерами вход воспрещен, и вообще у нас озеро вечно замерзшее, вот вам коньки — наслаждайтесь. «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);
Собственно и все. Протереть фланелевой тряпочкой, что бы блестело, и в путь.