paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-14 12:49:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fixes Sql parsing problems with spaces lacking between keyword and expression

Browse Source 
(like where(id=0) ) Mantis #21965, patch by Ludo, updated by Lacak2.

git-svn-id: trunk@21742 -
This commit is contained in:
marco 2012-06-30 17:53:42 +00:00
parent 65e701a198
commit c4ec774c4c
2 changed files with 134 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

156
packages/fcl-db/src/sqldb/sqldb.pp
View File

@ -1010,7 +1010,7 @@ begin
end; end;
if FWhereStartPos = 0 then if FWhereStartPos = 0 then
SQLstr := SQLstr + ' where (' + Filter + ')' SQLstr := SQLstr + ' where (' + ServerFilter + ')'
else if FWhereStopPos > 0 then else if FWhereStopPos > 0 then
system.insert(' and ('+ServerFilter+') ',SQLstr,FWhereStopPos+2) system.insert(' and ('+ServerFilter+') ',SQLstr,FWhereStopPos+2)
else else
@ -1217,18 +1217,17 @@ end;
function TCustomSQLQuery.SQLParser(const ASQL : string) : TStatementType; function TCustomSQLQuery.SQLParser(const ASQL : string) : TStatementType;
type TParsePart = (ppStart,ppWith,ppSelect,ppFrom,ppWhere,ppGroup,ppOrder,ppComment,ppBogus); type TParsePart = (ppStart,ppWith,ppSelect,ppTableName,ppFrom,ppWhere,ppGroup,ppOrder,ppBogus);
TPhraseSeparator = (sepNone, sepWhiteSpace, sepComma, sepComment, sepParentheses, sepEnd);
Var Var
PSQL,CurrentP, PSQL, CurrentP, SavedP,
PhraseP, PStatementPart : pchar; PhraseP, PStatementPart : pchar;
S : string; S : string;
ParsePart : TParsePart; ParsePart : TParsePart;
StrLength : Integer;
EndOfComment : Boolean;
BracketCount : Integer; BracketCount : Integer;
ConnOptions : TConnOptions; ConnOptions : TConnOptions;
FFromPart : String; Separator : TPhraseSeparator;
begin begin
PSQL:=Pchar(ASQL); PSQL:=Pchar(ASQL);
@ -1237,42 +1236,57 @@ begin
CurrentP := PSQL-1; CurrentP := PSQL-1;
PhraseP := PSQL; PhraseP := PSQL;
FTableName := '';
FUpdateable := False;
FWhereStartPos := 0; FWhereStartPos := 0;
FWhereStopPos := 0; FWhereStopPos := 0;
ConnOptions := TSQLConnection(DataBase).ConnOptions; ConnOptions := TSQLConnection(DataBase).ConnOptions;
FUpdateable := False;
repeat repeat
begin begin
inc(CurrentP); inc(CurrentP);
SavedP := CurrentP;
EndOfComment := SkipComments(CurrentP, sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions); case CurrentP^ of
if EndOfcomment then dec(CurrentP); ' ', #9, #10, #11, #12, #13:
if EndOfComment and (ParsePart = ppStart) then PhraseP := CurrentP; Separator := sepWhiteSpace;
',':
// skip everything between bracket, since it could be a sub-select, and Separator := sepComma;
// further nothing between brackets could be interesting for the parser. #0, ';':
if CurrentP^='(' then Separator := sepEnd;
begin '(':
inc(currentp);
BracketCount := 0;
while (currentp^ <> #0) and ((currentp^ <> ')') or (BracketCount > 0 )) do
begin begin
if currentp^ = '(' then inc(bracketcount) Separator := sepParentheses;
else if currentp^ = ')' then dec(bracketcount); // skip everything between brackets, since it could be a sub-select, and
inc(currentp); // further nothing between brackets could be interesting for the parser.
BracketCount := 1;
repeat
inc(CurrentP);
if CurrentP^ = '(' then inc(BracketCount)
else if CurrentP^ = ')' then dec(BracketCount);
until (CurrentP^ = #0) or (BracketCount = 0);
if CurrentP^ <> #0 then inc(CurrentP);
end; end;
EndOfComment := True; else
end; if SkipComments(CurrentP, sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions) then
Separator := sepComment
else
Separator := sepNone;
end;
if EndOfComment or (CurrentP^ in [' ',#13,#10,#9,#0,';']) then if (CurrentP > SavedP) and (SavedP > PhraseP) then
CurrentP := SavedP; // there is something before comment or left parenthesis
if Separator <> sepNone then
begin begin
if (CurrentP-PhraseP > 0) or (CurrentP^ in [';',#0]) then if ((Separator in [sepWhitespace,sepComment]) and (PhraseP = SavedP)) then
PhraseP := CurrentP; // skip comments(but not parentheses) and white spaces
if (CurrentP-PhraseP > 0) or (Separator = sepEnd) then
begin begin
strLength := CurrentP-PhraseP; SetString(s, PhraseP, CurrentP-PhraseP);
Setlength(S,strLength);
if strLength > 0 then Move(PhraseP^,S[1],(strLength));
s := uppercase(s); s := uppercase(s);
case ParsePart of case ParsePart of
@ -1284,7 +1298,6 @@ begin
else break; else break;
end; end;
if not FParseSQL then break; if not FParseSQL then break;
PStatementPart := CurrentP;
end; end;
ppWith : begin ppWith : begin
// WITH [RECURSIVE] CTE_name [ ( column_names ) ] AS ( CTE_query_definition ) [, ...] // WITH [RECURSIVE] CTE_name [ ( column_names ) ] AS ( CTE_query_definition ) [, ...]
@ -1299,69 +1312,53 @@ begin
end; end;
ppSelect : begin ppSelect : begin
if s = 'FROM' then if s = 'FROM' then
ParsePart := ppTableName;
end;
ppTableName:
begin
// Meta-data requests are never updateable
// and select-statements from more then one table
// and/or derived tables are also not updateable
if (FSchemaType = stNoSchema) and
(Separator in [sepWhitespace, sepComment, sepEnd]) then
begin begin
ParsePart := ppFrom; FTableName := s;
PhraseP := CurrentP; FUpdateable := True;
PStatementPart := CurrentP;
end; end;
ParsePart := ppFrom;
end; end;
ppFrom : begin ppFrom : begin
if (s = 'WHERE') or (s = 'ORDER') or (s = 'GROUP') or (s = 'LIMIT') or (CurrentP^=#0) or (CurrentP^=';') then if (s = 'WHERE') or (s = 'GROUP') or (s = 'ORDER') or (s = 'LIMIT') or (s = 'ROWS') or
(Separator = sepEnd) then
begin begin
if (s = 'WHERE') then case s of
begin 'WHERE': ParsePart := ppWhere;
ParsePart := ppWhere; 'GROUP': ParsePart := ppGroup;
StrLength := PhraseP-PStatementPart; 'ORDER': ParsePart := ppOrder;
end else ParsePart := ppBogus;
else if (s = 'GROUP') then end;
begin
ParsePart := ppGroup;
StrLength := PhraseP-PStatementPart;
end
else if (s = 'ORDER') then
begin
ParsePart := ppOrder;
StrLength := PhraseP-PStatementPart
end
else if (s = 'LIMIT') then
begin
ParsePart := ppBogus;
StrLength := PhraseP-PStatementPart
end
else
begin
ParsePart := ppBogus;
StrLength := CurrentP-PStatementPart;
end;
if Result = stSelect then
begin
Setlength(FFromPart,StrLength);
Move(PStatementPart^,FFromPart[1],(StrLength));
FFromPart := trim(FFromPart);
// Meta-data requests and are never updateable select-statements FWhereStartPos := PhraseP-PSQL+1;
// from more then one table are not updateable
if (FSchemaType=stNoSchema) and
(ExtractStrings([',',' '],[],pchar(FFromPart),nil) = 1) then
begin
FUpdateable := True;
FTableName := FFromPart;
end;
end;
FWhereStartPos := PStatementPart-PSQL+StrLength+1;
PStatementPart := CurrentP; PStatementPart := CurrentP;
end
else
// joined table or user_defined_function (...)
if (s = 'JOIN') or (Separator in [sepComma, sepParentheses]) then
begin
FTableName := '';
FUpdateable := False;
end; end;
end; end;
ppWhere : begin ppWhere : begin
if (s = 'ORDER') or (s = 'GROUP') or (s = 'LIMIT') or (CurrentP^=#0) or (CurrentP^=';') then if (s = 'GROUP') or (s = 'ORDER') or (s = 'LIMIT') or (s = 'ROWS') or
(Separator = sepEnd) then
begin begin
ParsePart := ppBogus; ParsePart := ppBogus;
FWhereStartPos := PStatementPart-PSQL; FWhereStartPos := PStatementPart-PSQL;
if (s = 'ORDER') or (s = 'GROUP') or (s = 'LIMIT') then if (Separator = sepEnd) then
FWhereStopPos := PhraseP-PSQL+1 FWhereStopPos := CurrentP-PSQL+1
else else
FWhereStopPos := CurrentP-PSQL+1; FWhereStopPos := PhraseP-PSQL+1;
end end
else if (s = 'UNION') then else if (s = 'UNION') then
begin begin
@ -1371,6 +1368,8 @@ begin
end; end;
end; {case} end; {case}
end; end;
if Separator in [sepComment, sepParentheses] then
dec(CurrentP);
PhraseP := CurrentP+1; PhraseP := CurrentP+1;
end end
end; end;
@ -1381,7 +1380,6 @@ procedure TCustomSQLQuery.InternalOpen;
var tel, fieldc : integer; var tel, fieldc : integer;
f : TField; f : TField;
s : string;
IndexFields : TStrings; IndexFields : TStrings;
ReadFromFile: Boolean; ReadFromFile: Boolean;
begin begin

76
packages/fcl-db/tests/testfieldtypes.pas
View File

@ -38,7 +38,7 @@ type
procedure TestInsertLargeStrFields; // bug 9600 procedure TestInsertLargeStrFields; // bug 9600
procedure TestNumericNames; // Bug9661 procedure TestNumericNames; // Bug9661
procedure TestApplyUpdFieldnames; // Bug 12275; procedure TestApplyUpdFieldnames; // Bug 12275;
procedure TestLimitQuery; // bug 15456 procedure TestServerFilter; // bug 15456
procedure Test11Params; procedure Test11Params;
procedure TestRowsAffected; // bug 9758 procedure TestRowsAffected; // bug 9758
procedure TestLocateNull; procedure TestLocateNull;
@ -1438,7 +1438,13 @@ begin
begin begin
SQL.Text:='select TT.NAME from FPDEV left join FPDEV TT on TT.ID=FPDEV.ID'; SQL.Text:='select TT.NAME from FPDEV left join FPDEV TT on TT.ID=FPDEV.ID';
Open; Open;
close; AssertFalse(CanModify);
Close;
SQL.Text:='select T1.NAME from FPDEV T1,FPDEV T2 where T1.ID=T2.ID';
Open;
AssertFalse(CanModify);
Close;
end; end;
end; end;
end; end;
@ -1565,25 +1571,57 @@ begin
end; end;
end; end;
procedure TTestFieldTypes.TestLimitQuery; procedure TTestFieldTypes.TestServerFilter;
begin begin
with TSQLDBConnector(DBConnector) do // Tests SQLParser and ServerFilter
begin with TSQLDBConnector(DBConnector).Query do
with query do begin
begin ServerFilter:='ID=21';
case sqlDBtype of ServerFiltered:=true;
interbase : SQL.Text:='select first 1 NAME from FPDEV where NAME=''TestName21''';
mssql : SQL.Text:='select top 1 NAME from FPDEV where NAME=''TestName21'''; // tests parsing SELECT without WHERE
else SQL.Text:='select NAME from FPDEV where NAME=''TestName21'' limit 1'; SQL.Text:='select * from FPDEV';
end; Open;
Open; CheckTrue(CanModify, SQL.Text);
close; CheckEquals(1, RecordCount);
ServerFilter:='ID=21'; Close;
ServerFiltered:=true;
open; SQL.Text:='select *'#13'from FPDEV'#13'order by 1';
close; Open;
end; CheckTrue(CanModify, SQL.Text);
CheckEquals(1, RecordCount);
Close;
// tests parsing SELECT with simple WHERE
SQL.Text:='select *'#9'from FPDEV'#9'where NAME<>''''';
Open;
CheckTrue(CanModify, SQL.Text);
CheckEquals(1, RecordCount);
Close;
// tests parsing SELECT with simple WHERE followed by ORDER BY
SQL.Text:='select *'#10'from FPDEV'#10'where NAME>'''' order by 1';
Open;
CheckTrue(CanModify, SQL.Text);
CheckEquals(1, RecordCount);
Close;
// tests parsing of WHERE ... LIMIT
case sqlDBtype of
interbase : SQL.Text:='select first 1 NAME from FPDEV where NAME=''TestName21''';
mssql : SQL.Text:='select top 1 NAME from FPDEV where NAME=''TestName21''';
else SQL.Text:='select NAME from FPDEV where NAME=''TestName21'' limit 1';
end; end;
Open;
CheckTrue(CanModify, SQL.Text);
Close;
// tests parsing SELECT with table alias and embedded comments (MySQL requires space after -- )
SQL.Text:='/**/select * from/**/FPDEV as fp-- comment'#13'where(NAME>''TestName20'')/**/order by 1';
Open;
CheckTrue(CanModify, SQL.Text);
Close;
end;
end; end;
procedure TTestFieldTypes.TestRowsAffected; procedure TTestFieldTypes.TestRowsAffected;