Browse Source

Database, right click: recalculate index statistics functionality. DB script: ignore error when creating RDB$ADMIN role which exists on FB 2.5+ databases.

Reinier Olislagers 11 years ago
parent
commit
aba698f5dd
6 changed files with 751 additions and 640 deletions
  1. 1 0
      TurboBird.lpi
  2. 13 8
      main.lfm
  3. 617 614
      main.lrs
  4. 22 7
      main.pas
  5. 41 6
      scriptdb.pas
  6. 57 5
      systables.pas

+ 1 - 0
TurboBird.lpi

@@ -283,6 +283,7 @@
         <Filename Value="calen.pas"/>
         <Filename Value="calen.pas"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="fmCalen"/>
         <ComponentName Value="fmCalen"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
         <ResourceBaseClass Value="Form"/>
         <UnitName Value="Calen"/>
         <UnitName Value="Calen"/>
       </Unit23>
       </Unit23>

+ 13 - 8
main.lfm

@@ -5,7 +5,7 @@ object fmMain: TfmMain
   Width = 1024
   Width = 1024
   ActiveControl = tvMain
   ActiveControl = tvMain
   Caption = 'TurboBird Admin for FireBird'
   Caption = 'TurboBird Admin for FireBird'
-  ClientHeight = 617
+  ClientHeight = 621
   ClientWidth = 1024
   ClientWidth = 1024
   Color = clWhite
   Color = clWhite
   Font.Name = 'Sans'
   Font.Name = 'Sans'
@@ -18,7 +18,7 @@ object fmMain: TfmMain
   LCLVersion = '1.2.2.0'
   LCLVersion = '1.2.2.0'
   object tvMain: TTreeView
   object tvMain: TTreeView
     Left = 0
     Left = 0
-    Height = 596
+    Height = 601
     Top = 0
     Top = 0
     Width = 360
     Width = 360
     Align = alLeft
     Align = alLeft
@@ -38,14 +38,14 @@ object fmMain: TfmMain
   end
   end
   object Splitter1: TSplitter
   object Splitter1: TSplitter
     Left = 360
     Left = 360
-    Height = 596
+    Height = 601
     Top = 0
     Top = 0
     Width = 14
     Width = 14
     Beveled = True
     Beveled = True
   end
   end
   object PageControl1: TPageControl
   object PageControl1: TPageControl
     Left = 377
     Left = 377
-    Height = 589
+    Height = 594
     Top = 3
     Top = 3
     Width = 644
     Width = 644
     ActivePage = TabSheet1
     ActivePage = TabSheet1
@@ -65,8 +65,8 @@ object fmMain: TfmMain
     object TabSheet1: TTabSheet
     object TabSheet1: TTabSheet
       BorderWidth = 1
       BorderWidth = 1
       Caption = 'Main'
       Caption = 'Main'
-      ClientHeight = 559
-      ClientWidth = 640
+      ClientHeight = 563
+      ClientWidth = 636
       Font.Color = clNavy
       Font.Color = clNavy
       Font.Name = 'Arial'
       Font.Name = 'Arial'
       ParentFont = False
       ParentFont = False
@@ -506,8 +506,8 @@ object fmMain: TfmMain
   end
   end
   object StatusBar1: TStatusBar
   object StatusBar1: TStatusBar
     Left = 0
     Left = 0
-    Height = 21
-    Top = 596
+    Height = 20
+    Top = 601
     Width = 1024
     Width = 1024
     Panels = <    
     Panels = <    
       item
       item
@@ -1890,6 +1890,11 @@ object fmMain: TfmMain
       }
       }
       OnClick = lmBackupClick
       OnClick = lmBackupClick
     end
     end
