examples/SelectInto/UdrSelectInto.pas

unit UdrSelectInto;

{
create or alter procedure select_into (
  select_statement blob sub_type 1 not null,
  table_name varchar(63) not null,
  table_type varchar(25) not null    -- 'global temporary preserve', 'global temporary[ delete]', <empty string> for standard table
) returns (
  status varchar(100)
)
external name 'selectinto!select_into'
engine udr;
}

interface

uses Classes, SysUtils, IB, FBUDRController, FBUDRIntf;

type
  TSelectInto = class(TFBUDRExecuteProcedure)
  public
    procedure Execute(context: IFBUDRExternalContext;
                      ProcMetadata: IFBUDRProcMetadata;
                      InputParams: IFBUDRInputParams;
                      OutputData: IFBUDROutputData); override;
  end;


implementation

uses StrUtils, IBUtils;

function SQLType2Name(SQLType: Cardinal) : AnsiString;
begin
  case SQLType of
    SQL_VARYING:          Result := 'VARCHAR';
    SQL_TEXT:             Result := 'CHAR';
    SQL_DOUBLE:           Result := 'DOUBLE PRECISION';
    SQL_FLOAT:            Result := 'FLOAT';
    SQL_LONG:             Result := 'INTEGER';
    SQL_SHORT:            Result := 'SMALLINT';
    SQL_TIMESTAMP:        Result := 'TIMESTAMP';
    SQL_TIMESTAMP_TZ:     Result := 'TIMESTAMP WITH TIMEZONE';
    SQL_TIMESTAMP_TZ_EX:  Result := 'TIMESTAMP WITH TIMEZONE';
    SQL_BLOB:             Result := 'BLOB';
    SQL_D_FLOAT:          Result := 'FLOAT';
    SQL_TYPE_TIME:        Result := 'TIME';
    SQL_TYPE_DATE:        Result := 'DATE';
    SQL_INT64:            Result := 'BIGINT';
    SQL_TIME_TZ:          Result := 'TIME WITH TIMEZONE';
    SQL_TIME_TZ_EX:       Result := 'TIME WITH TIMEZONE';
    SQL_DEC16:            Result := 'DECFLOAT(16)';
    SQL_DEC34:            Result := 'DECFLOAT(34)';
    SQL_INT128:           Result := 'INT128';
    SQL_NULL:             Result := 'VARCHAR(1)';
    SQL_BOOLEAN:          Result := 'BOOLEAN';
  else
    Result := 'UNKNOWN';
  end
end;

function Fld2SQLTypeDef(SQLType: Cardinal; SubType: Integer; Size: Cardinal; Scale: Integer; CharSetClause: String) : AnsiString;
var
  TypeDef: AnsiString;
begin
  TypeDef := SQLType2Name(SQLType);

  if Scale < 0 then
    case SQLType of
      SQL_SHORT:            TypeDef := format('NUMERIC(4,%d)', [-Scale]);
      SQL_LONG:             TypeDef := format('NUMERIC(9,%d)', [-Scale]);
      SQL_DOUBLE:           TypeDef := format('NUMERIC(15,%d)', [-Scale]);
      SQL_INT64:            TypeDef := format('NUMERIC(18,%d)', [-Scale]);  
      SQL_INT128:           TypeDef := format('NUMERIC(35,%d)', [-Scale]);
    end
  else
    case SQLType of
      SQL_VARYING,
      SQL_TEXT:             TypeDef := format(TypeDef + '(%d) %s', [Size, CharSetClause]);
      SQL_BLOB:             TypeDef := format(TypeDef + ' SUB_TYPE %d %s', [SubType, CharSetClause]);
    end;
  Result := TypeDef;
end;

procedure TSelectInto.Execute(context: IFBUDRExternalContext; ProcMetadata: IFBUDRProcMetadata; InputParams: IFBUDRInputParams; OutputData: IFBUDROutputData);
var
  Statement: IStatement;
  TX2: ITransaction;
  Dialect, DefaultCharSetID, i: Integer;
  SelectSQL, TableName, TableType: AnsiString;
  TypeDef, TypeDefs, CharSetClause, Command, CommitAction, SQL: AnsiString;
