Hierarchical database structures and Firebird PSQL

4

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>