Show domain-based field types in table management screen. Moving non-GUI shared functions to turbocommon.

comparison.pas

@@ -1562,7 +1562,6 @@ var
   DomainSize: Integer;
   Line: string;
 begin
-  //todo: align this with regular script code for domains, including collations
   if FModifiedDomainsList.Count > 0 then
   begin
     FQueryWindow.meQuery.Lines.Add('');

main.pas

@@ -7,18 +7,10 @@ interface
 uses
   Classes, SysUtils, IBConnection, sqldb, memds, FileUtil, LResources, Forms,
   Controls, Graphics, Dialogs, Menus, ComCtrls, Reg, QueryWindow, Grids,
-  ExtCtrls, Buttons, StdCtrls, TableManage,dbugintf, turbocommon;
+  ExtCtrls, Buttons, StdCtrls, TableManage, dbugintf, turbocommon;
 
 {$i turbocommon.inc}
 
-const
-  // Some field types used in e.g. RDB$FIELDS
-  //todo (low priority): perhaps move to enumeration with fixed constant values
-  BlobType = 261;
-  CharType = 14;
-  CStringType = 40; // probably null-terminated string used for UDFs
-  VarCharType = 37;
-
 type
   TDatabaseRec = record
     Index: Integer;
@@ -221,11 +213,6 @@ type
     function DeleteRegistration(Index: Integer): Boolean;
     // Returns BLOB subtype clause depending on subtype
     function GetBlobSubTypeName(SubType: integer): string;
-    // Returns field type DDL given a RDB$FIELD_TYPE value as well
-    // as subtype/length/scale (use -1 for empty/unknown values)
-    function GetFBTypeName(Index: Integer;
-      SubType: integer=-1; FieldLength: integer=-1; Precision: integer=-1;
-      Scale: integer=-1): string;
     // Get name of index used for primary key
     // Also returns name of constraint used
     function GetPrimaryKeyIndexName(DatabaseIndex: Integer; ATableName: string; var ConstraintName: string): string;
@@ -250,6 +237,7 @@ type
     procedure FillAndShowConstraintsForm(Form: TfmTableManage; ATableName: string; dbIndex: Integer);
     procedure ShowCompleteQueryWindow(DatabaseIndex: Integer; ATitle, AQueryText: string;
       OnCommitProcedure: TNotifyEvent = nil);
+    // Gets fields info and fills TableManage form(!) grids with info
     procedure ViewTableFields(ATableName: string; dbIndex: Integer; AStringGrid: TStringGrid);
     procedure ShowIndicesManagement(AForm: TForm; DatabaseIndex: Integer; ATableName: string);
     function GetTableNames(dbIndex: Integer): string;
@@ -272,8 +260,6 @@ type
 var
   fmMain: TfmMain;
 
-// Tries to guess if an RDB$RELATION_FIELDS.RDB$FIELD_SOURCE domain name for a column is system-generated.
-function IsFieldDomainSystemGenerated(FieldSource: string): boolean;
 
 implementation
 
@@ -286,13 +272,6 @@ uses CreateDb, ViewView, ViewTrigger, ViewSProc, ViewGen, NewTable, NewGen,
      PermissionManage, CopyTable, About, NewEditField, dbInfo, Comparison;
 
 
-function IsFieldDomainSystemGenerated(FieldSource: string): boolean;
-begin
-  // Unfortunately there does not seem to be a way to search the system tables to find out
-  // if the constraint name is system-generated
-  result:=(pos('RDB$',uppercase(Trim(FieldSource)))=1);
-end;
-
 procedure TfmMain.mnExitClick(Sender: TObject);
 begin
   Close;
@@ -2371,6 +2350,7 @@ begin
     ATab.Tag:= dbIndex;
     fmTableManage.Init(dbIndex, SelNode.Text);
     fmTableManage.PageControl1.TabIndex:= 0;
+    // Fields
     ViewTableFields(SelNode.Text, dbIndex, fmTableManage.sgFields);
 
     // Indices
