Tree Management Module Nested Sets
Task
Yeah, you have collected a boat that would ride on the ponds and enjoy life. I went to the next lake to rest, and they tell you that they say that dogs and boats are forbidden to enter, and in general we have a lake that is always frozen, so you can enjoy your skates. "Welcome to the Virtual Hosting lake". Somehow I didn’t notice that triggers in MySQL can only be created by the SUPER user, which is somewhat surprising, but we’ll leave it to the developers ’conscience. Triggers , of course, are good, but for now we will put them on the shelf. I have a solution for Perl, but when I created it, there were completely different tasks and requirements. Therefore, this article does not cancel the previous developments, but only offers an additional solution. So what is and what needs to be done. I have a certain set of objects and a certain "wrapper" for working with the database. In this “wrapper” I will include this module as an extension of its functionality. Wrap samopisnaya. I will make a reservation in advance, I am not an opponent of DBIx :: Class and other ready-made solutions, I use them in my work and am satisfied. The question rests on Virtual Hosting and others like it: the absence of mod_perl and the installation of additional modules. The solution for the same DBIx :: Class is in development, but not very fast due to the fact that there is no need, I have enough triggers. Therefore, I need only three procedures: insert , update and delete . It is procedures that in turn are examined as methods of the “wrapper” object. However, in this article, I will make it almost self-sufficient. I didn’t include transactions in this module, since I’m using them to a higher level, it’s easy to include them into the code, I think, it’s not difficult. Bugs and inaccuracies are possible, because the module is fresh and hasn’t been “baptized” , although some functional testing was done.
Basic procedures and variables
Procedures for connecting to the database, of course, but there is an object package $ dbh, which is determined from the outside. Also, to ensure universality, we will create an array in which we will define for each table our own set of fields responsible for the tree structure, you never know who wants to call them.
Perl code (1)
package MY :: NestedSets;
# All for an adult, without compromise ;-)
use strict;
use warnings;
our $ VERSION = '0.0.1';
# Determine the variables that will be used inside the package
our $ dbh = undef;
our $ tables = {
default => {# Table name
fields => {# Table fields
id => 'id', # Actually ID, you never know who will call
left_key => 'left_key', # Left key
right_key => 'right_key', # Right key
level => 'level', # Level
parent_id => 'parent_id', # parent ID
tree => 'tree' # tree id
},
multi => 1, # Tells us that there are several trees in the table
},
};
sub dbh {
# The first value can be the name of the package or the class of the package, if we still manage to create it
# therefore we cut it off now and then, we don’t have a class.
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__));
# Set our fields for a specific table
my ($ table_name, $ params) = @_;
$ tables -> {$ table_name} = $ params;
return $ tables;
}
In parallel, I will write the use script itself, which is also a test one. So, we use our module and define its basic data.
Perl code (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});
...
Insert node
The logic of operation is the same as for the trigger.
Perl code (3)
sub insert {
# We distribute the incoming data in places, and, accordingly, we check if we have enough
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';
# We find that for the table and take its additional attributes and synonyms of the fields
my $ table = $ tables -> {$ table_name} || $ tables -> {default};
my $ f = $ table -> {fields};
my $ result_flags = {is_last_unit => undef};
# Determine the initial data of the keys of the tree
$ new -> {$ f -> {left_key}} || = 0;
$ new -> {$ f -> {right_key}} = undef;
$ new -> {$ f -> {level}} = undef;
$ new -> {$ f -> {parent_id}} || = 0;
# Determine the keys if we have set or changed the parent node
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}};
# That would be clear, this is a request (in square brackets is not a mandatory expression):
# 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;
# Parent node found, means overriding key values
if ($ row) {
$ new -> {$ f -> {tree}} = $ row -> {tree} || undef;
$ new -> {$ f -> {left_key}} = $ row -> {left_key};
$ new -> {$ f -> {level}} = $ row -> {level};
} else {
# Parent node not found, then parent_id is left, reset it
$ new -> {$ f -> {parent_id}} = 0;
$ new -> {$ f -> {level}} = 0;
}
}
# Determine the keys if we have the left key, but the parent node is not specified, or not found
if (! $ new -> {$ f -> {parent_id}} && $ new -> {$ f -> {left_key}}) {
# It is important! $ tree parameter is required if multi-trees
return {success => 0, error => 'No tree value!'} unless $ new -> {$ f -> {tree}} && $ table -> {multi};
# At first I wanted to use SQL :: Abstract, but I didn’t like it, describing complex queries is more difficult and longer
# Find a node by the left or right key
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 ';
# Request is readable:
# 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;
# We found the node by the left key, therefore, we will have a new node in front of the found one
if ($ row && $ row -> {left_key} == $ new -> {$ f -> {left_key}}) {
$ new -> {$ f -> {parent_id}} = $ row -> {parent_id};
$ new -> {$ f -> {level}} = $ row -> {level};
# We found the node by the right key, therefore, we will have a new node under the found
} elsif ($ row) {
$ new -> {$ f -> {parent_id}} = $ row -> {id};
$ new -> {$ f -> {level}} = $ row -> {level} + 1;
} else {
# Again such a crap, indicated completely left data. It would be nice to swear, but for now we ignore these shoals,
# as we can handle ourselves without this data
$ new -> {$ f -> {left_key}} = undef;
}
}
# Actually, we could not get the insertion point, or simply it was not specified.
# We will insert at the end of the tree, so updating the existing nodes is not required, therefore we will make the appropriate flag:
unless ($ new -> {$ f -> {left_key}}) {
$ result_flags -> {is_last_unit} = 1;
# This is important again! $ tree parameter is required if multi-trees.
# In general, it was possible to check this at the very beginning, but this parameter is not necessary if we specified parent_id,
# then the value of the key tree is determined by it.
return {success => 0, error => 'No tree value!'} unless $ new -> {$ f -> {tree}} && $ table -> {multi};
# It's all simple, determine the maximum right key and enjoy
my $ sql = 'SELECT MAX ('. $ f -> {right_key}. ') + 1 AS left_key
FROM '. $ Table_name.
($ table -> {multi}? 'WHERE'. $ f -> {tree}. '='. $ new -> {$ f -> {tree}: '');
# Request is readable:
# 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;
# But the joy may not be complete, since there may be no nodes at all
$ new -> {$ f -> {left_key}} = $ row -> {left_key} || one;
$ new -> {$ f -> {parent_id}} = 0;
$ new -> {$ f -> {level}} = 0;
}
# Well, we have decided on the destination, you can do the key breaking in the tree:
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}};
# Request is readable:
# 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};
}
# Now, actually, why did we come here:
# The right key is calculated
$ new -> {$ f -> {right_key}} = $ new -> {$ f -> {left_key}} + 1;
# Putting keys
$ new -> {$ f -> {tree}} = $ new -> {$ f -> {tree}} if $ table -> {multi};
# It is necessary to display the fields in a certain order
my @fields = keys% {$ new};
# here we quota non numeric and empty lines and push in the order of @fields
# and yes, they still need to be checked before they got here, at least for the presence of double quotes
my @values ​​= map {defined $ new -> {$ _} && $ new -> {$ _} = ~ / ^ \ d + $ /? $ new -> {$ _}: '"'. $ new -> {$ _}. '"'} @fields;
# Actually INSERT
my $ query = 'INSERT INTO'. $ table_name. ' ('. (join', ', @fields).') VALUES ('. (join', ', @values).') ';
$ dbh-> do ($ query) || return {success => 0, error => $ dbh-> errstr};
# And here's what to return - a separate question, we, alas, cannot return the inserted row without a sample,
# since the table may contain default field values, and we did not specify them in INSERT.
# Do the same 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};
}
It turned out a lot of code, yes ... But if you remove the comments, it will be two times less lines ;-), but it is clear, I hope. Essentially: again, the priority is to set the parent. If a parent is specified and the left key is specified, the latter will be ignored in a valid tree. So keep in mind, if you want to create a node in submission to something, and at the same time indicate its place in the list of children, then parent_id is not necessary to transfer. Use:
Perl code (4)
...
my $ tree = 1;
# ------------------------------------------------- -------------------------------------------------- --------------------
# INSERT
# Record without coordinates
my $ insert = MY :: NestedSets-> insert ($ table_name, {field1 => 'row1 -'. $ tree, tr => $ tree});
warn Dumper $ insert;
# Record with parent
$ insert = MY :: NestedSets-> insert ($ table_name, {field1 => 'row2 -'. $ tree, pi => $ insert -> {row} -> {ids}, tr => $ tree});
warn Dumper $ insert;
# Records with 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;
# Incorrect settings
$ 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;
...
')
Node change
In addition to changing the tree structure itself (if necessary), changes to other fields will also be applied, as needed.
Perl code (5)
sub update {
# We distribute the incoming data in places, well, and, accordingly, we check if we have enough
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';
# We find that for the table and take its additional attributes and synonyms of the fields
my $ table = $ tables -> {$ table_name} || $ tables -> {default};
my $ f = $ table -> {fields};
return {success => 0, error => 'Bad income data!'} unless $ new -> {$ f -> {id}};
# Remove fields that can not be changed independently
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};
# Further dilemma. To accept the changes, we need to have the raw data.
# In this case, we don’t know what source data we had, and what fields really changed,
# therefore we do a selection of our variable node
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;
# Calculate new node coordinates
# Determine keys if we have a parent node changed
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}};
# That would be clear, this is a request (in square brackets is not a mandatory expression):
# 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;
# Parent node found, means override key values
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 node not found, then parent_id is left, reset it
$ new -> {$ f -> {parent_id}} = $ old -> {$ f -> {parent_id}};
}
} else {
# Transfer to the top level
# It's all simple, determine the maximum right key and enjoy
my $ sql = 'SELECT MAX ('. $ f -> {right_key}. ') + 1 AS left_key
FROM '. $ Table_name.
($ table -> {multi}? 'WHERE'. $ f -> {tree}. '='. $ old -> {$ f -> {tree}: '');
# Request is readable:
# 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;
}
}
# Determine the keys if we have the left key set but the parent node is not specified, or not found
if ($ tmp_left_key && $ new -> {$ f -> {left_key}} && # left_key was specified
$ new -> {$ f -> {left_key}} == $ tmp_left_key && # parent_id has not changed
$ tmp_left_key! = $ old -> {$ f -> {left_key}}) {# left_key changed
# At first I wanted to use SQL :: Abstract, but I didn’t like it, describing complex queries is more difficult and longer
# Find a node by the left or right key
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 ';
# Request is readable:
# 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;
# We found the node by the left key, therefore, we will have a new node in front of the found one
if ($ row && $ row -> {left_key} == $ new -> {$ f -> {left_key}}) {
$ new -> {$ f -> {parent_id}} = $ row -> {parent_id};
$ new -> {$ f -> {level}} = $ row -> {level};
# We found the node by the right key, therefore, we will have a new node under the found
} elsif ($ row) {
$ new -> {$ f -> {parent_id}} = $ row -> {id};
$ new -> {$ f -> {level}} = $ row -> {level} + 1;
} else {
# Again such a crap, indicated completely left data. Although there is an option that we put the node the very first
# then this is not a mistake. But in other cases, just ignore the movement.
$ new -> {$ f -> {left_key}} = $ new -> {$ f -> {left_key}} && $ new -> {$ f -> {left_key}} == 1? 1: $ old -> {$ f -> {left_key}};
}
}
# Now that we know what our left key is, we can check if we are sending inside
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'};
}
# We figured out the coordinates, the only thing is, We look, and do we even have changes on the tree?
if ($ new -> {$ f -> {left_key}} && $ new -> {$ f -> {left_key}}! = $ old -> {$ f -> {left_key}}) {
# Determine level and tree offsets
my $ skew_level = $ new -> {$ f -> {level}} - $ old -> {$ f -> {level}};
my $ skew_tree = $ old -> {$ f -> {right_key}} - $ old -> {$ f -> {left_key}} + 1;
# Move down the tree
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 {
# Move up the tree
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};
}
}
# To start, leave in $ new only those fields that have really changed, and which we generally have:
my @sets = ();
foreach my $ key (keys% {$ new}) {
# There is no such field
delete $ new -> {$ key}, next exists $ old -> {$ key};
# The content field has not changed
delete $ new -> {$ key}, next if $ old -> {$ key} && $ new -> {$ key} && $ new -> {$ key} eq $ old -> {$ key};
# The field without content and did not change
delete $ new -> {$ key}, next if! $ old -> {$ key} &&! $ new -> {$ key};
# ID will not change, but remove just in case
delete $ new -> {$ key}, next if $ key eq $ f -> {id};
# same, no value check
push @sets, $ key. '='. (defined $ new -> {$ key} && $ new -> {$ key} = ~ / ^ \ d + $ /? $ new -> {$ key}: '"'. $ new -> {$ key}. '"');
}
# Update modified fields
my $ query = 'UPDATE'. $ table_name.
'SET'. (Join ',', @sets).
'WHERE'. $ F -> {id}. ' = '. $ old -> {$ f -> {id}};
$ dbh-> do ($ query) || return {success => 0, error => $ dbh-> errstr};
# Again, we request a string after UPDATE, is it anyway what triggers have been updated?
$ 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};
}
Same priorities as during insertion. Well, also that the walking data is also not checked for validity, keep in mind. Use:
Perl code (6)
# ------------------------------------------------- -------------------------------------------------- --------------------
# UPDATE
# Move down the tree
my $ update = MY :: NestedSets-> update ($ table_name, {field1 => 'row-u-1 -'. $ tree, ids => 1, lk => 10, tr => $ tree});
warn Dumper $ update;
# Move up the tree
$ update = MY :: NestedSets-> update ($ table_name, {field1 => 'row-u-4 -'. $ tree, ids => 6, lk => 1, tr => $ tree});
warn Dumper $ update;
# Change parent
$ update = MY :: NestedSets-> update ($ table_name, {field1 => 'row-u-8 -'. $ tree, ids => 2, pi => 5, tr => $ tree});
warn Dumper $ update;
Deleting a node
Immediately code, comments inside:
Perl code (7)
sub delete {
# We distribute the incoming data in places, and, accordingly, we check if we have enough
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;
# We find that for the table and take its additional attributes and synonyms of the fields
my $ table = $ tables -> {$ table_name} || $ tables -> {default};
my $ f = $ table -> {fields};
# Since we are not limited, as in triggers, in the number and volume of transmitted parameters,
# implementation of deletion will be double: deleting the entire branch and deleting one tree node
# by default, delete the entire branch
$ flag = {cascade => 'cascade', one => 'one'} -> {$ flag || 'cascade'} || 'cascade';
# Select the node to be deleted, and we need only 3 fields: tree, left_key and right_key
# Although we can pass it as a parameter, but you never know, we could have changed the keys before that,
# a tree from this crumble.
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') {
# Remove branch
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};
# Remove the gap in the keys:
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}.'; ';
# Request in readable form:
# 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 {
# Remove the node
my $ query = 'DELETE FROM'. $ table_name. ' WHERE '. $ F -> {id}.' = '. $ id.' LIMIT 1 '; it is not enough
$ dbh-> do ($ query) || return {success => 0, error => $ dbh-> errstr};
# Remove the gap and rebuild the subordinate branch
$ 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}.' - one
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}.' - one
ELSE '. $ F -> {level}.'
END, '.
$ f -> {right_key}. ' = CASE WHEN '. $ F -> {right_key}.' <'. $ old -> {right_key}.'
THEN '. $ F -> {right_key}.' - one
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}.')) ; ';
# Request in readable form:
# 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};
}
To be honest, I have not yet figured out what would be the right way to return as a result, although just a flag of a successful completion, it seems to me more than enough. The use of:
Perl code (8)
my $ delete = MY :: NestedSets-> delete ($ table_name, 2);
$ delete = MY :: NestedSets-> delete ($ table_name, 3, 'one');
$ delete = MY :: NestedSets-> delete ($ table_name, 4);
Actually that's all. Wipe the flannel rag that would shine, and go.
Source: https://habr.com/ru/post/65495/
All Articles