+    object lmRecalculateStatistics: TMenuItem
+      Caption = 'Recalculate indexes'
+      Hint = 'Recalculate index statistics. Can be useful after large loads/edits'
+      OnClick = lmRecalculateStatisticsClick
+    end
     object lmSweep: TMenuItem
     object lmSweep: TMenuItem
       Caption = 'Sweep DB'
       Caption = 'Sweep DB'
       Bitmap.Data = {
       Bitmap.Data = {

File diff suppressed because it is too large
+ 617 - 614
main.lrs


+ 22 - 7
main.pas

@@ -51,6 +51,7 @@ type
     lmCompare: TMenuItem;
     lmCompare: TMenuItem;
     lmGetIncrementGen: TMenuItem;
     lmGetIncrementGen: TMenuItem;
     lmDropTable: TMenuItem;
     lmDropTable: TMenuItem;
+    lmRecalculateStatistics: TMenuItem;
     mnExit: TMenuItem;
     mnExit: TMenuItem;
     mnCreateDB: TMenuItem;
     mnCreateDB: TMenuItem;
     mnRegDB: TMenuItem;
     mnRegDB: TMenuItem;
@@ -170,6 +171,7 @@ type
     procedure lmViewTriggerClick(Sender: TObject);
     procedure lmViewTriggerClick(Sender: TObject);
     procedure lmViewUDFClick(Sender: TObject);
     procedure lmViewUDFClick(Sender: TObject);
     procedure lmDropTableClick(Sender: TObject);
     procedure lmDropTableClick(Sender: TObject);
+    procedure lmRecalculateStatisticsClick(Sender: TObject);
     procedure mnExitClick(Sender: TObject);
     procedure mnExitClick(Sender: TObject);
     procedure mnCreateDBClick(Sender: TObject);
     procedure mnCreateDBClick(Sender: TObject);
     procedure mnRegDBClick(Sender: TObject);
     procedure mnRegDBClick(Sender: TObject);
@@ -1877,14 +1879,13 @@ begin
         ScriptAllPermissions(dbIndex, List);
         ScriptAllPermissions(dbIndex, List);
         Lines.AddStrings(List);
         Lines.AddStrings(List);
         Lines.Add('');
         Lines.Add('');
-
       end;
       end;
       QueryWindow.Show;
       QueryWindow.Show;
     except
     except
-      on e: exception do
+      on E: Exception do
       begin
       begin
         Screen.Cursor:= crDefault;
         Screen.Cursor:= crDefault;
-        ShowMessage(e.Message);
+        ShowMessage(E.Message);
       end;
       end;
     end;
     end;
   finally
   finally
@@ -2292,6 +2293,7 @@ var
 begin
 begin
   dbIndex:= PtrInt(tvMain.Selected.Data);
   dbIndex:= PtrInt(tvMain.Selected.Data);
   FireBirdServices:= TFirebirdServices.Create;
   FireBirdServices:= TFirebirdServices.Create;
+  Screen.Cursor:= crSQLWait;
   try
   try
     FireBirdServices.VerboseOutput:= True;
     FireBirdServices.VerboseOutput:= True;
     with FireBirdServices, RegisteredDatabases[dbIndex] do
     with FireBirdServices, RegisteredDatabases[dbIndex] do
@@ -2309,17 +2311,18 @@ begin
         StartSweep;
         StartSweep;
         while ServiceQuery(S) do
         while ServiceQuery(S) do
           Lines:= Lines + S;
           Lines:= Lines + S;
-
-        ShowMessage('Sweep database: ' + AdbName + ' Completed');
+        Screen.Cursor:= crDefault;
+        ShowMessage('Sweep database: ' + AdbName + ' completed');
       except
       except
-        on e: exception do
+        on E: Exception do
         begin
         begin
-          MessageDlg('Error: ' + e.Message, mtError, [mbOK], 0);
+          MessageDlg('Error: ' + E.Message, mtError, [mbOK], 0);
         end;
         end;
       end;
       end;
       DetachService;
       DetachService;
     end;
     end;
   finally
   finally
+    Screen.Cursor:= crDefault;
     FireBirdServices.Free;
     FireBirdServices.Free;
   end;
   end;
 end;
 end;
@@ -3537,6 +3540,18 @@ begin
   end;
   end;
 end;
 end;
 
 
+procedure TfmMain.lmRecalculateStatisticsClick(Sender: TObject);
+begin
+  //Recalculate index statistics. May take a while for big dbs.
+  Screen.Cursor:= crSQLWait;
+  try
+    dmSysTables.RecalculateIndexStatistics(PtrInt(tvMain.Selected.Data));
+  finally
+    Screen.Cursor:= crDefault;
+  end;
+  ShowMessage('Recalculation of index statistics complete.');
+end;
+
 (********  Create new database  ********)
 (********  Create new database  ********)
 
 
 procedure TfmMain.mnCreateDBClick(Sender: TObject);
 procedure TfmMain.mnCreateDBClick(Sender: TObject);

+ 41 - 6
scriptdb.pas

@@ -9,6 +9,9 @@ uses
   Classes, SysUtils, turbocommon, dialogs;
   Classes, SysUtils, turbocommon, dialogs;
 
 
 
 
+// Scripts all roles; changes List to contain the CREATE ROLE SQL statements
+// Will deal with existing RDB$ADMIN role (FB 2.5+ has this present by default;
+// earlier db versions do not)
 function ScriptAllRoles(dbIndex: Integer; var List: TStringList): Boolean;
 function ScriptAllRoles(dbIndex: Integer; var List: TStringList): Boolean;
 // Scripts all UDF functions in a database
 // Scripts all UDF functions in a database
 function ScriptAllFunctions(dbIndex: Integer; var List: TStringList): Boolean;
 function ScriptAllFunctions(dbIndex: Integer; var List: TStringList): Boolean;
@@ -70,18 +73,50 @@ end;
 (********************  Script Roles  ***********************)
 (********************  Script Roles  ***********************)
 
 
 function ScriptAllRoles(dbIndex: Integer; var List: TStringList): Boolean;
 function ScriptAllRoles(dbIndex: Integer; var List: TStringList): Boolean;
+const
+  AdminRole= 'RDB$ADMIN';
 var
 var
   Count: Integer;
   Count: Integer;
+  HasRDBAdmin: boolean;
   i: Integer;
   i: Integer;
 begin
 begin
+  HasRDBAdmin:= false;
   List.CommaText:= dmSysTables.GetDBObjectNames(dbIndex, otRoles, Count);
   List.CommaText:= dmSysTables.GetDBObjectNames(dbIndex, otRoles, Count);
-  { todo: (low priority) wrap create role RDB$Admin statement - in FB 2.5+ this role is present
+  { Wwrap creates role RDB$Admin statement - in FB 2.5+ this role is present
   by default, in lower dbs it isn't. No way to find out in advance when writing
   by default, in lower dbs it isn't. No way to find out in advance when writing
-  a script. No support in FB yet for CREATE OR UPDATE ROLE so probably best
-  to do it in execute block with error handling or
-  first check system tables for role existence, again with execute block }
-  for i:= 0 to List.Count - 1 do
-    List[i]:= 'Create Role ' + List[i] + ';';
+  a script. No support in FB yet for CREATE OR UPDATE ROLE so best
+  to do it in execute block with error handling }
+  i:= 0;
+  while i<List.Count do
+  begin
+    if uppercase(List[i]) = AdminRole then
+    begin
+      // Delete now; recreate at beginning with line endings
+      HasRDBAdmin:= true;
+      List.Delete(i);
+    end
+    else
+    begin
+      // Normal role
+      List[i]:= 'Create Role ' + List[i] + ';';
+      inc(i);
+    end;
+  end;
+  if HasRDBAdmin then
+  begin
+    // Insert special role at beginning for easy editing
+    List.Insert(0, '-- use set term for isql etc. Needs to be changed for FlameRobin etc.');
+    List.Insert(1, 'set term !! ;'); //temporarily change terminator
+    List.Insert(2, 'Execute block As ');
+    List.Insert(3, 'Begin ');
+    List.Insert(4, '  Execute statement ''Create Role ' + AdminRole + ';''; ');
+    List.Insert(5, '  When any do ');
+    List.Insert(6, '  begin ');
+    List.Insert(7, '    -- ignore errors creating role (e.g. if it already exists) ');
+    List.Insert(8, '  end ');
+    List.Insert(9, 'End!! '); //closes block using changed terminator
+    List.Insert(10, 'set term ; !!');
+  end;
   Result:= List.Count > 0;
   Result:= List.Count > 0;
 end;
 end;
 
 

+ 57 - 5
systables.pas

@@ -36,6 +36,12 @@ type
     // Gets list of object names that have type specified by TVIndex
     // Gets list of object names that have type specified by TVIndex
     // Returns count of objects in Count
     // Returns count of objects in Count
     function GetDBObjectNames(DatabaseIndex: integer; ObjectType: TObjectType; var Count: Integer): string;
     function GetDBObjectNames(DatabaseIndex: integer; ObjectType: TObjectType; var Count: Integer): string;
+
+    // Recalculates index statistics for all fields in database
+    // Useful when a large amount of inserts/deletes may have changed the statistics
+    // and indexes are not as efficient as they could be.
+    function RecalculateIndexStatistics(dbIndex: integer): boolean;
+
     // Returns object list (list of object names, i.e. tables, views) sorted by dependency
     // Returns object list (list of object names, i.e. tables, views) sorted by dependency
     // Limits sorting within one category (e.g. views)
     // Limits sorting within one category (e.g. views)
     procedure SortDependencies(var ObjectList: TStringList);
     procedure SortDependencies(var ObjectList: TStringList);
@@ -95,9 +101,11 @@ type
       var ODSVerMajor, ODSVerMinor, Pages, PageSize: Integer;
       var ODSVerMajor, ODSVerMinor, Pages, PageSize: Integer;
       var ProcessList: TStringList; var ErrorMsg: string): Boolean;
       var ProcessList: TStringList; var ErrorMsg: string): Boolean;
 
 
