The idea of storing a hierarchical data in a relational database is very simple, but effective work with such a data requires some knowledge of server-side programming using procedural SQL (PSQL). So the hierarchical data structures are a good chance to get acquainted with PSQL. For demonstration purposes I created a simple database with single table TCLASS containing Delphi class hierarchy. Here is a SQL script that creates an empty database (I used Firebird version 2.1.4 and Firebird ISQL Tool to execute SQL scripts and single SQL statements):
SET SQL DIALECT 3;
SET NAMES WIN1251;
CREATE DATABASE 'localhost:c:\Projects\Hierarch\Test.FDB' user 'SYSDBA' password 'masterkey'
DEFAULT CHARACTER SET UTF8;
COMMIT;
CREATE TABLE TCLASS (
TCLASS_ID INTEGER NOT NULL,
TCLASS_ANCESTOR_ID INTEGER,
TCLASS_NAME VARCHAR(64) NOT NULL UNIQUE,
CONSTRAINT PK_TCLASS
PRIMARY KEY (TCLASS_ID)
);
COMMIT;
CREATE GENERATOR GEN_TCLASS_ID;
SET TERM ^ ;
CREATE TRIGGER BI_TCLASS FOR TCLASS
ACTIVE BEFORE INSERT POSITION 0
AS
BEGIN
IF (NEW.TCLASS_ID IS NULL) THEN
NEW.TCLASS_ID = GEN_ID(GEN_TCLASS_ID, 1);
END^
CREATE PROCEDURE ADDCLASS(CLASS_NAME VARCHAR(64), ANCESTOR_NAME VARCHAR(64))
RETURNS (CLASS_ID INTEGER)
AS
DECLARE ANCESTOR_ID INTEGER;
BEGIN
CLASS_ID = 0;
IF (ANCESTOR_NAME = '') THEN BEGIN
CLASS_ID = GEN_ID(GEN_TCLASS_ID, 1);
INSERT INTO TCLASS(TCLASS_ID, TCLASS_NAME)
VALUES(:CLASS_ID, :CLASS_NAME);
END
ELSE BEGIN
FOR
SELECT TCLASS_ID
FROM TCLASS
WHERE TCLASS_NAME = :ANCESTOR_NAME
INTO :ANCESTOR_ID
DO BEGIN
CLASS_ID = GEN_ID(GEN_TCLASS_ID, 1);
INSERT INTO TCLASS(TCLASS_ID, TCLASS_ANCESTOR_ID, TCLASS_NAME)
VALUES(:CLASS_ID, :ANCESTOR_ID, :CLASS_NAME);
END
END
END^
CREATE PROCEDURE GETANCESTORS_EX(CURRENT_ID INTEGER, CURRENT_LEVEL INTEGER)
RETURNS (CLASS_ID INTEGER, ANCESTOR_ID INTEGER, CLASS_NAME VARCHAR(64), CLASS_LEVEL INTEGER)
AS
BEGIN
FOR
SELECT TCLASS_ID, TCLASS_ANCESTOR_ID, TCLASS_NAME
FROM TCLASS
WHERE TCLASS_ID = :CURRENT_ID
INTO :CLASS_ID, :ANCESTOR_ID, :CLASS_NAME
DO BEGIN
CLASS_LEVEL = CURRENT_LEVEL - 1;
SUSPEND;
FOR
SELECT CLASS_ID, ANCESTOR_ID, CLASS_NAME, CLASS_LEVEL
FROM GETANCESTORS_EX(:ANCESTOR_ID, :CLASS_LEVEL)
INTO :CLASS_ID, :ANCESTOR_ID, :CLASS_NAME, :CLASS_LEVEL
DO BEGIN
SUSPEND;
END
END
END^
CREATE PROCEDURE GETANCESTORS(ID INTEGER)
RETURNS (CLASS_ID INTEGER, CLASS_NAME VARCHAR(64), CLASS_LEVEL INTEGER)
AS
BEGIN
FOR
SELECT TCLASS_ANCESTOR_ID
FROM TCLASS
WHERE TCLASS_ID = :ID
INTO :CLASS_ID
DO BEGIN
CLASS_LEVEL = 1000;
FOR
SELECT CLASS_ID, CLASS_NAME, CLASS_LEVEL
FROM GETANCESTORS_EX(:CLASS_ID, :CLASS_LEVEL)
INTO :CLASS_ID, :CLASS_NAME, :CLASS_LEVEL
DO BEGIN
SUSPEND;
END
END
END^
SET TERM ; ^
COMMIT;
TCLASS table contains TCLASS_ANCESTOR_ID field that links each record (Delphi class) with its ancestor record, so that TCLASS table can store a class hierarchy of unlimited depth:
CREATE TABLE TCLASS (
TCLASS_ID INTEGER NOT NULL,
TCLASS_ANCESTOR_ID INTEGER,
TCLASS_NAME VARCHAR(64) NOT NULL UNIQUE,
CONSTRAINT PK_TCLASS
PRIMARY KEY (TCLASS_ID)
);
Let us fill TCLASS table with data. To simplify the task I have written ADDCLASS procedure that inserts a single record into TCLASS table. The procedure has two parameters – a class name and ancestor class name. An ancestor class name is used to find an ancestor record ID.
CREATE PROCEDURE ADDCLASS(CLASS_NAME VARCHAR(64), ANCESTOR_NAME VARCHAR(64))
RETURNS (CLASS_ID INTEGER)
AS
DECLARE ANCESTOR_ID INTEGER;
BEGIN
CLASS_ID = 0;
IF (ANCESTOR_NAME = '') THEN BEGIN
CLASS_ID = GEN_ID(GEN_TCLASS_ID, 1);
INSERT INTO TCLASS(TCLASS_ID, TCLASS_NAME)
VALUES(:CLASS_ID, :CLASS_NAME);
END
ELSE BEGIN
FOR
SELECT TCLASS_ID
FROM TCLASS
WHERE TCLASS_NAME = :ANCESTOR_NAME
INTO :ANCESTOR_ID
DO BEGIN
CLASS_ID = GEN_ID(GEN_TCLASS_ID, 1);
INSERT INTO TCLASS(TCLASS_ID, TCLASS_ANCESTOR_ID, TCLASS_NAME)
VALUES(:CLASS_ID, :ANCESTOR_ID, :CLASS_NAME);
END
END
END^
If the second argument (ANCESTOR_NAME) is empty, the procedure assumes that the first argument (CLASS_NAME) is a name of the root of hierarchy (that should be TObject in Delphi); the procedure generates unique ID for a new record (TCLASS_ID field), leaves TCLASS_ANCESTOR_ID field empty (NULL) and executes INSERT SQL statement.
If the second argument is not empty, we have ‘FOR SELECT … DO …’ construction. The procedure executes SELECT statement, and executes a block of code after ‘DO’ keyword for every row in a dataset created by SELECT statement. In our case the dataset contains only one record (it can also be empty if ANCESTOR_NAME argument is wrong – in this case no new record is inserted and the returned value of CLASS_ID is 0).
Note that when a procedure parameters or local variables are used inside SQL statement (SELECT or INSERT) they should be preceded by ‘:’.
Now we can fill TCLASS table with some data using ADDCLASS procedure; here is a simple SQL script:
CONNECT 'localhost:c:\Projects\Hierarch\Test.FDB' user 'SYSDBA' password 'masterkey';
EXECUTE PROCEDURE ADDCLASS('TObject','');
EXECUTE PROCEDURE ADDCLASS('TList','TObject');
EXECUTE PROCEDURE ADDCLASS('TPersistent','TObject');
EXECUTE PROCEDURE ADDCLASS('TCollection','TPersistent');
EXECUTE PROCEDURE ADDCLASS('TStrings','TPersistent');
EXECUTE PROCEDURE ADDCLASS('TStringList','TStrings');
EXECUTE PROCEDURE ADDCLASS('TStream','TObject');
EXECUTE PROCEDURE ADDCLASS('THandleStream','TStream');
EXECUTE PROCEDURE ADDCLASS('TFileStream','THandleStream');
COMMIT;
After executing the script TCLASS table contains the following data:
SQL> SELECT * FROM TCLASS;
TCLASS_ID TCLASS_ANCESTOR_ID TCLASS_NAME
==================================================
1 <null> TObject
2 1 TList
3 1 TPersistent
4 3 TCollection
5 3 TStrings
6 5 TStringList
7 1 TStream
8 7 THandleStream
9 8 TFileStream
SQL>
A more interesting problem is to find all ancestors of a given class. The database contains two procedures that solve the problem. The first is
CREATE PROCEDURE GETANCESTORS_EX(CURRENT_ID INTEGER, CURRENT_LEVEL INTEGER)
RETURNS (CLASS_ID INTEGER, ANCESTOR_ID INTEGER, CLASS_NAME VARCHAR(64), CLASS_LEVEL INTEGER)
AS
BEGIN
FOR
SELECT TCLASS_ID, TCLASS_ANCESTOR_ID, TCLASS_NAME
FROM TCLASS
WHERE TCLASS_ID = :CURRENT_ID
INTO :CLASS_ID, :ANCESTOR_ID, :CLASS_NAME
DO BEGIN
CLASS_LEVEL = CURRENT_LEVEL - 1;
SUSPEND;
FOR
SELECT CLASS_ID, ANCESTOR_ID, CLASS_NAME, CLASS_LEVEL
FROM GETANCESTORS_EX(:ANCESTOR_ID, :CLASS_LEVEL)
INTO :CLASS_ID, :ANCESTOR_ID, :CLASS_NAME, :CLASS_LEVEL
DO BEGIN
SUSPEND;
END
END
END^
The first parameter (CURRENT_ID) is an ID of the direct ancestor of a given class. The second parameter (CURRENT_LEVEL) can be any integer value; it’s only purpose is an option to sort the resulting dataset by ancestors’ level.
The procedure is recursive. It has the same FOR SELECT … DO … logic as ADDCLASS procedure, but it uses SUSPEND statement in the block of code after DO keyword.
The usage of SUSPEND statement means that the procedure is written to be called by SELECT statement, as different from ADDCLASS procedure that is written to be called by EXECUTE PROCEDURE statement. The SUSPEND statement passes a row of data to the outer SELECT statement, forming a resulting dataset. Here is a usage example:
SQL> SELECT * FROM GETANCESTORS_EX(8, 99)
CON> ORDER BY CLASS_LEVEL;
CLASS_ID ANCESTOR_ID CLASS_NAME CLASS_LEVEL
====================================================
1 <null> TObject 96
7 1 TStream 97
8 7 THandleStream 98
SQL>
The first parameter value (8) is an ID of TFileStream direct ancestor (THandleStream), so the above SQL statement creates a dataset of TFileStream ancestors.
The GETANCESTORS procedure does the same work as GETANCESTORS_EX procedure, but is more user-friendly; GETANCESTORS has the only parameter that is a given class ID (not an ancestor ID as with GETANCESTORS_EX procedure).
CREATE PROCEDURE GETANCESTORS(ID INTEGER)
RETURNS (CLASS_ID INTEGER, CLASS_NAME VARCHAR(64), CLASS_LEVEL INTEGER)
AS
BEGIN
FOR
SELECT TCLASS_ANCESTOR_ID
FROM TCLASS
WHERE TCLASS_ID = :ID
INTO :CLASS_ID
DO BEGIN
CLASS_LEVEL = 1000;
FOR
SELECT CLASS_ID, CLASS_NAME, CLASS_LEVEL
FROM GETANCESTORS_EX(:CLASS_ID, :CLASS_LEVEL)
INTO :CLASS_ID, :CLASS_NAME, :CLASS_LEVEL
DO BEGIN
SUSPEND;
END
END
END^
The usage example (9 is an ID of TFileStream):
SQL> SELECT CLASS_ID INTEGER, CLASS_NAME
CON> FROM GETANCESTORS(9)
CON> ORDER BY CLASS_LEVEL;
CLASS_ID CLASS_NAME
==========================
1 TObject
7 TStream
8 THandleStream
SQL>
The Programming Works 