begin
  TypeDefs := '';
  with context do
  begin
    // prepare and analyse select_statement and create DDL of target table columns
    SelectSQL := InputParams.ByName('select_statement').AsString;
    Dialect := GetAttachment.GetSQLDialect;
    DefaultCharSetID := context.GetAttachment.getCharSetID;
    CharSetClause := '';

    Statement := GetAttachment.Prepare(GetTransaction, SelectSQL);
    with Statement.MetaData do
    begin
      for i := 0 to Count -1 do
      begin
        with ColMetaData[i] do
        begin
          case GetSQLType of SQL_VARYING,
                             SQL_TEXT,
                             SQL_BLOB: if (DefaultCharSetID <> getCharSetID) then
                                         CharSetClause := 'CHARACTER SET ' + GetAttachment.GetCharsetName(getCharSetID);
          end;
          TypeDef := Fld2SQLTypeDef(GetSQLType, SQLSubtype, Size, Scale, CharSetClause);
          TypeDefs := TypeDefs + ','#13#10 + QuoteIdentifierIfNeeded(Dialect, Name) + ' ' + TypeDef;
        end;
      end;
      Delete(TypeDefs, 1, 1);
    end;

    // create target table DDL
    TableName := InputParams.ByName('table_name').AsString;
    TableType := UpperCase(InputParams.ByName('table_type').AsString);

    // default: recreate standard table
    Command := 'RECREATE ';

    // global temporary?
    CommitAction := '';
    if AnsiContainsStr(TableType, 'GLOBAL TEMPORARY') then
    begin
      Command := Command + 'GLOBAL TEMPORARY';
      if AnsiContainsStr(TableType, 'PRESERVE') then
        CommitAction := 'ON COMMIT PRESERVE ROWS';
    end;

    // create target table within own TX, needs to be committed separately
    SQL := SQL + format('%s TABLE %s (%s) %s', [Command, TableName, TypeDefs, CommitAction]);
    TX2 := GetAttachment.StartTransaction([isc_tpb_write, isc_tpb_nowait, isc_tpb_read_committed], taCommit);
    GetAttachment.ExecImmediate(TX2, SQL);
    TX2.Commit();

    // fill target table
    SQL := format('INSERT INTO %s %s;', [TableName, SelectSQL]);
    GetAttachment.ExecImmediate(GetTransaction, SQL);
  end;
  OutputData.ByName('status').AsString := 'ok';
end;

initialization

FBRegisterUDRProcedure('select_into', TSelectInto);

