ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/examples/SelectInto/UdrSelectInto.pas
Revision: 402
Committed: Mon Aug 1 10:07:24 2022 UTC (20 months, 4 weeks ago) by tony
Content type: text/x-pascal
File size: 5422 byte(s)
Log Message:
IBX Release 2.5.0

File Contents

# Content
1 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.

Properties

Name Value
svn:eol-style native