+    // Gets index info for a certain database+table
     function GetIndices(dbIndex: Integer; ATableName: string; PrimaryIndexName: string;
     function GetIndices(dbIndex: Integer; ATableName: string; PrimaryIndexName: string;
       var List: TStringList): Boolean;
       var List: TStringList): Boolean;
 
 
+    // Gets all index info for a certain database
     function GetAllIndices(dbIndex: Integer; List, TablesList: TStringList): Boolean;
     function GetAllIndices(dbIndex: Integer; List, TablesList: TStringList): Boolean;
 
 
     function GetPrimaryKeyIndexName(dbIndex: Integer; ATableName: string; var ConstraintName: string): string;
     function GetPrimaryKeyIndexName(dbIndex: Integer; ATableName: string; var ConstraintName: string): string;
@@ -213,6 +221,48 @@ begin
   sqQuery.Close;
   sqQuery.Close;
 end;
 end;
 
 
+function TdmSysTables.RecalculateIndexStatistics(dbIndex: integer): boolean;
+var
+  i: integer;
+  Indices, Tables: TStringList;
+  TransActive: boolean;
+begin
+  result:= false;
+  Init(dbIndex);
+  sqQuery.Close;
+  Indices:= TStringList.Create;
+  Tables:= TStringList.Create;
+  try
+    if not(GetAllIndices(dbIndex, Indices, Tables)) then
+    begin
+      {$IFDEF DEBUG}
+      SendDebug('RecalculateIndexStatistics: GetAllIndices call failed.');
+      {$ENDIF}
+      exit(false);
+    end;
+
+    // Loop through all indices and reset statistics
+    TransActive:= stTrans.Active;
+    if (TransActive) then
+      stTrans.Commit;
+    for i:= 0 to Indices.Count-1 do
+    begin
+      stTrans.StartTransaction;
+      sqQuery.SQL.Text:= format('SET statistics INDEX %s',[Indices[i]]);
+      sqQuery.ExecSQL;
+      { Commit after each index; no need to batch it all up in one
+      big atomic transaction...}
+      stTrans.Commit;
+    end;
+    if TransActive then
+      stTrans.StartTransaction; //leave transaction the way we found it
+  finally
+    Indices.Free;
+    Tables.Free;
+  end;
+  result:= true;
+end;
+
 procedure TdmSysTables.SortDependencies(var ObjectList: TStringList);
 procedure TdmSysTables.SortDependencies(var ObjectList: TStringList);
 const
 const
   QueryTemplate=
   QueryTemplate=
