FirebirdSQL logo

Introduction

Firebird a eu la possibilité d’étendre les fonctionnalités du langage PSQL en écrivant des fonctions externes - UDF (User Defined Functions). Les UDF peuvent être compilées dans presque tous les langages compilable.

Firebird 3.0 a introduit une architecture de plugins pour étendre les fonctionnalités de Firebird. L’un de ces plugins est External Engine (moteurs externes). Le mécanisme UDR (User Defined Routines - sous-programme définies par l’utilisateur) ajoute une couche au-dessus de l’interface du moteur de firebird external. Les UDR présentent les avantages suivants par rapport aux UDF :

  • vous pouvez écrire non seulement des fonctions qui renvoient un résultat scalaire, mais aussi des procédures stockées (exécutables et sélectives), ainsi que des déclencheurs ;

  • amélioration du contrôle des paramètres d’entrée et de sortie. Dans un certain nombre de cas (passage par descripteur), les types et autres propriétés des paramètres d’entrée n’étaient pas contrôlés du tout, mais il était possible d’obtenir ces propriétés à l’intérieur de l’UDF. Les UDR fournissent une manière plus uniforme de déclarer les paramètres d’entrée et de sortie, comme c’est le cas avec les fonctions et procédures PSQL normales ;

  • le contexte de la connexion ou de la transaction en cours est disponible dans l’UDR, ce qui vous permet d’effectuer certaines manipulations sur la base de données en cours dans ce contexte ;

  • les procédures et fonctions externes (UDR) peuvent être regroupées dans des paquets PSQL ;

  • Les UDR peuvent être écrits dans n’importe quel langage de programmation (en option compilés dans des codes objets). Pour ce faire, il faut disposer d’un module externe approprié. Par exemple, il existe des plugins pour l’écriture de modules externes en Java ou dans l’un des langages .NET.

Dans ce guide, nous décrirons comment déclarer les UDR, leurs mécanismes internes, leurs capacités, et nous donnerons des exemples d’écriture d’UDR en Pascal.En outre, certains aspects de l’utilisation de la nouvelle API orientée objet seront abordés.

Plus loin dans les différents chapitres de ce manuel, lorsque nous utiliserons les termes procédure externe, fonction ou déclencheur, nous parlerons uniquement d’UDR et non plus d’UDF.

Note

Tous nos exemples fonctionnent avec Delphi 2009 et les versions antérieures, ainsi qu’avec Free Pascal / Code Typhon. Tous les exemples peuvent être compilés à la fois en Delphi et en Free Pascal / Code Typhon, sauf indication contraire.

Firebird API

Pour écrire des procédures externes, des fonctions ou des déclencheurs dans des langages de programmation compilés, il faut connaître la nouvelle API orientée objet de Firebird. Ce manuel ne contient pas de description complète de l’API OO Firebird. Vous pouvez le trouver dans le catalogue de documentation distribué avec Firebird doc/Using_OO_API.html (document en anglais). Pour les utilisateurs russophones, une traduction de ce document est disponible à l’adresse suivante https://github.com/sim1984/fbooapi.

Les fichiers inclus pour divers langages de programmation qui contiennent des API ne sont pas distribués dans le cadre de la distribution de Firebird pour Windows, mais vous pouvez les extraire des fichiers compressés distribués pour Linux (chemin dans l’archive /opt/firebird/include/firebird/Firebird.pas ).

CLOOP

CLOOP - Programmation orientée objet inter-langues. Cet outil n’est pas fourni avec Firebird. Il se trouve dans le code source sur le github de FirebirdSql.Une fois l’outil construit, vous pouvez générer une API pour votre langage de programmation (IdlFbInterfaces.h ou Firebird.pas) basée sur le fichier de description de l’interface include/firebird/FirebirdInterface.idl.

Pour Object Pascal, cela se fait avec la commande suivante :

cloop FirebirdInterface.idl pascal Firebird.pas Firebird --uses SysUtils \
  --interfaceFile Pascal.interface.pas \
  --implementationFile Pascal.implementation.pas \
  --exceptionClass FbException --prefix I \
  --functionsFile fb_get_master_interface.pas

Les fichiers Pascal.interface.pas, Pascal.implementation.pas et fb_get_master_interface.pas se trouvent à l’adresse suivante https://github.com/FirebirdSQL/firebird/tree/master/src/misc/pascal.

Note

Dans ce cas, pour les interfaces API Firebird, le préfixe I sera ajouté, comme il est accepté en Object Pascal.

Constantes

Le fichier Firebird.pas résultant manque des constantes isc_*. Ces constantes pour les langages C/C++ peuvent être trouvées sous https://github.com/FirebirdSQL/firebird/blob/master/src/include/consts_pub.h.Pour obtenir des constantes pour le langage Pascal, nous utilisons le script AWK pour les transformations syntaxiques. Sous Windows, vous devrez installer Gawk pour Windows ou utiliser le sous-système Windows pour Linux (disponible sous Windows 10). Cela se fait avec la commande suivante :

awk -f Pascal.Constants.awk consts_pub.h > const.pas

Le contenu du fichier résultant doit être copié dans la section const vide du fichier Firebird.pas immédiatement après l’implémentation. Le fichier Pascal.Constants.awk peut être trouvé à l’adresse suivante https://github.com/FirebirdSQL/firebird/tree/master/src/misc/pascal.

Gestion du temps de vie

Les interfaces Firebird ne sont pas basées sur la spécification COM, et leur durée de vie est donc gérée différemment.

Il y a deux interfaces dans Firebird qui traitent de la gestion de la durée de vie : IDisposable et IReferenceCounted. Cette dernière est particulièrement active lors de la création d’autres interfaces : IPlugin compte les liens, comme beaucoup d’autres interfaces utilisées par les plugins. Il s’agit notamment des interfaces qui décrivent la connexion à la base de données, la gestion des transactions et les instructions SQL.

Vous n’avez pas toujours besoin de la surcharge supplémentaire d’une interface à comptage de références. Par exemple, IMaster, l’interface principale qui appelle les fonctions disponibles pour le reste de l’API, a une durée de vie illimitée par définition. Pour les autres API, la durée de vie est strictement déterminée par la durée de vie de l’interface parent ; l’interface IStatus n’est pas multithreadée. Pour les interfaces dont la durée de vie est limitée, il est utile d’avoir un moyen facile de les détruire, c’est-à-dire la fonction dispose().

Tip

Si vous ne savez pas comment un objet est détruit, consultez sa hiérarchie s’il possède l’interface IReferenceCounted. Pour les interfaces à comptage de références, à la fin du travail avec l’objet, il est nécessaire de décrémenter le comptage de références en appelant la méthode release().

Example 1. Important

Certaines méthodes d’interfaces dérivées de IReferenceCounted libèrent l’interface après avoir été exécutées avec succès. Il n’est pas nécessaire d’appeler release() après avoir appelé ces méthodes.

Ceci est fait pour des raisons historiques, car des fonctions similaires de l’API ISC ont libéré l’identifiant correspondant.

Voici une liste de ces méthodes :

  • L’interface IAttachment

    • detach(status: IStatus) - déconnecte la connexion à la base de données. En cas de succès, l’interface est libérée.

    • dropDatabase(status: IStatus) - abandonner la base de données. En cas de succès, l’interface est libérée.

  • L’interface ITransaction

    • commit(status: IStatus) - confirmation de la transaction. En cas de succès, l’interface est libérée.

    • rollback(status: IStatus) - retour en arrière de la transaction. En cas de succès, l’interface est libérée.

  • L’interface IStatus

    • free(status: IStatus) - supprime une déclaration préparée. En cas de succès, l’interface est libérée.

  • L’interface IResultSet

    • close(status: IStatus) ferme le curseur. En cas de succès, l’interface est libérée.

  • L’interface IBlob

    • cancel(status: IStatus) - annule toutes les modifications apportées au BLOB temporaire (le cas échéant) et ferme le BLOB. En cas de succès, l’interface est libérée.

    • close(status: IStatus) - enregistre toutes les modifications apportées au BLOB temporaire (le cas échéant) et ferme le BLOB. En cas de succès, l’interface est libérée.

  • L’interface IService

    • detach(status: IStatus) - déconnecte la connexion avec le gestionnaire de services. En cas de succès, l’interface est libérée.

  • L’interface IEvents

    • cancel(status: IStatus) - annule l’abonnement à l’événement. En cas de succès, l’interface est libérée.

Déclarations d’une UDR

Les UDR peuvent être ajoutés ou supprimés de la base de données à l’aide d’une commandes DDL, de la même manière que vous ajoutez ou supprimez des procédures, des fonctions ou des déclencheurs PSQL normaux. Dans ce cas, au lieu du corps du déclencheur, son emplacement dans le module externe est spécifié en utilisant la clause EXTERNAL NAME.

Si l’on considère la syntaxe de cette déclaration, elle sera commune aux procédures externes, aux fonctions et aux déclencheurs.

Syntaxe
EXTERNAL NAME '<extname>' ENGINE <engine>
[AS <extbody>]

<extname> ::= '<module name>!<routine name>[!<misc info>]'

L’argument de cette déclaration EXTERNAL NAME est une chaîne de caractères indiquant l’emplacement de la fonction dans le module externe. Pour les modules externes utilisant le moteur UDR, cette ligne contient le nom du module externe, le nom de la fonction à l’intérieur du module externe et des informations définies par l’utilisateur, séparées par un délimiteur. Un point d’exclamation est utilisé comme séparateur (!).

La déclaration ENGINE spécifie le nom du moteur pour gérer la connexion des modules externes. Dans Firebird, pour travailler avec des modules externes écrits dans des langages compilés (C, C++, Pascal), il faut utiliser le moteur UDR. (Les fonctions externes écrites en Java nécessitent le moteur Java).

Après le mot-clé AS, une chaîne de caractères littérale peut être spécifiée - le "corps" du module externe (procédure, fonction ou déclencheur), elle peut être utilisée par le module externe à diverses fins. Par exemple, une requête SQL peut être spécifiée pour accéder à une base de données externe, ou un texte dans un certain langage pour être interprété par votre fonction.

Fonctions externes

Syntaxe
{CREATE [OR ALTER] | RECREATE} FUNCTION funcname [(<inparam> [, <inparam> ...])]
RETURNS <type> [COLLATE collation] [DETERMINISTIC]
EXTERNAL NAME <extname> ENGINE <engine>
[AS <extbody>]

<inparam> ::= <param_decl> [{= | DEFAULT} <value>]

<value> ::=  {literal | NULL | context_var}

<param_decl> ::= paramname <type> [NOT NULL] [COLLATE collation]

<extname> ::= '<module name>!<routine name>[!<misc info>]'

<type> ::= <datatype> | [TYPE OF] domain | TYPE OF COLUMN rel.col

<datatype> ::=
    {SMALLINT | INT[EGER] | BIGINT}
  | BOOLEAN
  | {FLOAT | DOUBLE PRECISION}
  | {DATE | TIME | TIMESTAMP}
  | {DECIMAL | NUMERIC} [(precision [, scale])]
  | {CHAR | CHARACTER | CHARACTER VARYING | VARCHAR} [(size)]
    [CHARACTER SET charset]
  | {NCHAR | NATIONAL CHARACTER | NATIONAL CHAR} [VARYING] [(size)]
  | BLOB [SUB_TYPE {subtype_num | subtype_name}]
    [SEGMENT SIZE seglen] [CHARACTER SET charset]
  | BLOB [(seglen [, subtype_num])]

Tous les paramètres d’une fonction externe peuvent être modifiés à l’aide de la fonction ALTER statement FUNCTION.

Syntaxe
ALTER FUNCTION funcname [(<inparam> [, <inparam> ...])]
RETURNS <type> [COLLATE collation] [DETERMINISTIC]
EXTERNAL NAME <extname> ENGINE <engine>
[AS <extbody>]

<extname> ::= '<module name>!<routine name>[!<misc info>]'

Vous pouvez supprimer une fonction externe en utilisant l’instruction DROP FUNCTION.

Syntaxe
DROP FUNCTION funcname
Table 1. Quelques paramètres de la fonction externe
Paramètres Description

funcname

Nom de la fonction stockée. Peut contenir jusqu’à 31 octets.

inparam

Description du paramètre d’entrée.

module name

Nom du module externe où réside la fonction.

routine name

Le nom interne de la fonction dans le module externe.

misc info

Informations définies par l’utilisateur à transmettre au module externe de la fonction.

engine

Nom du moteur pour l’utilisation des fonctions externes. Spécifie généralement le nom de l’UDR.

extbody

Corps de la fonction externe. Une chaîne de caractères littérale qui peut être utilisée par l’UDR à diverses fins.

Nous ne décrirons pas ici la syntaxe des paramètres d’entrée et du résultat de sortie. Elle correspond entièrement à la syntaxe des fonctions PSQL ordinaires, qui est décrite en détail dans le manuel du langage SQL. En revanche, nous donnons des exemples de déclaration de fonctions externes avec des explications.

CREATE FUNCTION sum_args (
    n1 INTEGER,
    n2 INTEGER,
    n3 INTEGER
)
RETURNS INTEGER
EXTERNAL NAME 'udrcpp_example!sum_args'
ENGINE UDR;

L’implémentation de la fonction se trouve dans le module udrcpp_example. Dans ce module, la fonction est enregistrée sous le nom sum_args. Le moteur UDR est utilisé pour faire fonctionner la fonction externe.

CREATE OR ALTER FUNCTION regex_replace (
  regex VARCHAR(60),
  str VARCHAR(60),
  replacement VARCHAR(60)
)
RETURNS VARCHAR(60)
EXTERNAL NAME 'org.firebirdsql.fbjava.examples.fbjava_example.FbRegex.replace(
      String, String, String)'
ENGINE java;

L’implémentation de la fonction est située dans la fonction statique replace de la classe org.firebirdsql.fbjava.examples.fbjava_example.FbRegex. Le moteur Java est utilisé pour exécuter la fonction externe.

Procédures externes

Syntaxe
{CREATE [OR ALTER] | RECREATE} PROCEDURE procname [(<inparam> [, <inparam> ...])]
RETURNS (<outparam> [, <outparam> ...])
EXTERNAL NAME <extname> ENGINE <engine>
[AS <extbody>]

<inparam> ::= <param_decl> [{= | DEFAULT} <value>]

<outparam>  ::=  <param_decl>

<value> ::=  {literal | NULL | context_var}

<param_decl> ::= paramname <type> [NOT NULL] [COLLATE collation]

<extname> ::= '<module name>!<routine name>[!<misc info>]'

<type> ::= <datatype> | [TYPE OF] domain | TYPE OF COLUMN rel.col

<datatype> ::=
    {SMALLINT | INT[EGER] | BIGINT}
  | BOOLEAN
  | {FLOAT | DOUBLE PRECISION}
  | {DATE | TIME | TIMESTAMP}
  | {DECIMAL | NUMERIC} [(precision [, scale])]
  | {CHAR | CHARACTER | CHARACTER VARYING | VARCHAR} [(size)]
    [CHARACTER SET charset]
  | {NCHAR | NATIONAL CHARACTER | NATIONAL CHAR} [VARYING] [(size)]
  | BLOB [SUB_TYPE {subtype_num | subtype_name}]
    [SEGMENT SIZE seglen] [CHARACTER SET charset]
  | BLOB [(seglen [, subtype_num])]

Tous les paramètres d’une procédure externe peuvent être modifiés à l’aide de l’instruction ALTER PROCEDURE.

Syntax
ALTER PROCEDURE procname [(<inparam> [, <inparam> ...])]
RETURNS (<outparam> [, <outparam> ...])
EXTERNAL NAME <extname> ENGINE <engine>
[AS <extbody>]

Vous pouvez supprimer une procédure externe en utilisant l’instruction DROP PROCEDURE.

Syntaxe
DROP PROCEDURE procname
Table 2. Quelques paramètres de la procédure externe
Paramètres Description

procname

Nom de la procédure stockée. Peut contenir jusqu’à 31 octets.

inparam

Description du paramètre d’entrée.

outparam

Description of the output parameter.

module name

Le nom du module externe dans lequel se trouve la procédure.

routine name

Nom interne de la procédure dans le module externe.

misc info

Informations définies par l’utilisateur à transmettre à la procédure du module externe.

engine

Nom du moteur pour l’utilisation des procédures externes. Spécifie généralement le nom de l’UDR.

extbody

Le corps de la procédure externe. Une chaîne de caractères littérale qui peut être utilisée par l’UDR à diverses fins.

Nous ne décrirons pas ici la syntaxe des paramètres d’entrée et de sortie. Elle est parfaitement cohérente avec la syntaxe des procédures PSQL ordinaires, qui est décrite en détail dans le manuel du langage SQL. Nous allons plutôt prendre des exemples de déclaration de procédures externes avec des explications.

CREATE PROCEDURE gen_rows_pascal (
    start_n INTEGER not null,
    end_n INTEGER not null
)
RETURNS (
    RESULT INTEGER not null
)
EXTERNAL NAME 'pascaludr!gen_rows'
ENGINE UDR;

L’implémentation de la fonction se trouve dans le module pascaludr. Dans ce module, la procédure est enregistrée sous le nom gen_rows. Le moteur UDR y est utilisé pour exécuter la procédure externe.

CREATE OR ALTER PROCEDURE write_log (
  message VARCHAR(100)
)
EXTERNAL NAME 'pascaludr!write_log'
ENGINE UDR;

L’implémentation de la fonction se trouve dans le module pascaludr. Dans ce module, la procédure est enregistrée sous le nom write_log. Le moteur UDR est utilisé pour exécuter la procédure externe.

CREATE OR ALTER PROCEDURE employee_pgsql (
  -- Firebird 3.0.0 présente un bogue avec les procédures externes sans paramètres
  dummy INTEGER = 1
)
RETURNS (
  id TYPE OF COLUMN employee.id,
  name TYPE OF COLUMN employee.name
)
EXTERNAL NAME 'org.firebirdsql.fbjava.examples.fbjava_example.FbJdbc
    .executeQuery()!jdbc:postgresql:employee|postgres|postgres'
ENGINE java
AS 'select * from employee';

L’implémentation de la fonction se trouve dans la fonction statique executeQuery de la classe org.firebirdsql.fbjava.examples.fbjava_example.FbJdbc. Le point d’exclamation " !" contient des informations sur la connexion à une base de données externe via JDBC. Le moteur Java est utilisé pour exécuter la fonction externe. Ici, dans le "corps" de la procédure externe, une requête SQL est transmise pour récupérer les données.

Note

Cette procédure utilise un stub qui passe un paramètre inutilisé. Ceci est dû au fait que dans Firebird 3.0 il y a un bogue avec le traitement des procédures externes sans paramètres.

Placement de procédures et de fonctions externes à l’intérieur de paquets

Un groupe de procédures et de fonctions apparentées est commodément placé dans des paquets PSQL. Les paquets peuvent contenir des procédures et des fonctions psql externes et conventionnelles.

Syntaxe
{CREATE [OR ALTER] | RECREATE} PACKAGE package_name
AS
BEGIN
  [<package_item> ...]
END

{CREATE | RECREATE} PACKAGE BODY package_name
AS
BEGIN
  [<package_item> ...]
  [<package_body_item> ...]
END

<package_item> ::=
    <function_decl>;
  | <procedure_decl>;

<function_decl> ::=
  FUNCTION func_name [(<in_params>)]
  RETURNS <type> [COLLATE collation]
  [DETERMINISTIC]

<procedure_decl> ::=
  PROCEDURE proc_name [(<in_params>)]
  [RETURNS (<out_params>)]

<package_body_item> ::=
    <function_impl>
  | <procedure_impl>

<function_impl> ::=
  FUNCTION func_name [(<in_impl_params>)]
  RETURNS <type> [COLLATE collation]
  [DETERMINISTIC]
  <routine body>

<procedure_impl> ::=
  PROCEDURE proc_name [(<in_impl_params>)]
  [RETURNS (<out_params>)]
  <routine body>

<routine body> ::= <sql routine body> | <external body reference>

<sql routine body> ::=
  AS
    [<declarations>]
  BEGIN
    [<PSQL_statements>]
  END

<declarations> ::= <declare_item> [<declare_item> ...]

<declare_item> ::=
    <declare_var>;
  | <declare_cursor>;
  | <subroutine declaration>;
  | <subroutine implimentation>

<subroutine declaration> ::= <subfunc_decl> | <subproc_decl>

<subroutine implimentation> ::= <subfunc_impl> | <subproc_impl>

<external body reference> ::=
  EXTERNAL NAME <extname> ENGINE <engine> [AS <extbody>]

<extname> ::= '<module name>!<routine name>[!<misc info>]'

Pour les procédures et fonctions externes, l’en-tête du paquet spécifie le nom, les paramètres d’entrée, leurs types, les valeurs par défaut et les paramètres de sortie. Dans le corps du paquet, tout est identique, à l’exception des valeurs par défaut, ainsi que de l’emplacement dans le module externe (déclaration EXTERNAL NAME), du nom du moteur et éventuellement du "corps" de la procédure/fonction.

Supposons que vous ayez écrit un UDR pour travailler avec des expressions régulières, qui se trouve dans un module externe (bibliothèque dynamique) PCRE, et que vous ayez plusieurs autres UDR qui effectuent d’autres tâches. Si nous n’utilisions pas les paquets PSQL, toutes nos procédures et fonctions externes seraient entremêlées les unes avec les autres et avec les procédures et fonctions PSQL normales. Il est donc difficile de trouver les dépendances et d’apporter des modifications aux modules externes, ce qui crée une certaine confusion et oblige à utiliser au moins des préfixes pour regrouper les procédures et les fonctions.

SET TERM ^;

