Browse Source

* Allow descendents to override methods to implement their own parsing. Fixes issue #40063

(cherry picked from commit c0354d09758d363485c45d1d231a78807d9d4e67)
Michaël Van Canneyt 1 year ago
parent
commit
bad6739fd9
1 changed files with 26 additions and 17 deletions
  1. 26 17
      packages/fcl-db/src/base/sqlscript.pp

+ 26 - 17
packages/fcl-db/src/base/sqlscript.pp

@@ -60,7 +60,6 @@ type
     FSeps : Array of string;
     FSeps : Array of string;
     procedure SetDefines(const Value: TStrings);
     procedure SetDefines(const Value: TStrings);
     function  FindNextSeparator(ASeps: Array of string; Out IsExtended : Boolean): AnsiString;
     function  FindNextSeparator(ASeps: Array of string; Out IsExtended : Boolean): AnsiString;
-    procedure AddToStatement(value: AnsiString; ForceNewLine : boolean);
     procedure SetDirectives(value: TStrings);
     procedure SetDirectives(value: TStrings);
     procedure SetDollarStrings(AValue: TStrings);
     procedure SetDollarStrings(AValue: TStrings);
     procedure SetSQL(value: TStrings);
     procedure SetSQL(value: TStrings);
@@ -71,20 +70,31 @@ type
     Procedure RecalcSeps;
     Procedure RecalcSeps;
     function GetLine: Integer;
     function GetLine: Integer;
   protected
   protected
-    procedure ClearStatement; virtual;
     procedure InternalStatement (Statement: TStrings; var StopExecution: Boolean); virtual;
     procedure InternalStatement (Statement: TStrings; var StopExecution: Boolean); virtual;
     procedure InternalDirective (Directive, Argument: String; var StopExecution: Boolean); virtual;
     procedure InternalDirective (Directive, Argument: String; var StopExecution: Boolean); virtual;
     // Runs commit. If ComitRetaining, use CommitRetraining if possible, else stop/starttransaction
     // Runs commit. If ComitRetaining, use CommitRetraining if possible, else stop/starttransaction
     procedure InternalCommit(CommitRetaining: boolean=true); virtual;
     procedure InternalCommit(CommitRetaining: boolean=true); virtual;
     Function ProcessConditional(const Directive : String; const Param : String) : Boolean; virtual;
     Function ProcessConditional(const Directive : String; const Param : String) : Boolean; virtual;
-    function NextStatement: AnsiString; virtual;
     procedure ProcessStatement; virtual;
     procedure ProcessStatement; virtual;
-    function Available: Boolean; virtual;
     procedure DefaultDirectives; virtual;
     procedure DefaultDirectives; virtual;
     procedure ExecuteStatement (Statement: TStrings; var StopExecution: Boolean); virtual; abstract;
     procedure ExecuteStatement (Statement: TStrings; var StopExecution: Boolean); virtual; abstract;
     procedure ExecuteDirective (Directive, Argument: String; var StopExecution: Boolean); virtual; abstract;
     procedure ExecuteDirective (Directive, Argument: String; var StopExecution: Boolean); virtual; abstract;
     // Executes commit. If possible and CommitRetaining, use CommitRetaining, else
     // Executes commit. If possible and CommitRetaining, use CommitRetaining, else
     procedure ExecuteCommit(CommitRetaining: boolean=true); virtual; abstract;
     procedure ExecuteCommit(CommitRetaining: boolean=true); virtual; abstract;
+    // Useful when you want to add your own parsing routines.
+    // Get next statement. This must also use AddToCurrentStatement  to add the statement.
+    function NextStatement: AnsiString; virtual;
+    // Add text to current statement. If InComment is false, strippedstatement will also be updated.
+    procedure AddToCurrentStatement(value: AnsiString; ForceNewLine : boolean); virtual;
+    // Clear current statement
+    procedure ClearStatement; virtual;
+    // Is a next statement available ?
+    function Available: Boolean; virtual;
+    // Current state
+    Property CurrentStatement : TStrings Read FCurrentStatement;
+    Property CurrentStrippedStatement : TStrings Read FCurrentStripped;
+    Property InComment : Boolean Read FComment Write FComment;
+    Property EmitLine : Boolean Read FEmitline Write FEmitline;
   public
   public
     constructor Create (AnOwner: TComponent); override;
     constructor Create (AnOwner: TComponent); override;
     destructor Destroy; override;
     destructor Destroy; override;
@@ -290,8 +300,7 @@ begin
   Result:=FLine - 1;
   Result:=FLine - 1;
 end;
 end;
 
 