@@ -1039,9 +1089,9 @@ begin
     sqQuery.Close;
     sqQuery.Close;
     Result:= True;
     Result:= True;
   except
   except
-    on e: exception do
+    on E: Exception do
     begin
     begin
-      ErrorMsg:= e.Message;
+      ErrorMsg:= E.Message;
       Result:= False;
       Result:= False;
     end;
     end;
   end;
   end;
@@ -1067,15 +1117,17 @@ begin
     end;
     end;
   end;
   end;
   sqQuery.Close
   sqQuery.Close
-
 end;
 end;
 
 
 function TdmSysTables.GetAllIndices(dbIndex: Integer; List, TablesList: TStringList): Boolean;
 function TdmSysTables.GetAllIndices(dbIndex: Integer; List, TablesList: TStringList): Boolean;
+const
+  SQL = 'SELECT * FROM RDB$INDICES ' +
+    'WHERE RDB$FOREIGN_KEY IS NULL ' +
+    'and RDB$system_flag = 0';
 begin
 begin
   Init(dbIndex);
   Init(dbIndex);
   sqQuery.Close;
   sqQuery.Close;
-  sqQuery.SQL.Text:= 'SELECT * FROM RDB$INDICES WHERE  RDB$FOREIGN_KEY IS NULL ' +
-   'and RDB$system_flag = 0';
+  sqQuery.SQL.Text:= SQL;
   sqQuery.Open;
   sqQuery.Open;
   Result:= sqQuery.RecordCount > 0;
   Result:= sqQuery.RecordCount > 0;
   List.Clear;
   List.Clear;

Some files were not shown because too many files changed in this diff