@@ -2380,7 +2360,7 @@ begin
     FillAndShowConstraintsForm(fmTableManage, SelNode.Text, dbIndex);
 
     // Triggers
-    fmTableManage.ViewTriggers;
+    fmTableManage.FillTriggers;
 
     // Permissions
     fmTableManage.FillPermissions;
@@ -3089,10 +3069,13 @@ begin
 end;
 
 (***************  View Table Fields/ Fields Management  ***************)
-
+{ todo: should be moved to tablemanage.pas if possible; even better split out
+between non-GUI query part and GUI updater part}
 procedure TfmMain.ViewTableFields(ATableName: string; dbIndex: Integer;
   AStringGrid: TStringGrid);
 var
+  FieldSize: integer;
+  FieldType: string;
   i: Integer;
   PKFieldsList: TStringList;
   DefaultValue: string;
@@ -3117,21 +3100,8 @@ begin
         Cells[1, RowCount - 1]:= Trim(FieldByName('Field_Name').AsString);
 
         // Field Type
-        Cells[2, RowCount - 1]:= GetFBTypeName(FieldByName('field_type_int').AsInteger,
-          FieldByName('Field_Sub_Type').AsInteger,
-          FieldByName('Field_Length').AsInteger,
-          FieldByName('Field_Precision').AsInteger,
-          FieldByName('Field_Scale').AsInteger);
-
-        // Correct field type if it is an array type
-        // Array should really be [upper_bound dim0,upperbound dim1,..]
-        // but for now don't bother as arrays are not supported anyway
-        // Assume dimension 0, just fill in upper bound
-        if not(FieldByName('array_upper_bound').IsNull) then
-          Cells[2, RowCount - 1]:=Cells[2, RowCount - 1] +
-            ' [' +
-            SQLQuery1.FieldByName('array_upper_bound').AsString +
-            ']';
+        GetFieldType(SQLQuery1,FieldType,FieldSize);
+        Cells[2, RowCount - 1]:= FieldType;
 
         // Computed fields (Calculated)
         if FieldByName('computed_source').AsString <> '' then
@@ -4138,63 +4108,6 @@ begin
   end;
 end;
 
-(**************  Get Firebird Type name  *****************)
-
-function TfmMain.GetFBTypeName(Index: Integer;
-  SubType: integer=-1; FieldLength: integer=-1;
-  Precision: integer=-1; Scale: integer=-1
-  ): string;
-begin
-  //todo: (low priority) add Firebird 3.0 beta BOOLEAN datatype number
-  case Index of
-    // See also
-    // http://firebirdsql.org/manual/migration-mssql-data-types.html
-    // http://stackoverflow.com/questions/12070162/how-can-i-get-the-table-description-fields-and-types-from-firebird-with-dbexpr
-    BlobType : Result:= 'BLOB';
-    14 : Result:= 'CHAR';
-    CStringType : Result:= 'CSTRING'; // probably null-terminated string used for UDFs
-    12 : Result:= 'DATE';
-    11 : Result:= 'D_FLOAT';
-    16 : Result:= 'BIGINT'; // Further processed below
-    27 : Result:= 'DOUBLE PRECISION';
-    10 : Result:= 'FLOAT';
-    8  : Result:= 'INTEGER'; // further processed below
-    9  : Result:= 'QUAD'; // unknown what this is=> see IB6 Language Reference RDB$FIELD_TYPE
-    7  : Result:= 'SMALLINT'; // further processed below
-    13 : Result:= 'TIME';
-    35 : Result:= 'TIMESTAMP';
-    VarCharType : Result:= 'VARCHAR';
-  else
-    Result:= 'Unknown Type';
-  end;
-  // Subtypes for numeric types
-  if Index in [7, 8, 16] then
-  begin
-    if SubType = 0 then {integer}
-    begin
-      case Index of
-        7: Result:= 'SMALLINT';
-        8: Result:= 'INTEGER';
-        16: Result:= 'BIGINT';
-      end;
-    end
-    else
-    begin
-      // Numeric/decimal: use precision/scale
-      if SubType = 1 then
-        Result:= 'Numeric('
-      else
-      if SubType = 2 then
-        Result:= 'Decimal(';
-
-      if Precision=-1 then {sensible default}
-        Result:= Result + '2,'
-      else
-        Result:= Result + IntToStr(Precision)+',';
-      Result:= Result + IntToStr(Abs(Scale)) + ') ';
-    end;
-  end;
-end;
 
 (*******************  Get Primary Key fields  ************************)
 

