mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-29 06:23:43 +02:00
* Implement DollarString extension for Postgres PL/SQL.
git-svn-id: trunk@33241 -
This commit is contained in:
michael
parent
578348817b
commit
d172c1282c
@ -19,7 +19,10 @@ unit sqlscript;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
Classes, SysUtils;
|
||||
|
||||
Const
|
||||
MinSQLSeps = 5; // Default, minimum number of standard SQL separators.
|
||||
|
||||
type
|
||||
|
||||
@ -33,6 +36,7 @@ type
|
||||
TCustomSQLScript = class(TComponent)
|
||||
private
|
||||
FAutoCommit: Boolean;
|
||||
FDollarStrings: Tstrings;
|
||||
FLine: Integer;
|
||||
FCol: Integer;
|
||||
FDefines: TStrings;
|
||||
@ -43,6 +47,7 @@ type
|
||||
FSkipModeStack: array[0..255] of TSQLSkipMode;
|
||||
FIsSkippingStack: array[0..255] of Boolean;
|
||||
FAborted: Boolean;
|
||||
FUseDollarString: Boolean;
|
||||
FUseSetTerm, FUseDefines, FUseCommit,
|
||||
FCommentsInSQL: Boolean;
|
||||
FTerminator: AnsiString;
|
||||
@ -52,12 +57,18 @@ type
|
||||
FDirectives: TStrings;
|
||||
FComment,
|
||||
FEmitLine: Boolean;
|
||||
FSeps : Array of string;
|
||||
procedure SetDefines(const Value: TStrings);
|
||||
function FindNextSeparator(sep: array of string): AnsiString;
|
||||
function FindNextSeparator(ASeps: Array of string; Out IsExtended : Boolean): AnsiString;
|
||||
procedure AddToStatement(value: AnsiString; ForceNewLine : boolean);
|
||||
procedure SetDirectives(value: TStrings);
|
||||
procedure SetDollarStrings(AValue: TStrings);
|
||||
procedure SetSQL(value: TStrings);
|
||||
procedure SetTerminator(AValue: AnsiString);
|
||||
procedure SetUseDollarString(AValue: Boolean);
|
||||
procedure SQLChange(Sender: TObject);
|
||||
procedure DollarStringsChange(Sender : TObject);
|
||||
Procedure RecalcSeps;
|
||||
function GetLine: Integer;
|
||||
protected
|
||||
procedure ClearStatement; virtual;
|
||||
@ -86,10 +97,12 @@ type
|
||||
property UseSetTerm: Boolean read FUseSetTerm write FUseSetTerm;
|
||||
property UseCommit: Boolean read FUseCommit write FUseCommit;
|
||||
property UseDefines: Boolean read FUseDefines write FUseDefines;
|
||||
Property UseDollarString : Boolean Read FUseDollarString Write SetUseDollarString;
|
||||
Property DollarStrings : TStrings Read FDollarStrings Write SetDollarStrings;
|
||||
property Defines : TStrings Read FDefines Write SetDefines;
|
||||
property Directives: TStrings read FDirectives write SetDirectives;
|
||||
property Script: TStrings read FSQL write SetSQL; // script to execute
|
||||
property Terminator: AnsiString read FTerminator write FTerminator;
|
||||
property Terminator: AnsiString read FTerminator write SetTerminator;
|
||||
property OnException : TSQLScriptExceptionEvent read FOnException write FOnException;
|
||||
end;
|
||||
|
||||
@ -155,21 +168,21 @@ begin
|
||||
Result := Result and ((L2 = L1) or (s1[L2+1] = ' '));
|
||||
end;
|
||||
|
||||
function GetFirstSeparator(S: AnsiString; Sep: array of string): AnsiString;
|
||||
function GetFirstSeparator(S: AnsiString; Sep: array of string): integer;
|
||||
|
||||
var
|
||||
i, C, M: Integer;
|
||||
|
||||
begin
|
||||
M:=length(S) + 1;
|
||||
Result:='';
|
||||
Result:=-1;
|
||||
for i:=0 to high(Sep) do
|
||||
begin
|
||||
C:=Pos(Sep[i],S);
|
||||
if (C<>0) and (C<M) then
|
||||
begin
|
||||
M:=C;
|
||||
Result:=Sep[i];
|
||||
Result:=i;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -192,6 +205,34 @@ begin
|
||||
FCol:=1;
|
||||
end;
|
||||
|
||||
procedure TCustomSQLScript.DollarStringsChange(Sender: TObject);
|
||||
begin
|
||||
RecalcSeps;
|
||||
end;
|
||||
|
||||
procedure TCustomSQLScript.RecalcSeps;
|
||||
|
||||
Var
|
||||
L : Integer;
|
||||
|
||||
begin
|
||||
L:=MinSQLSeps;
|
||||
If UseDollarString then
|
||||
L:=L+1+DollarStrings.Count;
|
||||
SetLength(FSeps,L);
|
||||
FSeps[0]:=FTerminator;
|
||||
FSeps[1]:='/*';
|
||||
FSeps[2]:='"';
|
||||
FSeps[3]:='''';
|
||||
FSeps[4]:='--';
|
||||
If UseDollarString then
|
||||
begin
|
||||
FSeps[MinSQLSeps]:='$$';
|
||||
For L:=0 to FDollarStrings.Count-1 do
|
||||
FSeps[MinSQLSeps+1+L]:='$'+FDollarStrings[L]+'$';
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomSQLScript.SetDirectives(value: TStrings);
|
||||
|
||||
var
|
||||
@ -212,6 +253,14 @@ begin
|
||||
DefaultDirectives;
|
||||
end;
|
||||
|
||||
procedure TCustomSQLScript.SetDollarStrings(AValue: TStrings);
|
||||
begin
|
||||
if FDollarStrings=AValue then Exit;
|
||||
FDollarStrings.Assign(AValue);
|
||||
If FUseDollarString then
|
||||
RecalcSeps;
|
||||
end;
|
||||
|
||||
procedure TCustomSQLScript.SetSQL(value: TStrings);
|
||||
begin
|
||||
FSQL.Assign(value);
|
||||
@ -219,12 +268,27 @@ begin
|
||||
FCol:=1;
|
||||
end;
|
||||
|
||||
procedure TCustomSQLScript.SetTerminator(AValue: AnsiString);
|
||||
begin
|
||||
if FTerminator=AValue then Exit;
|
||||
FTerminator:=AValue;
|
||||
if Length(FSeps)>0 then
|
||||
FSeps[0]:=FTerminator;
|
||||
end;
|
||||
|
||||
procedure TCustomSQLScript.SetUseDollarString(AValue: Boolean);
|
||||
begin
|
||||
if FUseDollarString=AValue then Exit;
|
||||
FUseDollarString:=AValue;
|
||||
RecalcSeps;
|
||||
end;
|
||||
function TCustomSQLScript.GetLine: Integer;
|
||||
begin
|
||||
Result:=FLine - 1;
|
||||
end;
|
||||
|
||||
procedure TCustomSQLScript.AddToStatement(value: AnsiString; ForceNewLine : Boolean);
|
||||
procedure TCustomSQLScript.AddToStatement(value: AnsiString;
|
||||
ForceNewLine: boolean);
|
||||
|
||||
Procedure DA(L : TStrings);
|
||||
|
||||
@ -242,10 +306,12 @@ begin
|
||||
DA(FCurrentStripped);
|
||||
end;
|
||||
|
||||
function TCustomSQLScript.FindNextSeparator(Sep: array of string): AnsiString;
|
||||
function TCustomSQLScript.FindNextSeparator(ASeps: array of string; out
|
||||
IsExtended: Boolean): AnsiString;
|
||||
|
||||
var
|
||||
S: AnsiString;
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
@ -256,8 +322,8 @@ begin
|
||||
begin
|
||||
S:=Copy(S,FCol,length(S));
|
||||
end;
|
||||
Result:=GetFirstSeparator(S,Sep);
|
||||
if (Result='') then
|
||||
I:=GetFirstSeparator(S,ASeps);
|
||||
if (I=-1) then
|
||||
begin
|
||||
if FEmitLine then
|
||||
AddToStatement(S,(FCol<=1));
|
||||
@ -266,6 +332,8 @@ begin
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result:=ASeps[i];
|
||||
IsExtended:=I>=MinSQLSeps;
|
||||
if FEmitLine then
|
||||
AddToStatement(Copy(S,1,Pos(Result,S)-1),(FCol=1));
|
||||
FCol:=(FCol-1)+Pos(Result,S);
|
||||
@ -446,14 +514,14 @@ function TCustomSQLScript.NextStatement: AnsiString;
|
||||
|
||||
var
|
||||
pnt: AnsiString;
|
||||
terminator_found: Boolean;
|
||||
b,isExtra,terminator_found: Boolean;
|
||||
|
||||
begin
|
||||
terminator_found:=False;
|
||||
ClearStatement;
|
||||
while FLine <= FSQL.Count do
|
||||
begin
|
||||
pnt:=FindNextSeparator([FTerminator, '/*', '"', '''', '--']);
|
||||
pnt:=FindNextSeparator(FSeps,isExtra);
|
||||
if (pnt=FTerminator) then
|
||||
begin
|
||||
FCol:=FCol + length(pnt);
|
||||
@ -468,7 +536,7 @@ begin
|
||||
else
|
||||
FEmitLine:=False;
|
||||
FCol:=FCol + length(pnt);
|
||||
pnt:=FindNextSeparator(['*/']);
|
||||
pnt:=FindNextSeparator(['*/'],b);
|
||||
if FCommentsInSQL then
|
||||
AddToStatement(pnt,false)
|
||||
else
|
||||
@ -489,7 +557,7 @@ begin
|
||||
begin
|
||||
AddToStatement(pnt,false);
|
||||
FCol:=FCol + length(pnt);
|
||||
pnt:=FindNextSeparator(['"']);
|
||||
pnt:=FindNextSeparator(['"'],b);
|
||||
AddToStatement(pnt,false);
|
||||
FCol:=FCol + length(pnt);
|
||||
end
|
||||
@ -497,9 +565,17 @@ begin
|
||||
begin
|
||||
AddToStatement(pnt,False);
|
||||
FCol:=FCol + length(pnt);
|
||||
pnt:=FindNextSeparator(['''']);
|
||||
pnt:=FindNextSeparator([''''],b);
|
||||
AddToStatement(pnt,false);
|
||||
FCol:=FCol + length(pnt);
|
||||
end
|
||||
else if IsExtra then
|
||||
begin
|
||||
AddToStatement(pnt,false);
|
||||
FCol:=FCol + length(pnt);
|
||||
pnt:=FindNextSeparator([pnt],b);
|
||||
AddToStatement(pnt,false);
|
||||
FCol:=FCol + length(pnt);
|
||||
end;
|
||||
end;
|
||||
if not terminator_found then
|
||||
@ -511,7 +587,7 @@ begin
|
||||
Result:=FCurrentStatement.Text;
|
||||
end;
|
||||
|
||||
Constructor TCustomSQLScript.Create (AnOwner: TComponent);
|
||||
constructor TCustomSQLScript.Create(AnOwner: TComponent);
|
||||
|
||||
Var
|
||||
L : TStringList;
|
||||
@ -530,6 +606,10 @@ begin
|
||||
L:=TStringList.Create();
|
||||
L.OnChange:=@SQLChange;
|
||||
FSQL:=L;
|
||||
L:=TStringList.Create();
|
||||
L.OnChange:=@DollarStringsChange;
|
||||
FDollarStrings:=L;
|
||||
ReCalcSeps;
|
||||
FDirectives:=TStringList.Create();
|
||||
FCurrentStripped:=TStringList.Create();
|
||||
FCurrentStatement:=TStringList.Create();
|
||||
@ -584,7 +664,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TCustomSQLScript.ProcessConditional(Directive: String; Param : String) : Boolean;
|
||||
function TCustomSQLScript.ProcessConditional(Directive: String; Param: String
|
||||
): Boolean;
|
||||
|
||||
Procedure PushSkipMode;
|
||||
|
||||
|
||||
@ -44,6 +44,8 @@ type
|
||||
property DoException : string read FExcept write FExcept;
|
||||
property Aborted;
|
||||
property Line;
|
||||
property UseDollarString;
|
||||
property dollarstrings;
|
||||
property Directives;
|
||||
property Defines;
|
||||
property Script;
|
||||
@ -114,6 +116,9 @@ type
|
||||
procedure TestDirectiveOnException2;
|
||||
procedure TestCommitOnException1;
|
||||
procedure TestCommitOnException2;
|
||||
procedure TestUseDollarSign;
|
||||
procedure TestUseDollarSign2;
|
||||
procedure TestUseDollarSign3;
|
||||
end;
|
||||
|
||||
{ TTestEventSQLScript }
|
||||
@ -693,6 +698,77 @@ begin
|
||||
AssertEquals ('commit count', 1, Script.FCommits);
|
||||
end;
|
||||
|
||||
|
||||
Const
|
||||
PLSQL1 = 'CREATE or replace FUNCTION test_double_bad_sum ( value1 int, value2 int ) '+
|
||||
'RETURNS int AS $$ '+
|
||||
'DECLARE '+
|
||||
' TheDoubleSum int; '+
|
||||
'BEGIN '+
|
||||
' -- Start '+
|
||||
' TheDoubleSum := value1; '+
|
||||
' /* sum '+
|
||||
' number '+
|
||||
' 1 */ '+
|
||||
' TheDoubleSum := TheDoubleSum + value2; '+
|
||||
' TheDoubleSum := TheDoubleSum + value2; -- Sum number 2 '+
|
||||
' return TheDoubleSum; '+
|
||||
'END; '+
|
||||
'$$ '+
|
||||
'LANGUAGE plpgsql';
|
||||
PLSQL2 = 'COMMENT ON FUNCTION test_double_bad_sum(IN integer, IN integer) '+
|
||||
' IS ''Just a '+
|
||||
' test function '+
|
||||
' !!!''';
|
||||
PLSQL3 = 'CREATE or replace FUNCTION test_double_bad_sum ( value1 int, value2 int ) '+
|
||||
'RETURNS int AS $BOB$ '+
|
||||
'DECLARE '+
|
||||
' TheDoubleSum int; '+
|
||||
'BEGIN '+
|
||||
' -- Start '+
|
||||
' TheDoubleSum := value1; '+
|
||||
' /* sum '+
|
||||
' number '+
|
||||
' 1 */ '+
|
||||
' TheDoubleSum := TheDoubleSum + value2; '+
|
||||
' TheDoubleSum := TheDoubleSum + value2; -- Sum number 2 '+
|
||||
' return TheDoubleSum; '+
|
||||
'END; '+
|
||||
'$BOB$ '+
|
||||
'LANGUAGE plpgsql';
|
||||
|
||||
procedure TTestSQLScript.TestUseDollarSign;
|
||||
|
||||
begin
|
||||
script.UseDollarString:=True;
|
||||
Add(PLSQL1+';');
|
||||
script.execute;
|
||||
// Double quotes because there are spaces.
|
||||
AssertStatDir('"'+plsql1+'"', '');
|
||||
end;
|
||||
|
||||
procedure TTestSQLScript.TestUseDollarSign2;
|
||||
begin
|
||||
script.UseDollarString:=True;
|
||||
Add(PLSQL1+';');
|
||||
Add(PLSQL2+';');
|
||||
script.execute;
|
||||
// Double quotes because there are spaces.
|
||||
AssertStatDir('"'+plsql1+'","'+PLSQL2+'"', '');
|
||||
|
||||
end;
|
||||
|
||||
procedure TTestSQLScript.TestUseDollarSign3;
|
||||
begin
|
||||
script.UseDollarString:=True;
|
||||
script.DollarStrings.Add('BOB');
|
||||
Add(PLSQL3+';');
|
||||
script.execute;
|
||||
// Double quotes because there are spaces.
|
||||
AssertStatDir('"'+plsql3+'"', '');
|
||||
|
||||
end;
|
||||
|
||||
{ TTestEventSQLScript }
|
||||
|
||||
procedure TTestEventSQLScript.Notify(Sender: TObject);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user