CREATE OR ALTER PACKAGE REGEXP
AS
BEGIN
  PROCEDURE preg_match(
      APattern VARCHAR(8192), ASubject VARCHAR(8192))
    RETURNS (Matches VARCHAR(8192));

  FUNCTION preg_is_match(
      APattern VARCHAR(8192), ASubject VARCHAR(8192))
    RETURNS BOOLEAN;

  FUNCTION preg_replace(
      APattern VARCHAR(8192),
      AReplacement VARCHAR(8192),
      ASubject VARCHAR(8192))
    RETURNS VARCHAR(8192);

  PROCEDURE preg_split(
      APattern VARCHAR(8192),
      ASubject VARCHAR(8192))
    RETURNS (Lines VARCHAR(8192));

  FUNCTION preg_quote(
      AStr VARCHAR(8192),
      ADelimiter CHAR(10) DEFAULT NULL)
    RETURNS VARCHAR(8192);
END^

RECREATE PACKAGE BODY REGEXP
AS
BEGIN
  PROCEDURE preg_match(
      APattern VARCHAR(8192),
      ASubject VARCHAR(8192))
    RETURNS (Matches VARCHAR(8192))
    EXTERNAL NAME 'PCRE!preg_match' ENGINE UDR;

  FUNCTION preg_is_match(
      APattern VARCHAR(8192),
      ASubject VARCHAR(8192))
    RETURNS BOOLEAN
  AS
  BEGIN
    RETURN EXISTS(
      SELECT * FROM preg_match(:APattern, :ASubject));
  END

  FUNCTION preg_replace(
      APattern VARCHAR(8192),
      AReplacement VARCHAR(8192),
      ASubject VARCHAR(8192))
    RETURNS VARCHAR(8192)
    EXTERNAL NAME 'PCRE!preg_replace' ENGINE UDR;

  PROCEDURE preg_split(
      APattern VARCHAR(8192),
      ASubject VARCHAR(8192))
    RETURNS (Lines VARCHAR(8192))
    EXTERNAL NAME 'PCRE!preg_split' ENGINE UDR;

  FUNCTION preg_quote(
      AStr VARCHAR(8192),
      ADelimiter CHAR(10))
    RETURNS VARCHAR(8192)
    EXTERNAL NAME 'PCRE!preg_quote' ENGINE UDR;
END^

SET TERM ;^

Déclencheurs externes

Syntaxe
{CREATE [OR ALTER] | RECREATE} TRIGGER trigname
{
    <relation_trigger_legacy>
  | <relation_trigger_sql2003>
  | <database_trigger>
  | <ddl_trigger>
}
<external-body>

<external-body> ::=
  EXTERNAL NAME <extname> ENGINE <engine>
  [AS <extbody>]

<relation_trigger_legacy> ::=
  FOR {tablename | viewname}
  [ACTIVE | INACTIVE]
  {BEFORE | AFTER} <mutation_list>
  [POSITION number]

<relation_trigger_sql2003> ::=
  [ACTIVE | INACTIVE]
  {BEFORE | AFTER} <mutation_list>
  [POSITION number]
  ON {tablename | viewname}

<database_trigger> ::=
  [ACTIVE | INACTIVE]
  ON db_event
  [POSITION number]

<ddl_trigger> ::=
  [ACTIVE | INACTIVE]
  {BEFORE | AFTER} <ddl_events>
  [POSITION number]

<mutation_list> ::= <mutation> [OR <mutation> [OR <mutation>]]

<mutation> ::= INSERT | UPDATE | DELETE

<db_event> ::=
    CONNECT
  | DISCONNECT
  | TRANSACTION START
  | TRANSACTION COMMIT
  | TRANSACTION ROLLBACK


<ddl_events> ::=
    ANY DDL STATEMENT
  | <ddl_event_item> [{OR <ddl_event_item>} ...]

<ddl_event_item> ::=
    CREATE TABLE | ALTER TABLE | DROP TABLE
  | CREATE PROCEDURE | ALTER PROCEDURE | DROP PROCEDURE
  | CREATE FUNCTION | ALTER FUNCTION | DROP FUNCTION
  | CREATE TRIGGER | ALTER TRIGGER | DROP TRIGGER
  | CREATE EXCEPTION | ALTER EXCEPTION | DROP EXCEPTION
  | CREATE VIEW | ALTER VIEW | DROP VIEW
  | CREATE DOMAIN | ALTER DOMAIN | DROP DOMAIN
  | CREATE ROLE | ALTER ROLE | DROP ROLE
  | CREATE SEQUENCE | ALTER SEQUENCE | DROP SEQUENCE
  | CREATE USER | ALTER USER | DROP USER
  | CREATE INDEX | ALTER INDEX | DROP INDEX
  | CREATE COLLATION | DROP COLLATION
  | ALTER CHARACTER SET
  | CREATE PACKAGE | ALTER PACKAGE | DROP PACKAGE
  | CREATE PACKAGE BODY | DROP PACKAGE BODY
  | CREATE MAPPING | ALTER MAPPING | DROP MAPPING

Un déclencheur externe peut être modifié avec l’instruction ALTER TRIGGER.

