Введение
В Firebird уже достаточно давно существует возможность расширениявозможностей языка PSQL с помощью написания внешних функций — UDF (UserDefined Functions). UDF можно писать практически на любом компилируемомязыке программирования.
В Firebird 3.0 была введена плагинная архитектура для расширениявозможностей Firebird. Одним из таких плагинов является External Engine(внешние движки). Механизм UDR (User Defined Routines — определяемыепользователем подпрограммы) добавляет слой поверх интерфейса движкаFirebirdExternal. UDR имеют следующие преимущества по сравнению с UDF:
-
можно писать не только функции возвращающие скалярный результат, но ихранимые процедуры (как выполняемые, так и селективные), а так жетриггеры;
-
улучшенный контроль входных и выходных параметров. В ряде случаев(передача по дескриптору) типы и другие свойства входных параметроввообще не контролировались, однако вы могли получить эти свойства внутриUDF. UDR предоставляют более унифицированный способ объявления входных ивыходных параметров, так как это делается в случае с обычными PSQLфункциями и процедурами;
-
в UDR доступен контекст текущего соединения или транзакции, чтопозволяет выполнять некоторые манипуляции с текущей базой данных в этомконтексте;
-
внешние процедуры и функции (UDR) можно группировать в PSQL пакетах;
-
UDR могут быть написаны на любом языке программирования (необязательнокомпилируемые в объектные коды), для этого необходим соответствующийExternal Engine плагин. Например, существуют плагины длянаписания внешних модулей на Java или на любом из .NET языков.
В данном руководстве мы расскажем как объявлять UDR, об их внутреннихмеханизмах, возможностях и приведём примеры написания UDR на языкеPascal. Кроме того, будут затронуты некоторые аспекты использованиянового объектно-ориентированного API.
Далее в различных главах этого руководства при употреблении терминоввнешняя процедура, функция или триггер мы будем иметь в виду именно UDR,а не UDF.
Note
|
Все наши примеры работают на Delphi 2009 и старше, а так же на FreePascal. Все примеры могут быть скомпилированы как в Delphi, так и в FreePascal, если это не оговорено отдельно. |
Firebird API
Для написания внешних процедур, функций или триггеров на компилируемыхязыках программирования нам потребуются знания о новом объектноориентированном API Firebird. Данное руководство не включает полногоописания Firebird API. Вы можете ознакомиться с ним в каталогедокументации, распространяемой вместе с Firebird(doc/Using_OO_API.html
). Для русскоязычных пользователей существуетперевод данного документа доступный по адресуhttps://github.com/sim1984/fbooapi/releases/download/1.0/fbapi30.pdf иhttps://github.com/sim1984/fbooapi/releases/download/1.0/fbapi40.pdf.
Подключаемые файлы для различных языков программирования, содержащиеинтерфейсы API, не распространяются в составе дистрибутива Firebird подWindows, однако вы можете извлечь их из распространяемых под Linuxсжатых tarbar файлов (путь внутри архива/opt/firebird/include/firebird/Firebird.pas
).
CLOOP
CLOOP — Cross Language Object Oriented Programming. Этот инструмент невходит в поставку Firebird. Его можно найти в исходных кодахhttps://github.com/FirebirdSQL/firebird/tree/B3_0_Release/extern/cloop.После того как инструмент будет собран, можно на основе файла описанияинтерфейсов include/firebird/FirebirdInterface.idl
сгенерировать APIдля вашего языка программирования (IdlFbInterfaces.h
илиFirebird.pas
).
Для Object pascal это делается следующей командой:
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
Файлы Pascal.interface.pas
, Pascal.implementation.pas
иfb_get_master_interface.pas
можно найти по адресуhttps://github.com/FirebirdSQL/firebird/tree/B3_0_Release/src/misc/pascal.
Note
|
Замечание
В данном случае для интерфейсов Firebird API будет добавлен префикс I, так как это принято в Object Pascal. |
Константы
В полученном файле Firebird.pas
отсутствуют isc_*
константы. Этиконстанты для языков C/C++ можно найти под адресуhttps://github.com/FirebirdSQL/firebird/blob/B3_0_Release/src/include/consts_pub.h.Для получения констант для языка Pascal воспользуемся AWK скриптом дляпреобразования синтаксиса. В Windows вам потребуется установить Gawk forWindows или воспользоваться Windows Subsystem for Linux (доступно вWindows 10). Это делается следующей командой:
awk -f Pascal.Constants.awk consts_pub.h > const.pas
Содержимое полученного файла необходимо скопировать в пустую секциюconst файла Firebird.pas
сразу после implementation. ФайлPascal.Constants.awk
, можно найти по адресуhttps://github.com/FirebirdSQL/firebird/tree/B3_0_Release/src/misc/pascal.
Управление временем жизни
Интерфейсы Firebird не основываются на спецификации COM, поэтомууправление их временем жизни осуществляется иначе.
В Firebird существует два интерфейса, имеющих дело с управлениемвременем жизни: IDisposable
и IReferenceCounted
. Последний особенноактивен при создании других интерфейсов: IPlugin
подсчитывает ссылки,как и многие другие интерфейсы, используемые подключаемыми модулями. Кним относятся интерфейсы, которые описывают соединение с базой данных,управление транзакциями и операторы SQL.
Не всегда нужны дополнительные издержки интерфейса с подсчетом ссылок.Например, IMaster
, основной интерфейс, который вызывает функции,доступные для остальной части API, имеет неограниченное время жизни поопределению. Для других интерфейсов API время жизни строго определяетсявременем жизни родительского интерфейса; интерфейс IStatus
не являетсямногопоточным. Для интерфейсов с ограниченным временем жизни полезноиметь простой способ их уничтожения, то есть функцию dispose()
.
Tip
|
Подсказка
Если вы не знаете, как уничтожается объект, посмотрите его иерархию,если в ней есть интерфейс |
Некоторые методы интерфейсов производных от IReferenceCounted
, освобождают интерфейспосле успешного выполнения. После вызова таких методов не надо вызывать release()
.
Так сделано по историческим причинам, потому что аналогичные функции из ISC API освобождали соответствующий хендл.
Приведу список таких методов:
-
Интерфейс
IAttachment
-
detach(status: IStatus)
- отключение соединения с базой данной. При успешном выполнении освобождает интерфейс. -
dropDatabase(status: IStatus)
- удаление базы данных. При успешном выполнении освобождает интерфейс.
-
-
Интерфейс
ITransaction
-
commit(status: IStatus)
- подтверждение транзакции. При успешном выполнении освобождает интерфейс. -
rollback(status: IStatus)
- откат транзакции. При успешном выполнении освобождает интерфейс.
-
-
Интерфейс
IStatement
-
free(status: IStatus)
- удаляет подготовленный запрос. При успешном выполнении освобождает интерфейс.
-
-
Интерфейс
IResultSet
-
close(status: IStatus)
- закрывает курсор. При успешном выполнении освобождает интерфейс.
-
-
Интерфейс
IBlob
-
cancel(status: IStatus)
- отменяет все изменения сделанные во временном BLOB (если они были) и закрывает BLOB. При успешном выполнении освобождает интерфейс. -
close(status: IStatus)
- сохраняет все изменения сделанные во временном BLOB (если они были) и закрывает BLOB. При успешном выполнении освобождает интерфейс.
-
-
Интерфейс
IService
-
detach(status: IStatus)
- отключение соединения с менеджером сервисов. При успешном выполнении освобождает интерфейс.
-
-
Интерфейс
IEvents
-
cancel(status: IStatus)
- отменяет подписку на события. При успешном выполнении освобождает интерфейс.
-
Объявления UDR
UDR могут быть добавлены или удалены из базы данных с помощью DDL командподобно тому, как вы добавляете или удаляете обычные PSQL процедуры,функции или триггеры. В этом случае вместо тела триггера указываетсяместо его расположения во внешнем модуле с помощью предложения EXTERNAL NAME
.
Рассмотрим синтаксис этого предложения, он будет общим для внешнихпроцедур, функций и триггеров.
EXTERNAL NAME '<extname>' ENGINE <engine> [AS <extbody>] <extname> ::= '<module name>!<routine name>[!<misc info>]'
Аргументом этого предложения EXTERNAL NAME
является строка, указывающаяна расположение функции во внешнем модуле. Для внешних модулей,использующих движок UDR, в этой строке через разделитель указано имявнешнего модуля, имя функции внутри модуля и определённая пользователеминформация. В качестве разделителя используется восклицательный знак(!).
В предложении ENGINE указывается имя движка для обработки подключениявнешних модулей. В Firebird для работы с внешними модулями написанных накомпилируемых языках (C, C++, Pascal) используется движок UDR. Длявнешних функций написанных на Java требуется движок Java.
После ключевого слова AS
может быть указан строковый литерал — "тело"внешнего модуля (процедуры, функции или триггера), оно может бытьиспользовано внешним модулем для различных целей. Например, может бытьуказан SQL запрос для доступа к внешней БД или текст на некотором языкедля интерпретации вашей функцией.
Внешние функции
{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])]
Все параметры внешней функции можно изменить с помощью оператора ALTERFUNCTION
.
ALTER FUNCTION funcname [(<inparam> [, <inparam> ...])] RETURNS <type> [COLLATE collation] [DETERMINISTIC] EXTERNAL NAME <extname> ENGINE <engine> [AS <extbody>] <extname> ::= '<module name>!<routine name>[!<misc info>]'
Удалить внешнюю функцию можно с помощью оператора DROP FUNCTION.
DROP FUNCTION funcname
Параметр | Описание |
---|---|
funcname |
Имя хранимой функции. Может содержать до 31 байта. |
inparam |
Описание входного параметра. |
module name |
Имя внешнего модуля, в котором расположена функция. |
routine name |
Внутреннее имя функции внутри внешнего модуля. |
misc info |
Определяемая пользователем информация для передачи в функциювнешнего модуля. |
engine |
Имя движка для использования внешних функций. Обычноуказывается имя UDR. |
extbody |
Тело внешней функции. Строковый литерал который можетиспользоваться UDR для различных целей. |
Здесь мы не будем описывать синтаксис входных параметров и выходногорезультата. Он полностью соответствует синтаксису для обычных PSQLфункций, который подробно описан в "Руководстве по языку SQL". Вместоэтого приведём примеры объявления внешних функций с пояснениями.
create function sum_args (
n1 integer,
n2 integer,
n3 integer
)
returns integer
external name 'udrcpp_example!sum_args'
engine udr;
Реализация функции находится в модуле udrcpp_example
. Внутри этогомодуля функция зарегистрирована под именем sum_args
. Для работы внешнейфункции используется движок UDR.
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;
Реализация функции находится в статической функции replace
классаorg.firebirdsql.fbjava.examples.fbjava_example.FbRegex
. Для работывнешней функции используется движок Java.
Внешние процедуры
{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])]
Все параметры внешней процедуры можно изменить с помощью оператора ALTER PROCEDURE
.
ALTER PROCEDURE procname [(<inparam> [, <inparam> ...])] RETURNS (<outparam> [, <outparam> ...]) EXTERNAL NAME <extname> ENGINE <engine> [AS <extbody>]
Удалить внешнюю процедуру можно с помощью оператора DROP PROCEDURE
.
DROP PROCEDURE procname
Параметр | Описание |
---|---|
procname |
Имя хранимой процедуры. Может содержать до 31 байта. |
inparam |
Описание входного параметра. |
outparam |
Описание выходного параметра. |
module name |
Имя внешнего модуля, в котором расположена процедура. |
routine name |
Внутреннее имя процедуры внутри внешнего модуля. |
misc info |
Определяемая пользователем информация для передачи впроцедуру внешнего модуля. |
engine |
Имя движка для использования внешних процедур. Обычноуказывается имя UDR. |
extbody |
Тело внешней процедуры. Строковый литерал который можетиспользоваться UDR для различных целей. |
Здесь мы не будем описывать синтаксис входных и выходных параметров. Онполностью соответствует синтаксису для обычных PSQL процедур, которыйподробно описан в "Руководстве по языку SQL". Вместо этого приведёмпримеры объявления внешних процедур с пояснениями.
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;
Реализация функции находится в модуле pascaludr
. Внутри этого модуляпроцедура зарегистрирована под именем gen_rows
. Для работы внешнейпроцедуры используется движок UDR.
create or alter procedure write_log (
message varchar(100)
)
external name 'pascaludr!write_log'
engine udr;
Реализация функции находится в модуле pascaludr
. Внутри этого модуляпроцедура зарегистрирована под именем write_log
. Для работы внешнейпроцедуры используется движок UDR.
create or alter procedure employee_pgsql (
-- Firebird 3.0.0 has a bug with external procedures without parameters
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';
Реализация функции находится в статической функции executeQuery классаorg.firebirdsql.fbjava.examples.fbjava_example.FbJdbc
. Послевосклицательного знака "!" располагаются сведения для подключения квнешней базе данных через JDBC. Для работы внешней функции используетсядвижок Java. Здесь в качестве "тела" внешней процедуру передаётся SQLзапрос для извлечения данных.
Note
|
Замечание
В этой процедуре используется заглушка, в которой передаётсянеиспользуемый параметр. Это связано с тем, что в Firebird 3.0присутствует баг с обработкой внешних процедур без параметров. |
Размещение внешних процедур и функций внутри пакетов
Группу взаимосвязанных процедур и функций удобно размещать в PSQLпакетах. В пакетах могут быть расположены как внешние, так и обычныеPSQL процедуры и функции.
{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>]'
Для внешних процедур и функций в заголовке пакета указываются имя,входные параметры, их типы, значения по умолчанию, и выходные параметры,а в теле пакета всё то же самое, кроме значений по умолчанию, а такжеместо расположения во внешнем модуле (предложение EXTERNAL NAME
), имядвижка, и возможно "тело" процедуры/функции.
Предположим вы написали UDR для работы с регулярными выражениями,которая расположена во внешнем модуле (динамической библиотеке) PCRE, иу вас есть ещё несколько UDR выполняющих другие задачи. Если бы мы неиспользовали PSQL пакеты, то все наши внешние процедуры и функции былибы перемешаны как друг с другом, так и с обычными PSQL процедурами ифункциями. Это усложняет поиск зависимостей и внесение изменений вовнешние модули, а кроме того создаёт путаницу, и заставляет как минимумиспользовать префиксы для группировки процедур и функций. PSQL пакетызначительно облегчают нам эту задачу.
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 ;^
Внешние триггеры
{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
Внешний триггер можно изменить с помощью оператора ALTER TRIGGER
.
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 }
Удалить внешний триггер можно с помощью оператора DROP TRIGGER
.
DROP TRIGGER trigname
Параметр | Описание |
---|---|
trigname |
Имя триггера. Может содержать до 31 байта. |
relation_trigger_legacy |
Объявление табличного триггера(унаследованное). |
relation_trigger_sql2003 |
Объявление табличного триггера согласностандарту SQL-2003. |
database_trigger |
Объявление триггера базы данных. |
ddl_trigger |
Объявление DDL триггера. |
tablename |
Имя таблицы. |
viewname |
Имя представления. |
mutation_list |
Список событий таблицы. |
mutation |
Одно из событий таблицы. |
db_event |
Событие соединения или транзакции. |
ddl_events |
Список событий изменения метаданных. |
ddl_event_item |
Одно из событий изменения метаданных. |
number |
Порядок срабатывания триггера. От 0 до 32767. |
extbody |
Тело внешнего триггера. Строковый литерал который можетиспользоваться UDR для различных целей. |
module name |
Имя внешнего модуля, в котором расположен триггер. |
routine name |
Внутреннее имя триггера внутри внешнего модуля. |
misc info |
Определяемая пользователем информация для передачи в триггервнешнего модуля. |
engine |
Имя движка для использования внешних триггеров. Обычноуказывается имя UDR. |
Приведём примеры объявления внешних триггеров с пояснениями.
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;
Реализация триггера находится в модуле udrcpp_example
. Внутри этогомодуля триггер зарегистрирован под именем replicate
. Для работы внешнеготриггера используется движок UDR.
В ссылке на внешний модуль используется дополнительный параметр ds1
,по которому внутри внешнего триггера из таблицы replicate_configчитается конфигурация для связи с внешней базой данных.
Структура UDR
Мы будем описывать структуру UDR на языке Pascal. Для объясненияминимальной структуры для построения UDR будем использовать стандартныепримеры из examples/udr/
переведённых на Pascal.
Создайте новый проект динамической библиотеки, который назовёмMyUdr. В результате у вас должен получиться файл MyUdr.dpr
(если высоздавали проект в Delphi) или файл MyUdr.lpr
(если вы создали проектв Lazarus). Теперь изменим главный файл проекта так, чтобы он выгляделследующим образом:
library MyUdr;
{$IFDEF FPC}
{$MODE DELPHI}{$H+}
{$ENDIF}
uses
{$IFDEF unix}
cthreads,
// the c memory manager is on some systems much faster for multi-threading
cmem,
{$ENDIF}
UdrInit in 'UdrInit.pas',
SumArgsFunc in 'SumArgsFunc.pas';
exports firebird_udr_plugin;
end.
В данном случае необходимо экспортировать всего одну функциюfirebird_udr_plugin
, которая является точкой входа для плагина внешнихмодулей UDR. Реализация этой функции будет находиться в модуле UdrInit
.
Note
|
Замечание
Если вы разрабатываете вашу UDR в Free Pascal, то вам потребуютсядополнительные директивы. Директива Директива Кроме того, нам потребуется подключить отдельные модули для поддержкимногопоточности в Linux и других Unix-подобных операционных системах. |
Регистрация функций
Теперь добавим модуль UdrInit
, он должен выглядеть следующим образом:
unit UdrInit;
{$IFDEF FPC}
{$MODE DELPHI}{$H+}
{$ENDIF}
interface
uses
Firebird;
// точка входа для External Engine модуля 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
// регистрируем наши функции
AUdrPlugin.registerFunction(AStatus, 'sum_args',
TSumArgsFunctionFactory.Create());
// регистрируем наши процедуры
//AUdrPlugin.registerProcedure(AStatus, 'sum_args_proc',
// TSumArgsProcedureFactory.Create());
//AUdrPlugin.registerProcedure(AStatus, 'gen_rows', TGenRowsFactory.Create());
// регистрируем наши триггеры
//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.
В функции firebird_udr_plugin
необходимо зарегистрировать фабрикинаших внешних процедур, функций и триггеров. Для каждой функции,процедуры или триггера необходимо написать свою фабрику. Это делается спомощью методов интерфейса IUdrPlugin
:
-
registerFunction
- регистрирует внешнюю функцию; -
registerProcedure
- регистрирует внешнюю процедуру; -
registerTrigger
- регистрирует внешний триггер.
Первым аргументом этих функций является указатель на статус вектор,далее следует внутреннее имя функции (процедуры или триггера).Внутреннее имя будет использоваться при созданиипроцедуры/функции/триггера на SQL. Третьим аргументом передаётсяэкземпляр фабрики для создания функции (процедуры или триггера).
Фабрика функций
Теперь необходимо написать фабрику и саму функцию. Они будут расположеныв модуле SumArgsFunc
. Примеры для написания процедур и триггеров будутпредставлены позже.
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
// структура на которое будет отображено входное сообщение
TSumArgsInMsg = record
n1: Integer;
n1Null: WordBool;
n2: Integer;
n2Null: WordBool;
n3: Integer;
n3Null: WordBool;
end;
PSumArgsInMsg = ^TSumArgsInMsg;
// структура на которое будет отображено выходное сообщение
TSumArgsOutMsg = record
result: Integer;
resultNull: WordBool;
end;
PSumArgsOutMsg = ^TSumArgsOutMsg;
// Фабрика для создания экземпляра внешней функции TSumArgsFunction
TSumArgsFunctionFactory = class(IUdrFunctionFactoryImpl)
// Вызывается при уничтожении фабрики
procedure dispose(); override;
{ Выполняется каждый раз при загрузке внешней функции в кеш метаданных.
Используется для изменения формата входного и выходного сообщения.
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней функции)
@param(AMetadata Метаданные внешней функции)
@param(AInBuilder Построитель сообщения для входных метаданных)
@param(AOutBuilder Построитель сообщения для выходных метаданных)
}
procedure setup(AStatus: IStatus; AContext: IExternalContext;
AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder;
AOutBuilder: IMetadataBuilder); override;
{ Создание нового экземпляра внешней функции TSumArgsFunction
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней функции)
@param(AMetadata Метаданные внешней функции)
@returns(Экземпляр внешней функции)
}
function newItem(AStatus: IStatus; AContext: IExternalContext;
AMetadata: IRoutineMetadata): IExternalFunction; override;
end;
// Внешняя функция TSumArgsFunction.
TSumArgsFunction = class(IExternalFunctionImpl)
// Вызывается при уничтожении экземпляра функции
procedure dispose(); override;
{ Этот метод вызывается непосредственно перед execute и сообщает
ядру наш запрошенный набор символов для обмена данными внутри
этого метода. Во время этого вызова контекст использует набор символов,
полученный из ExternalEngine::getCharSet.
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней функции)
@param(AName Имя набора символов)
@param(AName Длина имени набора символов)
}
procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
AName: PAnsiChar; ANameSize: Cardinal); override;
{ Выполнение внешней функции
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней функции)
@param(AInMsg Указатель на входное сообщение)
@param(AOutMsg Указатель на выходное сообщение)
}
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
// преобразовываем указатели на вход и выход к типизированным
xInput := PSumArgsInMsg(AInMsg);
xOutput := PSumArgsOutMsg(AOutMsg);
// по умолчанию выходной аргумент = NULL, а поэтому выставляем ему nullFlag
xOutput^.resultNull := True;
// если один из аргументов NULL значит и результат NULL
// в противном случае считаем сумму аргументов
with xInput^ do
begin
if not (n1Null or n2Null or n3Null) then
begin
xOutput^.result := n1 + n2 + n3;
// раз есть результат, то сбрасываем NULL флаг
xOutput^.resultNull := False;
end;
end;
end;
procedure TSumArgsFunction.getCharSet(AStatus: IStatus;
AContext: IExternalContext; AName: PAnsiChar; ANameSize: Cardinal);
begin
end;
end.
Фабрика внешней функции должна реализовать интерфейсIUdrFunctionFactory
. Для упрощения просто наследуем классIUdrFunctionFactoryImpl
. Для каждой внешней функции нужна своя фабрика.Впрочем, если фабрики не имеют специфики для создания некоторой функции,то можно написать обобщённую фабрику с помощью дженериков. Позже мыприведём пример как это сделать.
Метод dispose
вызывается при уничтожении фабрики, в нём мы должныосвободить ранее выделенные ресурсы. В данном случае просто вызываемдеструктор.
Метод setup выполняется каждый раз при загрузке внешней функции в кешметаданных. В нём можно делать различные действия которые необходимыперед созданием экземпляра функции, например изменить формат для входныхи выходных сообщений. Более подробно поговорим о нём позже.
Метод newItem
вызывается для создания экземпляра внешней функции. В этотметод передаётся указатель на статус вектор, контекст внешней функции иметаданные внешней функции. С помощью IRoutineMetadata
вы можетеполучить формат входного и выходного сообщения, тело внешней функции идругие метаданные. В этом методе вы можете создавать различныеэкземпляры внешней функции в зависимости от её объявления в PSQL.Метаданные можно передать в созданный экземпляр внешней функции если этонеобходимо. В нашем случае мы просто создаём экземпляр внешней функцииTSumArgsFunction
.
Экземпляр функции
Внешняя функция должна реализовать интерфейс IExternalFunction
. Дляупрощения просто наследуем класс IExternalFunctionImpl
.
Метод dispose
вызывается при уничтожении экземпляра функции, в нём мыдолжны освободить ранее выделенные ресурсы. В данном случае простовызываем деструктор.
Метод getCharSet
используется для того, чтобы сообщить контексту внешней функциинабор символов, который мы хотим использовать при работе с соединением из текущего контекста.По умолчанию соединение из текущего контекста работает в кодировке текущего подключения, что не всегда удобно.
Метод execute
обрабатывает непосредственно сам вызов функции. В этотметод передаётся указатель на статус вектор, указатель на контекствнешней функции, указатели на входное и выходное сообщение.
Контекст внешней функции может потребоваться нам для получения контекстатекущего соединения или транзакции. Даже если вы не будете использоватьзапросы к базе данных в текущем соединении, то эти контексты всё равномогут потребоваться вам, особенно при работе с типом BLOB. Примерыработы с типом BLOB, а также использование контекстов соединения итранзакции будут показаны позже.
Входные и выходные сообщения имеют фиксированную ширину, которая зависитот типов данных декларируемых для входных и выходных переменныхсоответственно. Это позволяет использовать типизированные указатели наструктуры фиксированный ширины, члены который должны соответствоватьтипам данных. Из примера видно, что для каждой переменной в структуреуказывается член соответствующего типа, после чего идёт член, которыйявляется признаком специального значения NULL (далее Null флаг). Помимоработы с буферами входных и выходных сообщений через структуры,существует ещё один способ с использованием адресной арифметики науказателях с использованием смещениях, значения которых можно получитьиз интерфейса IMessageMetadata
. Подробнее о работе с сообщениями мыпоговорим далее, а сейчас просто поясним что делалось в методе execute.
Первым делом мы преобразовываем не типизированные указатели ктипизированным. Для выходного значение устанавливаем Null флаг взначение True
(это необходимо чтобы функция возвращала NULL
, если одиниз входных аргументов равен NULL
). Затем проверяем Null флаги у всехвходных аргументов, если ни один из входных аргументов не равен NULL
, товыходное значение будет равно сумме значений аргументов. Важно не забытьсбросить Null флаг выходного аргумента в значение False
.
Регистрация процедур
Пришло время добавить в наш UDR модуль хранимую процедуру. Как известнохранимые процедуры бывают двух видов: выполняемые хранимые процедуры ихранимые процедуры для выборки данных. Сначала добавим выполняемуюхранимую процедуру, т.е. такую хранимую процедуру, которая может бытьвызвана с помощью оператора EXECUTE PROCEDURE
и может вернуть не болееодной записи.
Вернитесь в модуль UdrInit
и измените функцию firebird_udr_plugin
так,чтобы она выглядела следующим образом.
function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
// регистрируем наши функции
AUdrPlugin.registerFunction(AStatus, 'sum_args',
TSumArgsFunctionFactory.Create());
// регистрируем наши процедуры
AUdrPlugin.registerProcedure(AStatus, 'sum_args_proc',
TSumArgsProcedureFactory.Create());
//AUdrPlugin.registerProcedure(AStatus, 'gen_rows', TGenRowsFactory.Create());
// регистрируем наши триггеры
//AUdrPlugin.registerTrigger(AStatus, 'test_trigger',
// TMyTriggerFactory.Create());
theirUnloadFlag := AUnloadFlagLocal;
Result := @myUnloadFlag;
end;
Note
|
Замечание
Не забудьте добавить в список |
Фабрика процедур
Фабрика внешней процедуры должна реализовать интерфейсIUdrProcedureFactory
. Для упрощения просто наследуем классIUdrProcedureFactoryImpl
. Для каждой внешней процедуры нужна свояфабрика. Впрочем, если фабрики не имеют специфики для создания некоторойпроцедуры, то можно написать обобщённую фабрику с помощью дженериков.Позже мы приведём пример как это сделать.
Метод dispose
вызывается при уничтожении фабрики, в нём мы должныосвободить ранее выделенные ресурсы. В данном случае просто вызываемдеструктор.
Метод setup
выполняется каждый раз при загрузке внешней процедуры в кешметаданных. В нём можно делать различные действия которые необходимыперед созданием экземпляра процедуры, например изменение формата длявходных и выходных сообщений. Более подробно поговорим о нём позже.
Метод newItem
вызывается для создания экземпляра внешней процедуры. Вэтот метод передаётся указатель на статус вектор, контекст внешнейпроцедуры и метаданные внешней процедуры. С помощью IRoutineMetadata
выможете получить формат входного и выходного сообщения, тело внешнейфункции и другие метаданные. В этом методе вы можете создавать различныеэкземпляры внешней функции в зависимости от её объявления в PSQL.Метаданные можно передать в созданный экземпляр внешней процедуры еслиэто необходимо. В нашем случае мы просто создаём экземпляр внешнейпроцедуры TSumArgsProcedure
.
Фабрику процедуры, а также саму процедуру расположим в модуле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
// структура на которое будет отображено входное сообщение
TSumArgsInMsg = record
n1: Integer;
n1Null: WordBool;
n2: Integer;
n2Null: WordBool;
n3: Integer;
n3Null: WordBool;
end;
PSumArgsInMsg = ^TSumArgsInMsg;
// структура на которое будет отображено выходное сообщение
TSumArgsOutMsg = record
result: Integer;
resultNull: WordBool;
end;
PSumArgsOutMsg = ^TSumArgsOutMsg;
// Фабрика для создания экземпляра внешней процедуры TSumArgsProcedure
TSumArgsProcedureFactory = class(IUdrProcedureFactoryImpl)
// Вызывается при уничтожении фабрики
procedure dispose(); override;
{ Выполняется каждый раз при загрузке внешней процедуры в кеш метаданных
Используется для изменения формата входного и выходного сообщения.
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней процедуры)
@param(AMetadata Метаданные внешней процедуры)
@param(AInBuilder Построитель сообщения для входных метаданных)
@param(AOutBuilder Построитель сообщения для выходных метаданных)
}
procedure setup(AStatus: IStatus; AContext: IExternalContext;
AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder;
AOutBuilder: IMetadataBuilder); override;
{ Создание нового экземпляра внешней процедуры TSumArgsProcedure
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней процедуры)
@param(AMetadata Метаданные внешней процедуры)
@returns(Экземпляр внешней процедуры)
}
function newItem(AStatus: IStatus; AContext: IExternalContext;
AMetadata: IRoutineMetadata): IExternalProcedure; override;
end;
TSumArgsProcedure = class(IExternalProcedureImpl)
public
// Вызывается при уничтожении экземпляра процедуры
procedure dispose(); override;
{ Этот метод вызывается непосредственно перед open и сообщает
ядру наш запрошенный набор символов для обмена данными внутри
этого метода. Во время этого вызова контекст использует набор символов,
полученный из ExternalEngine::getCharSet.
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней функции)
@param(AName Имя набора символов)
@param(AName Длина имени набора символов)
}
procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
AName: PAnsiChar; ANameSize: Cardinal); override;
{ Выполнение внешней процедуры
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней функции)
@param(AInMsg Указатель на входное сообщение)
@param(AOutMsg Указатель на выходное сообщение)
@returns(Набор данных для селективной процедуры или
nil для процедур выполнения)
}
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
// Набор данных для выполняемых процедур возращать не надо
Result := nil;
// преобразовываем указатели на вход и выход к типизированным
xInput := PSumArgsInMsg(AInMsg);
xOutput := PSumArgsOutMsg(AOutMsg);
// по умолчанию выходной аргумент = NULL, а поэтому выставляем ему nullFlag
xOutput^.resultNull := True;
// если один из аргументов NULL значит и результат NULL
// в противном случае считаем сумму аргументов
with xInput^ do
begin
if not (n1Null or n2Null or n3Null) then
begin
xOutput^.result := n1 + n2 + n3;
// раз есть результат, то сбрасываем NULL флаг
xOutput^.resultNull := False;
end;
end;
end;
end.
Экземпляр процедуры
Внешняя процедура должна реализовать интерфейс IExternalProcedure
. Дляупрощения просто наследуем класс IExternalProcedureImpl
.
Метод dispose
вызывается при уничтожении экземпляра процедуры, в нём мыдолжны освободить ранее выделенные ресурсы. В данном случае простовызываем деструктор.
Метод getCharSet
используется для того, чтобы сообщить контексту внешней процедурынабор символов, который мы хотим использовать при работе с соединением из текущего контекста.По умолчанию соединение из текущего контекста работает в кодировке текущего подключения, что не всегда удобно.
Метод open
обрабатывает непосредственно сам вызов процедуры. В этотметод передаётся указатель на статус вектор, указатель на контекствнешней процедуры, указатели на входное и выходное сообщение. Если у васвыполняемая процедура, то метод должен вернуть значение nil
, в противномслучае должен вернуться экземпляр набора выходных данных для процедуры.В данном случае нам не нужно создавать экземпляр набора данных. Простопереносим логику из метода TSumArgsFunction.execute
.
Хранимая процедура выбора
Теперь добавим в наш UDR модуль простую процедуру выбора. Для этогоизменим функцию регистрации firebird_udr_plugin
.
function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
// регистрируем наши функции
AUdrPlugin.registerFunction(AStatus, 'sum_args',
TSumArgsFunctionFactory.Create());
// регистрируем наши процедуры
AUdrPlugin.registerProcedure(AStatus, 'sum_args_proc',
TSumArgsProcedureFactory.Create());
AUdrPlugin.registerProcedure(AStatus, 'gen_rows', TGenRowsFactory.Create());
// регистрируем наши триггеры
//AUdrPlugin.registerTrigger(AStatus, 'test_trigger',
// TMyTriggerFactory.Create());
theirUnloadFlag := AUnloadFlagLocal;
Result := @myUnloadFlag;
end;
Note
|
Замечание
Не забудьте добавить в список |
Фабрика процедур полностью идентична как для случая с выполняемойхранимой процедурой. Методы экземпляра процедуры тоже идентичны, заисключением метода open
, который разберём чуть подробнее.
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;
// Фабрика для создания экземпляра внешней процедуры TGenRowsProcedure
TGenRowsFactory = class(IUdrProcedureFactoryImpl)
// Вызывается при уничтожении фабрики
procedure dispose(); override;
{ Выполняется каждый раз при загрузке внешней функции в кеш метаданных.
Используется для изменения формата входного и выходного сообщения.
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней функции)
@param(AMetadata Метаданные внешней функции)
@param(AInBuilder Построитель сообщения для входных метаданных)
@param(AOutBuilder Построитель сообщения для выходных метаданных)
}
procedure setup(AStatus: IStatus; AContext: IExternalContext;
AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder;
AOutBuilder: IMetadataBuilder); override;
{ Создание нового экземпляра внешней процедуры TGenRowsProcedure
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней функции)
@param(AMetadata Метаданные внешней функции)
@returns(Экземпляр внешней функции)
}
function newItem(AStatus: IStatus; AContext: IExternalContext;
AMetadata: IRoutineMetadata): IExternalProcedure; override;
end;
// Внешняя процедура TGenRowsProcedure.
TGenRowsProcedure = class(IExternalProcedureImpl)
public
// Вызывается при уничтожении экземпляра процедуры
procedure dispose(); override;
{ Этот метод вызывается непосредственно перед open и сообщает
ядру наш запрошенный набор символов для обмена данными внутри
этого метода. Во время этого вызова контекст использует набор символов,
полученный из ExternalEngine::getCharSet.
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней функции)
@param(AName Имя набора символов)
@param(AName Длина имени набора символов)
}
procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
AName: PAnsiChar; ANameSize: Cardinal); override;
{ Выполнение внешней процедуры
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней функции)
@param(AInMsg Указатель на входное сообщение)
@param(AOutMsg Указатель на выходное сообщение)
@returns(Набор данных для селективной процедуры или
nil для процедур выполнения)
}
function open(AStatus: IStatus; AContext: IExternalContext; AInMsg: Pointer;
AOutMsg: Pointer): IExternalResultSet; override;
end;
// Выходной набор данных для процедуры TGenRowsProcedure
TGenRowsResultSet = class(IExternalResultSetImpl)
Input: PInput;
Output: POutput;
// Вызывается при уничтожении экземпляра набора данных
procedure dispose(); override;
{ Извлечение очередной записи из набора данных.
В некотором роде аналог SUSPEND. В этом методе должна
подготавливаться очередная запись из набора данных.
@param(AStatus Статус вектор)
@returns(True если в наборе данных есть запись для извлечения,
False если записи закончились)
}
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;
// если один из входных аргументов NULL ничего не возвращаем
if PInput(AInMsg).startNull or PInput(AInMsg).finishNull then
begin
POutput(AOutMsg).nNull := True;
// намеренно ставим выходной результат таким, чтобы
// метод TGenRowsResultSet.fetch вернул false
Output.n := Input.finish;
exit;
end;
// проверки
if PInput(AInMsg).start > PInput(AInMsg).finish then
raise Exception.Create('First parameter greater then second parameter.');
with TGenRowsResultSet(Result) do
begin
// начальное значение
Output.nNull := False;
Output.n := Input.start - 1;
end;
end;
{ TGenRowsResultSet }
procedure TGenRowsResultSet.dispose;
begin
Destroy;
end;
// Если возвращает True то извлекается очередная запись из набора данных.
// Если возвращает False то записи в наборе данных закончились
// новые значения в выходном векторе вычисляются каждый раз
// при вызове этого метода
function TGenRowsResultSet.fetch(AStatus: IStatus): Boolean;
begin
Inc(Output.n);
Result := (Output.n <= Input.finish);
end;
end.
В методе open
экземпляра процедуры TGenRowsProcedure
проверяем первыйи второй входной аргумент на значение NULL
, если один из аргументовравен NULL
, то и выходной аргумент равен NULL
, кроме того процедура недолжна вернуть ни одной строки при выборке через оператор SELECT
,поэтому присваиваем Output.n
такое значение чтобы метод TGenRowsResultSet.fetch
вернул False
.
Кроме того мы проверяем, чтобы первый аргумент не превышал значениевторого, в противном случае бросаем исключение. Не волнуйтесь этоисключение будет перехвачено в подсистеме UDR и преобразовано кисключению Firebird. Это одно из преимуществ новых UDR перед Legacy UDF.
Поскольку мы создаём процедуру выбора, то метод open должен возвращатьэкземпляр набора данных, который реализует интерфейс IExternalResultSet
.Для упрощения унаследуем свой набор данных от классаIExternalResultSetImpl
.
Метод dispose
предназначен для освобождения выделенных ресурсов. В нёммы просто вызываем деструктор.
Метод fetch
вызывается при извлечении очередной записи операторомSELECT
. Этот метод по сути является аналогом оператора SUSPEND
используемый в обычных PSQL хранимых процедурах. Каждый раз когда онвызывается, в нём подготавливаются новые значения для выходногосообщения. Метод возвращает true
, если запись должна быть возвращенавызывающей стороне, и false
, если данных для извлечения больше нет. Внашем случае мы просто инкрементируем текущее значение выходнойпеременной до тех пор, пока оно не больше максимальной границы.
Note
|
Замечание
В Delphi нет поддержки оператора
Вы можете использовать любой класс коллекции, заполнить его в методе |
Регистрация триггеров
Теперь добавим в наш UDR модуль внешний триггер.
Note
|
Замечание
В оригинальных примерах на C++ триггер копирует запись в другую внешнююбазу данных. Я считаю, что такой пример излишне сложен для первогоознакомления с внешними триггерами. Работа с подключениями к внешнимбазам данных будет рассмотрен позже. |
Вернитесь в модуль UdrInit
и измените функцию firebird_udr_plugin
так,чтобы она выглядела следующим образом.
function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
// регистрируем наши функции
AUdrPlugin.registerFunction(AStatus, 'sum_args',
TSumArgsFunctionFactory.Create());
// регистрируем наши процедуры
AUdrPlugin.registerProcedure(AStatus, 'sum_args_proc',
TSumArgsProcedureFactory.Create());
AUdrPlugin.registerProcedure(AStatus, 'gen_rows', TGenRowsFactory.Create());
// регистрируем наши триггеры
AUdrPlugin.registerTrigger(AStatus, 'test_trigger',
TMyTriggerFactory.Create());
theirUnloadFlag := AUnloadFlagLocal;
Result := @myUnloadFlag;
end;
Note
|
Замечание
Не забудьте добавить в список |
Фабрика триггеров
Фабрика внешнего триггера должна реализовать интерфейсIUdrTriggerFactory
. Для упрощения просто наследуем классIUdrTriggerFactoryImpl
. Для каждого внешнего триггера нужна свояфабрика.
Метод dispose
вызывается при уничтожении фабрики, в нём мы должныосвободить ранее выделенные ресурсы. В данном случае просто вызываемдеструктор.
Метод setup
выполняется каждый раз при загрузке внешнего триггера в кешметаданных. В нём можно делать различные действия которые необходимыперед созданием экземпляра триггера, например для изменения форматасообщений для полей таблицы. Более подробно поговорим о нём позже.
Метод newItem
вызывается для создания экземпляра внешнего триггера. Вэтот метод передаётся указатель на статус вектор, контекст внешнеготриггера и метаданные внешнего триггера. С помощью IRoutineMetadata
выможете получить формат сообщения для новых и старых значений полей, теловнешнего триггера и другие метаданные. В этом методе вы можете создаватьразличные экземпляры внешнего триггера в зависимости от его объявления вPSQL. Метаданные можно передать в созданный экземпляр внешнего триггераесли это необходимо. В нашем случае мы просто создаём экземпляр внешнеготриггера TMyTrigger
.
Фабрику триггера, а также сам триггер расположим в модуле 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;
}
// структура для отображения сообщений NEW.* и OLD.*
// должна соответствовать набору полей таблицы 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;
// Фабрика для создания экземпляра внешнего триггера TMyTrigger
TMyTriggerFactory = class(IUdrTriggerFactoryImpl)
// Вызывается при уничтожении фабрики
procedure dispose(); override;
{ Выполняется каждый раз при загрузке внешнего триггера в кеш метаданных.
Используется для изменения формата сообщений для полей.
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешнего триггера)
@param(AMetadata Метаданные внешнего триггера)
@param(AFieldsBuilder Построитель сообщения для полей таблицы)
}
procedure setup(AStatus: IStatus; AContext: IExternalContext;
AMetadata: IRoutineMetadata; AFieldsBuilder: IMetadataBuilder); override;
{ Создание нового экземпляра внешнего триггера TMyTrigger
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешнего триггера)
@param(AMetadata Метаданные внешнего триггера)
@returns(Экземпляр внешнего триггера)
}
function newItem(AStatus: IStatus; AContext: IExternalContext;
AMetadata: IRoutineMetadata): IExternalTrigger; override;
end;
TMyTrigger = class(IExternalTriggerImpl)
// Вызывается при уничтожении триггера
procedure dispose(); override;
{ Этот метод вызывается непосредственно перед execute и сообщает
ядру наш запрошенный набор символов для обмена данными внутри
этого метода. Во время этого вызова контекст использует набор символов,
полученный из ExternalEngine::getCharSet.
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешнего триггера)
@param(AName Имя набора символов)
@param(AName Длина имени набора символов)
}
procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
AName: PAnsiChar; ANameSize: Cardinal); override;
{ выполнение триггера TMyTrigger
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешнего триггера)
@param(AAction Действие (текущее событие) триггера)
@param(AOldMsg Сообщение для старых значение полей :OLD.*)
@param(ANewMsg Сообщение для новых значение полей :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.
Экземпляр триггера
Внешний триггер должен реализовать интерфейс IExternalTrigger
. Дляупрощения просто наследуем класс IExternalTriggerImpl
.
Метод dispose
вызывается при уничтожении экземпляра триггера, в нём мыдолжны освободить ранее выделенные ресурсы. В данном случае простовызываем деструктор.
Метод getCharSet
используется для того, чтобы сообщить контексту внешнего триггерунабор символов, который мы хотим использовать при работе с соединением из текущего контекста.По умолчанию соединение из текущего контекста работает в кодировке текущего подключения, что не всегда удобно.
Метод execute
вызывается при выполнении триггера на одно из событий длякоторого создан триггер. В этот метод передаётся указатель на статусвектор, указатель на контекст внешнего триггера, действие (событие)которое вызвало срабатывание триггера и указатели на сообщения длястарых и новых значений полей. Возможные действия (события) триггераперечислены константами в интерфейсе IExternalTrigger
. Такие константыначинаются с префикса ACTION_
. Знания о текущем действие необходимо,поскольку в Firebird существуют триггеры созданные для несколькихсобытий сразу. Сообщения необходимы только для триггеров на действиятаблицы, для DDL триггеров, а также для триггеров на события подключения иотключения от базы данных и триггеров на события старта, завершения иотката транзакции указатели на сообщения будут инициализированызначением nil
. В отличие от процедур и функций сообщения триггеровстроятся для полей таблицы на события которой создан триггер.Статические структуры для таких сообщений строятся по тем же принципам,что и структуры сообщений для входных и выходных параметров процедуры,только вместо переменных берутся поля таблицы.
Note
|
Замечание
Обратите внимание, что если вы используете отображение сообщений наструктуры, то ваши триггеры могут сломаться после изменения составаполей таблицы и их типов. Чтобы этого не произошло, используйте работу ссообщением через смещения получаемые из |
В нашем простейшем триггере мы определяем тип события, и в теле триггеравыполняем следующий PSQL аналог
...
if (:new.B IS NULL) THEN
:new.B = :new.A + 1;
...
Сообщения
Под сообщением в UDR понимается область памяти фиксированного размерадля передачи в процедуру или функцию входных аргументов, или возвратавыходных аргументов. Для внешних триггеров на события записи таблицысообщения используются для получения и возврата данных в NEW и OLD.
Для доступа к отдельным переменным или полям таблицы, необходимо знатькак минимум тип этой переменной, и смещение от начала буфера сообщений.Как уже упоминалось ранее для этого существует два способа:
-
преобразование указателя на буфер сообщения к указателю на статическуюструктуру (в Delphi это запись, т.е.
record
); -
получение смещений с помощью экземпляра класса реализующего интерфейс
IMessageMetadata
, и чтение/запись из буфера данных, размеромсоответствующим типу переменной или поля.
Первый способ является наиболее быстрым, второй — более гибким, так какв ряде случаев позволяет изменять типы и размеры для входных и выходныхпеременных или полей таблицы без перекомпиляции динамической библиотекисодержащей UDR.
Работа с буфером сообщения с использованием структуры
Как говорилось выше мы можем работать с буфером сообщений черезуказатель на структуру. Такая структура выглядит следующим образом:
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;
Типы членов данных должны соответствовать типам входных/выходныхпеременных или полей (для триггеров). Null-индикатор должен быть послекаждой переменной/поля, даже если у них есть ограничение NOT NULL
.Null-индикатор занимает 2 байта. Значение -1 обозначает чтопеременная/поле имеют значение NULL
. Поскольку на данный момент вNULL-индикатор пишется только признак NULL
, то удобно отразить его на2-х байтный логический тип. Типы данных SQL отображаются в структуреследующим образом:
SQL тип | Delphi тип | Замечание |
---|---|---|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Доступно начиная с Firebird 4.0. |
|
|
|
|
|
|
|
|
Доступно начиная с Firebird 4.0. |
|
|
Доступно начиная с Firebird 4.0. |
|
Тип данных зависит от точности и диалекта:
|
В качестве значения в сообщение будет передано число умноженное на10M. |
|
Тип данных зависит от точности и диалекта:
|
В качестве значения в сообщение будет передано число умноженное на10M. |
|
|
M вычисляется по формуле |
|
|
M вычисляется по формуле |
|
|
|
|
|
|
|
|
Доступно начиная с Firebird 4.0. |
|
|
|
|
|
Доступно начиная с Firebird 4.0. |
|
|
Содержимое BLOB никогда не передаётсянепосредственно, вместо него передаётся BlobId. Как работать с типомBLOB будет рассказано в главе Работа с типом BLOB. |
Теперь рассмотрим несколько примеров того как составлять структурысообщений по декларациям процедур, функций или триггеров.
Предположим у нас есть внешняя функция объявленная следующим образом:
function SUM_ARGS(A SMALLINT, B INTEGER) RETURNS BIGINT
....
В этом случае структуры для входных и выходных сообщений будут выглядетьтак:
TInput = record
A: Smallint;
ANull: WordBool;
B: Integer;
BNull: WordBool;
end;
PInput = ^TInput;
TOutput = record
Value: Int64;
Null: WordBool;
end;
POutput = ^TOutput;
Если та же самая функция определена с другими типами (в 3 диалекте):
function SUM_ARGS(A NUMERIC(4, 2), B NUMERIC(9, 3)) RETURNS NUMERIC(18, 6)
....
В этом случае структуры для входных и выходных сообщений будут выглядетьтак:
TInput = record
A: Smallint;
ANull: WordBool;
B: Integer;
BNull: WordBool;
end;
PInput = ^TInput;
TOutput = record
Value: Int64;
Null: WordBool;
end;
POutput = ^TOutput;
Предположим у нас есть внешняя процедура объявленная следующим образом:
procedure SOME_PROC(A CHAR(3) CHARACTER SET WIN1251, B VARCHAR(10) CHARACTER SET UTF8)
....
В этом случае структура для входного сообщения будет выглядеть так:
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;
Работа с буфером сообщений с помощью IMessageMetadata
Как было описано выше с буфером сообщений можно работать сиспользованием экземпляра объекта реализующего интерфейсIMessageMetadata
. Этот интерфейс позволяет узнать о переменной/полеследующие сведения:
-
имя переменной/поля;
-
тип данных;
-
набор символов для строковых данных;
-
подтип для типа данных BLOB;
-
размер буфера в байтах под переменную/поле;
-
может ли переменная/поле принимать значение NULL;
-
смещение в буфере сообщений для данных;
-
смещение в буфере сообщений для NULL-индикатора.
Методы интерфейса IMessageMetadata
-
getCount
unsigned getCount(StatusType* status)
возвращает количество полей/параметров в сообщении. Во всех вызовах,содержащих индексный параметр, это значение должно быть:
0 <= index < getCount()
. -
getField
const char* getField(StatusType* status, unsigned index)
возвращает имя поля.
-
getRelation
const char* getRelation(StatusType* status, unsigned index)
возвращает имя отношения (из которого выбрано данное поле).
-
getOwner
const char* getOwner(StatusType* status, unsigned index)
возвращает имя владельца отношения.
-
getAlias
const char* getAlias(StatusType* status, unsigned index)
возвращает псевдоним поля.
-
getType
unsigned getType(StatusType* status, unsigned index)
возвращает SQL тип поля.
-
isNullable
FB_BOOLEAN isNullable(StatusType* status, unsigned index)
возвращает true, если поле может принимать значение NULL.
-
getSubType
int getSubType(StatusType* status, unsigned index)
возвращает подтип поля BLOB (0 - двоичный, 1 - текст и т. д.).
-
getLength
unsigned getLength(StatusType* status, unsigned index)
возвращает максимальную длину поля в байтах.
-
getScale
int getScale(StatusType* status, unsigned index)
возвращает масштаб для числового поля.
-
getCharSet
unsigned getCharSet(StatusType* status, unsigned index)
возвращает набор символов для символьных полей и текстового BLOB.
-
getOffset
unsigned getOffset(StatusType* status, unsigned index)
возвращает смещение данных поля в буфере сообщений (используйте его длядоступа к данным в буфере сообщений).
-
getNullOffset
unsigned getNullOffset(StatusType* status, unsigned index)
возвращает смещение NULL индикатора для поля в буфере сообщений.
-
getBuilder
IMetadataBuilder* getBuilder(StatusType* status)
возвращает интерфейс
IMetadataBuilder
, инициализированный метаданнымиэтого сообщения. -
getMessageLength
unsigned getMessageLength(StatusType* status)
возвращает длину буфера сообщения (используйте его для выделения памятипод буфер).
Получение и использование IMessageMetadata
Экземпляры объектов реализующих интерфейс IMessageMetadata
для входных ивыходных переменных можно получить из интерфейса IRoutineMetadata
. Он непередаётся непосредственно в экземпляр процедуры, функции или триггера.Это необходимо делать явно в фабрике соответствующего типа. Например:
// Фабрика для создания экземпляра внешней функции TSumArgsFunction
TSumArgsFunctionFactory = class(IUdrFunctionFactoryImpl)
// Вызывается при уничтожении фабрики
procedure dispose(); override;
{ Выполняется каждый раз при загрузке внешней функции в кеш метаданных
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней функции)
@param(AMetadata Метаданные внешней функции)
@param(AInBuilder Построитель сообщения для входных метаданных)
@param(AOutBuilder Построитель сообщения для выходных метаданных)
}
procedure setup(AStatus: IStatus; AContext: IExternalContext;
AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder;
AOutBuilder: IMetadataBuilder); override;
{ Создание нового экземпляра внешней функции TSumArgsFunction
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней функции)
@param(AMetadata Метаданные внешней функции)
@returns(Экземпляр внешней функции)
}
function newItem(AStatus: IStatus; AContext: IExternalContext;
AMetadata: IRoutineMetadata): IExternalFunction; override;
end;
// Внешняя функция TSumArgsFunction.
TSumArgsFunction = class(IExternalFunctionImpl)
private
FMetadata: IRoutineMetadata;
public
property Metadata: IRoutineMetadata read FMetadata write FMetadata;
public
// Вызывается при уничтожении экземпляра функции
procedure dispose(); override;
{ Этот метод вызывается непосредственно перед execute и сообщает
ядру наш запрошенный набор символов для обмена данными внутри
этого метода. Во время этого вызова контекст использует набор символов,
полученный из ExternalEngine::getCharSet.
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней функции)
@param(AName Имя набора символов)
@param(AName Длина имени набора символов)
}
procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
AName: PAnsiChar; ANameSize: Cardinal); override;
{ Выполнение внешней функции
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней функции)
@param(AInMsg Указатель на входное сообщение)
@param(AOutMsg Указатель на выходное сообщение)
}
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;
Экземпляры IMessageMetadata
для входных и выходных переменных можнополучить с помощью методов getInputMetadata
и getOutputMetadata
изIRoutineMetadata
. Метаданные для полей таблицы, на которую написантриггер, можно получить с помощью метода getTriggerMetadata
.
Important
|
Важно
Обратите внимание, жизненный цикл объектов интерфейса |
Для получения значения соответствующего входного аргумента намнеобходимо воспользоваться адресной арифметикой. Для этого получаемсмещение из IMessageMetadata
с помощью метода getOffset
и прибавляем кадресу буфера для входного сообщения. После чего полученный результатприводим к соответствующему типизированному указателю. Примерна такая жесхема работы для получения null индикаторов аргументов, только дляполучения смещений используется метод getNullOffset
.
........................
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
// получаем значения входных аргументов по их смещениям
n1 := PInteger(PByte(AInMsg) + xInputMetadata.getOffset(AStatus, 0))^;
n2 := PInteger(PByte(AInMsg) + xInputMetadata.getOffset(AStatus, 1))^;
n3 := PInteger(PByte(AInMsg) + xInputMetadata.getOffset(AStatus, 2))^;
// получаем значения null-индикаторов входных аргументов по их смещениям
n1Null := PWordBool(PByte(AInMsg) +
xInputMetadata.getNullOffset(AStatus, 0))^;
n2Null := PWordBool(PByte(AInMsg) +
xInputMetadata.getNullOffset(AStatus, 1))^;
n3Null := PWordBool(PByte(AInMsg) +
xInputMetadata.getNullOffset(AStatus, 2))^;
// по умолчанию выходной аргемент = NULL, а потому выставляем ему nullFlag
resultNull := True;
Result := 0;
// если один из аргументов NULL значит и результат NULL
// в противном случае считаем сумму аргументов
if not(n1Null or n2Null or n3Null) then
begin
Result := n1 + n2 + n3;
// раз есть результат, то сбрасываем 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
|
Замечание
В главе Контекст соединения и транзакции приведёнбольшой пример для работы с различными SQL типами с использованиеминтерфейса |
Фабрики
Вы уже сталкивались с фабриками ранее. Настало время рассмотреть ихболее подробно.
Фабрики предназначены для создания экземпляров процедур, функций илитриггеров. Класс фабрики должен быть наследником одного из интерфейсовIUdrProcedureFactory
, IUdrFunctionFactory
или IUdrTriggerFactory
взависимости от типа UDR. Их экземпляры должны быть зарегистрированы вкачестве точки входа UDR в функции firebird_udr_plugin
.
function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
// регистрируем нашу функцию
AUdrPlugin.registerFunction(AStatus, 'sum_args',
TSumArgsFunctionFactory.Create());
// регистрируем нашу процедуру
AUdrPlugin.registerProcedure(AStatus, 'gen_rows', TGenRowsFactory.Create());
// регистрируем наш триггер
AUdrPlugin.registerTrigger(AStatus, 'test_trigger',
TMyTriggerFactory.Create());
theirUnloadFlag := AUnloadFlagLocal;
Result := @myUnloadFlag;
end;
В данном примере класс TSumArgsFunctionFactory
наследует интерфейсIUdrFunctionFactory
, TGenRowsFactory
наследует интерфейсIUdrProcedureFactory
, а TMyTriggerFactory
наследует интерфейсIUdrTriggerFactory
.
Экземпляры фабрик создаются и привязываются к точкам входа в моментпервой загрузки внешней процедуры, функции или триггера. Это происходитодин раз при создании каждого процесса Firebird. Таким образом, дляархитектуры SuperServer для всех соединений будет ровно один экземплярфабрики связанный с каждой точкой входа, для Classic это количествоэкземпляров будет умножено на количество соединений.
При написании классов фабрик вам необходимо реализовать методы setup
иnewItem
из интерфейсов IUdrProcedureFactory
, IUdrFunctionFactory
или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;
Кроме того, поскольку эти интерфейсы наследуют интерфейс IDisposable
, тонеобходимо так же реализовать метод dispose
. Это обозначает что Firebirdсам выгрузит фабрику, когда это будет необходимо. В методе dispose
необходимо разместить код, который освобождает ресурсы, при уничтоженииэкземпляра фабрики. Для упрощения реализации методов интерфейсов удобновоспользоваться классами IUdrProcedureFactoryImpl
,IUdrFunctionFactoryImpl
, IUdrTriggerFactoryImpl
. Рассмотрим каждыйиз методов более подробно.
Метод newItem
Метод newItem
вызывается для создания экземпляра внешней процедуры,функции или триггера. Создание экземпляров UDR происходит в момент еёзагрузки в кэш метаданных, т.е. при первом вызове процедуры, функции илитриггера. В настоящий момент кэш метаданных раздельный для каждогосоединения для всех архитектур сервера.
Кэш метаданных процедур и функция связан с их именами в базе данных.Например, две внешние функции с разными именами, но одинаковыми точкамивхода, будут разными экземплярами IUdrFunctionFactory
. Точка входасостоит из имени внешнего модуля и имени под которым зарегистрированафабрика. Как это можно использовать покажем позже.
В метод newItem
передаётся указатель на статус вектор, контекствыполнения UDR и метаданные UDR.
В простейшем случае реализация этого метода тривиальна
function TSumArgsFunctionFactory.newItem(AStatus: IStatus;
AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalFunction;
begin
// создаём экземпляр внешней функции
Result := TSumArgsFunction.Create();
end;
С помощью IRoutineMetadata
вы можете получить формат входного ивыходного сообщения, тело UDR и другие метаданные. Метаданные можнопередать в созданный экземпляр UDR. В этом случае в экземпляр классареализующего вашу UDR необходимо добавить поле для хранения метаданных.
// Внешняя функция TSumArgsFunction.
TSumArgsFunction = class(IExternalFunctionImpl)
private
FMetadata: IRoutineMetadata;
public
property Metadata: IRoutineMetadata read FMetadata write FMetadata;
public
...
end;
В этом случае реализация метода newItem выглядит следующим образом:
function TSumArgsFunctionFactory.newItem(AStatus: IStatus;
AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalFunction;
begin
Result := TSumArgsFunction.Create();
with Result as TSumArgsFunction do
begin
Metadata := AMetadata;
end;
end;
Создание экземпляров UDR в зависимости от их объявления
В методе newItem
вы можете создавать различные экземпляры внешнейпроцедуры или функции в зависимости от её объявления в PSQL. Для этогоможно использовать информацию полученную из IMessageMetadata
.
Допустим мы хотим реализовать PSQL пакет с однотипным набором внешнихфункций для возведения числа в квадрат под различные типы данных иединой точкой входа.
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 ; ^
Для проверки функций будем использовать следующий запрос
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
Для упрощения работы с IMessageMetadata
и буферами можно написатьудобную обёртку или попробовать совместно использовать IMessageMetadata
и структуры для отображения сообщений. Здесь мы покажем использованиевторого способа.
Реализация такой идея достаточно проста: в фабрике функций мы будемсоздавать различные экземпляры функций в зависимости от типа входногоаргумента. В современных версиях Delphi вы можете использовать дженерикидля обобщения кода.
.......................
type
// структура на которое будет отображено входное сообщение
TSqrInMsg<T> = record
n1: T;
n1Null: WordBool;
end;
// структура на которое будет отображено выходное сообщение
TSqrOutMsg<T> = record
result: T;
resultNull: WordBool;
end;
// Фабрика для создания экземпляра внешней функции TSqrFunction
TSqrFunctionFactory = class(IUdrFunctionFactoryImpl)
// Вызывается при уничтожении фабрики
procedure dispose(); override;
{ Выполняется каждый раз при загрузке внешней функции в кеш метаданных.
Используется для изменения формата входного и выходного сообщения.
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней функции)
@param(AMetadata Метаданные внешней функции)
@param(AInBuilder Построитель сообщения для входных метаданных)
@param(AOutBuilder Построитель сообщения для выходных метаданных)
}
procedure setup(AStatus: IStatus; AContext: IExternalContext;
AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder;
AOutBuilder: IMetadataBuilder); override;
{ Создание нового экземпляра внешней функции TSqrFunction
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней функции)
@param(AMetadata Метаданные внешней функции)
@returns(Экземпляр внешней функции)
}
function newItem(AStatus: IStatus; AContext: IExternalContext;
AMetadata: IRoutineMetadata): IExternalFunction; override;
end;
// Внешняя функция 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;
// Вызывается при уничтожении экземпляра функции
procedure dispose(); override;
{ Этот метод вызывается непосредственно перед execute и сообщает
ядру наш запрошенный набор символов для обмена данными внутри
этого метода. Во время этого вызова контекст использует набор символов,
полученный из ExternalEngine::getCharSet.
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней функции)
@param(AName Имя набора символов)
@param(AName Длина имени набора символов)
}
procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
AName: PAnsiChar; ANameSize: Cardinal); override;
{ Выполнение внешней функции
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней функции)
@param(AInMsg Указатель на входное сообщение)
@param(AOutMsg Указатель на выходное сообщение)
}
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
// получаем тип входного аргумента
xInputMetadata := AMetadata.getInputMetadata(AStatus);
xInputType := TFBType(xInputMetadata.getType(AStatus, 0));
xInputMetadata.release;
// создаём экземпляр функции в зависимости от типа
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;
.................
Метод setup
Метод setup
позволяет изменить типы входных параметров и выходныхпеременных для внешних процедур и функций или полей для триггеров. Дляэтого используется интерфейс IMetadataBuilder
, который позволяетпостроить входные и выходные сообщения с заданными типами, размерностьюи набором символов. Входные сообщения будут перестроены в форматзаданный в методе setup
, а выходные перестроены из формата заданного вметоде setup
в формат сообщения определенного в DLL процедуры, функцииили триггера. Типы полей или параметров должны быть совместимы дляпреобразования.
Данный метод позволяет упростить создание обобщённых для разных типовпараметров процедур и функций путём их приведения в наиболее общий тип.Более сложный и полезный пример будет рассмотрен позже, а пока немногоизменим уже существующий пример внешней функции SumArgs
.
Наша функция будет работать с сообщениями, которые описываются следующейструктурой
type
// структура на которое будет отображено входное сообщение
TSumArgsInMsg = record
n1: Integer;
n1Null: WordBool;
n2: Integer;
n2Null: WordBool;
n3: Integer;
n3Null: WordBool;
end;
PSumArgsInMsg = ^TSumArgsInMsg;
// структура на которое будет отображено выходное сообщение
TSumArgsOutMsg = record
result: Integer;
resultNull: WordBool;
end;
PSumArgsOutMsg = ^TSumArgsOutMsg;
Теперь создадим фабрику функций, в методе setup
зададим форматсообщений, которые соответствуют выше приведённым структурам.
{ 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
// строим сообщение для входных параметров
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));
// строим сообщение для выходных параметров
AOutBuilder.setType(AStatus, 0, Cardinal(SQL_LONG));
AOutBuilder.setLength(AStatus, 0, sizeof(Int32));
end;
Реализация функции тривиальна
procedure TSumArgsFunction.execute(AStatus: IStatus; AContext: IExternalContext;
AInMsg, AOutMsg: Pointer);
var
xInput: PSumArgsInMsg;
xOutput: PSumArgsOutMsg;
begin
// преобразовываем указатели на вход и выход к типизированным
xInput := PSumArgsInMsg(AInMsg);
xOutput := PSumArgsOutMsg(AOutMsg);
// по умолчанию выходной аргемент = NULL, а потому выставляем ему nullFlag
xOutput^.resultNull := True;
// если один из аргументов NULL значит и резултат NULL
// в противном случае считаем сумму аргументов
with xInput^ do
begin
if not(n1Null or n2Null or n3Null) then
begin
xOutput^.result := n1 + n2 + n3;
// раз есть результат, то сбрасываем NULL флаг
xOutput^.resultNull := False;
end;
end;
end;
Теперь даже если мы объявим функции следующим образом, она всё равносохранит свою работоспособность, поскольку входные и выходные сообщениябудут преобразованы к тому формату, что мы задали в методе 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;
Вы можете проверить вышеприведённое утверждение выполнив следующийзапрос
select FN_SUM_ARGS('15', '21', '35') from rdb$database
Обобщённые фабрики
В процессе разработки UDR необходимо под каждую внешнюю процедуру,функцию или триггер писать свою фабрику создающую экземпляр это UDR. Этузадачу можно упростить написав обобщённые фабрики с помощью такназываемых дженериков. Они доступны начиная с Delphi 2009, в Free Pascalначиная с версии FPC 2.2.
Note
|
Замечание
В Free Pascal синтаксис создания обобщённых типов отличается от Delphi.Начиная с версии FPC 2.6.0 декларируется совместимый с Delphi синтаксис. |
Рассмотрим два основных случая для которых будут написаны обобщённыефабрики:
-
экземплярам внешних процедур, функций и триггеров не требуются какие-либосведения о метаданных, не нужны специальные действия в логикесоздания экземпляров UDR, для работы с сообщениями используютсяфиксированные структуры;
-
экземплярам внешних процедур, функций и триггеров требуются сведения ометаданных, не нужны специальные действия в логике создания экземпляровUDR, для работы с сообщениями используются экземпляры интерфейсов
IMessageMetadata
.
В первом случае достаточно просто создавать нужный экземпляр класса вметоде newItem
без дополнительных действий. Для этого воспользуемсяограничением конструктора в классах потомках классовIUdrFunctionFactoryImpl
, IUdrProcedureFactoryImpl
,IUdrTriggerFactoryImpl
. Объявления таких фабрик выглядит следующимобразом:
unit UdrFactories;
{$IFDEF FPC}
{$MODE DELPHI}{$H+}
{$ENDIF}
interface
uses SysUtils, Firebird;
type
// Простая фабрика внешних функций
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;
// Простая фабрика внешних процедур
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;
// Простая фабрика внешних триггеров
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;
В секции реализации тело метода setup
можно оставить пустым, в нихничего не делается, в теле метода dispose
просто вызвать деструктор. А втеле метода newItem
необходимо просто вызвать конструктор по умолчаниюдля подстановочного типа 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;
Теперь для случая 1 можно не писать фабрики под каждую процедуру,функцию или триггер. Вместо этого регистрировать их с помощью обобщённыхфабрик следующим образом:
function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
// регистрируем нашу функцию
AUdrPlugin.registerFunction(AStatus, 'sum_args',
TFunctionSimpleFactory<TSumArgsFunction>.Create());
// регистрируем нашу процедуру
AUdrPlugin.registerProcedure(AStatus, 'gen_rows',
TProcedureSimpleFactory<TGenRowsProcedure>.Create());
// регистрируем наш триггер
AUdrPlugin.registerTrigger(AStatus, 'test_trigger',
TTriggerSimpleFactory<TMyTrigger>.Create());
theirUnloadFlag := AUnloadFlagLocal;
Result := @myUnloadFlag;
end;
Второй случай более сложный. По умолчанию сведения о метаданных непередаются в экземпляры процедур, функций и триггеров. Однако метаданныхпередаются в качестве параметра в методе newItem
фабрик. Метаданные UDRимеют тип IRoutineMetadata
, жизненный цикл которого контролируется самимдвижком Firebird, поэтому его можно смело передавать в экземпляры UDR.Из него можно получить экземпляры интерфейсов для входного и выходногосообщения, метаданные и тип триггера, имя UDR, пакета, точки входа итело UDR. Сами классы для реализаций внешних процедур, функций итриггеров не имеют полей для хранения метаданных, поэтому нам придётсясделать своих наследников.
unit UdrFactories;
{$IFDEF FPC}
{$MODE DELPHI}{$H+}
{$ENDIF}
interface
uses SysUtils, Firebird;
type
...
// Внешняя функция с метаданными
TExternalFunction = class(IExternalFunctionImpl)
Metadata: IRoutineMetadata;
end;
// Внешняя процедура с метаданными
TExternalProcedure = class(IExternalProcedureImpl)
Metadata: IRoutineMetadata;
end;
// Внешний триггер с метаданными
TExternalTrigger = class(IExternalTriggerImpl)
Metadata: IRoutineMetadata;
end;
В этом случае ваши собственные хранимые процедуры, функции и триггерыдолжны быть унаследованы от новых классов с метаданными.
Теперь объявим фабрики, которые будут создавать UDR и инициализироватьметаданные.
unit UdrFactories;
{$IFDEF FPC}
{$MODE DELPHI}{$H+}
{$ENDIF}
interface
uses SysUtils, Firebird;
type
...
// Фабрика внешних функций с метаданными
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;
// Фабрика внешних процедур с метаданными
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;
// Фабрика внешних триггеров с метаданными
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;
Реализация метода newItem
тривиальна и похожа на первый случай, заисключением того, что необходимо инициализировать поле с метаданными.
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;
Готовый модуль с обобщёнными фабриками можно скачать по адресуhttps://github.com/sim1984/udr-book/blob/master/examples/Common/UdrFactories.pas.
Работа с типом BLOB
В отличие от других типов данных BLOB передаются по ссылке(идентификатор BLOB), а не по значению. Это логично, BLOB могут бытьогромных размеров, а потому поместить их в буфер фиксированный шириныневозможно. Вместо этого в буфер сообщений помещается так называемыйBLOB идентификатор, а работа с данными типа BLOB осуществляются черезинтерфейс IBlob
.
Ещё одной важной особенностью типа BLOB является то, что BLOB являетсянеизменяемым типом, вы не можете изменить содержимое BLOB с заданнымидентификатором, вместо этого нужно создать BLOB с новым содержимым иидентификатором.
Поскольку размер данных типа BLOB может быть очень большим, то данныеBLOB читаются и пишутся порциями (сегментами), максимальный размерсегмента равен 64 Кб. Чтение сегмента осуществляется методом getSegment
интерфейса IBlob
. Запись сегмента осуществляется методом putSegment
интерфейса IBlob
.
Чтение данных из BLOB
В качестве примера чтения BLOB рассмотрим процедуру, которая разбиваетстроку по разделителю (обратная процедура для встроенной агрегатнойфункции LIST). Она объявлена следующим образом
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;
Зарегистрируем фабрику нашей процедуры:
function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
// регистрируем нашу процедуру
AUdrPlugin.registerProcedure(AStatus, 'split', TProcedureSimpleFactory<TSplitProcedure>.Create());
theirUnloadFlag := AUnloadFlagLocal;
Result := @myUnloadFlag;
end;
Здесь я применил обобщённую фабрику процедур для простых случаев, когдафабрика просто создаёт экземпляр процедуры без использования метаданных.Такая фабрика объявлена следующим образом:
...
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
...
Теперь перейдём к реализации процедуры. Сначала объявим структуры длявходного и выходного сообщения.
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;
Как видите вместо значения BLOB передаётся идентификатор BLOB, которыйописывается структурой ISC_QUAD
.
Теперь опишем класс процедуры и возвращаемого набора данных:
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
// Вызывается при уничтожении экземпляра процедуры
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;
Дополнительные методы SaveBlobToStream
и readBlob
предназначены длячтения BLOB. Первая читает BLOB в поток, вторая — основана на первой ивыполняет преобразование прочтённого потока в строку Delphi. В наборданных передаётся массив строк OutputArray
и счётчик возвращённыхзаписей Counter
.
В методе open
читается BLOB и преобразуется в строку. Полученная строкаразбивается по разделителю с помощью встроенного метода Split
из хелперадля строк. Полученный массив строк передаётся в результирующий наборданных.
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
// создаём пустой массив
OutputArray := [];
Counter := 1;
end;
Exit;
end;
xText := readBlob(AStatus, AContext, @xInput.txt);
xDelimiter := TFBCharSet.CS_UTF8.GetString(TBytes(@xInput.delimiter), 0, 4);
// автоматически не правильно определяется потому что строки
// не завершены нулём
// ставим кол-во байт/4
SetLength(xDelimiter, 1);
with TSplitResultSet(Result) do
begin
OutputArray := xText.Split([xDelimiter], TStringSplitOptions.ExcludeEmpty);
Counter := 0;
end;
end;
Note
|
Замечание
Тип перечисление |
Теперь опишем процедуру чтения данных из BLOB в поток. Для того чтобыпрочитать данные из BLOB, его необходимо его открыть. Это можно сделатьвызвав метод openBlob
интерфейса IAttachment
. Поскольку мы читаем BLOBиз своей базы данных, то будем открывать его в контексте текущегоподключения. Контекст текущего подключения и контекст текущей транзакциимы можем получить из контекста внешней процедуры, функции или триггера(интерфейс IExternalContext
).
BLOB читается порциями (сегментами), максимальный размер сегмента равен64 Кб. Чтение сегмента осуществляется методом getSegment
интерфейса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;
// метод close в случае успеха совобождает интерфейс IBlob
// поэтому последующий вызов release не нужен
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
|
Замечание
Обратите внимание, интерфейсы |
Important
|
Важно
Метод В примере переменной |
На основе метода SaveBlobToStream
написана процедура чтения BLOB встроку:
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
|
Замечание
К сожалению Free Pascal не обеспечивает полную обратную совместимость сDelphi для класса |
Метод fetch
выходного набора данных извлекает из массива строк элемент синдексом Counter
и увеличивает его до тех пор, пока не будет извлечёнпоследний элемент массива. Каждая извлечённая строка преобразуется кцелому. Если это невозможно сделать, то будет возбуждено исключение скодом 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;
// исключение будут перехвачены в любом случае с кодом isc_random
// здесь же мы будем выбрасывать стандартную для 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('Cannot convert string to integer'));
statusVector[4] := NativeIntPtr(isc_arg_end);
AStatus.setErrors(@statusVector);
end;
end;
inc(Counter);
Result := True;
end
else
Result := False;
end;
Note
|
Замечание
На самом деле обработка любых ошибок кроме |
Работоспособность процедуры можно проверить следующим образом:
SELECT ids.ID
FROM SPLIT((SELECT LIST(ID) FROM MYTABLE), ',') ids
Note
|
Замечание
Главным недостатком такой реализации состоит в том, что BLOB будетвсегда прочитан целиком, даже если вы хотите досрочно прерватьизвлечение записей из процедуры. При желании вы можете изменить кодпроцедуры таким образом, чтобы разбиение на подстроки осуществлялосьболее маленькими порциями. Для этого чтение этих порций необходимоосуществлять в методе |
Запись данных в BLOB
В качестве примера записи BLOB рассмотрим функцию читающую содержимоеBLOB из файла.
Note
|
Замечание
Этот пример является адаптированной версией UDF функций для чтения изаписи BLOB из/в файл. Оригинальная UDF доступна по адресуblobsaveload.zip |
Утилиты для чтения и записи BLOB из/в файл оформлены в виде пакета
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^
Зарегистрируем фабрики наших процедур и функций:
function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
// регистрируем
AUdrPlugin.registerProcedure(AStatus, 'SaveBlobToFile', TSaveBlobToFileProcFactory.Create());
AUdrPlugin.registerFunction(AStatus, 'LoadBlobFromFile', TLoadBlobFromFileFuncFactory.Create());
theirUnloadFlag := AUnloadFlagLocal;
Result := @myUnloadFlag;
end;
В данном случае приведём пример только для функции считывающий BLOB изфайла, полный пример UDR вы можете скачать по адресу06.BlobSaveLoad.Интерфейсная часть модуля с описанием функции LoadBlobFromFile
выглядитследующим образом:
interface
uses
Firebird, Classes, SysUtils;
type
// входное сообщений функции
TInput = record
filename: record
len: Smallint;
str: array [0 .. 1019] of AnsiChar;
end;
filenameNull: WordBool;
end;
TInputPtr = ^TInput;
// выходное сообщение функции
TOutput = record
blobData: ISC_QUAD;
blobDataNull: WordBool;
end;
TOutputPtr = ^TOutput;
// реализация функции 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;
// Фабрика для создания экземпляра внешней функции 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;
Приведём только реализацию основного метода execute классаTLoadBlobFromFile
, остальные методы классов элементарны.
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;
// получаем имя файла
xFileName := TEncoding.UTF8.GetString(TBytes(@xInput.filename.str), 0,
xInput.filename.len * 4);
SetLength(xFileName, xInput.filename.len);
// читаем файл в поток
xStream := TFileStream.Create(xFileName, fmOpenRead or fmShareDenyNone);
att := AContext.getAttachment(AStatus);
trx := AContext.getTransaction(AStatus);
blob := nil;
try
xStreamSize := xStream.Size;
// определяем максимальный размер буфера (сегмента)
if xStreamSize > MaxBufSize then
xBufferSize := MaxBufSize
else
xBufferSize := xStreamSize;
// создаём новый blob
blob := att.createBlob(AStatus, trx, @xOutput.blobData, 0, nil);
// читаем содержимое потока и пишем его в 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;
// закрываем BLOB
// метод close в случае успеха совобождает интерфейс IBlob
// поэтому последующий вызов release не нужен
blob.close(AStatus);
blob := nil;
finally
if Assigned(blob) then
blob.release;
trx.release;
att.release;
xStream.Free;
end;
end;
Первым делом необходимо создать новый BLOB и привязать его в blobIdвыхода с помощью метода createBlob
интерфейса IAttachment
. Поскольку мыпишем пусть и временный BLOB для своей базы данных, то будем создаватьего в контексте текущего подключения. Контекст текущего подключения иконтекст текущей транзакции мы можем получить из контекста внешнейпроцедуры, функции или триггера (интерфейс IExternalContext
).
Так же как и в случае с чтением данных из BLOB, запись ведётся посегментно с помощью метода putSegment
интерфейса IBlob
до тех пор, покаданные в потоке файла не закончатся. По завершению записи данных в BLOBнеобходимо закрыть его с помощью метода close
.
Important
|
Важно
Метод |
Хелпер для работы с типом BLOB
В выше описанных примерах мы использовали сохранение содержимого BLOB впоток, а также загрузку содержимого BLOB в поток. Это довольно частаяоперация при работе с типом BLOB, поэтому было бы хорошо написатьспециальный набор утилит для повторного использования кода.
Современные версии Delphi и Free Pascal позволяют расширять существующиеклассы и типы без наследования с помощью так называемых хэлперов.Добавим методы в интерфейс IBlob для сохранения и загрузки содержимогопотока из/в Blob.
Создадим специальный модуль FbBlob
, где будет размещён наш хэлпер.
unit FbBlob;
interface
uses Classes, SysUtils, Firebird;
const
MAX_SEGMENT_SIZE = $7FFF;
type
TFbBlobHelper = class helper for IBlob
{ Загружает в BLOB содержимое потока
@param(AStatus Статус вектор)
@param(AStream Поток)
}
procedure LoadFromStream(AStatus: IStatus; AStream: TStream);
{ Загружает в поток содержимое BLOB
@param(AStatus Статус вектор)
@param(AStream Поток)
}
procedure SaveToStream(AStatus: IStatus; 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.
Теперь вы можете значительно упростить операции с типом BLOB, напримервышеприведенная функция сохранения BLOB в файл может быть переписанатак:
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;
// получаем имя файла
xFileName := TEncoding.UTF8.GetString(TBytes(@xInput.filename.str), 0,
xInput.filename.len * 4);
SetLength(xFileName, xInput.filename.len);
// читаем файл в поток
xStream := TFileStream.Create(xFileName, fmOpenRead or fmShareDenyNone);
att := AContext.getAttachment(AStatus);
trx := AContext.getTransaction(AStatus);
blob := nil;
try
// создаём новый blob
blob := att.createBlob(AStatus, trx, @xOutput.blobData, 0, nil);
// загружаем содержимое потока в BLOB
blob.LoadFromStream(AStatus, xStream);
// закрываем BLOB
// метод close в случае успеха совобождает интерфейс IBlob
// поэтому последующий вызов release не нужен
blob.close(AStatus);
blob := nil;
finally
if Assigned(blob) then
blob.release;
att.release;
trx.release;
xStream.Free;
end;
end;
Контекст соединения и транзакции
Если ваша внешняя процедура, функция или триггер должна получать данныеиз собственной базы данных не через входные аргументы, а например череззапрос, то вам потребуется получать контекст текущего соединения и/илитранзакции. Кроме того, контекст соединения и транзакции необходим есливы будете работать с типом BLOB.
Контекст выполнения текущей процедуры, функции или триггера передаётся вкачестве параметра с типом IExternalContext
в метод execute
триггера илифункции, или в метод open процедуры. Интерфейс IExternalContext
позволяет получить текущее соединение с помощью метода getAttachment
, итекущую транзакцию с помощью метода getTransaction
. Это даёт большуюгибкость вашим UDR, например вы можете выполнять запросы к текущей базеданных с сохранением текущего сессионного окружения, в той же транзакцииили в новой транзакции, созданной с помощью метода startTransactionинтерфейса IExternalContext
. В последнем случае запрос будет выполнентак как будто он выполняется в автономной транзакции. Кроме того, выможете выполнить запрос к внешней базе данных с использованиемтранзакции присоединённой к текущей транзакции, т.е. транзакции сдвухфазным подтверждением (2PC).
В качестве примера работы с контекстом выполнения функции напишемфункцию, которая будет сериализовать результат выполнения SELECT
запросав формате JSON. Она объявлена следующим образом:
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;
Поскольку мы позволяем выполнять произвольный SQL запрос, то мы не знаемзаранее формат выходных полей, и мы не сможем использовать структуру сфиксированными полями. В этом случае нам придётся работать с интерфейсомIMessageMetadata
. Мы уже сталкивались с ним ранее, но на этот разпридётся работать с ним более основательно, поскольку мы должныобрабатывать все существующие типы Firebird.
Note
|
Замечание
В JSON можно закодировать практически любые типы данных кроме бинарных.Для кодирования типов |
Зарегистрируем фабрику нашей функции:
function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
// регистрируем функцию
AUdrPlugin.registerFunction(AStatus, 'getJson', TFunctionSimpleFactory<TJsonFunction>.Create());
theirUnloadFlag := AUnloadFlagLocal;
Result := @myUnloadFlag;
end;
Теперь объявим структуры для входного и выходного сообщения, а так жеинтерфейсную часть нашей функции:
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;
// Внешняя функция TSumArgsFunction.
TJsonFunction = class(IExternalFunctionImpl)
public
procedure dispose(); override;
procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
AName: PAnsiChar; ANameSize: Cardinal); override;
{ Преобразует целое в строку в соответствии с масштабом
@param(AValue Значение)
@param(Scale Масштаб)
@returns(Строковое представление масштабированного целого)
}
function MakeScaleInteger(AValue: Int64; Scale: Smallint): string;
{ Добавляет закодированную запись в массив объектов Json
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней функции)
@param(AJson Массив объектов Json)
@param(ABuffer Буфер записи)
@param(AMeta Метаданные курсора)
@param(AFormatSetting Установки формата даты и времени)
}
procedure writeJson(AStatus: IStatus; AContext: IExternalContext;
AJson: TJsonArray; ABuffer: PByte; AMeta: IMessageMetadata;
AFormatSettings: TFormatSettings);
{ Выполнение внешней функции
@param(AStatus Статус вектор)
@param(AContext Контекст выполнения внешней функции)
@param(AInMsg Указатель на входное сообщение)
@param(AOutMsg Указатель на выходное сообщение)
}
procedure execute(AStatus: IStatus; AContext: IExternalContext;
AInMsg: Pointer; AOutMsg: Pointer); override;
end;
Дополнительный метод MakeScaleInteger
предназначен для преобразованиямасштабируемых чисел в строку, метод writeJson
кодирует очередную записьвыбранную из курсора в Json объект и добавляет его в массив такихобъектов.
В этом примере, нам потребуется реализовать метод getCharSet
, чтобы указать желаемую кодировкурезультата запроса выполняемого в контексте текущего подключения внутри внешней функции. По умолчаниюэта внутренний запрос будет выполняться в кодировке текущего подключения. Однако это не совсем удобно.Мы заранее не знаем в какой кодировке будет работать клиент, поэтому придётся определять кодировку каждоговозвращаемого строкового поля и перекодировать в UTF8. Для упрощения задачи, сразу укажем контексту, что мы собираемсяработать внутри процедуры в кодировке UTF8.
procedure TJsonFunction.getCharSet(AStatus: IStatus; AContext: IExternalContext;
AName: PAnsiChar; ANameSize: Cardinal);
begin
// затираем предыдущую кодировку
FillChar(AName, ANameSize, #0);
// ставим желаемую кодировку
StrCopy(AName, 'UTF8');
end;
Эти методы мы опишем позже, а пока приведём основной методexecute
для выполнения внешней функции.
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;
// если один из входных аргументов NULL, то и результат NULL
if xInput.SqlNull or xInput.SqlDialectNull then
begin
xOutput.NullFlag := True;
Exit;
end;
xOutput.NullFlag := False;
// установки форматирования даты и времени
{$IFNDEF FPC}
xFormatSettings := TFormatSettings.Create;
{$ELSE}
xFormatSettings := DefaultFormatSettings;
{$ENDIF}
xFormatSettings.DateSeparator := '-';
xFormatSettings.TimeSeparator := ':';
// создаём поток байт для чтения blob
inStream := TBytesStream.Create(nil);
{$IFNDEF FPC}
outStream := TStringStream.Create('', 65001);
{$ELSE}
outStream := TStringStream.Create('');
{$ENDIF}
jsonArray := TJsonArray.Create;
// получение текущего соединения и транзакции
att := AContext.getAttachment(AStatus);
tra := AContext.getTransaction(AStatus);
stmt := nil;
rs := nil;
inBlob := nil;
outBlob := nil;
try
// читаем BLOB в поток
inBlob := att.openBlob(AStatus, tra, @xInput.SqlText, 0, nil);
inBlob.SaveToStream(AStatus, inStream);
// метод close в случае успеха совобождает интерфейс IBlob
// поэтому последующий вызов release не нужен
inBlob.close(AStatus);
inBlob := nil;
// подготавливаем оператор
stmt := att.prepare(AStatus, tra, inStream.Size, @inStream.Bytes[0],
xInput.SqlDialect, IStatement.PREPARE_PREFETCH_METADATA);
// получаем выходные метаданные курсора
cursorMetaData := stmt.getOutputMetadata(AStatus);
// откурываем курсор
rs := stmt.openCursor(AStatus, tra, nil, nil, nil, 0);
// выделяем буфер нужного размера
msgLen := cursorMetaData.getMessageLength(AStatus);
msg := AllocMem(msgLen);
try
// читаем каждую запись курсора
while rs.fetchNext(AStatus, msg) = IStatus.RESULT_OK do
begin
// и пишем её в JSON
writeJson(AStatus, AContext, jsonArray, msg, cursorMetaData,
xFormatSettings);
end;
finally
// освобождаем буфер
FreeMem(msg);
end;
// закрываем курсор
// метод close в случае успеха совобождает интерфейс IResultSet
// поэтому последующий вызов release не нужен
rs.close(AStatus);
rs := nil;
// освобождаем подготовленный запрос
// метод free в случае успеха совобождает интерфейс IStatement
// поэтому последующий вызов release не нужен
stmt.free(AStatus);
stmt := nil;
// пишем JSON в поток
{$IFNDEF FPC}
outStream.WriteString(jsonArray.ToJSON);
{$ELSE}
outStream.WriteString(jsonArray.AsJSON);
{$ENDIF}
// пишем json в выходной blob
outBlob := att.createBlob(AStatus, tra, @xOutput.Json, 0, nil);
outBlob.LoadFromStream(AStatus, outStream);
// метод close в случае успеха совобождает интерфейс IBlob
// поэтому последующий вызов release не нужен
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;
Первым делом получаем из контекста выполнения функции текущееподключение и текущую транзакцию с помощью методов getAttachment
иgetTransaction
интерфейса IExternalContext
. Затем читаем содержимое BLOBдля получения текста SQL запроса. Запрос подготавливается с помощьюметода prepare интерфейса IAttachment
. Пятым параметром передаётся SQLдиалект полученный из входного параметра нашей функции. Шестымпараметром передаём флаг IStatement.PREPARE_PREFETCH_METADATA
, чтообозначает что мы хотим получить метаданные курсора вместе с результатомпрепарирования запроса. Сами выходные метаданные курсора получаем спомощью метода getOutputMetadata
интерфейса IStatement
.
Note
|
Замечание
На самом деле метод |
Далее открываем курсор с помощью метода openCursor
в рамках текущейтранзакции (параметр 2). Получаем размер выходного буфера под результаткурсора с помощью метода getMessageLength
интерфейса IMessageMetadata
.Это позволяет выделить память под буфер, которую мы освободим сразупосле вычитки последней записи курсора.
Записи курсора читаются с помощью метода fetchNext
интерфейсаIResultSet
. Этот метод заполняет буфер msg
значениями полей курсора ивозвращает IStatus.RESULT_OK
до тех пор, пока записи курсора некончатся. Каждая прочитанная запись передаётся в метод writeJson,который добавляет объект типа TJsonObject
с сериализованной записьюкурсора в массив TJsonArray
.
После завершения работы с курсором, закрываем его методом close
,преобразуем массив Json объектов в строку, пишем её в выходной поток,который записываем в выходной Blob.
Теперь разберём метод writeJson
. Объект IUtil
потребуется нам для того,чтобы получать функции для декодирования даты и времени. В этом методеактивно задействована работа с метаданными выходных полей курсора спомощью интерфейса IMessageMetadata
. Первым дело создаём объект типTJsonObject
в который будем записывать значения полей текущей записи.В качестве имён ключей будем использовать алиасы полей из курсора. Еслиустановлен NullFlag, то пишем значение null для ключа и переходим кследующему полю, в противном случае анализируем тип поля и пишем егозначение в 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;
// типы
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
// Получаем IUtil
util := AContext.getMaster().getUtilInterface();
// Создаём объект TJsonObject в которой будем
// записывать значение полей записи
jsonObject := TJsonObject.Create;
for i := 0 to AMeta.getCount(AStatus) - 1 do
begin
// получаем алиас поля в запросе
FieldName := AMeta.getAlias(AStatus, i);
NullFlag := PWordBool(ABuffer + AMeta.getNullOffset(AStatus, i))^;
if NullFlag then
begin
// если NULL пишем его в JSON и переходим к следующему полю
{$IFNDEF FPC}
jsonObject.AddPair(FieldName, TJsonNull.Create);
{$ELSE}
jsonObject.Add(FieldName, TJsonNull.Create);
{$ENDIF}
continue;
end;
// получаем указатель на данные поля
pData := ABuffer + AMeta.getOffset(AStatus, i);
// аналог AMeta->getType(AStatus, i) & ~1
fieldType := AMeta.getType(AStatus, i) and not 1;
case fieldType of
// VARCHAR
SQL_VARYING:
begin
// размер буфера для VARCHAR
metaLength := AMeta.getLength(AStatus, i);
SetLength(CharBuffer, metaLength);
charset := TFBCharSet(AMeta.getCharSet(AStatus, i));
charLength := PSmallint(pData)^;
// бинарные данные кодируем в base64
if charset = CS_BINARY then
begin
{$IFNDEF FPC}
StringValue := TNetEncoding.base64.EncodeBytesToString((pData + 2),
charLength);
{$ELSE}
// Для VARCHAR первые 2 байта - длина в байтах
// поэтому копируем в буфер начиная с 3 байта
Move((pData + 2)^, CharBuffer[0], metaLength);
StringValue := charset.GetString(CharBuffer, 0, charLength);
StringValue := EncodeStringBase64(StringValue);
{$ENDIF}
end
else
begin
// Для VARCHAR первые 2 байта - длина в байтах
// поэтому копируем в буфер начиная с 3 байта
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
// размер буфера для CHAR
metaLength := AMeta.getLength(AStatus, i);
SetLength(CharBuffer, metaLength);
charset := TFBCharSet(AMeta.getCharSet(AStatus, i));
Move(pData^, CharBuffer[0], metaLength);
// бинарные данные кодируем в 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), где p = 10..15 в 1 диалекте
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), где 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), где p = 5..9
// DECIMAL(p, s), где 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), где p = 10..18 в 3 диалекте
// DECIMAL(p, s), где p = 10..18 в 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)^;
// получаем составные части даты-времени
util.decodeDate(TimestampValue.timestamp_date, @year, @month, @day);
util.decodeTime(TimestampValue.timestamp_time, @hours, @minutes, @seconds,
@fractions);
// получаем дату-время в родном типе Delphi
DateTimeValue := EncodeDate(year, month, day) +
EncodeTime(hours, minutes, seconds, fractions div 10);
// форматируем дату-время по заданному формату
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);
// получаем составные части даты-времени и часовой пояс
util.decodeTimeStampTz(AStatus, TimestampValueTz, @year, @month, @day, @hours, @minutes, @seconds,
@fractions, 64, @tzBuffer[0]);
// получаем дату-время в родном типе Delphi
DateTimeValue := EncodeDate(year, month, day) +
EncodeTime(hours, minutes, seconds, fractions div 10);
// форматируем дату-время по заданному формату + часовой пояс
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)^;
// получаем составные части даты
util.decodeDate(DateValue, @year, @month, @day);
// получаем дату в родном типе Delphi
DateTimeValue := EncodeDate(year, month, day);
// форматируем дату по заданному формату
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)^;
// получаем составные части времени
util.decodeTime(TimeValue, @hours, @minutes, @seconds, @fractions);
// получаем время в родном типе Delphi
DateTimeValue := EncodeTime(hours, minutes, seconds,
fractions div 10);
// форматируем время по заданному формату
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);
// получаем составные части времени и часовой пояс
util.decodeTimeTz(AStatus, TimeValueTz, @hours, @minutes, @seconds,
@fractions, 64, @tzBuffer[0]);
// получаем время в родном типе Delphi
DateTimeValue := EncodeTime(hours, minutes, seconds,
fractions div 10);
// форматируем время по заданному формату + часовой пояс
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
// текст
charset := TFBCharSet(AMeta.getCharSet(AStatus, i));
// создаём поток с заданой кодировкой
{$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}
// все остальные подтипытипы считаем бинарными
binaryStream := TBytesStream.Create;
try
blob.SaveToStream(AStatus, binaryStream);
blob.close(AStatus);
blob := nil;
// кодируем строку в 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;
// добавление записи в формате Json в массив
{$IFNDEF FPC}
AJson.AddElement(jsonObject);
{$ELSE}
AJson.Add(jsonObject);
{$ENDIF}
end;
Note
|
Замечание
Перечисление типа Перечисление |
Для строк типа CHAR
и VARCHAR
проверяем кодировку, если это кодировкаOCTETS
, то кодируем строку алгоритмом base64, в противном случаепреобразуем данные из буфера в строку Delphi. Обратите внимание, что длятипа VARCHAR первые 2 байта содержат длину строки в символах.
Типы SMALLINT
, INTEGER
, BIGINT
могут быть как обычными целыми числами,так масштабируемыми. Масштаб числа можно получить методом getScale
интерфейса IMessageMetadata
. Если масштаб не равен 0, то требуетсяспециальная обработка числа, которая осуществляет методомMakeScaleInteger
.
Типы DATE
, TIME
и TIMESTAMP
декодируются на составные части даты ивремени с помощью методов decodeDate
и decodeTime
интерфейса IUtil
.Используем части даты и времени для получения даты-времени в стандартномDelphi типе TDateTime.
С типом BLOB работаем через потоки Delphi. Если BLOB бинарный, тосоздаём поток типа TBytesStream
. Полученный массив байт кодируем спомощью алгоритма base64. Если BLOB текстовый, то используемспециализированный поток TStringStream
для строк, который позволяетучесть кодовую страницу. Кодовую страницу мы получаем из кодировки BLOBполя.
Для работы с типом данных INT128
существует специальный интерфейс IInt128
. Его можно получитьвызвав метод getInt128
интерфейса IUtil
.Этот тип появился в Firebird 4.0 и предназначен для точного представления очень больших чисел.Не существует непосредственного типа данных в Delphi, который мог бы работать с этим типом,поэтому просто выводим его строковое представление.
Для работы с типами DECFLOAT(16)
и DECFLOAT(34)
существуют специальные интерфейсы IDecFloat16
и IDecFloat34
.Их можно получить вызвав методы getDecFloat16
или getDecFloat34
интерфейса IUtil
.Эти типы доступны начиная с Firebird 4.0. Не существует непосредственных типов данных в Delphi, которые могли бы работать с этим типами.Эти типы можно отобразить в BCD или представить в виде строки.
Типы TIME WITH TIME ZONE
и TIMESTAMP WITH TIME ZONE
декодируются на составные части даты ивремени, а также наименование часового пояса, с помощью методов decodeTimeStampTz
и decodeTimeTz
.Используем части даты и времени для получения даты-времени в стандартномDelphi типе TDateTime. Далее преобразуем значение этого типа в строку и добавляем к ней наименование часового пояса.
Appendix A: Замечание о лицензии
На содержание настоящей Документации распространяется действие лицензии Public Documentation License Version 1.0 (далее “Лицензия”);вы можете использовать эту Документацию только в том случае, если вы соблюдаете условия настоящей Лицензии.Копии лицензии доступны по адресу https://www.firebirdsql.org/pdfmanual/pdl.pdf (PDF) и https://www.firebirdsql.org/manual/pdl.html (HTML).
Оригинальная документация называется Написание UDR Firebird на Pascal.
Первоначальными авторами оригинальной документации являются: Денис Симонов.Авторы текста на русском языке — Денис Симонов.
Автор(ы): Денис Симонов.
Части, созданные Денисом Симоновым, защищены авторским правом © 2018–2023.Все права защищены.
(Контакты авторов: sim-mail at list dot ru).