end.
Revision:	402
Committed:	Mon Aug 1 10:07:24 2022 UTC (2 years, 4 months ago) by tony
Content type:	text/x-pascal
File size:	5422 byte(s)
Log Message:	IBX Release 2.5.0
#	User	Rev	Content
1	tony	402	unit UdrSelectInto;
2
3			{
4			create or alter procedure select_into (
5			select_statement blob sub_type 1 not null,
6			table_name varchar(63) not null,
7			table_type varchar(25) not null -- 'global temporary preserve', 'global temporary[ delete]', <empty string> for standard table
8			) returns (
9			status varchar(100)
10			)
11			external name 'selectinto!select_into'
12			engine udr;
13			}
14
15			interface
16
17			uses Classes, SysUtils, IB, FBUDRController, FBUDRIntf;
18
19			type
20			TSelectInto = class(TFBUDRExecuteProcedure)
21			public
22			procedure Execute(context: IFBUDRExternalContext;
23			ProcMetadata: IFBUDRProcMetadata;
24			InputParams: IFBUDRInputParams;
25			OutputData: IFBUDROutputData); override;
26			end;
27
28
29			implementation
30
31			uses StrUtils, IBUtils;
32
33			function SQLType2Name(SQLType: Cardinal) : AnsiString;
34			begin
35			case SQLType of
36			SQL_VARYING: Result := 'VARCHAR';
37			SQL_TEXT: Result := 'CHAR';
38			SQL_DOUBLE: Result := 'DOUBLE PRECISION';
39			SQL_FLOAT: Result := 'FLOAT';
40			SQL_LONG: Result := 'INTEGER';
41			SQL_SHORT: Result := 'SMALLINT';
42			SQL_TIMESTAMP: Result := 'TIMESTAMP';
43			SQL_TIMESTAMP_TZ: Result := 'TIMESTAMP WITH TIMEZONE';
44			SQL_TIMESTAMP_TZ_EX: Result := 'TIMESTAMP WITH TIMEZONE';
45			SQL_BLOB: Result := 'BLOB';
46			SQL_D_FLOAT: Result := 'FLOAT';
47			SQL_TYPE_TIME: Result := 'TIME';
48			SQL_TYPE_DATE: Result := 'DATE';
49			SQL_INT64: Result := 'BIGINT';
50			SQL_TIME_TZ: Result := 'TIME WITH TIMEZONE';
51			SQL_TIME_TZ_EX: Result := 'TIME WITH TIMEZONE';
52			SQL_DEC16: Result := 'DECFLOAT(16)';
53			SQL_DEC34: Result := 'DECFLOAT(34)';
54			SQL_INT128: Result := 'INT128';
55			SQL_NULL: Result := 'VARCHAR(1)';
56			SQL_BOOLEAN: Result := 'BOOLEAN';
57			else
58			Result := 'UNKNOWN';
59			end
60			end;
61
62			function Fld2SQLTypeDef(SQLType: Cardinal; SubType: Integer; Size: Cardinal; Scale: Integer; CharSetClause: String) : AnsiString;
63			var
64			TypeDef: AnsiString;
65			begin
66			TypeDef := SQLType2Name(SQLType);
67
68			if Scale < 0 then
69			case SQLType of
70			SQL_SHORT: TypeDef := format('NUMERIC(4,%d)', [-Scale]);
71			SQL_LONG: TypeDef := format('NUMERIC(9,%d)', [-Scale]);
72			SQL_DOUBLE: TypeDef := format('NUMERIC(15,%d)', [-Scale]);
73			SQL_INT64: TypeDef := format('NUMERIC(18,%d)', [-Scale]);
74			SQL_INT128: TypeDef := format('NUMERIC(35,%d)', [-Scale]);
75			end
76			else
77			case SQLType of
78			SQL_VARYING,
79			SQL_TEXT: TypeDef := format(TypeDef + '(%d) %s', [Size, CharSetClause]);
80			SQL_BLOB: TypeDef := format(TypeDef + ' SUB_TYPE %d %s', [SubType, CharSetClause]);
81			end;
82			Result := TypeDef;
83			end;
84
85			procedure TSelectInto.Execute(context: IFBUDRExternalContext; ProcMetadata: IFBUDRProcMetadata; InputParams: IFBUDRInputParams; OutputData: IFBUDROutputData);
86			var
87			Statement: IStatement;
88			TX2: ITransaction;
89			Dialect, DefaultCharSetID, i: Integer;
90			SelectSQL, TableName, TableType: AnsiString;
91			TypeDef, TypeDefs, CharSetClause, Command, CommitAction, SQL: AnsiString;
92			begin
93			TypeDefs := '';
94			with context do
95			begin
96			// prepare and analyse select_statement and create DDL of target table columns
97			SelectSQL := InputParams.ByName('select_statement').AsString;
98			Dialect := GetAttachment.GetSQLDialect;
99			DefaultCharSetID := context.GetAttachment.getCharSetID;
100			CharSetClause := '';
101
102			Statement := GetAttachment.Prepare(GetTransaction, SelectSQL);
103			with Statement.MetaData do
104			begin
105			for i := 0 to Count -1 do
106			begin
107			with ColMetaData[i] do
108			begin
109			case GetSQLType of SQL_VARYING,
110			SQL_TEXT,
111			SQL_BLOB: if (DefaultCharSetID <> getCharSetID) then
112			CharSetClause := 'CHARACTER SET ' + GetAttachment.GetCharsetName(getCharSetID);
113			end;
114			TypeDef := Fld2SQLTypeDef(GetSQLType, SQLSubtype, Size, Scale, CharSetClause);
115			TypeDefs := TypeDefs + ','#13#10 + QuoteIdentifierIfNeeded(Dialect, Name) + ' ' + TypeDef;
116			end;
117			end;
118			Delete(TypeDefs, 1, 1);
119			end;
120
121			// create target table DDL
122			TableName := InputParams.ByName('table_name').AsString;
123			TableType := UpperCase(InputParams.ByName('table_type').AsString);
124
125			// default: recreate standard table
126			Command := 'RECREATE ';
127
128			// global temporary?
129			CommitAction := '';
130			if AnsiContainsStr(TableType, 'GLOBAL TEMPORARY') then
131			begin
132			Command := Command + 'GLOBAL TEMPORARY';
133			if AnsiContainsStr(TableType, 'PRESERVE') then
134			CommitAction := 'ON COMMIT PRESERVE ROWS';
135			end;
136
137			// create target table within own TX, needs to be committed separately
138			SQL := SQL + format('%s TABLE %s (%s) %s', [Command, TableName, TypeDefs, CommitAction]);
139			TX2 := GetAttachment.StartTransaction([isc_tpb_write, isc_tpb_nowait, isc_tpb_read_committed], taCommit);
140			GetAttachment.ExecImmediate(TX2, SQL);
141			TX2.Commit();
142
143			// fill target table
144			SQL := format('INSERT INTO %s %s;', [TableName, SelectSQL]);
145			GetAttachment.ExecImmediate(GetTransaction, SQL);
146			end;
147			OutputData.ByName('status').AsString := 'ok';
148			end;
149
150			initialization
151
152			FBRegisterUDRProcedure('select_into', TSelectInto);
153
154			end.