Syntaxe
ALTER TRIGGER trigname {
[ACTIVE | INACTIVE]
[
    {BEFORE | AFTER} {<mutation_list> | <ddl_events>}
  | ON db_event
]
[POSITION number]
[<external-body>]

<external-body> ::=
  EXTERNAL NAME <extname> ENGINE <engine>
  [AS <extbody>]

<extname> ::= '<module name>!<routine name>[!<misc info>]'

<mutation_list> ::= <mutation> [OR <mutation> [OR <mutation>]]

<mutation> ::= { INSERT | UPDATE | DELETE }

Vous pouvez supprimer un déclencheur externe en utilisant l’instruction DROP TRIGGER.

Syntaxe
DROP TRIGGER trigname
Table 3. Quelques paramètres de déclencheur externe
Paramètres Description

trigname

Nom du déclencheur. Peut contenir jusqu’à 31 octets.

relation_trigger_legacy

Déclaration de déclencheur de table (héritée).

relation_trigger_sql2003

Déclaration de déclencheur de table selon la norme SQL-2003.

database_trigger

Déclaration d’un trigger de base de données.

ddl_trigger

Déclaration de déclencheur DDL.

tablename

Nom de la table.

viewname

Le nom de la vue.

mutation_list

Liste des événements de la table.

mutation

Un des événements de la table.

db_event

Événement de connexion ou de transaction.

ddl_events

Liste des événements de modification des métadonnées.

ddl_event_item

L’un des événements de modification des métadonnées.

number

Ordre dans lequel le déclencheur se déclenche. De 0 à 32767.

extbody

Corps du déclencheur externe. Une chaîne littérale qui peut être utilisée par l’UDR à diverses fins.

module name

Nom du module externe où se trouve le déclencheur.

routine name

Nom interne du déclencheur dans le module externe.

misc info

Informations définies par l’utilisateur à transmettre au module externe de déclenchement.

engine

Nom du moteur pour utiliser les déclencheurs externes. Il s’agit généralement du nom de l’UDR.

Voici des exemples de déclaration de déclencheurs externes accompagnés d’explications.

CREATE DATABASE 'c:\temp\slave.fdb';

CREATE TABLE persons (
    id INTEGER NOT NULL,
    name VARCHAR(60) NOT NULL,
    address VARCHAR(60),
    info BLOB SUB_TYPE TEXT
);

COMMIT;

CREATE DATABASE 'c:\temp\master.fdb';

CREATE TABLE persons (
    id INTEGER NOT NULL,
    name VARCHAR(60) NOT NULL,
    address VARCHAR(60),
    info BLOB SUB_TYPE TEXT
);

CREATE TABLE replicate_config (
    name VARCHAR(31) NOT NULL,
    data_source VARCHAR(255) NOT NULL
);

INSERT INTO replicate_config (name, data_source)
   VALUES ('ds1', 'c:\temp\slave.fdb');

CREATE TRIGGER persons_replicate
AFTER INSERT ON persons
EXTERNAL NAME 'udrcpp_example!replicate!ds1'
ENGINE UDR;

L’implémentation du trigger se trouve dans le module udrcpp_example. Dans ce module, le déclencheur est enregistré sous le nom replicate. Le moteur UDR est utilisé pour faire fonctionner le déclencheur externe.

Le lien vers le module externe utilise un paramètre supplémentaire ds1, selon lequel, dans le déclencheur externe, la configuration pour la connexion à la base de données externe est lue à partir de la table replicate_config.

Structure de l’UDR

Nous allons décrire la structure de l’UDR en Pascal. Pour expliquer la structure minimale de construction d’un UDR, nous utiliserons les exemples standards de examples/udr/ traduits en Pascal.

Créez un nouveau projet de bibliothèque dynamique, que nous appellerons MyUdr. Le résultat devrait être un fichier MyUdr.dpr (si vous avez créé le projet en Delphi) ou un fichier MyUdr.lpr (si vous avez créé le projet en Lazarus). Modifions maintenant le fichier principal du projet pour qu’il ressemble à ceci :

library MyUdr;

{$IFDEF FPC}
  {$MODE DELPHI}{$H+}
{$ENDIF}

uses
{$IFDEF unix}
    cthreads,
    // le gestionnaire de mémoire c est, sur certains systèmes, beaucoup plus rapide pour le multithreading
    cmem,
{$ENDIF}
  UdrInit in 'UdrInit.pas',
  SumArgsFunc in 'SumArgsFunc.pas';

exports firebird_udr_plugin;

end.

Dans ce cas, seule une fonction firebird_udr_plugin doit être exportée, qui est le point d’entrée du plugin UDR. L’implémentation de cette fonction se fera dans le module UdrInit.

Note

Si vous développez votre UDR en Free Pascal, vous aurez besoin de directives supplémentaires. La directive {$mode objfpc} est nécessaire pour activer le mode Object Pascal.A la place, vous pouvez utiliser la directive {$mode delphi} pour assurer la compatibilité avec Delphi. Comme mes exemples peuvent être compilés aussi bien en FPC qu’en Delphi, j’ai choisi {$mode delphi}.

La directive {$H+} permet de supporter les longues chaînes de caractères. Ceci est nécessaire si vous utilisez les types string, ansistring, et pas seulement les chaînes à terminaison nulle PChar, PAnsiChar, PWideChar.

En outre, nous devrons inclure des modules distincts pour prendre en charge le multithreading sous Linux et d’autres systèmes d’exploitation de type Unix.

Enregistrement des fonctions

Ajoutons maintenant le module UdrInit, il devrait ressembler à ceci :

unit UdrInit;

{$IFDEF FPC}
  {$MODE DELPHI}{$H+}
{$ENDIF}

interface

uses
  Firebird;

// point d'entrée pour le moteur externe du module UDR
function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
  AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;

implementation

uses
  SumArgsFunc;

var
  myUnloadFlag: Boolean;
  theirUnloadFlag: BooleanPtr;

function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
  AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
  // inscrire notre fonction
  AUdrPlugin.registerFunction(AStatus, 'sum_args',
    TSumArgsFunctionFactory.Create());
  // enregistrer notre procédure
  //AUdrPlugin.registerProcedure(AStatus, 'sum_args_proc',
  //  TSumArgsProcedureFactory.Create());
  //AUdrPlugin.registerProcedure(AStatus, 'gen_rows', TGenRowsFactory.Create());
  // enregistrement de notre déclencheur
  //AUdrPlugin.registerTrigger(AStatus, 'test_trigger',
  //  TMyTriggerFactory.Create());

  theirUnloadFlag := AUnloadFlagLocal;
  Result := @myUnloadFlag;
end;

initialization

myUnloadFlag := false;

finalization

if ((theirUnloadFlag <> nil) and not myUnloadFlag) then
  theirUnloadFlag^ := true;

end.

Dans la fonction firebird_udr_plugin, nous devons enregistrer les classes de nos procédures, fonctions et triggers externes. Pour chaque fonction, procédure ou déclencheur, vous devez écrire votre propre classe. Ceci est fait en utilisant les méthodes de l’interface IUdrPlugin :

  • registerFunction - enregistre une fonction externe ;

  • registerProcedure - enregistre une procédure externe ;

  • registerTrigger - enregistre un déclencheur externe.

Le premier argument de ces fonctions est un pointeur sur un vecteur d’état, suivi du nom interne de la fonction (procédure ou déclencheur). Le nom interne sera utilisé lors de la création d’une procédure/fonction/trigger en SQL. Le troisième argument est une instance d’un constructeur pour la création d’une fonction (procédure ou déclencheur).

Fonction : classe

Maintenant, nous devons écrire la classe et la fonction elle-même. Elles seront situées dans le module SumArgsFunc. Des exemples d’écriture de procédures et de triggers seront présentés plus tard.

unit SumArgsFunc;

{$IFDEF FPC}
{$MODE DELPHI}{$H+}
{$ENDIF}

interface

uses
  Firebird;

{ *********************************************************
    create function sum_args (
      n1 integer,
      n2 integer,
      n3 integer
    ) returns integer
    external name 'myudr!sum_args'
    engine udr;
 ********************************************************* }

type
  // la structure à laquelle le message d'entrée sera associé
  TSumArgsInMsg = record
    n1: Integer;
    n1Null: WordBool;
    n2: Integer;
    n2Null: WordBool;
    n3: Integer;
    n3Null: WordBool;
  end;
  PSumArgsInMsg = ^TSumArgsInMsg;

  // la structure à laquelle le message de sortie sera associé
  TSumArgsOutMsg = record
    result: Integer;
    resultNull: WordBool;
  end;
  PSumArgsOutMsg = ^TSumArgsOutMsg;

  // Classe pour l'instanciation de la fonction externe TSumArgsFunction
  TSumArgsFunctionFactory = class(IUdrFunctionFactoryImpl)
    // Appelé lorsque la classe est détruite
    procedure dispose(); override;

    { Exécuté chaque fois qu'une fonction externe est chargée dans le cache de métadonnées.
       Permet de modifier le format des messages d'entrée et de sortie.

      @param(AStatus vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AMetadata Métadonnées de la fonction externe)
      @param(AInBuilder Constructeur de messages pour les métadonnées d'entrée)
      @param(AOutBuilder Constructeur de messages pour les métadonnées de sortie)
    }
    procedure setup(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder;
      AOutBuilder: IMetadataBuilder); override;

    { Création d'une nouvelle instance de fonction externe TSumArgsFunction

      @param(AStatus vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AMetadata Métadonnées de la fonction externe)
      @returns(Instance de la fonction externe)
    }
    function newItem(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata): IExternalFunction; override;
  end;

  // Fonction externe TSumArgsFunction.
  TSumArgsFunction = class(IExternalFunctionImpl)
    // Appelé lorsque l'instance de la fonction est détruite
    procedure dispose(); override;

    { Cette méthode est appelée juste avant l'exécution et indique au noyau le jeu de caractères
      requis pour échanger des données en interne avec cette méthode. Lors de cet appel, le contexte
      utilise le jeu de caractères obtenu par ExternalEngine::getCharSet.

      @param(AStatus Vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AName Nom du jeu de caractères)
      @param(ANameSize Longueur du nom du jeu de caractères)
    }
    procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
      AName: PAnsiChar; ANameSize: Cardinal); override;

    { Exécution d'une fonction externe

      @param(AStatus Vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AInMsg Pointeur vers le message d'entrée)
      @param(AOutMsg Pointeur vers le message de sortie)
    }
    procedure execute(AStatus: IStatus; AContext: IExternalContext;
      AInMsg: Pointer; AOutMsg: Pointer); override;
  end;

implementation

{ TSumArgsFunctionFactory }

procedure TSumArgsFunctionFactory.dispose;
begin
  Destroy;
end;

function TSumArgsFunctionFactory.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalFunction;
begin
  Result := TSumArgsFunction.Create();
end;

procedure TSumArgsFunctionFactory.setup(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata;
  AInBuilder, AOutBuilder: IMetadataBuilder);
begin

end;

{ TSumArgsFunction }

procedure TSumArgsFunction.dispose;
begin
  Destroy;
end;

procedure TSumArgsFunction.execute(AStatus: IStatus; AContext: IExternalContext;
  AInMsg, AOutMsg: Pointer);
var
  xInput: PSumArgsInMsg;
  xOutput: PSumArgsOutMsg;
begin
  // convertir les pointeurs d'entrée et de sortie en pointeurs typés
  xInput := PSumArgsInMsg(AInMsg);
  xOutput := PSumArgsOutMsg(AOutMsg);
  // par défaut, l'argument de sortie est NULL, il faut donc lui donner la valeur nullFlag
  xOutput^.resultNull := True;
  // si l'un des arguments est NULL, le résultat est NULL
  // sinon, nous calculons la somme des arguments
  with xInput^ do
  begin
    if not (n1Null or n2Null or n3Null) then
    begin
      xOutput^.result := n1 + n2 + n3;
      // s'il y a un résultat, réinitialiser le drapeau NULL
      xOutput^.resultNull := False;
    end;
  end;
end;

procedure TSumArgsFunction.getCharSet(AStatus: IStatus;
  AContext: IExternalContext; AName: PAnsiChar; ANameSize: Cardinal);
begin
end;

end.

La classe de fonctions externe doit implémenter l’interface IUdrFunctionFactory. Pour simplifier, nous héritons simplement de la classe IUdrFunctionFactoryImpl. Chaque fonction externe a besoin de sa propre classe.Cependant, si les interfaces n’ont pas de spécificités pour créer une certaine fonction, alors vous pouvez écrire une interface générique en utilisant les generics. Nous donnerons plus loin un exemple de cette méthode.

La méthode dispose est appelée lors de la destruction de la classe, au cours de laquelle nous devons libérer les ressources précédemment allouées. Dans ce cas, nous appelons simplement le destructeur.

La méthode de configuration est exécutée chaque fois qu’une fonction externe est chargée dans le cache de métadonnées. Elle permet d’effectuer diverses actions nécessaires avant de créer une instance d’une fonction, par exemple modifier le format des messages d’entrée et de sortie. Nous y reviendrons plus en détail ultérieurement.

La méthode newItem est appelée pour instancier la fonction externe. Cette méthode reçoit un pointeur sur le vecteur d’état, le contexte de la fonction externe et les métadonnées de la fonction externe. Avec IRoutineMetadata, vous pouvez obtenir le format du message d’entrée et de sortie, le corps de la fonction externe et d’autres métadonnées. Dans cette méthode, vous pouvez créer différentes instances d’une fonction externe en fonction de sa déclaration dans PSQL. Les métadonnées peuvent être transmises à l’instance de fonction externe créée si nécessaire. Dans notre cas, nous créons simplement une instance de la fonction externe TSumArgsFunction.

Instance de la fonction

Une fonction externe doit implémenter l’interface IExternalFunction. Pour simplifier, nous héritons simplement de la classe IExternalFunctionImpl.

La méthode dispose est appelée lorsque l’instance de la fonction est détruite, ce qui nous oblige à libérer les ressources précédemment allouées. Dans ce cas, nous appelons simplement le destructeur.

La méthode getCharSet est utilisée pour indiquer au contexte de la fonction externe le jeu de caractères que nous voulons utiliser lorsque nous travaillons avec la connexion du contexte courant. Par défaut, la connexion du contexte courant fonctionne dans l’encodage de la connexion courante, ce qui n’est pas toujours pratique.

La méthode execute gère l’appel de fonction par elle-même. Elle reçoit un pointeur sur le vecteur d’état, un pointeur sur le contexte de la fonction externe, des pointeurs sur les messages d’entrée et de sortie.

Nous pouvons avoir besoin du contexte d’une fonction externe pour obtenir le contexte de la connexion ou de la transaction en cours. Même si vous n’utilisez pas de requêtes de base de données dans la connexion actuelle, vous pouvez toujours avoir besoin de ces contextes, en particulier lorsque vous travaillez avec le type BLOB. Des exemples de travail avec le type BLOB, ainsi que l’utilisation des contextes de connexion et de transaction, seront présentés plus loin.

Les messages d’entrée et de sortie ont une largeur fixe, qui dépend des types de données déclarés pour les variables d’entrée et de sortie, respectivement. Cela permet d’utiliser des pointeurs typés vers des structures de largeur fixe dont les membres doivent correspondre aux types de données. L’exemple montre que pour chaque variable de la structure, un membre du type correspondant est indiqué, après quoi il y a un membre qui est un signe d’une valeur NULL spéciale (ci-après dénommé "Null flag"). En plus de travailler avec des tampons de messages d’entrée et de sortie à travers des structures, il existe une autre façon d’utiliser l’arithmétique d’adressage sur des pointeurs en utilisant des offsets, dont les valeurs peuvent être obtenues à partir de l’interface IMessageMetadata. Nous reviendrons plus tard sur le travail avec les messages, mais pour l’instant nous nous contenterons d’expliquer ce qui a été fait dans la méthode execute.

Tout d’abord, nous convertissons les pointeurs non typés en pointeurs typés. Pour la valeur de sortie, nous mettons le drapeau Null à True (ceci est nécessaire pour que la fonction retourne NULL si l’un des arguments d’entrée est NULL). Ensuite, nous vérifions les drapeaux Null de tous les arguments d’entrée, si aucun des arguments d’entrée n’est égal à NULL, alors la valeur de sortie sera égale à la somme des valeurs des arguments. Il est important de se rappeler de réinitialiser le drapeau Null de l’argument de sortie à false.

Inscription des procédures

Il est temps d’ajouter une procédure stockée à notre module UDR. Comme vous le savez, il existe deux types de procédures stockées : les procédures stockées exécutables et les procédures stockées pour récupérer des données. Tout d’abord, ajoutons une procédure stockée exécutable, c’est-à-dire une procédure stockée qui peut être appelée avec l’instruction EXECUTE PROCEDURE et qui peut retourner au plus un enregistrement.

Retournez au module UdrInit et changez la fonction firebird_udr_plugin pour qu’elle ressemble à ceci.

function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
  AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
  // inscrire notre fonction
  AUdrPlugin.registerFunction(AStatus, 'sum_args',
    TSumArgsFunctionFactory.Create());
  // inscrire notre procédure
  AUdrPlugin.registerProcedure(AStatus, 'sum_args_proc',
    TSumArgsProcedureFactory.Create());
  //AUdrPlugin.registerProcedure(AStatus, 'gen_rows', TGenRowsFactory.Create());
  // inscrire notre déclencheur
  //AUdrPlugin.registerTrigger(AStatus, 'test_trigger',
  // TMyTriggerFactory.Create());

  theirUnloadFlag := AUnloadFlagLocal;
  Result := @myUnloadFlag;
end;
Note

N’oubliez pas d’ajouter le module uses SumArgsProc à la liste où se trouve notre procédure.

Classes de procédures

La classe de la procédure externe doit implémenter l’interface IUdrProcedureFactory. Pour simplifier, nous héritons simplement de la classe IUdrProcedureFactoryImpl. Chaque procédure externe a besoin de sa propre classe. Cependant, si les classes n’ont pas de spécificités pour créer certaines procédures, vous pouvez écrire une classe générique en utilisant les génériques.Nous donnerons plus loin un exemple de cette méthode.

La méthode dispose est appelée lorsque la classe est détruite, nous devons y libérer les ressources précédemment allouées. Dans ce cas, nous appelons simplement le Destructor.

La méthode setup est exécutée à chaque fois que l’on charge la procédure externe dans les métadonnées du cache. Elle permet d’effectuer diverses actions nécessaires avant de créer une copie de la procédure, par exemple, un changement de format pour les messages d’entrée et de sortie. Nous en parlerons plus en détail ultérieurement.

La méthode Newitem est utilisée pour créer une copie de la procédure externe. IN Cette méthode est transmise à l’indicateur de l’état du vecteur, du contexte de la procédure externe et des métadonnées de la procédure externe.En utilisant IRoutineMetadata vous pouvez obtenir le format d’entrée et de sortie, le corps des fonctions externes et d’autres métadonnées. Cette méthode permet de créer plusieurs copies de la fonction externe en fonction de sa déclaration dans PSQL.Les métadonnées peuvent être transférées à la copie créée de la procédure externe si nécessaire. Dans notre cas, nous créons simplement une copie des procédures externes TSumArgsProcedure.

La classe de la procédure, ainsi que la procédure même du module SumArgsProc:

unit SumArgsProc;

{$IFDEF FPC}
{$MODE DELPHI}{$H+}
{$ENDIF}

interface

uses
  Firebird;

  { **********************************************************

    create procedure sp_sum_args (
      n1 integer,
      n2 integer,
      n3 integer
    ) returns (result integer)
    external name 'myudr!sum_args_proc'
    engine udr;

    ********************************************************* }
type
  // La structure dans laquelle le message d'entrée sera affiché
  TSumArgsInMsg = record
    n1: Integer;
    n1Null: WordBool;
    n2: Integer;
    n2Null: WordBool;
    n3: Integer;
    n3Null: WordBool;
  end;
  PSumArgsInMsg = ^TSumArgsInMsg;

  // La structure pour laquelle la sortie sera affichée
  TSumArgsOutMsg = record
    result: Integer;
    resultNull: WordBool;
  end;
  PSumArgsOutMsg = ^TSumArgsOutMsg;

  // Classe pour créer une copie de la procédure externe TSUMARGSPROCEDURE
  TSumArgsProcedureFactory = class(IUdrProcedureFactoryImpl)
    // Appelé lors de la destruction de la classe
    procedure dispose(); override;

    {Elle est effectuée à chaque fois lors du chargement de la procédure externe dans le cache des métadonnées.
       Permet de modifier le format d'entrée et de sortie.

      @param(AStatus vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AMetadata Métadonnées de la fonction externe)
      @param(AInBuilder Constructeur de messages pour les métadonnées d'entrée)
      @param(AOutBuilder Constructeur de messages pour les métadonnées de sortie)
    }
    procedure setup(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder;
      AOutBuilder: IMetadataBuilder); override;

    { Creating a new copy of the external procedure TSumArgsProcedure

      @param(AStatus vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AMetadata Métadonnées de la fonction externe)
      @returns(Instance de la fonction externe)
    }
    function newItem(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata): IExternalProcedure; override;
  end;

  TSumArgsProcedure = class(IExternalProcedureImpl)
  public
    // Appelé lors de la destruction d'une copie de la procédure
    procedure dispose(); override;

    { Cette méthode est appelée juste avant l'exécution et indique au noyau le jeu de caractères requis pour échanger
      des données en interne avec cette méthode. Lors de cet appel, le contexte utilise le jeu de caractères obtenu
      par ExternalEngine::getCharSet.

      @param(AStatus Vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AName Nom du jeu de caractères)
      @param(ANameSize Longueur du nom du jeu de caractères)
    }
    procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
      AName: PAnsiChar; ANameSize: Cardinal); override;

    { Procédure externe

      @param(AStatus Vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AInMsg Pointeur du message (`IMessageMetadata`) d'entrée)
      @param(AOutMsg Pointeur du message (`IMessageMetadata`) de sortie)
      @returns(Ensemble de données pour une procédure sélective ou Nil pour les procédures)
    }
    function open(AStatus: IStatus; AContext: IExternalContext; AInMsg: Pointer;
      AOutMsg: Pointer): IExternalResultSet; override;
  end;

implementation

{ TSumArgsProcedureFactory }

procedure TSumArgsProcedureFactory.dispose;
begin
  Destroy;
end;

function TSumArgsProcedureFactory.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalProcedure;
begin
  Result := TSumArgsProcedure.create;
end;

procedure TSumArgsProcedureFactory.setup(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata; AInBuilder,
  AOutBuilder: IMetadataBuilder);
begin

end;

{ TSumArgsProcedure }

procedure TSumArgsProcedure.dispose;
begin
  Destroy;
end;

procedure TSumArgsProcedure.getCharSet(AStatus: IStatus;
  AContext: IExternalContext; AName: PAnsiChar; ANameSize: Cardinal);
begin

end;

function TSumArgsProcedure.open(AStatus: IStatus; AContext: IExternalContext;
  AInMsg, AOutMsg: Pointer): IExternalResultSet;
var
  xInput: PSumArgsInMsg;
  xOutput: PSumArgsOutMsg;
begin
  // Il n'est pas nécessaire de renvoyer de données pour que les procédures soient exécutées
  Result := nil;
  // convertir les pointeurs d'entrée et de sortie en pointeurs typés
  xInput := PSumArgsInMsg(AInMsg);
  xOutput := PSumArgsOutMsg(AOutMsg);
  // Par défaut, l'argument de sortie = NULL, et nous lui exposons donc le drapeau nullflag
  xOutput^.resultNull := True;
  // Si l'un des arguments est NULL, le résultat sera NULL.
  // Dans le cas contraire, nous considérons le nombre d'arguments
  with xInput^ do
  begin
    if not (n1Null or n2Null or n3Null) then
    begin
      xOutput^.result := n1 + n2 + n3;
      // puisqu'il y a un résultat, laisser tomber le drapeau NULL
      xOutput^.resultNull := False;
    end;
  end;
end;

end.

Instance de procédure

Une procédure externe doit implémenter l’interface IExternalProcedure. Pour simplifier, nous héritons simplement de la classe IExternalProcedureImpl.

La méthode dispose est appelée lorsque l’instance de la procédure est détruite, ce qui nous oblige à libérer les ressources précédemment allouées. Dans ce cas, nous appelons simplement le destructeur.

La méthode getCharSet est utilisée pour indiquer au contexte de la procédure externe le jeu de caractères que nous voulons utiliser lorsque nous travaillons avec la connexion du contexte courant. Par défaut, la connexion du contexte courant travaille dans l’encodage de la connexion courante, ce qui n’est pas toujours pratique.

La méthode open gère directement l’appel de procédure lui-même. Cette méthode reçoit un pointeur sur le vecteur d’état, un pointeur sur le contexte de la procédure externe, des pointeurs sur les messages d’entrée et de sortie. Si vous avez une procédure exécutable, alors la méthode doit retourner nil, sinon elle doit retourner une instance de l’ensemble des valeurs de sortie pour la procédure.Dans ce cas, nous n’avons pas besoin d’instancier l’ensemble de données. Nous transférons simplement la logique de la méthode TSumArgsFunction.execute.

Enregistrement d’une procédure sélective

Ajoutons maintenant une procédure sélective simple à notre module UDR. Pour ce faire, nous allons modifier la fonction d’enregistrement firebird_udr_plugin.

function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
  AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
  // Nous enregistrons la fonction
  AUdrPlugin.registerFunction(AStatus, 'sum_args',
    TSumArgsFunctionFactory.Create());
  // Nous enregistrons notre procédure
  AUdrPlugin.registerProcedure(AStatus, 'sum_args_proc',
    TSumArgsProcedureFactory.Create());
  AUdrPlugin.registerProcedure(AStatus, 'gen_rows', TGenRowsFactory.Create());
  // Nous enregistrons notre déclencheur
  //AUdrPlugin.registerTrigger(AStatus, 'test_trigger',
  //  TMyTriggerFactory.Create());

  theirUnloadFlag := AUnloadFlagLocal;
  Result := @myUnloadFlag;
end;
Note

N’oubliez pas d’ajouter le module GenRowsProc à la liste uses, qui contiendra notre procédure.

La classe de procédure est complètement identique à celle d’une procédure stockée exécutable. Les méthodes d’instance de procédure sont également identiques, à l’exception de la méthode open, que nous allons analyser un peu plus en détail.

unit GenRowsProc;

{$IFDEF FPC}
{$MODE DELPHI}{$H+}
{$ENDIF}

interface

uses
  Firebird, SysUtils;

type
  { **********************************************************

    create procedure gen_rows (
      start  integer,
      finish integer
    ) returns (n integer)
    external name 'myudr!gen_rows'
    engine udr;

    ********************************************************* }

  TInput = record
    start: Integer;
    startNull: WordBool;
    finish: Integer;
    finishNull: WordBool;
  end;
  PInput = ^TInput;

  TOutput = record
    n: Integer;
    nNull: WordBool;
  end;
  POutput = ^TOutput;

  // Classe pour la création d'une instance de la procédure externe TGenRowsProcedure
   TGenRowsFactory = class(IUdrProcedureFactoryImpl)
     // Appelé lors de la destruction de la classe
     procedure dispose(); override;

     { Exécuté chaque fois qu'une fonction externe est chargée dans le cache de métadonnées.
       Permet de modifier le format des messages d'entrée et de sortie.

      @param(AStatus vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AMetadata Métadonnées de la fonction externe)
      @param(AInBuilder Constructeur de messages pour les métadonnées d'entrée)
      @param(AOutBuilder Constructeur de messages pour les métadonnées de sortie)
     }
     procedure setup(AStatus: IStatus; AContext: IExternalContext;
       AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder;
       AOutBuilder: IMetadataBuilder); override;

     { Créer une nouvelle instance de la procédure externe TGenRowsProcedure

      @param(AStatus vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AMetadata Métadonnées de la fonction externe)
      @returns(Instance de la fonction externe)
     }
     function newItem(AStatus: IStatus; AContext: IExternalContext;
       AMetadata: IRoutineMetadata): IExternalProcedure; override;
   end;

   // Procédure externe TGenRowsProcedure.
   TGenRowsProcedure = class(IExternalProcedureImpl)
   public
     // Appelé lorsque l'instance de procédure est détruite
     procedure dispose(); override;

     {  Cette méthode est appelée juste avant l'ouverture et indique au noyau le jeu de caractères
        requis pour l'échange de données dans le cadre de cette méthode. Lors de cet appel, le contexte
        utilise le jeu de caractères obtenu à partir de ExternalEngine::getCharSet.

      @param(AStatus Vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AName Nom du jeu de caractères)
      @param(ANameSize Longueur du nom du jeu de caractères)
     }
     procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
       AName: PAnsiChar; ANameSize: cardinal); override;

     { Execution de la procédure externe

      @param(AStatus Vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AInMsg Pointeur du message (`IMessageMetadata`) d'entrée)
      @param(AOutMsg Pointeur du message (`IMessageMetadata`) de sortie)
      @returns(Ensemble de données pour une procédure sélective ou Nil pour les procédures)
     }
     function open(AStatus: IStatus; AContext: IExternalContext; AInMsg: Pointer;
       AOutMsg: Pointer): IExternalResultSet; override;
   end;

   // Ensemble de données de sortie pour la procédure TGenRowsProcedure
   TGenRowsResultSet = class(IExternalResultSetImpl)
     Input: PInput;
     Output: POutput;

     // Appelé lorsque l'instance du jeu de données est détruite
     procedure dispose(); override;

     { Récupère l'enregistrement suivant de l'ensemble de données. Cette méthode est quelque peu analogue
       à SUSPEND. Dans cette méthode, l'enregistrement suivant de l'ensemble de données doit être préparé.

       @param(AStatus Vecteur de statut)
       @returns(True si l'ensemble de données comporte une entrée à extraire,
                False s'il n'y a plus d'entrées)
     }
     function fetch(AStatus: IStatus): Boolean; override;
   end;

implementation

{ TGenRowsFactory }

procedure TGenRowsFactory.dispose;
begin
   Destroy;
end;

function TGenRowsFactory.newItem(AStatus: IStatus; AContext: IExternalContext;
   AMetadata: IRoutineMetadata): IExternalProcedure;
begin
   Result := TGenRowsProcedure.create;
end;

procedure TGenRowsFactory.setup(AStatus: IStatus; AContext: IExternalContext;
   AMetadata: IRoutineMetadata; AInBuilder, AOutBuilder: IMetadataBuilder);
begin

end;

{ TGenRowsProcedure }

procedure TGenRowsProcedure.dispose;
begin
   Destroy;
end;

procedure TGenRowsProcedure.getCharSet(AStatus: IStatus;
   AContext: IExternalContext; AName: PAnsiChar; ANameSize: cardinal);
begin

end;

function TGenRowsProcedure.open(AStatus: IStatus; AContext: IExternalContext;
   AInMsg, AOutMsg: Pointer): IExternalResultSet;
begin
   Result := TGenRowsResultSet.create;
   with TGenRowsResultSet(Result) do
   begin
     Input := AInMsg;
     Output := AOutMsg;
   end;

   // si l'un des arguments d'entrée est NULL, ne rien renvoyer
   if PInput(AInMsg).startNull or PInput(AInMsg).finishNull then
   begin
      POutput(AOutMsg).nNull := True;
      // a intentionnellement défini la sortie de manière à ce que
      // la méthode TGenRowsResultSet.fetch renvoie un résultat faux.
      Output.n := Input.finish;
      exit;
   end;
   // vérifications
   if PInput(AInMsg).start > PInput(AInMsg).finish then
     raise Exception.Create('First parameter greater then second parameter.');

   with TGenRowsResultSet(Result) do
   begin
     // valeur initiale
     Output.nNull := False;
     Output.n := Input.start - 1;
   end;
end;

{ TGenRowsResultSet }

procedure TGenRowsResultSet.dispose;
begin
   Destroy;
end;

// Si elle renvoie la valeur True, l'enregistrement suivant de l'ensemble de données est récupéré.
// S'il renvoie False, les enregistrements de l'ensemble de données sont terminés ;
// les nouvelles valeurs du vecteur de sortie sont calculées à chaque appel de cette méthode.

function TGenRowsResultSet.fetch(AStatus: IStatus): Boolean;
begin
  Inc(Output.n);
  Result := (Output.n <= Input.finish);
end;

end.

Dans la méthode open de l’instance de la procédure TGenRowsProcedure, nous vérifions la valeur NULL du premier et second arguments d’entrée, si l’un des arguments est NULL, alors l’argument de sortie est NULL, de plus, la procédure ne doit retourner aucune ligne lors de la récupération via l’instruction SELECT, nous assignons donc à Output.n une valeur telle que la méthode TGenRowsResultSet.fetch renvoie False.

De plus, nous vérifions que le premier argument ne dépasse pas la valeur du second, sinon nous lançons une exception. Ne vous inquiétez pas, cette exception sera capturée dans le sous-système UDR et convertie en une exception Firebird. C’est l’un des avantages des nouveaux UDR par rapport aux anciennes UDF.

Puisque nous créons une procédure de sélection, la méthode open doit retourner une instance de dataset qui implémente l’interface IExternalResultSet. Pour simplifier, héritons notre jeu de données de la classe IExternalResultSetImpl.

La méthode dispose est conçue pour libérer les ressources allouées. Dans cette méthode, nous appelons simplement le destructeur.

La méthode fetch est appelée lorsque l’enregistrement suivant est récupéré par l’instruction SELECT. Cette méthode est essentiellement analogue à l’instruction SUSPEND utilisée dans les procédures stockées PSQL ordinaires. Chaque fois qu’elle est appelée, elle prépare de nouvelles valeurs pour le message de sortie. La méthode retourne vrai si l’enregistrement doit être retourné à l’appelant, et faux s’il n’y a plus de données à récupérer. Dans notre cas, nous incrémentons simplement la valeur actuelle de la variable de sortie jusqu’à ce qu’elle soit supérieure à la limite maximale.

Note

Delphi ne supporte pas l’opérateur yield, vous ne pourrez donc pas écrire du code comme celui-ci:

while(...) do {
  ...
  yield result;
}

Vous pouvez utiliser n’importe quelle classe de collection, la remplir dans la méthode open de la procédure stockée, et ensuite retourner les valeurs de cette collection élément par élément à fetch. Cependant, dans ce cas, vous perdez la possibilité d’interrompre prématurément l’exécution de la procédure (récupération incomplète dans SELECT ou délimiteurs FIRST / ROWS / FETCH dans la déclaration SELECT).

Enregistrement d’un déclencheur

Ajoutons maintenant un déclencheur externe à notre module UDR.

Note

Dans les exemples originaux en C++, le déclencheur copie l’enregistrement dans une autre base de données externe. Je pense qu’un tel exemple est trop compliqué pour une première familiarisation avec les déclencheurs externes. L’utilisation de connexions à des bases de données externes sera abordée ultérieurement.

Retournez au module UdrInit et changez la fonction firebird_udr_plugin pour qu’elle ressemble à ceci.

function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
  AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
  // Nous enregistrons la fonction
  AUdrPlugin.registerFunction(AStatus, 'sum_args',
    TSumArgsFunctionFactory.Create());
  // Nous enregistrons notre procédure
  AUdrPlugin.registerProcedure(AStatus, 'sum_args_proc',
    TSumArgsProcedureFactory.Create());
  AUdrPlugin.registerProcedure(AStatus, 'gen_rows', TGenRowsFactory.Create());
   Nous enregistrons notre déclencheur
  //AUdrPlugin.registerTrigger(AStatus, 'test_trigger',
  //  TMyTriggerFactory.Create());

  theirUnloadFlag := AUnloadFlagLocal;
  Result := @myUnloadFlag;
end;
Note

N’oubliez pas d’ajouter le module TestTrigger à la liste uses, où se trouvera notre trigger.

Classe d’un déclencheur

Une classe de déclenchement externe doit implémenter l’interface IUdrTriggerFactory. Pour simplifier les choses, nous héritons simplement de la classe IUdrTriggerFactoryImpl. Chaque trigger externe a besoin de sa propre classe.

La méthode dispose est appelée lors de la destruction de la classe, au cours de laquelle nous devons libérer les ressources précédemment allouées. Dans ce cas, nous appelons simplement le destructeur.

La méthode setup est exécutée chaque fois qu’un trigger externe est chargé dans le cache de métadonnées. Dans cette méthode, vous pouvez effectuer diverses actions qui sont nécessaires avant de créer une instance de trigger, par exemple, pour changer le format des messages pour les champs de la table. Nous y reviendrons plus en détail ultérieurement.

La méthode newItem est appelée pour instancier un déclencheur externe. On passe à cette méthode un pointeur sur le vecteur d’état, le contexte du déclencheur externe et les métadonnées du déclencheur externe. Avec IRoutineMetadata, vous pouvez obtenir le format du message pour les valeurs des champs nouveaux et anciens, le corps du déclencheur externe et d’autres métadonnées. Dans cette méthode, vous pouvez créer différentes instances du déclencheur externe en fonction de sa déclaration dans PSQL. Les métadonnées peuvent être transmises à l’instance de déclencheur externe créée si nécessaire. Dans notre cas, nous instançons simplement le trigger externe TMyTrigger.

Nous allons placer la classe du déclencheur, ainsi que le déclencheur lui-même, dans le module TestTrigger:

unit TestTrigger;

{$IFDEF FPC}
{$MODE DELPHI}{$H+}
{$ENDIF}

interface

uses
  Firebird, SysUtils;

type
  { **********************************************************
    create table test (
      id int generated by default as identity,
      a int,
      b int,
      name varchar(100),
      constraint pk_test primary key(id)
    );

    create or alter trigger tr_test_biu for test
    active before insert or update position 0
    external name 'myudr!test_trigger'
    engine udr;
  }

  // La structure d'affichage des messages NEW.* et OLD.* doit correspondre à l'ensemble des champs de la table de test.
  TFieldsMessage = record
    Id: Integer;
    IdNull: WordBool;
    A: Integer;
    ANull: WordBool;
    B: Integer;
    BNull: WordBool;
    Name: record
      Length: Word;
      Value: array [0 .. 399] of AnsiChar;
    end;
    NameNull: WordBool;
  end;

  PFieldsMessage = ^TFieldsMessage;

  // Classe pour l'instanciation d'un déclencheur externe TMyTrigger
  TMyTriggerFactory = class(IUdrTriggerFactoryImpl)
    // Appelé lors de la destruction de la classe
    procedure dispose(); override;

    { Exécuté chaque fois qu'un déclencheur externe est chargé dans le cache de métadonnées.
      Utilisé pour modifier le format du message pour les champs.

      @param(AStatus Vecteur de statut)
      @param(AContext Contexte d'exécution du déclencheur externe)
      @param(AMetadata Métadonnées du déclencheur externe)
      @param(AFieldsBuilder Constructeur de messages (`IMessageMetadata`) pour les champs de table)
    }
    procedure setup(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata; AFieldsBuilder: IMetadataBuilder); override;

    { Création d'une nouvelle instance du déclencheur externe TMyTrigger

      @param(AStatus Vecteur de statut)
      @param(AContext Contexte d'exécution du déclencheur externe)
      @param(AMetadata Métadonnées du déclencheur externe)
      @returns(Instance du déclencheur externe)
    }
    function newItem(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata): IExternalTrigger; override;
  end;

  TMyTrigger = class(IExternalTriggerImpl)
    // Appelé lorsque le déclencheur est détruit
    procedure dispose(); override;

    { Cette méthode est appelée juste avant l'exécution et indique au noyau le jeu de caractères demandé
      pour échanger des données en interne.

      cette méthode. Lors de cet appel, le contexte utilise le jeu de caractères
      obtenu par ExternalEngine::getCharSet.

      @param(AStatus Vecteur de statut)
      @param(AContext Contexte d'exécution du déclencheur externe)
      @param(AName Nom du jeu de caractères)
      @param(ANameSize Longueur du nom du jeu de caractères)
    }
    procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
      AName: PAnsiChar; ANameSize: Cardinal); override;

    { exécution du déclencheur TMyTrigger

      @param(AStatus Vecteur de statut)
      @param(AContext Contexte d'exécution du déclencheur externe)
      @param(AAction Action du déclencheur (événement en cours))
      @param(AOldMsg Message pour les anciennes valeurs de champ :OLD.*)
      @param(ANewMsg Message pour les nouvelles valeurs de champ :NEW.*)
    }
    procedure execute(AStatus: IStatus; AContext: IExternalContext;
      AAction: Cardinal; AOldMsg: Pointer; ANewMsg: Pointer); override;
  end;

implementation

{ TMyTriggerFactory }

procedure TMyTriggerFactory.dispose;
begin
  Destroy;
end;

function TMyTriggerFactory.newItem(AStatus: IStatus; AContext: IExternalContext;
  AMetadata: IRoutineMetadata): IExternalTrigger;
begin
  Result := TMyTrigger.create;
end;

procedure TMyTriggerFactory.setup(AStatus: IStatus; AContext: IExternalContext;
  AMetadata: IRoutineMetadata; AFieldsBuilder: IMetadataBuilder);
begin

end;

{ TMyTrigger }

procedure TMyTrigger.dispose;
begin
  Destroy;
end;

procedure TMyTrigger.execute(AStatus: IStatus; AContext: IExternalContext;
  AAction: Cardinal; AOldMsg, ANewMsg: Pointer);
var
  xOld, xNew: PFieldsMessage;
begin
  // xOld := PFieldsMessage(AOldMsg);
  xNew := PFieldsMessage(ANewMsg);
  case AAction of
    IExternalTrigger.ACTION_INSERT:
      begin
        if xNew.BNull and not xNew.ANull then
        begin
          xNew.B := xNew.A + 1;
          xNew.BNull := False;
        end;
      end;

    IExternalTrigger.ACTION_UPDATE:
      begin
        if xNew.BNull and not xNew.ANull then
        begin
          xNew.B := xNew.A + 1;
          xNew.BNull := False;
        end;
      end;

    IExternalTrigger.ACTION_DELETE:
      begin

      end;
  end;
end;

procedure TMyTrigger.getCharSet(AStatus: IStatus; AContext: IExternalContext;
  AName: PAnsiChar; ANameSize: Cardinal);
begin

end;

end.

instance d’un déclencheur

Un déclencheur externe doit implémenter l’interface IExternalTrigger. Pour simplifier, nous héritons simplement de la classe IExternalTriggerImpl.

La méthode dispose est appelée lorsque l’instance du trigger est détruite, ce qui nous oblige à libérer les ressources précédemment allouées. Dans ce cas, nous appelons simplement le destructeur.

La méthode getCharSet est utilisée pour indiquer au contexte de déclenchement externe le jeu de caractères que nous voulons utiliser lorsque nous travaillons avec la connexion du contexte courant. Par défaut, la connexion du contexte courant travaille dans l’encodage de la connexion courante, ce qui n’est pas toujours pratique.

La méthode execute est appelée lorsqu’un trigger est exécuté sur l’un des événements pour lesquels le trigger a été créé. On passe à cette méthode un pointeur sur le vecteur d’état, un pointeur sur le contexte du trigger externe, l’action (événement) qui a provoqué le déclenchement du trigger, et des pointeurs sur les messages pour les anciennes et nouvelles valeurs de champ. Les actions (événements) de déclenchement possibles sont listées par des constantes dans l’interface IExternalTrigger. Ces constantes commencent par le préfixe ACTION_. Il est nécessaire de connaître l’action en cours car Firebird crée des triggers pour plusieurs événements à la fois. Les messages ne sont nécessaires que pour les triggers sur les actions des tables, pour les triggers DDL, ainsi que pour les triggers sur les événements de connexion et de déconnexion de la base de données et les triggers sur les événements de démarrage, de fin et de retour en arrière des transactions.Pour les événements de démarrage, de fin et de retour en arrière des transactions, les pointeurs vers les messages seront initialisés à nil. Contrairement aux procédures et aux fonctions, les messages des déclencheurs sont construits pour les champs de la table sur les événements desquels le déclencheur a été créé. Les structures statiques de ces messages sont construites selon les mêmes principes que les structures de messages pour les paramètres d’entrée et de sortie d’une procédure, mais les champs de la table sont pris à la place des variables.

Note

Veuillez noter que si vous utilisez le mapping message-to-struct, alors vos triggers peuvent être interrompus après avoir changé la composition des champs de la table et leurs types. Pour éviter cela, utilisez le travail avec le message à travers les offsets obtenus à partir de IMessageMetadata. Ce n’est pas aussi vrai pour les procédures et les fonctions, puisque les paramètres d’entrée et de sortie ne changent pas. Ou du moins, vous le faites explicitement, ce qui peut vous amener à penser que vous devez également ré-écrire la procédure/fonction externe.

Dans notre déclencheur le plus simple, nous définissons le type d’événement et, dans le corps du déclencheur, nous exécutons la commande PSQL suivante:

...
  IF (:new.B IS NULL) THEN
    :new.B = :new.A + 1;
...

Messages

Dans l’UDR, un message est une zone de mémoire de taille fixe permettant de transmettre des arguments d’entrée à une procédure ou à une fonction, ou de renvoyer des arguments de sortie.Pour les déclencheurs d’événements externes, les entrées de la table des messages sont utilisées pour recevoir et renvoyer des données dans NEW et OLD.

Pour accéder à des variables individuelles ou à des champs d’un tableau, vous devez connaître au moins le type de cette variable et le décalage par rapport au début de la mémoire tampon du message. Comme indiqué précédemment, il existe deux façons de procéder :

  • conversion d’un pointeur sur un tampon de message en un pointeur sur une structure statique (dans Delphi, il s’agit d’un enregistrement, à savoir record) ;

  • obtenir des décalages en utilisant une instance de la classe qui implémente l’interface IMessageMetadata, et lire / écrire à partir du tampon de données, la taille correspondant au type de la variable ou du champ.

La première méthode est la plus rapide, la seconde est plus souple, car elle permet dans certains cas de modifier les types et les tailles des variables d’entrée et de sortie ou des champs de table sans recompiler la bibliothèque dynamique contenant l’UDR.

Travailler avec le tampon de messages à l’aide d’une structure

Comme indiqué ci-dessus, nous pouvons travailler avec le tampon de messages par l’intermédiaire d’un pointeur sur une structure. Cette structure se présente comme suit :

Syntax
TMyStruct = record
  <var_1>: <type_1>;
  <nullIndicator_1>: WordBool;
  <var_2>: <type_1>;
  <nullIndicator_2>: WordBool;
  ...
  <var_N>: <type_1>;
  <nullIndicator_N>: WordBool;
end;
PMyStruct = ^TMyStruct;

Les types des membres des données doivent correspondre aux types des variables d’entrée/sortie ou des champs (pour les déclencheurs). Il doit y avoir un indicateur null après chaque variable/champ, même s’ils ont une contrainte NOT NULL. L’indicateur null prend 2 octets. La valeur -1 signifie que la variable/le champ a la valeur NULL. Puisque pour le moment seul l’attribut NULL est écrit dans l’indicateur NULL, il est pratique de le refléter sur un type logique de 2 octets.

Les types de données SQL apparaissent dans la structure comme suit :

Table 4. Mapping SQL types to Delphi types
type Sql type Pascal Remarque

BOOLEAN

Boolean, ByteBool

SMALLINT

Smallint

INTEGER

Integer

BIGINT

Int64

INT128

FB_I128

Disponible depuis Firebird 4.0.

FLOAT

Single

DOUBLE PRECISION

Double

DECFLOAT(16)

FB_DEC16

Disponible depuis Firebird 4.0.

DECFLOAT(34)

FB_DEC34

Disponible depuis Firebird 4.0.

NUMERIC(N, M)

Le type de données dépend de la précision et du dialecte :

  • 1-4 — Smallint;

  • 5-9 — Integer;

  • 10-18 (3 dialect) — Int64;

  • 10-15 (1 dialect) — Double;

  • 19-38 - FB_I128 (depuis Firebird 4.0).

En tant que valeur, le nombre multiplié par 10M.

DECIMAL(N, M)

Le type de données dépend de la précision et du dialecte :

  • 1-4 — Integer;

  • 5-9 — Integer;

  • 10-18 (3 dialect) — Int64;

  • 10-15 (1 dialect) — Double;

  • 19-38 - FB_I128 (since Firebird 4.0).

En tant que valeur, le nombre multiplié par 10M.

CHAR(N)

array[0 .. M] of AnsiChar

M est calculé par la formule M = N * BytesPerChar - 1, où BytesPerChar - nombre d’octets par caractère, dépend de la variable/du champ d’encodage. Par exemple, pour UTF-8, le nombre d’octets par caractère est de 4, pour WIN1251, il est de 1.

VARCHAR(N)

record
  Length: Smallint;
  Data: array[0 .. M] of AnsiChar;
end

M est calculé par la formule M = N * BytesPerChar - 1, où BytesPerChar - nombre d’octets par caractère, dépend de la variable/du champ d’encodage. Par exemple, pour UTF-8, le nombre d’octets par caractère est de 4, pour WIN1251, il est de 1. Longueur est la longueur réelle de la chaîne en caractères.

DATE

ISC_DATE

TIME

ISC_TIME

TIME WITH TIME ZONE

ISC_TIME_TZ

Disponible depuis Firebird 4.0.

TIMESTAMP

ISC_TIMESTAMP

TIMESTAMP WITH TIME ZONE

ISC_TIMESTAMP_TZ

Disponible depuis Firebird 4.0.

BLOB

ISC_QUAD

Le contenu du BLOB n’est jamais transmis directement ; c’est l’identifiant du Blob qui est transmis. La manière de travailler avec le type BLOB sera décrite dans le chapitre Travailler avec le type BLOB.

Examinons maintenant quelques exemples de construction de structures de messages à partir de déclarations de procédures, de fonctions ou de déclencheurs.

Supposons que nous ayons une fonction externe déclarée comme suit :

function SUM_ARGS(A SMALLINT, B INTEGER) RETURNS BIGINT
....

Dans ce cas, les structures des messages d’entrée et de sortie ressembleront à ceci :

TInput = record
  A: Smallint;
  ANull: WordBool;
  B: Integer;
  BNull: WordBool;
end;
PInput = ^TInput;

TOutput = record
  Value: Int64;
  Null: WordBool;
end;
POutput = ^TOutput;

Si la même fonction est définie avec d’autres types (dans le dialecte 3) :

function SUM_ARGS(A NUMERIC(4, 2), B NUMERIC(9, 3)) RETURNS NUMERIC(18, 6)
....

Dans ce cas, les structures des messages d’entrée et de sortie se présentent comme suit :

TInput = record
  A: Smallint;
  ANull: WordBool;
  B: Integer;
  BNull: WordBool;
end;
PInput = ^TInput;

TOutput = record
  Value: Int64;
  Null: WordBool;
end;
POutput = ^TOutput;

Supposons que nous ayons une procédure externe déclarée comme suit :

PROCEDURE SOME_PROC(A CHAR(3) CHARACTER SET WIN1251, B VARCHAR(10) CHARACTER SET UTF8)
....

Dans ce cas, la structure du message d’entrée sera la suivante :

TInput = record
  A: array[0..2] of AnsiChar;
  ANull: WordBool;
  B: record
    Length: Smallint;
    Value: array[0..39] of AnsiChar;
  end;
  BNull: WordBool;
end;
PInput = ^TInput;

Travailler avec la mémoire tampon des messages en utilisant IMessageMetadata

Comme décrit ci-dessus, vous pouvez travailler avec le tampon de messages en utilisant une instance d’un objet qui implémente l’interface IMessageMetadata.Cette interface vous permet d’obtenir les informations suivantes sur une variable ou un champ :

  • nom de la variable ou du champ;

  • type de données;

  • jeu de caractères pour les données de type chaîne de caractères;

  • sous-type pour le type de données BLOB;

  • taille de la mémoire tampon en octets pour la variable/le champ;

  • si une variable/un champ peut prendre une valeur NULL;

  • offset dans la mémoire tampon du message pour les données;

  • offset dans la mémoire tampon du message pour l’indicateur NULL.

Méthodes de l’interface IMessageMetadata

  1. getCount

    function getCount(status: IStatus): Cardinal;

    renvoie le nombre de champs/paramètres dans le message. Dans tous les appels contenant un paramètre d’index, cette valeur doit être : 0 <= index < getCount().

  2. getField

    function getField(status: IStatus; index: Cardinal): PAnsiChar;

    renvoie le nom du champ.

  3. getRelation

    function getRelation(status: IStatus; index: Cardinal): PAnsiChar;

    renvoie le nom de la relation (dans laquelle le champ donné est sélectionné).

  4. getOwner

    function getOwner(status: IStatus; index: Cardinal): PAnsiChar;

    renvoie le nom du propriétaire de la relation.

  5. getAlias

    function getAlias(status: IStatus; index: Cardinal): PAnsiChar;

    renvoie l’alias du champ.

  6. getType

    function getType(status: IStatus; index: Cardinal): Cardinal;

    renvoie le type SQL du champ.

  7. isNullable

    function isNullable(status: IStatus; index: Cardinal): Boolean;

    renvoie un résultat positif si le champ peut être nul.

  8. getSubType

    function getSubType(status: IStatus; index: Cardinal): Integer;

    renvoie le sous-type du champ BLOB (0 - binary, 1 - text, etc.).

  9. getLength

    function getLength(status: IStatus; index: Cardinal): Cardinal;

    renvoie la longueur maximale du champ en octets.

  10. getScale

    function getScale(status: IStatus; index: Cardinal): Integer;

    renvoie la dimension d’un champ numérique.

  11. getCharSet

    function getCharSet(status: IStatus; index: Cardinal): Cardinal;

    renvoie le jeu de caractères pour les champs de caractères et le texte BLOB.

  12. getOffset

    function getOffset(status: IStatus; index: Cardinal): Cardinal;

    renvoie le décalage des données du champ dans le tampon du message (à utiliser pour accéder aux données dans le tampon du message).

  13. getNullOffset

    function getNullOffset(status: IStatus; index: Cardinal): Cardinal;

    renvoie le décalage NULL de l’indicateur du champ dans le tampon du message.

  14. getBuilder

    function getBuilder(status: IStatus): IMetadataBuilder;

    renvoie l’interface IMetadataBuilder initialisée avec les métadonnées de ce message.

  15. getMessageLength

    function getMessageLength(status: IStatus): Cardinal;

    renvoie la longueur du tampon de messages (à utiliser pour allouer de la mémoire au tampon).

  16. getAlignment

    function getAlignment(status: IStatus): Cardinal;

    Renvoie l’alignement en octets.

  17. getAlignedLength

    function getAlignedLength(status: IStatus): Cardinal;

    Renvoie la taille de la structure de métadonnées après l’alignement.

Obtention et utilisation des IMessageMetadata

Les instances des objets qui implémentent l’interface IMessageMetadata pour les variables d’entrée et de sortie peuvent être obtenues à partir de l’interface IRoutineMetadata. Elles ne sont pas passées directement à une instance de procédure, de fonction ou de trigger. Cela doit être fait explicitement dans la classe du type approprié. Par exemple, dans le cas d’une procédure, d’une fonction ou d’un déclencheur :

  // Classe pour l'instanciation de la fonction externe TSumArgsFunction
  TSumArgsFunctionFactory = class(IUdrFunctionFactoryImpl)
    // Appelé lorsque la classe est détruite
    procedure dispose(); override;

    { Exécuté chaque fois qu'une fonction externe est chargée dans le cache de métadonnées.
       Permet de modifier le format des messages d'entrée et de sortie.

      @param(AStatus vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AMetadata Métadonnées de la fonction externe)
      @param(AInBuilder Constructeur de messages pour les métadonnées d'entrée)
      @param(AOutBuilder Constructeur de messages pour les métadonnées de sortie)
    }
    procedure setup(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder;
      AOutBuilder: IMetadataBuilder); override;

    { Création d'une nouvelle instance de fonction externe TSumArgsFunction

      @param(AStatus vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AMetadata Métadonnées de la fonction externe)
      @returns(Instance de la fonction externe)
    }
    function newItem(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata): IExternalFunction; override;
  end;

  // Fonction externe TSumArgsFunction.
  TSumArgsFunction = class(IExternalFunctionImpl)
    // Appelé lorsque l'instance de la fonction est détruite
    procedure dispose(); override;

    { Cette méthode est appelée juste avant l'exécution et indique au noyau le jeu de caractères requis
      pour échanger des données en interne avec cette méthode. Lors de cet appel, le contexte utilise
      le jeu de caractères obtenu par ExternalEngine::getCharSet.

      @param(AStatus Vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AName Nom du jeu de caractères)
      @param(ANameSize Longueur du nom du jeu de caractères)
    }
    procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
      AName: PAnsiChar; ANameSize: Cardinal); override;

    { Exécution d'une fonction externe

      @param(AStatus Vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AInMsg Pointeur vers le message d'entrée)
      @param(AOutMsg Pointeur vers le message de sortie)
    }
    procedure execute(AStatus: IStatus; AContext: IExternalContext;
      AInMsg: Pointer; AOutMsg: Pointer); override;
  end;
........................

{ TSumArgsFunctionFactory }

procedure TSumArgsFunctionFactory.dispose;
begin
  Destroy;
end;

function TSumArgsFunctionFactory.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalFunction;
begin
  Result := TSumArgsFunction.Create();
  with Result as TSumArgsFunction do
  begin
    Metadata := AMetadata;
  end;
end;

procedure TSumArgsFunctionFactory.setup(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata;
  AInBuilder, AOutBuilder: IMetadataBuilder);
begin

end;

Les instances de IMessageMetadata pour les variables d’entrée et de sortie peuvent être obtenues en utilisant les méthodes getInputMetadata et getOutputMetadata de IRoutineMetadata.Les métadonnées pour les champs de la table sur laquelle le trigger est écrit peuvent être obtenues en utilisant la méthode getTriggerMetadata.

Important
Important

Veuillez noter que le cycle de vie des objets de l’interface IMessageMetadata est contrôlé en utilisant le comptage de références. Elle hérite de l’interface IReferenceCounted. Les méthodes getInputMetadata et getOutputMetadata augmentent le nombre de références de 1 pour les objets retournés, donc après avoir fini d’utiliser ces objets, vous devez diminuer le nombre de références pour les variables xInputMetadata et xOutputMetadata en appelant la méthode release.

Pour obtenir la valeur de l’argument d’entrée correspondant, nous devons utiliser sont adresse. Pour ce faire, nous obtenons l’offset de IMessageMetadata en utilisant la méthode getOffset et nous l’ajoutons à l’adresse du tampon pour le message d’entrée. Ensuite, nous réduisons le résultat obtenu au pointeur typé correspondant. Il s’agit à peu près du même schéma de travail pour obtenir les indicateurs nuls des arguments, mais la méthode getNullOffset est utilisée pour obtenir les décalages.

........................

procedure TSumArgsFunction.execute(AStatus: IStatus; AContext: IExternalContext;
  AInMsg, AOutMsg: Pointer);
var
  n1, n2, n3: Integer;
  n1Null, n2Null, n3Null: WordBool;
  Result: Integer;
  resultNull: WordBool;
  xInputMetadata, xOutputMetadata: IMessageMetadata;
begin
  xInputMetadata := FMetadata.getInputMetadata(AStatus);
  xOutputMetadata := FMetadata.getOutputMetadata(AStatus);
  try
    // obtenir les valeurs des arguments d'entrée par leurs décalages
    n1 := PInteger(PByte(AInMsg) + xInputMetadata.getOffset(AStatus, 0))^;
    n2 := PInteger(PByte(AInMsg) + xInputMetadata.getOffset(AStatus, 1))^;
    n3 := PInteger(PByte(AInMsg) + xInputMetadata.getOffset(AStatus, 2))^;
    // obtenir les valeurs des indicateurs nuls des arguments d'entrée en fonction de leurs décalages
    n1Null := PWordBool(PByte(AInMsg) +
      xInputMetadata.getNullOffset(AStatus, 0))^;
    n2Null := PWordBool(PByte(AInMsg) +
      xInputMetadata.getNullOffset(AStatus, 1))^;
    n3Null := PWordBool(PByte(AInMsg) +
      xInputMetadata.getNullOffset(AStatus, 2))^;
    //par défaut, l'argument de sortie est NULL, nous lui attribuons donc la valeur nullFlag
    resultNull := True;
    Result := 0;
    // si l'un des arguments est NULL, le résultat est NULL sinon, on calcule la somme des arguments
    if not(n1Null or n2Null or n3Null) then
    begin
      Result := n1 + n2 + n3;
      // une fois qu'il y a un résultat, réinitialiser le drapeau NULL
      resultNull := False;
    end;
    PWordBool(PByte(AInMsg) + xOutputMetadata.getNullOffset(AStatus, 0))^ := resultNull;
    PInteger(PByte(AInMsg) + xOutputMetadata.getOffset(AStatus, 0))^ := Result;
  finally
    xInputMetadata.release;
    xOutputMetadata.release;
  end;
end;
Note

Dans le chapitre Contexte de connexion et de transaction , exemple pour travailler avec différents types SQL en utilisant l’interface IMessageMetadata.

Les classes

Vous avez déjà vu des classes. Il est temps de les examiner en détail.

Les classes sont conçues pour créer des instances de procédures, de fonctions ou de déclencheurs. La classe factory doit hériter de l’une des interfaces IUdrProcedureFactory, IUdrFunctionFactory ou IUdrTriggerFactory en fonction du type d’UDR.Les instances de ces interfaces doivent être enregistrées en tant que points d’entrée UDR dans la fonction firebird_udr_plugin.

function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
  AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
  // Nous enregistrons la fonction
  AUdrPlugin.registerFunction(AStatus, 'sum_args',
    TSumArgsFunctionFactory.Create());
  // Nous enregistrons notre procédure
  AUdrPlugin.registerProcedure(AStatus, 'sum_args_proc',
    TSumArgsProcedureFactory.Create());
  AUdrPlugin.registerProcedure(AStatus, 'gen_rows', TGenRowsFactory.Create());
   Nous enregistrons notre déclencheur
  //AUdrPlugin.registerTrigger(AStatus, 'test_trigger',
  //  TMyTriggerFactory.Create());

  theirUnloadFlag := AUnloadFlagLocal;
  Result := @myUnloadFlag;
end;

Dans cet exemple, la classe TSumArgsFunctionFactory hérite de l’interface IUdrFunctionFactory, TGenRowsFactory hérite de l’interface IUdrProcedureFactory, et TMyTriggerFactory hérite de l’interface IUdrTriggerFactory.

Les instances de la classe sont créées et liées aux points d’entrée la première fois qu’une procédure externe, une fonction ou un déclencheur est chargé. Cela se produit une fois par création de processus Firebird. Ainsi, pour l’architecture SuperServer, pour toutes les connexions, il y aura exactement une instance de classe associée à chaque point d’entrée ; pour Classic, ce nombre d’instances sera multiplié par le nombre de connexions.

Lorsque vous écrivez des classes UDR, vous devez implémenter les méthodes setup et newItem des interfaces IUdrProcedureFactory, IUdrFunctionFactory ou IUdrTriggerFactory.

  IUdrFunctionFactory = class(IDisposable)
    const VERSION = 3;

    procedure setup(status: IStatus; context: IExternalContext;
      metadata: IRoutineMetadata; inBuilder: IMetadataBuilder;
        outBuilder: IMetadataBuilder);

    function newItem(status: IStatus; context: IExternalContext;
      metadata: IRoutineMetadata): IExternalFunction;
  end;

  IUdrProcedureFactory = class(IDisposable)
    const VERSION = 3;

    procedure setup(status: IStatus; context: IExternalContext;
      metadata: IRoutineMetadata; inBuilder: IMetadataBuilder;
        outBuilder: IMetadataBuilder);

    function newItem(status: IStatus; context: IExternalContext;
      metadata: IRoutineMetadata): IExternalProcedure;
  end;

  IUdrTriggerFactory = class(IDisposable)
    const VERSION = 3;

    procedure setup(status: IStatus; context: IExternalContext;
      metadata: IRoutineMetadata; fieldsBuilder: IMetadataBuilder);

    function newItem(status: IStatus; context: IExternalContext;
      metadata: IRoutineMetadata): IExternalTrigger;
  end;

De plus, comme ces interfaces héritent de l’interface IDisposable, vous devez également implémenter la méthode dispose. Cela signifie que Firebird déchargera la classe elle-même lorsque cela sera nécessaire. Dans la méthode dispose, vous devez placer du code qui libère les ressources lorsque l’instance de la classe est détruite. Pour simplifier l’implémentation des méthodes de l’interface, il est pratique d’utiliser les classes IUdrProcedureFactoryImpl, IUdrFunctionFactoryImpl, IUdrTriggerFactoryImpl. Examinons chacune de ces méthodes plus en détail.

Methode newItem

La méthode newItem est appelée pour instancier une procédure, une fonction ou un déclencheur externe. Une UDR est instancié lorsqu’il est chargé dans le cache de métadonnées, c’est-à-dire la première fois qu’une procédure, une fonction ou un déclencheur est appelé. Actuellement, le cache de métadonnées est un cache par connexion pour toutes les architectures de serveur.

Le cache de métadonnées des procédures et des fonctions est associé à leur nom dans la base de données. Par exemple, deux fonctions externes avec des noms différents mais les mêmes points d’entrée seront des instances différentes de IUdrFunctionFactory. Le point d’entrée est constitué du nom du module externe et du nom sous lequel la classe est enregistrée. Nous verrons plus loin comment cela peut être utilisé.

La méthode newItem reçoit un pointeur sur le vecteur d’état, le contexte d’exécution de l’UDR et les métadonnées de l’UDR.

Dans le cas le plus simple, la mise en œuvre de cette méthode est triviale

function TSumArgsFunctionFactory.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalFunction;
begin
  // créer une instance d'une fonction externe
  Result := TSumArgsFunction.Create();
end;

Avec IRoutineMetadata vous pouvez obtenir le format du message d’entrée et de sortie, le corps de l’UDR et d’autres métadonnées. Les métadonnées peuvent être transmises à l’instance UDR créée. Dans ce cas, vous devez ajouter un champ pour stocker les métadonnées à une instance de la classe qui implémente votre UDR.

  // Fonction externe TSumArgsFunction.
  TSumArgsFunction = class(IExternalFunctionImpl)
  private
    FMetadata: IRoutineMetadata;
  public
    property Metadata: IRoutineMetadata read FMetadata write FMetadata;
  public
  ...
  end;

Dans ce cas, l’implémentation de la méthode newItem ressemble à ceci :

function TSumArgsFunctionFactory.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalFunction;
begin
  Result := TSumArgsFunction.Create();
  with Result as TSumArgsFunction do
  begin
    Metadata := AMetadata;
  end;
end;

Création d’instances d’UDR en fonction de leur déclaration

Dans la méthode newItem, vous pouvez créer différentes instances d’une procédure ou d’une fonction externe, en fonction de sa déclaration dans PSQL. Pour ce faire, vous pouvez utiliser les informations obtenues à partir de IMessageMetadata.

Supposons que nous voulions implémenter un package PSQL avec le même ensemble de fonctions externes pour élever un nombre au carré pour différents types de données et un point d’entrée unique.

SET TERM ^ ;

CREATE OR ALTER PACKAGE MYUDR2
AS
BEGIN
  FUNCTION SqrSmallint(AInput SMALLINT) RETURNS INTEGER;
  FUNCTION SqrInteger(AInput INTEGER) RETURNS BIGINT;
  FUNCTION SqrBigint(AInput BIGINT) RETURNS BIGINT;
  FUNCTION SqrFloat(AInput FLOAT) RETURNS DOUBLE PRECISION;
  FUNCTION SqrDouble(AInput DOUBLE PRECISION) RETURNS DOUBLE PRECISION;
END^

RECREATE PACKAGE BODY MYUDR2
AS
BEGIN
  FUNCTION SqrSmallint(AInput SMALLINT) RETURNS INTEGER
  EXTERNAL NAME 'myudr2!sqrt_func'
  ENGINE UDR;

  FUNCTION SqrInteger(AInput INTEGER) RETURNS BIGINT
  EXTERNAL NAME 'myudr2!sqrt_func'
  ENGINE UDR;

  FUNCTION SqrBigint(AInput BIGINT) RETURNS BIGINT
  EXTERNAL NAME 'myudr2!sqrt_func'
  ENGINE UDR;

  FUNCTION SqrFloat(AInput FLOAT) RETURNS DOUBLE PRECISION
  EXTERNAL NAME 'myudr2!sqrt_func'
  ENGINE UDR;

  FUNCTION SqrDouble(AInput DOUBLE PRECISION) RETURNS DOUBLE PRECISION
  EXTERNAL NAME 'myudr2!sqrt_func'
  ENGINE UDR;

END
^

SET TERM ; ^

Pour tester les fonctions, nous utiliserons la requête suivante

SELECT
  myudr2.SqrSmallint(1) as n1,
  myudr2.SqrInteger(2) as n2,
  myudr2.SqrBigint(3) as n3,
  myudr2.SqrFloat(3.1) as n4,
  myudr2.SqrDouble(3.2) as n5
FROM rdb$database

Pour faciliter le travail avec IMessageMetadata et les tampons, vous pouvez écrire un wrapper pratique ou essayer d’utiliser IMessageMetadata et des structures pour afficher les messages ensemble. Ici, nous allons montrer l’utilisation de la seconde méthode.

L’implémentation de cette idée est assez simple : dans la classe de fonctions, nous allons créer différentes instances de fonctions en fonction du type de l’argument d’entrée.Dans les versions modernes de Delphi, vous pouvez utiliser les génériques pour généraliser le code.

.......................
type
  // la structure à laquelle le message d'entrée sera associé
  TSqrInMsg<T> = record
    n1: T;
    n1Null: WordBool;
  end;

  // la structure à laquelle le message de sortie sera associé
  TSqrOutMsg<T> = record
    result: T;
    resultNull: WordBool;
  end;

  // Classe pour l'instanciation d'une fonction externe TSqrFunction
  TSqrFunctionFactory = class(IUdrFunctionFactoryImpl)
    // Appelé lors de la destruction de la classe
    procedure dispose(); override;

    { Exécuté chaque fois qu'une fonction externe est chargée dans le cache de métadonnées.
      Permet de modifier le format des messages d'entrée et de sortie.

      @param(AStatus Vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AMetadata Métadonnées de la fonction externe)
      @param(AInBuilder Constructeur de messages pour les métadonnées d'entrée)
      @param(AOutBuilder Constructeur de messages pour les métadonnées de sortie)
    }
    procedure setup(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder;
      AOutBuilder: IMetadataBuilder); override;

    { Création d'une nouvelle instance d'une TSqrFunction externe

      @param(AStatus Vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AMetadata Métadonnées de la fonction externe)
      @returns(Instance de fonction externe)
    }
    function newItem(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata): IExternalFunction; override;
  end;


  // Fonction externe TSqrFunction.
  TSqrFunction<TIn, TOut> = class(IExternalFunctionImpl)
  private
    function sqrExec(AIn: TIn): TOut; virtual; abstract;
  public
    type
      TInput = TSqrInMsg<TIn>;
      TOutput = TSqrOutMsg<TOut>;
      PInput = ^TInput;
      POutput = ^TOutput;
    // Appelé lorsque l'instance de la fonction est détruite
    procedure dispose(); override;

    { Cette méthode est appelée juste avant l'exécution et indique au noyau le jeu de caractères requis
      pour communiquer dans cette méthode.

      Lors de cet appel, le contexte utilise le jeu de caractères obtenu par ExternalEngine::getCharSet.

      @param(AStatus Vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AName Nom du jeu de caractères)
      @param(ANameSize Longueur du nom du jeu de caractères)
    }
    procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
      AName: PAnsiChar; ANameSize: Cardinal); override;

    { Exécution d'une fonction externe

      @param(AStatus Vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AInMsg Pointeur vers le message d'entrée)
      @param(AOutMsg Pointeur vers le message de sortie)
    }
    procedure execute(AStatus: IStatus; AContext: IExternalContext;
      AInMsg: Pointer; AOutMsg: Pointer); override;
  end;

  TSqrExecSmallint = class(TSqrFunction<Smallint, Integer>)
  public
    function sqrExec(AIn: Smallint): Integer; override;
  end;

  TSqrExecInteger = class(TSqrFunction<Integer, Int64>)
  public
    function sqrExec(AIn: Integer): Int64; override;
  end;

  TSqrExecInt64 = class(TSqrFunction<Int64, Int64>)
  public
    function sqrExec(AIn: Int64): Int64; override;
  end;

  TSqrExecFloat = class(TSqrFunction<Single, Double>)
  public
    function sqrExec(AIn: Single): Double; override;
  end;

  TSqrExecDouble = class(TSqrFunction<Double, Double>)
  public
    function sqrExec(AIn: Double): Double; override;
  end;

implementation

uses
  SysUtils, FbTypes, System.TypInfo;

{ TSqrFunctionFactory }

procedure TSqrFunctionFactory.dispose;
begin
  Destroy;
end;

function TSqrFunctionFactory.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalFunction;
var
  xInputMetadata: IMessageMetadata;
  xInputType: TFBType;
begin
  // obtenir le type de l'argument d'entrée
  xInputMetadata := AMetadata.getInputMetadata(AStatus);
  xInputType := TFBType(xInputMetadata.getType(AStatus, 0));
  xInputMetadata.release;
  // créer une instance d'une fonction en fonction du type
  case xInputType of
    SQL_SHORT:
      result := TSqrExecSmallint.Create();
    SQL_LONG:
      result := TSqrExecInteger.Create();
    SQL_INT64:
      result := TSqrExecInt64.Create();
    SQL_FLOAT:
      result := TSqrExecFloat.Create();
    SQL_DOUBLE, SQL_D_FLOAT:
      result := TSqrExecDouble.Create();
  else
    result := TSqrExecInt64.Create();
  end;

end;

procedure TSqrFunctionFactory.setup(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata;
  AInBuilder, AOutBuilder: IMetadataBuilder);
begin

end;

{ TSqrFunction }

procedure TSqrFunction<TIn, TOut>.dispose;
begin
  Destroy;
end;

procedure TSqrFunction<TIn, TOut>.execute(AStatus: IStatus;
  AContext: IExternalContext; AInMsg, AOutMsg: Pointer);
var
  xInput: PInput;
  xOutput: POutput;
begin
  xInput := PInput(AInMsg);
  xOutput := POutput(AOutMsg);
  xOutput.resultNull := True;
  if (not xInput.n1Null) then
  begin
    xOutput.resultNull := False;
    xOutput.result := Self.sqrExec(xInput.n1);
  end;
end;

procedure TSqrFunction<TIn, TOut>.getCharSet(AStatus: IStatus;
  AContext: IExternalContext; AName: PAnsiChar; ANameSize: Cardinal);
begin
end;


{ TSqrtExecSmallint }
function TSqrExecSmallint.sqrExec(AIn: Smallint): Integer;
begin
  Result := AIn * AIn;
end;

{ TSqrExecInteger }
function TSqrExecInteger.sqrExec(AIn: Integer): Int64;
begin
  Result := AIn * AIn;
end;

{ TSqrExecInt64 }
function TSqrExecInt64.sqrExec(AIn: Int64): Int64;
begin
  Result := AIn * AIn;
end;

{ TSqrExecFloat }
function TSqrExecFloat.sqrExec(AIn: Single): Double;
begin
  Result := AIn * AIn;
end;

{ TSqrExecDouble }
function TSqrExecDouble.sqrExec(AIn: Double): Double;
begin
  Result := AIn * AIn;
end;

.................

méthode de configuration

La méthode setup permet de modifier les types de paramètres d’entrée et de variables de sortie pour les procédures et fonctions externes ou les champs pour les triggers. Pour cela, on utilise l’interface iMetadatabuilder qui permet de construire des messages d’entrée et de sortie avec des types spécifiés, une dimension et un ensemble de caractères. Les messages d’entrée seront reconstruits dans le format défini dans la méthode setup, et le week-end est reconstruit à partir du format défini dans le format setup vers le format du message dans la procédure, la fonction ou le déclencheur de la DLL. Les types de champs ou de paramètres doivent être compatibles pour la transformation.

Cette méthode permet de simplifier la création de généralisations pour différents types de paramètres et de fonctions en les ramenant au type le plus général. Un exemple plus compliqué et plus utile sera étudié plus tard, mais pour l’instant, nous allons légèrement modifier l’exemple existant de la fonction externe de sumargs.

Notre fonction fonctionnera avec des messages décrits par la structure suivante

type
  // la structure à laquelle le message d'entrée sera associé
  TSumArgsInMsg = record
    n1: Integer;
    n1Null: WordBool;
    n2: Integer;
    n2Null: WordBool;
    n3: Integer;
    n3Null: WordBool;
  end;

  PSumArgsInMsg = ^TSumArgsInMsg;

  // la structure à laquelle le message de sortie sera associé
  TSumArgsOutMsg = record
    result: Integer;
    resultNull: WordBool;
  end;

  PSumArgsOutMsg = ^TSumArgsOutMsg;

Créons maintenant une classe de fonctions, dans la méthode setup nous définissons les messages de format qui correspondent aux structures ci-dessus.

{ TSumArgsFunctionFactory }

procedure TSumArgsFunctionFactory.dispose;
begin
  Destroy;
end;

function TSumArgsFunctionFactory.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalFunction;
begin
  Result := TSumArgsFunction.Create();
end;

procedure TSumArgsFunctionFactory.setup(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata;
  AInBuilder, AOutBuilder: IMetadataBuilder);
begin
  // construction d'un message pour les paramètres d'entrée
  AInBuilder.setType(AStatus, 0, Cardinal(SQL_LONG));
  AInBuilder.setLength(AStatus, 0, sizeof(Int32));
  AInBuilder.setType(AStatus, 1, Cardinal(SQL_LONG));
  AInBuilder.setLength(AStatus, 1, sizeof(Int32));
  AInBuilder.setType(AStatus, 2, Cardinal(SQL_LONG));
  AInBuilder.setLength(AStatus, 2, sizeof(Int32));
  // construction d'un message pour les paramètres de sortie
  AOutBuilder.setType(AStatus, 0, Cardinal(SQL_LONG));
  AOutBuilder.setLength(AStatus, 0, sizeof(Int32));
end;

Fonctions de mise en œuvre triviales

procedure TSumArgsFunction.execute(AStatus: IStatus; AContext: IExternalContext;
  AInMsg, AOutMsg: Pointer);
var
  xInput: PSumArgsInMsg;
  xOutput: PSumArgsOutMsg;
begin
  // convertir les pointeurs d'entrée et de sortie en caractères typés
  xInput := PSumArgsInMsg(AInMsg);
  xOutput := PSumArgsOutMsg(AOutMsg);
  // par défaut, l'argument de sortie est NULL, nous lui attribuons donc la valeur nullFlag
  xOutput^.resultNull := True;
  // si l'un des arguments est NULL, le résultat est NULL sinon, on calcule la somme des arguments
  with xInput^ do
  begin
    if not(n1Null or n2Null or n3Null) then
    begin
      xOutput^.result := n1 + n2 + n3;
      // une fois qu'il y a un résultat, réinitialiser le flag NULL
      xOutput^.resultNull := False;
    end;
  end;
end;

Maintenant, même si nous déclarons les fonctions comme suit, il restera opérationnel, puisque les messages d’entrée et de sortie seront convertis au format que nous avons défini dans la méthode setup.

CREATE OR ALTER FUNCTION FN_SUM_ARGS (
    N1 VARCHAR(15),
    N2 VARCHAR(15),
    N3 VARCHAR(15))
RETURNS VARCHAR(15)
EXTERNAL NAME 'MyUdrSetup!sum_args'
ENGINE UDR;

Vous pouvez vérifier l’affirmation ci-dessus en exécutant la requête suivante

SELECT FN_SUM_ARGS('15', '21', '35') FROM rdb$database

Les classes génériques

Dans le processus de développement de l’UDR, il est nécessaire pour chaque procédure, fonction ou déclencheur externe d’écrire votre classe créant une instance de l’UDR. Cette tâche peut être simplifiée en écrivant des classes généralisées à l’aide de ce que l’on appelle les génériques. Ils sont disponibles à partir de Delphi 2009, en Free Pascal à partir de la version FPC 2.2.

Note

En Free Pascal, la syntaxe de création des types génériques est différente de celle de Delphi.Depuis la version FPC 2.6.0, la syntaxe compatible avec Delphi est déclarée.

Considérons les deux principaux cas pour lesquels des usines généralisées seront écrites :

  • les copies de procédures, de fonctions et de déclencheurs externes ne nécessitent pas d’informations sur les métadonnées, ni d’actions spéciales dans la logique de création des copies UDR ; des structures fixes sont utilisées pour travailler avec les messages ;

  • Les corps des procédures, fonctions et déclencheurs externes ont besoin d’informations sur les métadonnées, des actions spéciales ne sont pas nécessaires dans la logique de création des copies UDR, et les instances de messages IMessagemetadata sont utilisées pour travailler avec les messages.

Dans le premier cas, il suffit de créer la copie désirée de la classe dans la méthode Newitem sans actions supplémentaires.Pour ce faire, nous utiliserons la restriction du concepteur dans les classes IUdrFunctionFactoryImpl, IUdrProcedureFactoryImpl, IUdrTriggerFactoryImpl. Les annonces de telles classes sont les suivantes :

unit UdrFactories;

{$IFDEF FPC}
{$MODE DELPHI}{$H+}
{$ENDIF}

interface

uses SysUtils, Firebird;

type

  // Une simple classe de fonctions externes
  TFunctionSimpleFactory<T: IExternalFunctionImpl, constructor> = class
    (IUdrFunctionFactoryImpl)
    procedure dispose(); override;

    procedure setup(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder;
      AOutBuilder: IMetadataBuilder); override;

    function newItem(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata): IExternalFunction; override;
  end;

  // Une simple procédure externe
  TProcedureSimpleFactory<T: IExternalProcedureImpl, constructor> = class
    (IUdrProcedureFactoryImpl)
    procedure dispose(); override;

    procedure setup(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder;
      AOutBuilder: IMetadataBuilder); override;

    function newItem(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata): IExternalProcedure; override;
  end;

  // Une simple classe de déclencheur externe
  TTriggerSimpleFactory<T: IExternalTriggerImpl, constructor> = class
    (IUdrTriggerFactoryImpl)
    procedure dispose(); override;

    procedure setup(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata; AFieldsBuilder: IMetadataBuilder); override;

    function newItem(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata): IExternalTrigger; override;
  end;

Dans la section d’implémentation, le corps de la méthode setup peut être laissé vide, rien n’y est fait, dans le corps de la méthode dispose, il suffit d’appeler le destructeur. Et dans le corps de la méthode Newitem, il suffit d’appeler le designer par défaut pour le type de substitution t.

implementation

{ TProcedureSimpleFactory<T> }
procedure TProcedureSimpleFactory<T>.dispose;
begin
  Destroy;
end;

function TProcedureSimpleFactory<T>.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalProcedure;
begin
  Result := T.Create;
end;

procedure TProcedureSimpleFactory<T>.setup(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata;
  AInBuilder, AOutBuilder: IMetadataBuilder);
begin

end;


{ TFunctionFactory<T> }
procedure TFunctionSimpleFactory<T>.dispose;
begin
  Destroy;
end;

function TFunctionSimpleFactory<T>.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalFunction;
begin
  Result := T.Create;
end;

procedure TFunctionSimpleFactory<T>.setup(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata;
  AInBuilder, AOutBuilder: IMetadataBuilder);
begin

end;

{ TTriggerSimpleFactory<T> }
procedure TTriggerSimpleFactory<T>.dispose;
begin
  Destroy;
end;

function TTriggerSimpleFactory<T>.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalTrigger;
begin
  Result := T.Create;
end;

procedure TTriggerSimpleFactory<T>.setup(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata;
  AFieldsBuilder: IMetadataBuilder);
begin

end;

Dans le premier cas, vous ne pouvez pas écrire des classes pour chaque procédure, fonction ou déclencheur. Au lieu de cela, enregistrez-les avec des classes génériques comme suit :

function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
  AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
  // inscrire notre fonction
  AUdrPlugin.registerFunction(AStatus, 'sum_args',
    TFunctionSimpleFactory<TSumArgsFunction>.Create());
  // inscrire notre procédure
  AUdrPlugin.registerProcedure(AStatus, 'gen_rows',
    TProcedureSimpleFactory<TGenRowsProcedure>.Create());
  // inscrire notre déclencheur
  AUdrPlugin.registerTrigger(AStatus, 'test_trigger',
    TTriggerSimpleFactory<TMyTrigger>.Create());

  theirUnloadFlag := AUnloadFlagLocal;
  Result := @myUnloadFlag;
end;

Le second cas est plus compliqué. Par défaut, les informations sur les métadonnées ne sont pas transmises dans les copies des procédures, des fonctions et des déclencheurs. Cependant, les métadonnées sont transmises en tant que paramètre dans la méthode des classes newitem. Les métadonnées UDR ont le type IRoutineMetadata, dont le cycle de vie est contrôlé par le moteur Firebird lui-même, de sorte qu’elles peuvent être transférées en toute sécurité dans les copies UDR. A partir de là, vous pouvez obtenir des copies des interfaces pour les messages d’entrée et de sortie, les métadonnées et le type de déclencheur, le nom de l’UDR, le paquetage, les points d’entrée et le corps de l’UDR. Les classes elles-mêmes pour l’implémentation des procédures externes, des fonctions et des déclencheurs n’ont pas de champs pour stocker les métadonnées, nous devrons donc les hérités.

unit UdrFactories;

{$IFDEF FPC}
{$MODE DELPHI}{$H+}
{$ENDIF}

interface

uses SysUtils, Firebird;

type
...

  // Fonction externe avec métadonnées
  TExternalFunction = class(IExternalFunctionImpl)
    Metadata: IRoutineMetadata;
  end;

  // Procédure externe avec métadonnées
  TExternalProcedure = class(IExternalProcedureImpl)
    Metadata: IRoutineMetadata;
  end;

  // Déclencheur externe avec métadonnées
  TExternalTrigger = class(IExternalTriggerImpl)
    Metadata: IRoutineMetadata;
  end;

Dans ce cas, vos propres procédures stockées, fonctions et triggers doivent être hérités de nouvelles classes avec des métadonnées.

Déclarons maintenant les classes qui créeront l’UDR et initialiseront les métadonnées.

unit UdrFactories;

{$IFDEF FPC}
{$MODE DELPHI}{$H+}
{$ENDIF}

interface

uses SysUtils, Firebird;

type
...

  // Classe de fonctions externes avec métadonnées
  TFunctionFactory<T: TExternalFunction, constructor> = class
    (IUdrFunctionFactoryImpl)
    procedure dispose(); override;

    procedure setup(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder;
      AOutBuilder: IMetadataBuilder); override;

    function newItem(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata): IExternalFunction; override;
  end;

  // Classe de procédures externes avec métadonnées
  TProcedureFactory<T: TExternalProcedure, constructor> = class
    (IUdrProcedureFactoryImpl)
    procedure dispose(); override;

    procedure setup(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder;
      AOutBuilder: IMetadataBuilder); override;

    function newItem(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata): IExternalProcedure; override;
  end;

  // Classe de déclencheurs externes avec métadonnées
  TTriggerFactory<T: TExternalTrigger, constructor> = class
    (IUdrTriggerFactoryImpl)
    procedure dispose(); override;

    procedure setup(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata; AFieldsBuilder: IMetadataBuilder); override;

    function newItem(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata): IExternalTrigger; override;
  end;

L’implémentation de la méthode newitem est triviale et est similaire au premier cas, sauf qu’il est nécessaire d’initialiser le champ avec AMetadata.

implementation
...

{ TFunctionFactory<T> }

procedure TFunctionFactory<T>.dispose;
begin
  Destroy;
end;

function TFunctionFactory<T>.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalFunction;
begin
  Result := T.Create;
  (Result as T).Metadata := AMetadata;
end;

procedure TFunctionFactory<T>.setup(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata;
  AInBuilder, AOutBuilder: IMetadataBuilder);
begin

end;

{ TProcedureFactory<T> }
procedure TProcedureFactory<T>.dispose;
begin
  Destroy;
end;

function TProcedureFactory<T>.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalProcedure;
begin
  Result := T.Create;
  (Result as T).Metadata := AMetadata;
end;

procedure TProcedureFactory<T>.setup(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata;
  AInBuilder, AOutBuilder: IMetadataBuilder);
begin

end;

{ TTriggerFactory<T> }
procedure TTriggerFactory<T>.dispose;
begin
  Destroy;
end;

function TTriggerFactory<T>.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalTrigger;
begin
  Result := T.Create;
  (Result as T).Metadata := AMetadata;
end;

procedure TTriggerFactory<T>.setup(AStatus: IStatus; AContext: IExternalContext;
  AMetadata: IRoutineMetadata; AFieldsBuilder: IMetadataBuilder);
begin

end;

Un module prêt à l’emploi avec des classes génériques peut être téléchargé à l’adresse suivante https://github.com/sim1984/udr-book/blob/master/examples/Common/UdrFactories.pas.

Travailler avec le type BLOB

Contrairement aux autres types de données BLOB, elles sont transmises par leur Id (identifiant BLOB) et non par la valeur. C’est logique, car les Blob peuvent être énormes et il est donc impossible de les placer dans une mémoire tampon de largeur fixe. Au lieu de cela, l’identifiant BLOB est placé dans le tampon du message, et le travail avec les données de type BLOB est effectué par l’intermédiaire de l’interface IBlob.

Une autre caractéristique importante du type BLOB est qu’il s’agit d’un type inchangé, vous ne pouvez pas modifier le contenu du BLOB avec un identifiant donné, mais vous devez créer un BLOB avec un nouveau contenu et l’identifiant.

Comme la taille du type BLOB peut être très grande, les données BLOB sont lues et écrites par portions (segments), la taille maximale d’un segment étant de 64 Ko. Le segment est lu par l’interface getSegment Iblob. Le segment est enregistré par l’interface putSegment Iblob.

Lecture des données d’un BLOB

Pour illustrer la lecture d’un BLOB, prenons l’exemple d’une procédure qui divise une chaîne de caractères par délimiteur (procédure inverse des fonctions intégrées d’agrégation LIST). Elle est déclarée comme suit :

CREATE PROCEDURE split (
    txt BLOB SUB_TYPE TEXT CHARACTER SET UTF8,
    delimiter CHAR(1) CHARACTER SET UTF8 = ','
)
RETURNS (
    id INTEGER
)
EXTERNAL NAME 'myudr!split'
ENGINE UDR;

Inscrivons notre classe de procédures :

function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
  AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
  // inscrire notre procédure
  AUdrPlugin.registerProcedure(AStatus, 'split', TProcedureSimpleFactory<TSplitProcedure>.Create());

  theirUnloadFlag := AUnloadFlagLocal;
  Result := @myUnloadFlag;
end;

Ici, j’ai utilisé une classe généralisée pour les cas simples où la classe crée simplement une copie de la procédure sans utiliser de métadonnées. Une telle classe est déclarée comme suit :

...
interface

uses SysUtils, Firebird;

type

  TProcedureSimpleFactory<T: IExternalProcedureImpl, constructor> =
  class(IUdrProcedureFactoryImpl)
    procedure dispose(); override;

    procedure setup(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder;
      AOutBuilder: IMetadataBuilder); override;

    function newItem(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata): IExternalProcedure; override;
  end;

...

implementation

{ TProcedureSimpleFactory<T> }
procedure TProcedureSimpleFactory<T>.dispose;
begin
  Destroy;
end;

function TProcedureSimpleFactory<T>.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalProcedure;
begin
  Result := T.Create;
end;

procedure TProcedureSimpleFactory<T>.setup(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata; AInBuilder,
  AOutBuilder: IMetadataBuilder);
begin

...

Passons maintenant à la mise en œuvre de la procédure. Commençons par déclarer des structures pour les messages d’entrée et de sortie.

  TInput = record
    txt: ISC_QUAD;
    txtNull: WordBool;
    delimiter: array [0 .. 3] of AnsiChar;
    delimiterNull: WordBool;
  end;

  TInputPtr = ^TInput;

  TOutput = record
    Id: Integer;
    Null: WordBool;
  end;

  TOutputPtr = ^TOutput;

Comme vous pouvez le voir, au lieu de la valeur du BLOB, c’est l’identifiant du Blob qui est transmis, qui est décrit par la structure ISC_QUAD.

Décrivons maintenant la classe de procédure et l’ensemble des données renvoyées :

  TSplitProcedure = class(IExternalProcedureImpl)
  private
    procedure SaveBlobToStream(AStatus: IStatus; AContext: IExternalContext;
      ABlobId: ISC_QUADPtr; AStream: TStream);
    function readBlob(AStatus: IStatus; AContext: IExternalContext;
      ABlobId: ISC_QUADPtr): string;
  public
    // Appelé lors de la destruction d'une copie de la procédure
    procedure dispose(); override;

    procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
      AName: PAnsiChar; ANameSize: Cardinal); override;

    function open(AStatus: IStatus; AContext: IExternalContext; AInMsg: Pointer;
      AOutMsg: Pointer): IExternalResultSet; override;
  end;

  TSplitResultSet = class(IExternalResultSetImpl)
{$IFDEF FPC}
    OutputArray: TStringArray;
{$ELSE}
    OutputArray: TArray<string>;
{$ENDIF}
    Counter: Integer;
    Output: TOutputPtr;

    procedure dispose(); override;
    function fetch(AStatus: IStatus): Boolean; override;
  end;

Les fonctions supplémentaires SaveBlobToStream et` readBlob` sont conçues pour lire Blob. La première lit Blob dans un flux, la seconde est basée sur la première et effectue une conversion du flux de lecture dans une ligne Delphi. L’ensemble des données des lignes du OutputArray et le compteur des enregistrements retournés Counter sont transmis.

Dans la méthode open, le Blob est lu et converti en une ligne.La ligne résultante est divisée en un séparateur en utilisant la méthode intégrée split d’un Helper pour les chaines de caractères. Le tableau de chaines de caractères résultant est transmis à l’ensemble de données.

function TSplitProcedure.open(AStatus: IStatus; AContext: IExternalContext;
  AInMsg, AOutMsg: Pointer): IExternalResultSet;
var
  xInput: TInputPtr;
  xText: string;
  xDelimiter: string;
begin
  xInput := AInMsg;

  Result := TSplitResultSet.Create;
  TSplitResultSet(Result).Output := AOutMsg;

  if xInput.txtNull or xInput.delimiterNull then
  begin
    with TSplitResultSet(Result) do
    begin
      // Nous créons un tableau vide
      OutputArray := [];
      Counter := 1;
    end;
    Exit;
  end;

  xText := readBlob(AStatus, AContext, @xInput.txt);
  xDelimiter := TFBCharSet.CS_UTF8.GetString(TBytes(@xInput.delimiter), 0, 4);
  SetLength(xDelimiter, 1);

  with TSplitResultSet(Result) do
  begin
    OutputArray := xText.Split([xDelimiter], TStringSplitOptions.ExcludeEmpty);
    Counter := 0;
  end;
end;
Note

Le type TFBCharSet n’est pas inclus dans Firebird.pas. Il a été écrit par moi pour soulager le travail avec les encodages de Firebird. Dans ce cas, nous pensons que toutes nos lignes sont encodées en UTF-8.

Nous allons maintenant décrire la procédure de lecture des données d’un BLOB vers un flux. Pour lire les données d’un BLOB, il faut l’ouvrir. Cela peut être fait en appelant la méthode openBlob de l’interface IAttachment`. Puisque nous lisons un Blob à partir de notre base de données, nous l’ouvrirons dans le contexte de la connexion actuelle. Le contexte de la connexion courante et le contexte de la transaction courante peuvent être obtenus à partir du contexte de la procédure externe, de la fonction ou du trigger (IEXTERNALCONTEXT).

Le Blob est lu par portions (segments), la taille maximale d’un segment étant de 64 KB. Le segment est lu par la méthode getSegment de l’interface IBlob.

procedure TSplitProcedure.SaveBlobToStream(AStatus: IStatus;
  AContext: IExternalContext; ABlobId: ISC_QUADPtr; AStream: TStream);
var
  att: IAttachment;
  trx: ITransaction;
  blob: IBlob;
  buffer: array [0 .. 32767] of AnsiChar;
  l: Integer;
begin
  try
    att := AContext.getAttachment(AStatus);
    trx := AContext.getTransaction(AStatus);
    blob := att.openBlob(AStatus, trx, ABlobId, 0, nil);
    while True do
    begin
      case blob.getSegment(AStatus, SizeOf(buffer), @buffer, @l) of
        IStatus.RESULT_OK:
          AStream.WriteBuffer(buffer, l);
        IStatus.RESULT_SEGMENT:
          AStream.WriteBuffer(buffer, l);
      else
        break;
      end;
    end;
    AStream.Position := 0;
    // La méthode `CLOSE` en cas de succès combine l'interface IBLOB.
    // Par conséquent, l'appel suivant n'est pas nécessaire
    blob.close(AStatus);
    blob := nil;
  finally
    if Assigned(blob) then
      blob.release;
    if Assigned(trx) then
      trx.release;
    if Assigned(att) then
      att.release;
  end;
end;
Note

Veuillez noter que les interfaces IAttachment, ITransaction et IBlob héritent de l’interface IReferenceCounted, ce qui signifie qu’il s’agit d’objets avec le calcul des liens. Les méthodes des objets qui renvoient des objets de ces interfaces fixent le compteur de liens à 1.Une fois le travail avec ces objets terminé, vous devez réduire le compteur de liens à l’aide de la méthode release.

Important
Important

La méthode close de l’interface` IBlob` en cas d’exécution réussie libère l’interface, il n’est donc pas nécessaire d’appeler la méthode release.

Dans l’exemple de la variable blob assignée à la valeur nil. Plus loin dans la section finally, si le pointeur est initialisé à l’interface IBlob, et seulement si l’exécutiona été terminée avant l’appel blob.close (AStatus) ou si ce challenge s’est terminé par une erreur, Iblob.release est appelé.

Sur la base de la méthode SaveBlobToStream, la procédure de lecture de Blob dans la ligne est écrite :

function TSplitProcedure.readBlob(AStatus: IStatus; AContext: IExternalContext;
  ABlobId: ISC_QUADPtr): string;
var
{$IFDEF FPC}
  xStream: TBytesStream;
{$ELSE}
  xStream: TStringStream;
{$ENDIF}
begin
{$IFDEF FPC}
  xStream := TBytesStream.Create(nil);
{$ELSE}
  xStream := TStringStream.Create('', 65001);
{$ENDIF}
  try
    SaveBlobToStream(AStatus, AContext, ABlobId, xStream);
{$IFDEF FPC}
    Result := TEncoding.UTF8.GetString(xStream.Bytes, 0, xStream.Size);
{$ELSE}
    Result := xStream.DataString;
{$ENDIF}
  finally
    xStream.Free;
  end;
end;
Note

Malheureusement, Free Pascal ne fournit pas une compatibilité inverse complète avec Delphi pour la classe TStringStream. Dans la version pour FPC, vous ne pouvez pas spécifier l’encodage avec lequel le flux fonctionnera, et il est donc nécessaire de traiter la transformation dans la ligne d’une manière spéciale.

La méthode fetch de l’ensemble des données extrait un élément avec l’index Counter de la ligne et l’augmente jusqu’à ce que le dernier élément du tableau soit extrait. Chaque ligne extraite est convertie en un tout. Si cela est impossible, une exception sera levée avec le code isc_convert_error.

procedure TSplitResultSet.dispose;
begin
  SetLength(OutputArray, 0);
  Destroy;
end;

function TSplitResultSet.fetch(AStatus: IStatus): Boolean;
var
  statusVector: array [0 .. 4] of NativeIntPtr;
begin
  if Counter <= High(OutputArray) then
  begin
    Output.Null := False;
    // Les exceptions seront interceptées dans tous les cas avec le code ISC_Random Ici,
    // nous lancerons l'erreur standard de Firebird ISC_CONVERT_ERROR
    try
      Output.Id := OutputArray[Counter].ToInteger();
    except
      on e: EConvertError do
      begin

        statusVector[0] := NativeIntPtr(isc_arg_gds);
        statusVector[1] := NativeIntPtr(isc_convert_error);
        statusVector[2] := NativeIntPtr(isc_arg_string);
        statusVector[3] := NativeIntPtr(PAnsiChar('Impossible de convertir une chaîne de caractères en un nombre entier'));
        statusVector[4] := NativeIntPtr(isc_arg_end);

        AStatus.setErrors(@statusVector);
      end;
    end;
    inc(Counter);
    Result := True;
  end
  else
    Result := False;
end;
Note

En fait, le traitement des erreurs autres que isc_random n’est pas très pratique, vous pouvez écrire votre wrapper pour simplifier.

La performance de la procédure peut être vérifiée comme suit :

SELECT ids.ID
FROM SPLIT((SELECT LIST(ID) FROM MYTABLE), ',') ids
Note

Le principal inconvénient de cette implémentation est que Blob sera toujours lu entièrement, même si vous souhaitez interrompre l’extraction des enregistrements de la procédure plus tôt que prévu. Si vous le souhaitez, vous pouvez modifier le code de la procédure de manière à ce que le découpage en plus petit bloc. Pour ce faire, la lecture de ces blocs doit être effectuée dans la méthode Fetch au fur et à mesure que le résultat est extrait.

Enregistrement des données dans un Blob

Comme exemple d’enregistrement de Blob, considérons la fonction du contenu du lecteur du Blob à partir du fichier.

Note

Cet exemple est une version adaptée des fonctions UDF pour la lecture et l’enregistrement de BLOB depuis/vers un fichier. L’UDF original est disponible à l’adresse suivante blobsaveload.zip

Les utilitaires de lecture et d’enregistrement de Blob depuis/vers le fichier sont délivrés sous la forme d’un package

CREATE PACKAGE BlobFileUtils
AS
BEGIN
  PROCEDURE SaveBlobToFile(ABlob BLOB, AFileName VARCHAR(255) CHARACTER SET UTF8);

  FUNCTION LoadBlobFromFile(AFileName VARCHAR(255) CHARACTER SET UTF8) RETURNS BLOB;
END^

CREATE PACKAGE BODY BlobFileUtils
AS
BEGIN
  PROCEDURE SaveBlobToFile(ABlob BLOB, AFileName VARCHAR(255) CHARACTER SET UTF8)
  EXTERNAL NAME 'BlobFileUtils!SaveBlobToFile'
  ENGINE UDR;

  FUNCTION LoadBlobFromFile(AFileName VARCHAR(255) CHARACTER SET UTF8) RETURNS BLOB
  EXTERNAL NAME 'BlobFileUtils!LoadBlobFromFile'
  ENGINE UDR;
END^

Inscrivons les classes de nos procédures et de nos fonctions :

function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
  AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
  // enregistrable
  AUdrPlugin.registerProcedure(AStatus, 'SaveBlobToFile', TSaveBlobToFileProcFactory.Create());
  AUdrPlugin.registerFunction(AStatus, 'LoadBlobFromFile', TLoadBlobFromFileFuncFactory.Create());

  theirUnloadFlag := AUnloadFlagLocal;
  Result := @myUnloadFlag;
end;

Dans ce cas, nous donnons un exemple uniquement pour la fonction de lecture de BLOB depuis le fichier, l’exemple complet d’udr peut être téléchargé à BlobSaveLoad La partie interface du module avec une description de la fonction Loadblobfromfile est la suivante :

interface

uses
  Firebird, Classes, SysUtils;

type

  // Messages d'entrée de la fonction
  TInput = record
    filename: record
      len: Smallint;
      str: array [0 .. 1019] of AnsiChar;
    end;
    filenameNull: WordBool;
  end;
  TInputPtr = ^TInput;

  // Fonction de sortie
  TOutput = record
    blobData: ISC_QUAD;
    blobDataNull: WordBool;
  end;
  TOutputPtr = ^TOutput;

  // fonctionnalités de réalisation Loadblobfromfile
  TLoadBlobFromFileFunc = class(IExternalFunctionImpl)
  public
    procedure dispose(); override;

    procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
      AName: PAnsiChar; ANameSize: Cardinal); override;

    procedure execute(AStatus: IStatus; AContext: IExternalContext;
      AInMsg: Pointer; AOutMsg: Pointer); override;
  end;

  // Classe permettant de créer une copie de la fonction externe Loadblobfromfile
  TLoadBlobFromFileFuncFactory = class(IUdrFunctionFactoryImpl)
    procedure dispose(); override;

    procedure setup(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder;
      AOutBuilder: IMetadataBuilder); override;

    function newItem(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata): IExternalFunction; override;
  end;

Nous ne donnons que l’implémentation de la classe Execute de base tloadblobfromfile, les autres classes de classes sont élémentaires.

procedure TLoadBlobFromFileFunc.execute(AStatus: IStatus;
  AContext: IExternalContext; AInMsg: Pointer; AOutMsg: Pointer);
const
  MaxBufSize = 16384;
var
  xInput: TInputPtr;
  xOutput: TOutputPtr;
  xFileName: string;
  xStream: TFileStream;
  att: IAttachment;
  trx: ITransaction;
  blob: IBlob;
  buffer: array [0 .. 32767] of Byte;
  xStreamSize: Integer;
  xBufferSize: Integer;
  xReadLength: Integer;
begin
  xInput := AInMsg;
  xOutput := AOutMsg;
  if xInput.filenameNull then
  begin
    xOutput.blobDataNull := True;
    Exit;
  end;
  xOutput.blobDataNull := False;
  // Nous obtenons le nom du fichier
  xFileName := TEncoding.UTF8.GetString(TBytes(@xInput.filename.str), 0,
    xInput.filename.len * 4);
  SetLength(xFileName, xInput.filename.len);
  // Nous lisons le fichier dans le flux
  xStream := TFileStream.Create(xFileName, fmOpenRead or fmShareDenyNone);
  att := AContext.getAttachment(AStatus);
  trx := AContext.getTransaction(AStatus);
  blob := nil;
  try
    xStreamSize := xStream.Size;
    // Déterminer la taille maximale du tampon (segment)
    if xStreamSize > MaxBufSize then
      xBufferSize := MaxBufSize
    else
      xBufferSize := xStreamSize;
    // Nous créons un nouveau Blob
    blob := att.createBlob(AStatus, trx, @xOutput.blobData, 0, nil);
    // Nous lisons le contenu du flux et l'écrivons dans le Blob
    while xStreamSize <> 0 do
    begin
      if xStreamSize > xBufferSize then
        xReadLength := xBufferSize
      else
        xReadLength := xStreamSize;
      xStream.ReadBuffer(buffer, xReadLength);

      blob.putSegment(AStatus, xReadLength, @buffer[0]);

      Dec(xStreamSize, xReadLength);
    end;
    // Ferme le Blob
    // La méthode CLOSE en cas de succès combine l'interface IBLOB
    // L'appel suivant n'est donc pas nécessaire
    blob.close(AStatus);
    blob := nil;
  finally
    if Assigned(blob) then
      blob.release;
    trx.release;
    att.release;
    xStream.Free;
  end;
end;

Tout d’abord, il est nécessaire de créer un nouveau Blob et de le lier dans la sortie Blobid à l’aide de la méthode createBlob de IAttachment.Étant donné que nous écrivons un objet blob temporaire pour notre base de données, nous allons le créer dans le contexte de la connexion actuelle. Le contexte de la connexion en cours et le contexte de la transaction en cours peuvent être obtenus à partir du contexte de la procédure, de la fonction ou du déclencheur externe (le IExternalContext).

Comme dans le cas de la lecture de données à partir d’un objet blob, l’enregistrement est effectué par segmentation à l’aide de la méthode putSegment IBlob jusqu’à ce que les données du flux de fichiers soient terminées. Une fois l’enregistrement des données terminé dans Blob, il est nécessaire de le fermer à l’aide de la méthode close.

Important
Important

La méthode close de l’interface IBlob en cas d’exécution réussie libère l’interface.Par conséquent, il n’est pas nécessaire d’appeler la méthode Release.

Assistant pour l’utilisation du type Blob

Dans les exemples décrits, nous avons utilisé la préservation du contenu de BLOB dans le flux, ainsi que le chargement du contenu de BLOB dans le flux. Il s’agit d’une opération assez fréquente lorsque l’on travaille avec le type BLOB, il serait donc bon d’écrire un ensemble spécial d’utilitaires pour la réutilisation du code.

Les versions modernes de Delphi et de Free Pascal vous permettent d’étendre les classes et les types existants sans héritage en utilisant ce que l’on appelle un Helper. Ajoutez les méthodes à l’interface IBlob pour enregistrer et charger le contenu du flux de/vers le Blob.

Créez un module spécial FbBlob, où notre Helper sera placé.

unit FbBlob;

interface

uses Classes, SysUtils, Firebird;

const
  MAX_SEGMENT_SIZE = $7FFF;

type
  TFbBlobHelper = class helper for IBlob
    procedure LoadFromStream(AStatus: IStatus; AStream: TStream);
    { Charge le contenu d'un BLOB dans le flux

      @param(AStatus IStatus)
      @param(AStream TStream)
    }
    procedure SaveToStream(AStatus: IStatus; AStream: TStream);
    { Charge dans un Blob le contenu du flux

      @param(AStatus IStatus)
      @param(AStream TStream)
    }
  end;

implementation

uses Math;

procedure TFbBlobHelper.LoadFromStream(AStatus: IStatus; AStream: TStream);
var
  xStreamSize: Integer;
  xReadLength: Integer;
  xBuffer: array [0 .. MAX_SEGMENT_SIZE] of Byte;
begin
  xStreamSize := AStream.Size;
  AStream.Position := 0;
  while xStreamSize <> 0 do
  begin
    xReadLength := Min(xStreamSize, MAX_SEGMENT_SIZE);
    AStream.ReadBuffer(xBuffer, xReadLength);
    Self.putSegment(AStatus, xReadLength, @xBuffer[0]);
    Dec(xStreamSize, xReadLength);
  end;
end;

procedure TFbBlobHelper.SaveToStream(AStatus: IStatus; AStream: TStream);
var
  xInfo: TFbBlobInfo;
  Buffer: array [0 .. MAX_SEGMENT_SIZE] of Byte;
  xBytesRead: Cardinal;
  xBufferSize: Cardinal;
begin
  AStream.Position := 0;
  xBufferSize := Min(SizeOf(Buffer), MAX_SEGMENT_SIZE);
  while True do
  begin
    case Self.getSegment(AStatus, xBufferSize, @Buffer[0], @xBytesRead) of
      IStatus.RESULT_OK:
        AStream.WriteBuffer(Buffer, xBytesRead);
      IStatus.RESULT_SEGMENT:
        AStream.WriteBuffer(Buffer, xBytesRead);
    else
      break;
    end;
  end;
end;

end.

Maintenant, vous pouvez grandement simplifier les opérations avec le type BLOB, par exemple, la fonction ci-dessus d’enregistrement de Blob dans le fichier peut être réécrite comme suit :

procedure TLoadBlobFromFileFunc.execute(AStatus: IStatus;
  AContext: IExternalContext; AInMsg: Pointer; AOutMsg: Pointer);
var
  xInput: TInputPtr;
  xOutput: TOutputPtr;
  xFileName: string;
  xStream: TFileStream;
  att: IAttachment;
  trx: ITransaction;
  blob: IBlob;
begin
  xInput := AInMsg;
  xOutput := AOutMsg;
  if xInput.filenameNull then
  begin
    xOutput.blobDataNull := True;
    Exit;
  end;
  xOutput.blobDataNull := False;
  // Nous obtenons le nom du fichier
  xFileName := TEncoding.UTF8.GetString(TBytes(@xInput.filename.str), 0,
    xInput.filename.len * 4);
  SetLength(xFileName, xInput.filename.len);
  // Nous lisons le fichier dans le flux
  xStream := TFileStream.Create(xFileName, fmOpenRead or fmShareDenyNone);
  att := AContext.getAttachment(AStatus);
  trx := AContext.getTransaction(AStatus);
  blob := nil;
  try
    // Nous créons un nouveau Blob
    blob := att.createBlob(AStatus, trx, @xOutput.blobData, 0, nil);
    // Nous chargeons le contenu du flux dans Blob
    blob.LoadFromStream(AStatus, xStream);
    // Fermer Blob
    // En cas de succès, la méthode CLOSE combine l’interface IBLOB
    // Par conséquent, l’appel suivant n’est pas nécessaire
    blob.close(AStatus);
    blob := nil;
  finally
    if Assigned(blob) then
      blob.release;
    att.release;
    trx.release;
    xStream.Free;
  end;
end;

Contexte de connexion et de transaction

Si votre procédure, fonction ou déclencheur externe doit recevoir des données de votre propre base de données non pas par le biais d’arguments d’entrée, mais par exemple par le biais d’une requête, vous devrez alors recevoir le contexte de la connexion et/ou des transactions en cours. De plus, le contexte de la connexion et de la transaction est nécessaire si vous travaillez avec le type BLOB.

Le contexte de la procédure, de la fonction ou du déclencheur en cours est transmis en tant que paramètre avec le type IExternalContext dans la méthode ou la fonction de déclencheur execute, ou dans la méthode de procédure ouverte. L’interface IExternalContext vous permet d’obtenir la connexion actuelle à l’aide de la méthode getAttachment et la transaction actuelle à l’aide de la méthode getTransaction. Cela donne une plus grande flexibilité à votre UDR, par exemple, vous pouvez répondre aux demandes de base de données actuelles tout en conservant l’environnement de session actuel, dans la même transaction ou dans une nouvelle transaction créée à l’aide de la méthode d’interface StartTransaction IExternalContext. Dans ce dernier cas, la demande sera faite comme si elle était exécutée dans une transaction autonome. De plus, vous pouvez vous conformer à la base de données externe en utilisant la transaction jointe à la transaction en cours, c’est-à-dire les transactions avec confirmation en deux phases (2PC).

À titre d’exemple de travail avec le contexte de la fonction, nous allons écrire une fonction qui sérialisera le résultat de l’exécution de la requête SELECT au format JSON. Il est déclaré comme suit :

CREATE FUNCTION GetJson (
    sql_text BLOB SUB_TYPE TEXT CHARACTER SET UTF8,
    sql_dialect SMALLINT NOT NULL DEFAULT 3
)
RETURNS RETURNS BLOB SUB_TYPE TEXT CHARACTER SET UTF8
EXTERNAL NAME 'JsonUtils!getJson'
ENGINE UDR;

Comme nous nous permettons d’exécuter une requête SQL arbitraire, nous ne connaissons pas à l’avance le format des champs de sortie, et nous ne pourrons pas utiliser une structure avec des champs fixes. Dans ce cas, nous devrons travailler avec l’interface IMessageMetadata. Nous l’avons déjà rencontré précédemment, mais cette fois-ci, nous devrons travailler avec lui de manière plus approfondie, car nous devons traiter tous les types de Firebird existants.

Note

En JSON, vous pouvez encoder presque tous les types de données, à l’exception des données binaires.Pour coder les types de char, varchar avec octets none et blob sub_type binary nous allons encoder le contenu binaire en utilisant le codage base64, qui peut déjà être placé en JSON.

We will register the factory of our function:

function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
  AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
  // Nous enregistrons une fonction
  AUdrPlugin.registerFunction(AStatus, 'getJson', TFunctionSimpleFactory<TJsonFunction>.Create());

  theirUnloadFlag := AUnloadFlagLocal;
  Result := @myUnloadFlag;
end;

Maintenant, nous allons déclarer les structures pour le message d’entrée et de sortie, ainsi que la partie interface de notre fonction :

unit JsonFunc;

{$IFDEF FPC}
{$MODE objfpc}{$H+}
{$DEFINE DEBUGFPC}
{$ENDIF}

interface

uses
  Firebird,
  UdrFactories,
  FbTypes,
  FbCharsets,
  SysUtils,
  System.NetEncoding,
  System.Json;

{ *********************************************************
 create function GetJson (
   sql_text blob sub_type text,
   sql_dialect smallint not null default 3
 ) returns blob sub_type text character set utf8
 external name 'JsonUtils!getJson'
 engine udr;
 ********************************************************* }

type

  TInput = record
    SqlText: ISC_QUAD;
    SqlNull: WordBool;
    SqlDialect: Smallint;
    SqlDialectNull: WordBool;
  end;

  InputPtr = ^TInput;

  TOutput = record
    Json: ISC_QUAD;
    NullFlag: WordBool;
  end;

  OutputPtr = ^TOutput;

  // Fonction Tsumargsfunction externe.
  TJsonFunction = class(IExternalFunctionImpl)
  public
    procedure dispose(); override;

    procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
      AName: PAnsiChar; ANameSize: Cardinal); override;

    { Convertit l’ensemble en une ligne conforme à l’échelle

      @param(AValue La valeur en paramètre)
      @param(Scale Diviseur)
      @returns(Strokal Représentation d’un ensemble à l’échelle)
    }
    function MakeScaleInteger(AValue: Int64; Scale: Smallint): string;

    { Ajoute une entrée codée à un tableau d’objets JSON

      @param(AStatus Statut du vecteur)
      @param(AContext Le contexte de la fonction externe)
      @param(AJson Un tableau d’objets JSON)
      @param(ABuffer Enregistrements de tampon)
      @param(AMeta Curseur de métadonnées)
      @param(AFormatSetting Réglage de la date et de l’heure)
    }
    procedure writeJson(AStatus: IStatus; AContext: IExternalContext;
      AJson: TJsonArray; ABuffer: PByte; AMeta: IMessageMetadata;
      AFormatSettings: TFormatSettings);

    { External function

      @param (AStatus Vecteur d’état)
      @PARAM (ACONTEXT Contexte de la fonction externe)
      @param (AInMSG Message d’entrée)
      @PARAM (AOutMSG Message de sortie)
    }
    procedure execute(AStatus: IStatus; AContext: IExternalContext;
      AInMsg: Pointer; AOutMsg: Pointer); override;
  end;

La méthode supplémentaire de MakeScaleInteger est conçue pour convertir des nombres en une ligne, la méthode Writejson encode l’enregistrement suivant de l’objet sélectionné à partir du curseur en Json et l’ajoute au tableau de ces objets.

Dans cet exemple, nous devrons implémenter la méthode getCharSet pour indiquer l’encodage souhaité de la requête pour la demande de la connexion courante au sein de la fonction externe.Par défaut, cette requête interne sera effectuée dans l’encodage de la connexion courante. Cependant, ce n’est pas tout à fait pratique. Nous ne savons pas à l’avance quel encodage le client va fonctionner, nous devrons donc déterminer l’encodage de chaque champ de chaîne retourné et le transcoder en UTF8. Pour simplifier la tâche, nous indiquerons immédiatement au contexte que nous allons travailler à l’intérieur de la procédure en encodage UTF8.

procedure TJsonFunction.getCharSet(AStatus: IStatus; AContext: IExternalContext;
  AName: PAnsiChar; ANameSize: Cardinal);
begin
  // rectifier l’encodage précédent
  Fillchar (aname, anamesize, #0);
  // mettre l’encodage souhaité
  Strcopy (aname, 'UTF8');
end;

Nous décrirons ces méthodes plus tard, mais pour l’instant nous donnerons la méthode principale de 'execute' pour exécuter une fonction externe.

procedure TJsonFunction.execute(AStatus: IStatus; AContext: IExternalContext;
  AInMsg, AOutMsg: Pointer);
var
  xFormatSettings: TFormatSettings;
  xInput: InputPtr;
  xOutput: OutputPtr;
  att: IAttachment;
  tra: ITransaction;
  stmt: IStatement;
  inBlob, outBlob: IBlob;
  inStream: TBytesStream;
  outStream: TStringStream;
  cursorMetaData: IMessageMetadata;
  rs: IResultSet;
  msgLen: Cardinal;
  msg: Pointer;
  jsonArray: TJsonArray;
begin
  xInput := AInMsg;
  xOutput := AOutMsg;
  // Si l’un des arguments d’entrée est nul, le résultat est nul
  if xInput.SqlNull or xInput.SqlDialectNull then
  begin
    xOutput.NullFlag := True;
    Exit;
  end;
  xOutput.NullFlag := False;
  // Définition de la mise en forme de la date et de l’heure
{$IFNDEF FPC}
  xFormatSettings := TFormatSettings.Create;
{$ELSE}
  xFormatSettings := DefaultFormatSettings;
{$ENDIF}
  xFormatSettings.DateSeparator := '-';
  xFormatSettings.TimeSeparator := ':';
  // Nous créons un flux d’octets pour la lecture d’objets blob
  inStream := TBytesStream.Create(nil);
{$IFNDEF FPC}
  outStream := TStringStream.Create('', 65001);
{$ELSE}
  outStream := TStringStream.Create('');
{$ENDIF}
  jsonArray := TJsonArray.Create;
  // Obtention de la connexion et de la transaction en cours
  att := AContext.getAttachment(AStatus);
  tra := AContext.getTransaction(AStatus);
  stmt := nil;
  rs := nil;
  inBlob := nil;
  outBlob := nil;
  try
    // Nous lisons le Blob dans un flux
    inBlob := att.openBlob(AStatus, tra, @xInput.SqlText, 0, nil);
    inBlob.SaveToStream(AStatus, inStream);
    // La méthode Close, en cas de succès, combine l’interface IBLOB Par conséquent,
    // l’appel suivant n’est pas nécessaire
    inBlob.close(AStatus);
    inBlob := nil;
    // On assigne IStatement
    stmt := att.prepare(AStatus, tra, inStream.Size, @inStream.Bytes[0],
      xInput.SqlDialect, IStatement.PREPARE_PREFETCH_METADATA);
    // Nous obtenons les métadonnées du curseur
    cursorMetaData := stmt.getOutputMetadata(AStatus);
    // Nous ouvrons le curseur
    rs := stmt.openCursor(AStatus, tra, nil, nil, nil, 0);
    // Nous mettons en évidence le tampon à la taille souhaitée
    msgLen := cursorMetaData.getMessageLength(AStatus);
    msg := AllocMem(msgLen);
    try
      // Nous lisons chaque enregistrement de curseur
      while rs.fetchNext(AStatus, msg) = IStatus.RESULT_OK do
      begin
        // et l'écrivons en json
        writeJson(AStatus, AContext, jsonArray, msg, cursorMetaData,
          xFormatSettings);
      end;
    finally
      // Nous libérons le tampon
      FreeMem(msg);
    end;
    // Fermer le curseur En cas de succès, la méthode CLOSE combine l’interface IRESULTSET
    // Par conséquent, l’appel suivant n’est pas nécessaire
    rs.close(AStatus);
    rs := nil;
    // Nous libérons la requête préparée La méthode FREE, en cas de succès, combine l’interface ISTATEMENT
    // Par conséquent, l’appel suivant n’est pas nécessaire
    stmt.free(AStatus);
    stmt := nil;
    // Nous écrivons json dans le flux
{$IFNDEF FPC}
    outStream.WriteString(jsonArray.ToJSON);
{$ELSE}
    outStream.WriteString(jsonArray.AsJSON);
{$ENDIF}
    //On écrit json sur le Blob
    outBlob := att.createBlob(AStatus, tra, @xOutput.Json, 0, nil);
    outBlob.LoadFromStream(AStatus, outStream);
    // CLOSE en cas de succès combine l’interface IBLOB Par conséquent, l’appel suivant n’est pas nécessaire
    outBlob.close(AStatus);
    outBlob := nil;
  finally
    if Assigned(inBlob) then
      inBlob.release;
    if Assigned(stmt) then
      stmt.release;
    if Assigned(rs) then
      rs.release;
    if Assigned(outBlob) then
      outBlob.release;
    tra.release;
    att.release;
    jsonArray.Free;
    inStream.Free;
    outStream.Free;
  end;
end;

Tout d’abord, nous obtenons une connexion actuelle à partir du contexte de la fonction et de la transaction en cours en utilisant les méthodes getAttachment et getTransaction de l’interface IExternalContext. Ensuite, nous lisons le contenu du BLOB pour obtenir le texte de la requête SQL. La requête est préparée à l’aide de la méthode Prepare de l’interface IAttachment. Le cinquième paramètre est transmis par le dialecte SQL obtenu à partir du paramètre d’entrée de notre fonction.

Le sixième paramètre est l’indicateur IStatement.PREPARE_PREFETCH_METADATA, ce qui signifie que nous voulons obtenir un curseur de métadonnées avec le résultat de la préparation de la requête. Nous obtenons la fin du curseur de métadonnées à l’aide de getOutputMetadata via l’interface IStatement.

Note
Comment

En fait, la méthode getoutPutmetadata renverra les métadonnées de fin dans tous les cas. L’indicateur IStatement.PREPARE_PREFETCH_METADATA forcera les métadonnées avec le résultat de la préparation d’une demande pour un paquet réseau.Étant donné que nous nous conformons à une demande dans le cadre de la connexion actuelle de n’importe quel échange de réseau, ce n’est pas fondamental.

Ensuite, ouvrez le curseur à l’aide de la méthode openCursor dans le cadre de la transaction en cours (paramètre 2). Nous obtenons la taille du tampon de sortie au résultat du curseur à l’aide de getMessageLength de l’interface IMessageMetadata. Cela vous permet de mettre à dimension la mémoire du tampon, que nous libérerons immédiatement après le verrouillage du dernier enregistrement du curseur.

Les enregistrements de curseur sont lus à l’aide de la méthode fetchNext de IResultSet. Cette méthode remplit le tampon msg avec les valeurs des champs du curseur et renvoie IStatus.RESULT_OK jusqu’à ce que les enregistrements du curseur soient terminés. Chaque enregistrement lu est transmis à la méthode Writejson, qui ajoute un objet tel que TJsonObject avec un curseur sérialisé enregistrant dans le tableau TJsonArray.

Après avoir terminé le travail avec le curseur, nous le fermons par la méthode close, convertissons un tableau d’objets json en une ligne, écrivons-le dans le flux de sortie, que nous écrivons dans la sortie Blob.

Analysons maintenant la méthode writeJson. Nous aurons besoin de l’objet IUtil pour recevoir des fonctions de décodage de la date et de l’heure. Cette méthode consiste activement à travailler avec les champs de sortie des métadonnées du curseur à l’aide de l’interface IMessageMetadata.

Tout d’abord, nous créons un type d’objet TJsonObject dans lequel nous allons enregistrer les valeurs des champs de l’enregistrement courant. Comme noms des clés, nous utiliserons l’alias des champs du curseur. Si Nullflag est vérifié, alors nous écrivons la valeur de NULL pour la clé et passons au champ suivant, sinon nous analysons le type de champ et écrivons sa valeur en JSON.

function TJsonFunction.MakeScaleInteger(AValue: Int64; Scale: Smallint): string;
var
  L: Integer;
begin
  Result := AValue.ToString;
  L := Result.Length;
  if (-Scale >= L) then
    Result := '0.' + Result.PadLeft(-Scale, '0')
  else
    Result := Result.Insert(Scale + L, '.');
end;


procedure TJsonFunction.writeJson(AStatus: IStatus; AContext: IExternalContext;
  AJson: TJsonArray; ABuffer: PByte; AMeta: IMessageMetadata;
  AFormatSettings: TFormatSettings);
var
  jsonObject: TJsonObject;
  i: Integer;
  FieldName: string;
  NullFlag: WordBool;
  fieldType: Cardinal;
  pData: PByte;
  util: IUtil;
  metaLength: Integer;
  // types
  CharBuffer: TBytes;
  charLength: Smallint;
  charset: TFBCharSet;
  StringValue: string;
  SmallintValue: Smallint;
  IntegerValue: Integer;
  BigintValue: Int64;
  Scale: Smallint;
  SingleValue: Single;
  DoubleValue: Double;
  Dec16Value: FB_DEC16Ptr;
  xDec16Buf: array[0..IDecFloat16.STRING_SIZE-1] of AnsiChar;
  xDecFloat16: IDecFloat16;
  Dec34Value: FB_DEC34Ptr;
  xDec34Buf: array[0..IDecFloat34.STRING_SIZE-1] of AnsiChar;
  xDecFloat34: IDecFloat34;
  BooleanValue: Boolean;
  DateValue: ISC_DATE;
  TimeValue: ISC_TIME;
  TimeValueTz: ISC_TIME_TZPtr;
  TimestampValue: ISC_TIMESTAMP;
  TimestampValueTz: ISC_TIMESTAMP_TZPtr;
  tzBuffer: array[0..63] of AnsiChar;
  DateTimeValue: TDateTime;
  year, month, day: Cardinal;
  hours, minutes, seconds, fractions: Cardinal;
  blobId: ISC_QUADPtr;
  BlobSubtype: Smallint;
  att: IAttachment;
  tra: ITransaction;
  blob: IBlob;
  textStream: TStringStream;
  binaryStream: TBytesStream;
{$IFDEF FPC}
  base64Stream: TBase64EncodingStream;
  xFloatJson: TJSONFloatNumber;
{$ENDIF}
  xInt128: IInt128;
  Int128Value: FB_I128Ptr;
  xInt128Buf: array[0..IInt128.STRING_SIZE-1] of AnsiChar;
begin
  // Nous obtenons Util
  util := AContext.getMaster().getUtilInterface();
  // Nous créons un objet Tjsonobject dans lequel nous allons
  // écrire la valeur des champs d'enregistrement.
  jsonObject := TJsonObject.Create;
  for i := 0 to AMeta.getCount(AStatus) - 1 do
  begin
    // Nous obtenons des champs alias dans la requête
    FieldName := AMeta.getAlias(AStatus, i);
    NullFlag := PWordBool(ABuffer + AMeta.getNullOffset(AStatus, i))^;
    if NullFlag then
    begin
      // Si Null, nous l'écrivons en json et passons au champ suivant.
{$IFNDEF FPC}
      jsonObject.AddPair(FieldName, TJsonNull.Create);
{$ELSE}
      jsonObject.Add(FieldName, TJsonNull.Create);
{$ENDIF}
      continue;
    end;
    // Nous recevons un pointeur sur ces champs
    pData := ABuffer + AMeta.getOffset(AStatus, i);
    // identique AMeta->getType(AStatus, i) & ~1
    fieldType := AMeta.getType(AStatus, i) and not 1;
    case fieldType of
      // VARCHAR
      SQL_VARYING:
        begin
          // Taille de la mémoire tampon pour Varchar
          metaLength := AMeta.getLength(AStatus, i);
          SetLength(CharBuffer, metaLength);
          charset := TFBCharSet(AMeta.getCharSet(AStatus, i));
          charLength := PSmallint(pData)^;
          // Les données binaires sont encodées en Base64
          if charset = CS_BINARY then
          begin
{$IFNDEF FPC}
            StringValue := TNetEncoding.base64.EncodeBytesToString((pData + 2),
              charLength);
{$ELSE}
            // Pour Varchar, les 2 premiers octets - longueur en octets,
            // donc copie dans la mémoire tampon à partir de 3 octets.
            Move((pData + 2)^, CharBuffer[0], metaLength);
            StringValue := charset.GetString(CharBuffer, 0, charLength);
            StringValue := EncodeStringBase64(StringValue);
{$ENDIF}
          end
          else
          begin
            // Pour Varchar, les 2 premiers octets - longueur en octets,
            // donc copie dans la mémoire tampon à partir de 3 octets.
            Move((pData + 2)^, CharBuffer[0], metaLength);
            StringValue := charset.GetString(CharBuffer, 0, charLength);
          end;
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
      // CHAR
      SQL_TEXT:
        begin
          // Taille de la mémoire tampon pour Char
          metaLength := AMeta.getLength(AStatus, i);
          SetLength(CharBuffer, metaLength);
          charset := TFBCharSet(AMeta.getCharSet(AStatus, i));
          Move(pData^, CharBuffer[0], metaLength);
          // Données binaires encodées en Base64
          if charset = CS_BINARY then
          begin
{$IFNDEF FPC}
            StringValue := TNetEncoding.base64.EncodeBytesToString(pData,
              metaLength);
{$ELSE}
            StringValue := charset.GetString(CharBuffer, 0, metaLength);
            StringValue := EncodeStringBase64(StringValue);
{$ENDIF}
          end
          else
          begin
            StringValue := charset.GetString(CharBuffer, 0, metaLength);
            charLength := metaLength div charset.GetCharWidth;
            SetLength(StringValue, charLength);
          end;
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
      // FLOAT
      SQL_FLOAT:
        begin
          SingleValue := PSingle(pData)^;
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, TJSONNumber.Create(SingleValue));
{$ELSE}
          jsonObject.Add(FieldName, TJSONFloatNumber.Create(SingleValue));
{$ENDIF}
        end;
      // DOUBLE PRECISION
      // DECIMAL(p, s), where p = 10..15 in 1 dialect
      SQL_DOUBLE, SQL_D_FLOAT:
        begin
          DoubleValue := PDouble(pData)^;
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, TJSONNumber.Create(DoubleValue));
{$ELSE}
          jsonObject.Add(FieldName, TJSONFloatNumber.Create(DoubleValue));
{$ENDIF}
        end;
      // DECFLOAT(16)
      SQL_DEC16:
        begin
          Dec16Value := FB_Dec16Ptr(pData);
          xDecFloat16 := util.getDecFloat16(AStatus);
          xDecFloat16.toString(AStatus, Dec16Value, IDecFloat16.STRING_SIZE, @xDec16Buf[0]);
          StringValue := AnsiString(@xDec16Buf[0]);
          StringValue := Trim(StringValue);
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
      // DECFLOAT(34)
      SQL_DEC34:
        begin
          Dec34Value := FB_Dec34Ptr(pData);
          xDecFloat34 := util.getDecFloat34(AStatus);
          xDecFloat34.toString(AStatus, Dec34Value, IDecFloat34.STRING_SIZE, @xDec34Buf[0]);
          StringValue := AnsiString(@xDec34Buf[0]);
          StringValue := Trim(StringValue);
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
      // INTEGER
      // NUMERIC(p, s), où p = 1..4
      SQL_SHORT:
        begin
          Scale := AMeta.getScale(AStatus, i);
          SmallintValue := PSmallint(pData)^;
          if (Scale = 0) then
          begin
{$IFNDEF FPC}
            jsonObject.AddPair(FieldName, TJSONNumber.Create(SmallintValue));
{$ELSE}
            jsonObject.Add(FieldName, SmallintValue);
{$ENDIF}
          end
          else
          begin
            StringValue := MakeScaleInteger(SmallintValue, Scale);
{$IFNDEF FPC}
            jsonObject.AddPair(FieldName, TJSONNumber.Create(StringValue));
{$ELSE}
            xFloatJson := TJSONFloatNumber.Create(0);
            xFloatJson.AsString := StringValue;
            jsonObject.Add(FieldName, xFloatJson);
{$ENDIF}
          end;
        end;
      // INTEGER
      // NUMERIC(p, s), où p = 5..9
      // DECIMAL(p, s), où p = 1..9
      SQL_LONG:
        begin
          Scale := AMeta.getScale(AStatus, i);
          IntegerValue := PInteger(pData)^;
          if (Scale = 0) then
          begin
{$IFNDEF FPC}
            jsonObject.AddPair(FieldName, TJSONNumber.Create(IntegerValue));
{$ELSE}
            jsonObject.Add(FieldName, IntegerValue);
{$ENDIF}
          end
          else
          begin
            StringValue := MakeScaleInteger(IntegerValue, Scale);
{$IFNDEF FPC}
            jsonObject.AddPair(FieldName, TJSONNumber.Create(StringValue));
{$ELSE}
            xFloatJson := TJSONFloatNumber.Create(0);
            xFloatJson.AsString := StringValue;
            jsonObject.Add(FieldName, xFloatJson);
{$ENDIF}
          end;
        end;
      // BIGINT
      // NUMERIC(p, s), where p = 10..18 in dialect 3
      // DECIMAL(p, s), where p = 10..18 in dialect 3
      SQL_INT64:
        begin
          Scale := AMeta.getScale(AStatus, i);
          BigintValue := Pint64(pData)^;
          if (Scale = 0) then
          begin
{$IFNDEF FPC}
            jsonObject.AddPair(FieldName, TJSONNumber.Create(BigintValue));
{$ELSE}
            jsonObject.Add(FieldName, BigintValue);
{$ENDIF}
          end
          else
          begin
            StringValue := MakeScaleInteger(BigintValue, Scale);
{$IFNDEF FPC}
            jsonObject.AddPair(FieldName, TJSONNumber.Create(StringValue));
{$ELSE}
            xFloatJson := TJSONFloatNumber.Create(0);
            xFloatJson.AsString := StringValue;
            jsonObject.Add(FieldName, xFloatJson);
{$ENDIF}
          end;
        end;
      SQL_INT128:
        begin
          Scale := AMeta.getScale(AStatus, i);
          Int128Value := FB_I128Ptr(pData);
          xInt128 := util.getInt128(AStatus);
          xInt128.toString(AStatus, Int128Value, Scale, IInt128.STRING_SIZE, @xInt128Buf[0]);
          StringValue := AnsiString(@xInt128Buf[0]);
          StringValue := Trim(StringValue);
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
      // TIMESTAMP
      SQL_TIMESTAMP:
        begin
          TimestampValue := PISC_TIMESTAMP(pData)^;
          // nous obtenons le décodage de la date-heure
          util.decodeDate(TimestampValue.timestamp_date, @year, @month, @day);
          util.decodeTime(TimestampValue.timestamp_time, @hours, @minutes, @seconds,
            @fractions);
          // Nous obtenons une date-heure dans notre type delphi
          DateTimeValue := EncodeDate(year, month, day) +
            EncodeTime(hours, minutes, seconds, fractions div 10);
          // On met en forme une date-heure selon un format donné
          StringValue := FormatDateTime('yyyy/mm/dd hh:nn:ss', DateTimeValue,
            AFormatSettings);
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
      // TIMESTAMP WITH TIME_ZONE
      SQL_TIMESTAMP_TZ:
        begin
          TimestampValueTz := ISC_TIMESTAMP_TZPtr(pData);
          // Nous obtenons les composants de la date-heure et du fuseau horaire
          util.decodeTimeStampTz(AStatus, TimestampValueTz, @year, @month, @day, @hours, @minutes, @seconds,
            @fractions, 64, @tzBuffer[0]);
          // Nous obtenons une date-heure dans notre type delphi
          DateTimeValue := EncodeDate(year, month, day) +
            EncodeTime(hours, minutes, seconds, fractions div 10);
          // Formater la date-heure selon le format donné + fuseau horaire
          StringValue := FormatDateTime('yyyy/mm/dd hh:nn:ss', DateTimeValue,
            AFormatSettings) + ' ' + AnsiString(@tzBuffer[0]);
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
      // DATE
      SQL_DATE:
        begin
          DateValue := PISC_DATE(pData)^;
          // Nous obtenons les composants de la date
          util.decodeDate(DateValue, @year, @month, @day);
          // On obtient une date dans le type natif Delphi
          DateTimeValue := EncodeDate(year, month, day);
          // Nous formatons la date selon le format donné
          StringValue := FormatDateTime('yyyy/mm/dd', DateTimeValue,
            AFormatSettings);
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
      // TIME
      SQL_TIME:
        begin
          TimeValue := PISC_TIME(pData)^;
          // Nous obtenons les composantes de l’heure
          util.decodeTime(TimeValue, @hours, @minutes, @seconds, @fractions);
          // Nous obtenons le temps dans le type natif Delphi
          DateTimeValue := EncodeTime(hours, minutes, seconds,
            fractions div 10);
          // Nous formatons l’heure selon un format donné
          StringValue := FormatDateTime('hh:nn:ss', DateTimeValue,
            AFormatSettings);
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
      // TIME WITH TIME ZONE
      SQL_TIME_TZ:
        begin
          TimeValueTz := ISC_TIME_TZPtr(pData);
          // Nous obtenons les composants de l’heure et du fuseau horaire
          util.decodeTimeTz(AStatus, TimeValueTz, @hours, @minutes, @seconds,
            @fractions, 64, @tzBuffer[0]);
          // Nous obtenons le temps dans le type natif Delphi
          DateTimeValue := EncodeTime(hours, minutes, seconds,
            fractions div 10);
          // Nous formatons l’heure en fonction d’un format donné + fuseau horaire
          StringValue := FormatDateTime('hh:nn:ss', DateTimeValue,
            AFormatSettings) + ' ' + AnsiString(@tzBuffer[0]);
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
      // BOOLEAN
      SQL_BOOLEAN:
        begin
          BooleanValue := PBoolean(pData)^;
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, TJsonBool.Create(BooleanValue));
{$ELSE}
          jsonObject.Add(FieldName, BooleanValue);
{$ENDIF}
        end;
      // BLOB
      SQL_BLOB, SQL_QUAD:
        begin
          BlobSubtype := AMeta.getSubType(AStatus, i);
          blobId := ISC_QUADPtr(pData);
          att := AContext.getAttachment(AStatus);
          tra := AContext.getTransaction(AStatus);
          blob := att.openBlob(AStatus, tra, blobId, 0, nil);
          try
            if BlobSubtype = 1 then
            begin
              // lyrics
              charset := TFBCharSet(AMeta.getCharSet(AStatus, i));
              // Créer un flux avec un encodage donné
{$IFNDEF FPC}
              textStream := TStringStream.Create('', charset.GetCodePage);
              try
                blob.SaveToStream(AStatus, textStream);
                blob.close(AStatus);
                blob := nil;
                StringValue := textStream.DataString;
              finally
                textStream.Free;
              end;
{$ELSE}
              binaryStream := TBytesStream.Create(nil);
              try
                blob.SaveToStream(AStatus, binaryStream);
                blob.close(AStatus);
                blob := nil;
                StringValue := TEncoding.UTF8.GetString(binaryStream.Bytes, 0,
                  binaryStream.Size);
              finally
                binaryStream.Free;
              end;
{$ENDIF}
            end
            else
            begin
{$IFNDEF FPC}
              // Tous les autres sous-types sont considérés comme binaires
              binaryStream := TBytesStream.Create;
              try
                blob.SaveToStream(AStatus, binaryStream);
                blob.close(AStatus);
                blob := nil;
                // Encoder la chaîne en base64
                StringValue := TNetEncoding.base64.EncodeBytesToString
                  (binaryStream.Memory, binaryStream.Size);
              finally
                binaryStream.Free;
              end
{$ELSE}
              textStream := TStringStream.Create('');
              base64Stream := TBase64EncodingStream.Create(textStream);
              try
                blob.SaveToStream(AStatus, base64Stream);
                blob.close(AStatus);
                blob := nil;
                StringValue := textStream.DataString;
              finally
                base64Stream.Free;
                textStream.Free;
              end;
{$ENDIF}
            end;
          finally
            if Assigned(blob) then blob.release;
            if Assigned(tra) then tra.release;
            if Assigned(att) then att.release;
          end;
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
    end;
  end;
  // Ajout d’une entrée au format json à un tableau
{$IFNDEF FPC}
  AJson.AddElement(jsonObject);
{$ELSE}
  AJson.Add(jsonObject);
{$ENDIF}
end;
Note

La liste du type TFbType est absente dans le module standard Firebird.pas. Cependant, il n’est pas pratique d’utiliser des valeurs numériques, j’ai donc écrit un module spécial FbTypes dans lequel j’ai placé des types supplémentaires pour plus de commodité.

L’énumération de TFBCharSet est également absente dans le module Firebird.pas.J’ai écrit un module séparé FbCharsets dans lequel ce transfert est posté. De plus, pour ce type, un Helper spécial est écrit, qui contient des fonctions permettant d’obtenir le nom de l’ensemble de caractères, le code page, la taille du symbole en octets, l’obtention de la classe TEncoding dans l’encodage nécessaire, ainsi que la fonction de conversion de la chaine d’octets en une chaîne de caractères Unicode Delphi.

Pour les lignes de type CHAR et VARCHAR, vérifiez l’encodage, si son encodage est OCTETS, alors nous encodons la ligne avec l’algorithme base64, sinon nous convertissons les données du tampon vers la ligne Delphi. Veuillez noter que pour le type de VARCHAR, les 2 premiers octets contiennent la longueur de la chaîne de caractères.

Les types de SMALLINT, INTEGER, BIGINT peuvent être des entiers ordinaires, donc évolutifs. L’échelle du nombre peut être obtenue par la fonction getScale de l’interface IMessageMetadata. Si l’échelle n’est pas égale à 0, un traitement spécial du nombre est nécessaire, qui est effectué par le MakeScaleInteger.

Les types DATE, TIME et TIMESTAMP sont décodés sur les composants de la date et de l’heure à l’aide des méthodes decodeDate et decodeTime de l’interface IUtil. Nous utilisons des parties de la date et de l’heure pour recevoir la date et l’heure dans le type standard Delphi TDateTime.

Avec le type BLOB, nous travaillons à travers des flux Delphi. Si le Blob est binaire, nous créons un flux comme TBytesStream. Le résultat d’un tableau d’octets est codé à l’aide de l’algorithme base64.Si BLOB est textuel, alors nous utilisons un flux spécialisé TStringStream pour une chaîne de caractères, ce qui permet de prendre en compte le code page. Nous obtenons le code page à partir de l’encodage du champ BLOB.

Pour travailler avec les données INT128, il y a une interface spéciale IInt128. Il peut être obtenu en appelant le getInt128 de l’interface IUtil. Ce type est apparu dans Firebird 4.0 et est conçu pour représenter avec précision de très grands nombres. Il n’y a pas de type de données direct dans Delphi, qui pourrait fonctionner avec ce type, nous affichons donc simplement au format de chaîne de caractères.

Pour travailler avec les types DECFLOAT(16) et DECFLOAT(34), il existe des interfaces spéciales IDecFloat16 et IDecFloat34.Ils peuvent être obtenus en appelant getDecFloat16 ou getDecFloat34 de l’interface IUtil. Ces types sont disponibles à partir de Firebird 4.0. Il n’y a pas de types de données directes dans Delphi qui pourraient fonctionner avec ces types. Ces types peuvent être affichés en BCD ou présentés sous la forme d’une chaîne de caractères.

Les types TIME WITH TIME ZONE et TIMESTAMP WITH TIME ZONE sont décodés sur les composants de la date et de l’heure, ainsi que sur le nom du fuseau horaire, à l’aide des méthodes decodeTimeStampTz et decodeTimeTz. Nous utilisons des parties de la date et de l’heure pour recevoir la date et l’heure dans le type standard de Delphi TDateTime. Ensuite, nous convertissons la valeur de ce type dans une chaîne de caractères et y ajoutons le nom du fuseau horaire.

Appendices

Appendix A: License notice

Le contenu de cette documentation est soumis à desLicence de documentation version 1.0 (ci-après dénommée « Licence ») ;vous ne pouvez utiliser cette Documentation que si vous respectez les conditions de la présente Licence.Des copies de la licence sont disponibles à l’adresse suivante : PDF and HTML.

La documentation originale s’appelle Writing UDR Firebird en Pascal.

L’auteur original de la documentation est : Denis Simonov.L’auteur du texte en russe est Denis Simonov.

Auteur: Denis Simonov.

Les parties créées par Denis Simonov sont protégées par le droit d’auteur © 2018-2023.Tous droits réservés.

(Contacts de l’auteur: sim-mail at list dot ru).

Contributeur : Martin Köditz.

Traduction en anglais. Les parties créées par Martin Köditz sont protégées par le droit d’auteur © 2023.Tous droits réservés.

(Contacts de l’auteur: martin koeditz at it syn dot de).

Contributeur : @Arcantar.

Traduction en français. Les parties créées par @arcantar sont protégées par le droit d’auteur © 2024.Tous droits réservés.

Appendix B: Historique du document

L’historique exact du fichier est enregistré dans le dépôt git firebird-documentation ; voir firebird-documentation

Historique des révisions

1.0.0-fr

23 Jan 2024

@A

Traduction française du document anglais par @Arcantar.

1.0.0

22 Sep 2023

MK

Traduction anglaise du document russe par Martin Köditz.

1.0.0-ru

21 Sep 2023

DS

Première version du document. L’original a été rédigé par Denis Simonov en langue russe.