-procedure TCustomSQLScript.AddToStatement(value: AnsiString;
-  ForceNewLine: boolean);
+procedure TCustomSQLScript.AddToCurrentStatement(value: AnsiString;  ForceNewLine: boolean);
 
 
   Procedure DA(L : TStrings);
   Procedure DA(L : TStrings);
 
 
@@ -329,7 +338,7 @@ begin
     if (I=-1) then
     if (I=-1) then
       begin
       begin
       if FEmitLine then
       if FEmitLine then
-        AddToStatement(S,(FCol<=1));
+        AddToCurrentStatement(S,(FCol<=1));
       FCol:=1;
       FCol:=1;
       FLine:=FLine+1;
       FLine:=FLine+1;
       end
       end
@@ -338,7 +347,7 @@ begin
       Result:=ASeps[i];
       Result:=ASeps[i];
       IsExtended:=I>=MinSQLSeps;
       IsExtended:=I>=MinSQLSeps;
       if FEmitLine then
       if FEmitLine then
-        AddToStatement(Copy(S,1,Pos(Result,S)-1),(FCol=1));
+        AddToCurrentStatement(Copy(S,1,Pos(Result,S)-1),(FCol=1));
       FCol:=(FCol-1)+Pos(Result,S);
       FCol:=(FCol-1)+Pos(Result,S);
       break;
       break;
       end;
       end;
@@ -538,13 +547,13 @@ begin
       begin
       begin
       FComment:=True;
       FComment:=True;
       if FCommentsInSQL then
       if FCommentsInSQL then
-        AddToStatement(pnt,false)
+        AddToCurrentStatement(pnt,false)
       else
       else
         FEmitLine:=False;
         FEmitLine:=False;
       FCol:=FCol + length(pnt);
       FCol:=FCol + length(pnt);
       pnt:=FindNextSeparator(['*/'],b);
       pnt:=FindNextSeparator(['*/'],b);
       if FCommentsInSQL then
       if FCommentsInSQL then
-        AddToStatement(pnt,false)
+        AddToCurrentStatement(pnt,false)
       else
       else
         FEmitLine:=True;
         FEmitLine:=True;
       FCol:=FCol + length(pnt);
       FCol:=FCol + length(pnt);
@@ -554,33 +563,33 @@ begin
       begin
       begin
       FComment:=True;
       FComment:=True;
       if FCommentsInSQL then
       if FCommentsInSQL then
-        AddToStatement(Copy(FSQL[FLine-1],FCol,Length(FSQL[FLine-1])-FCol+1),False);
+        AddToCurrentStatement(Copy(FSQL[FLine-1],FCol,Length(FSQL[FLine-1])-FCol+1),False);
       Inc(Fline);
       Inc(Fline);
       FCol:=1;
       FCol:=1;
       FComment:=False;
       FComment:=False;
       end
       end
     else if pnt = '"' then
     else if pnt = '"' then
       begin
       begin
-      AddToStatement(pnt,false);
+      AddToCurrentStatement(pnt,false);
       FCol:=FCol + length(pnt);
       FCol:=FCol + length(pnt);
       pnt:=FindNextSeparator(['"'],b);
       pnt:=FindNextSeparator(['"'],b);
-      AddToStatement(pnt,false);
+      AddToCurrentStatement(pnt,false);
       FCol:=FCol + length(pnt);
       FCol:=FCol + length(pnt);
       end
       end
     else if pnt = '''' then
     else if pnt = '''' then
       begin
       begin
-      AddToStatement(pnt,False);
+      AddToCurrentStatement(pnt,False);
       FCol:=FCol + length(pnt);
       FCol:=FCol + length(pnt);
       pnt:=FindNextSeparator([''''],b);
       pnt:=FindNextSeparator([''''],b);
-      AddToStatement(pnt,false);
+      AddToCurrentStatement(pnt,false);
       FCol:=FCol + length(pnt);
       FCol:=FCol + length(pnt);
       end
       end
     else if IsExtra then
     else if IsExtra then
       begin
       begin
-        AddToStatement(pnt,false);
+        AddToCurrentStatement(pnt,false);
         FCol:=FCol + length(pnt);
         FCol:=FCol + length(pnt);
         pnt:=FindNextSeparator([pnt],b);
         pnt:=FindNextSeparator([pnt],b);
-        AddToStatement(pnt,false);
+        AddToCurrentStatement(pnt,false);
         FCol:=FCol + length(pnt);
         FCol:=FCol + length(pnt);
       end;
       end;
     end;
     end;