newgen.pas

@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, IBConnection, sqldb, FileUtil, LResources, Forms, Controls,
-  Graphics, Dialogs, StdCtrls, Buttons;
+  Graphics, Dialogs, StdCtrls, Buttons, turbocommon;
 
 type
 
@@ -96,7 +96,7 @@ begin
     cbFields.Clear;
     while not fmMain.SQLQuery1.EOF do
     begin
-      FType:= fmMain.GetFBTypeName(fmMain.SQLQuery1.FieldByName('field_type_int').AsInteger,
+      FType:= GetFBTypeName(fmMain.SQLQuery1.FieldByName('field_type_int').AsInteger,
         fmMain.SQLQuery1.FieldByName('field_sub_type').AsInteger,
         fmMain.SQLQuery1.FieldByName('field_length').AsInteger,
         fmMain.SQLQuery1.FieldByName('field_precision').AsInteger,

scriptdb.pas

@@ -5,7 +5,7 @@ unit Scriptdb;
 interface
 
 uses
-  Classes, SysUtils;
+  Classes, SysUtils, turbocommon;
 
 
 function ScriptAllRoles(dbIndex: Integer; var List: TStringList): Boolean;
@@ -240,7 +240,7 @@ begin
         begin
           // Field type is not based on a domain but a standard SQL type
           // Field type
-          FieldLine:= FieldLine + fmMain.GetFBTypeName(FieldByName('field_type_int').AsInteger,
+          FieldLine:= FieldLine + GetFBTypeName(FieldByName('field_type_int').AsInteger,
             FieldByName('field_sub_type').AsInteger,
             FieldByName('field_length').AsInteger,
             FieldByName('field_precision').AsInteger,

systables.pas

@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, sqldb, IBConnection, FileUtil, LResources, Forms, Controls,
-  Dialogs, dbugintf;
+  Dialogs, dbugintf, turbocommon;
 
 type
 
@@ -657,7 +657,7 @@ begin
 
   if sqQuery.RecordCount > 0 then
   begin
-    DomainType:= fmMain.GetFBTypeName(sqQuery.FieldByName('RDB$FIELD_TYPE').AsInteger,
+    DomainType:= GetFBTypeName(sqQuery.FieldByName('RDB$FIELD_TYPE').AsInteger,
       sqQuery.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger,
       sqQuery.FieldByName('RDB$FIELD_LENGTH').AsInteger,
       sqQuery.FieldByName('RDB$FIELD_PRECISION').AsInteger,
@@ -915,12 +915,13 @@ begin
   begin
     with sqQuery do
     begin
+      //todo: harmonize with implementation in turbocommon
       if (FieldByName('field_source').IsNull) or
         (trim(FieldByName('field_source').AsString)='') or
         (IsFieldDomainSystemGenerated(trim(FieldByname('field_source').AsString))) then
       begin
         // Field type is not based on a domain but a standard SQL type
-        FieldType:= fmMain.GetFBTypeName(FieldByName('field_type_int').AsInteger,
+        FieldType:= GetFBTypeName(FieldByName('field_type_int').AsInteger,
           FieldByName('field_sub_type').AsInteger,
           FieldByName('field_length').AsInteger,
           FieldByName('field_precision').AsInteger,

tablemanage.pas

@@ -89,9 +89,14 @@ type
   public
     PKeyName, ConstraintName: string;
     procedure Init(dbIndex: Integer; TableName: string);
+    // Fill grid with constraint info
+    { Todo: fillconstraints relies on a query being set correctly elsewhere; get
+    rid of that - see e.g. FillPermissions }
     procedure FillConstraints(dbIndex: Integer);
-    procedure ViewTriggers;
+    // Get info on permissions and fill grid with it
     procedure FillPermissions;
+    // Get info on triggers and fill grid with it
+    procedure FillTriggers;
   end;
 
 var
@@ -357,7 +362,7 @@ end;
 procedure TfmTableManage.bbRefreshTriggersClick(Sender: TObject);
 begin
   FSQLTrans.Commit;
-  ViewTriggers;
+  FillTriggers;
   Parent.Show;
   Show;
 end;
@@ -379,10 +384,8 @@ begin
     Cells[2, RowCount - 1]:= FieldByName('OtherFieldName').AsString;
     Cells[3, RowCount - 1]:= FieldByName('KeyName').AsString;
     Next;
-
   end;
   SQLQuery1.Close;
-
 end;
 
 procedure TfmTableManage.cbIndexTypeChange(Sender: TObject);
@@ -470,11 +473,11 @@ begin
   SQLQuery1.Close;
 end;
 
-procedure TfmTableManage.ViewTriggers;
+procedure TfmTableManage.FillTriggers;
 begin
   SQLQuery1.Close;
-  SQLQuery1.SQL.Text:= 'SELECT RDB$Trigger_Name, RDB$Trigger_Inactive FROM RDB$TRIGGERS WHERE RDB$SYSTEM_FLAG=0 ' +
-    'and RDB$Relation_Name = ''' + FTableName + '''';
+  SQLQuery1.SQL.Text:= Format('SELECT RDB$Trigger_Name, RDB$Trigger_Inactive FROM RDB$TRIGGERS WHERE RDB$SYSTEM_FLAG=0 ' +
+    'and RDB$Relation_Name = ''%s'' ',[FTableName]);
   SQLQuery1.Open;
   sgTriggers.RowCount:= 1;
   with sgTriggers, SQLQuery1 do
@@ -499,6 +502,9 @@ var
   ObjType: Integer;
   Permissions: string;
 begin
+  {todo: analyse transaction behaviour. Why do we have an explicit commit here? Also,
+  get rid of the implicit rollbacks and use a separate read only transaction for extracting
+  DDL and other read only info}
   FSQLTrans.Commit;
   UsersList:= TStringList.Create;
   try

turbocommon.pas

@@ -7,7 +7,28 @@ unit turbocommon;
 interface
 
 uses
-  Classes, SysUtils;
+  Classes, SysUtils, sqldb;
+
+const
+  // Some field types used in e.g. RDB$FIELDS
+  //todo (low priority): perhaps move to enumeration with fixed constant values
+  BlobType = 261;
+  CharType = 14;
+  CStringType = 40; // probably null-terminated string used for UDFs
+  VarCharType = 37;
+
+// Given field retrieval query in FieldQuery, return field type and size.
+// Includes support for field types that are domains and arrays
+procedure GetFieldType(FieldQuery: TSQLQuery; var FieldType: string; var FieldSize: integer);
+
+// Returns field type DDL given a RDB$FIELD_TYPE value as well
+// as subtype/length/scale (use -1 for empty/unknown values)
+function GetFBTypeName(Index: Integer;
+  SubType: integer=-1; FieldLength: integer=-1; Precision: integer=-1;
+  Scale: integer=-1): string;
+
+// Tries to guess if an RDB$RELATION_FIELDS.RDB$FIELD_SOURCE domain name for a column is system-generated.
+function IsFieldDomainSystemGenerated(FieldSource: string): boolean;
 
 // Given TIBConnection parameters, sets transaction isolation level
 procedure SetTransactionIsolation(Params: TStringList);
@@ -22,5 +43,108 @@ begin
   Params.Add('isc_tpb_nowait');
 end;
 
+procedure GetFieldType(FieldQuery: TSQLQuery; var FieldType: string; var FieldSize: integer);
+// Requires FieldQuery to be the correct field retrieval query.
+// todo: migrate field retrieval query to turbocommon
+begin
+  FieldType:= '';
+  FieldSize:= 0;
+
+  if (FieldQuery.FieldByName('field_source').IsNull) or
+    (trim(FieldQuery.FieldByName('field_source').AsString)='') or
+    (IsFieldDomainSystemGenerated(trim(FieldQuery.FieldByname('field_source').AsString))) then
+  begin
+    // Field type is not based on a domain but a standard SQL type
+    FieldType:= GetFBTypeName(FieldQuery.FieldByName('field_type_int').AsInteger,
+      FieldQuery.FieldByName('field_sub_type').AsInteger,
+      FieldQuery.FieldByName('field_length').AsInteger,
+      FieldQuery.FieldByName('field_precision').AsInteger,
+      FieldQuery.FieldByName('field_scale').AsInteger);
+    // Array should really be [lowerbound:upperbound] (if dimension is 0)
+    // but for now don't bother as arrays are not supported anyway
+    // Assume 0 dimension, 1 lower bound; just fill in upper bound
+    if not(FieldQuery.FieldByName('array_upper_bound').IsNull) then
+      FieldType := FieldType +
+        ' [' +
+        FieldQuery.FieldByName('array_upper_bound').AsString +
+        ']';
+    if FieldQuery.FieldByName('field_type_int').AsInteger = VarCharType then
+      FieldSize:= FieldQuery.FieldByName('characterlength').AsInteger
+    else
+      FieldSize:= FieldQuery.FieldByName('field_length').AsInteger;
+  end
+  else
+  begin
+    // Field is based on a domain
+    FieldType:= trim(FieldQuery.FieldByName('field_source').AsString);
+  end;
+end;
+
+(**************  Get Firebird Type name  *****************)
+
+function GetFBTypeName(Index: Integer;
+  SubType: integer=-1; FieldLength: integer=-1;
+  Precision: integer=-1; Scale: integer=-1
+  ): string;
+begin
+  //todo: (low priority) add Firebird 3.0 beta BOOLEAN datatype number
+  case Index of
+    // See also
+    // http://firebirdsql.org/manual/migration-mssql-data-types.html
+    // http://stackoverflow.com/questions/12070162/how-can-i-get-the-table-description-fields-and-types-from-firebird-with-dbexpr
+    BlobType : Result:= 'BLOB';
+    14 : Result:= 'CHAR';
+    CStringType : Result:= 'CSTRING'; // probably null-terminated string used for UDFs
+    12 : Result:= 'DATE';
+    11 : Result:= 'D_FLOAT';
+    16 : Result:= 'BIGINT'; // Further processed below
+    27 : Result:= 'DOUBLE PRECISION';
+    10 : Result:= 'FLOAT';
+    8  : Result:= 'INTEGER'; // further processed below
+    9  : Result:= 'QUAD'; // unknown what this is=> see IB6 Language Reference RDB$FIELD_TYPE
+    7  : Result:= 'SMALLINT'; // further processed below
+    13 : Result:= 'TIME';
+    35 : Result:= 'TIMESTAMP';
+    VarCharType : Result:= 'VARCHAR';
+  else
+    Result:= 'Unknown Type';
+  end;
+  // Subtypes for numeric types
+  if Index in [7, 8, 16] then
+  begin
+    if SubType = 0 then {integer}
+    begin
+      case Index of
+        7: Result:= 'SMALLINT';
+        8: Result:= 'INTEGER';
+        16: Result:= 'BIGINT';
+      end;
+    end
+    else
+    begin
+      // Numeric/decimal: use precision/scale
+      if SubType = 1 then
+        Result:= 'Numeric('
+      else
+      if SubType = 2 then
+        Result:= 'Decimal(';
+
+      if Precision=-1 then {sensible default}
+        Result:= Result + '2,'
+      else
+        Result:= Result + IntToStr(Precision)+',';
+      Result:= Result + IntToStr(Abs(Scale)) + ') ';
+    end;
+  end;
+end;
+
+function IsFieldDomainSystemGenerated(FieldSource: string): boolean;
+begin
+  // Unfortunately there does not seem to be a way to search the system tables to find out
+  // if the constraint name is system-generated
+  result:=(pos('RDB$',uppercase(Trim(FieldSource)))=1);
+end;
+
+
 end.