00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { Expression Parser classes and interfaces }
00005 { }
00006 { Originally written by Sergey Seroukhov }
00007 { }
00008 {*********************************************************}
00009
00010 {@********************************************************}
00011 { Copyright (c) 1999-2006 Zeos Development Group }
00012 { }
00013 { License Agreement: }
00014 { }
00015 { This library is distributed in the hope that it will be }
00016 { useful, but WITHOUT ANY WARRANTY; without even the }
00017 { implied warranty of MERCHANTABILITY or FITNESS FOR }
00018 { A PARTICULAR PURPOSE. See the GNU Lesser General }
00019 { Public License for more details. }
00020 { }
00021 { The source code of the ZEOS Libraries and packages are }
00022 { distributed under the Library GNU General Public }
00023 { License (see the file COPYING / COPYING.ZEOS) }
00024 { with the following modification: }
00025 { As a special exception, the copyright holders of this }
00026 { library give you permission to link this library with }
00027 { independent modules to produce an executable, }
00028 { regardless of the license terms of these independent }
00029 { modules, and to copy and distribute the resulting }
00030 { executable under terms of your choice, provided that }
00031 { you also meet, for each linked independent module, }
00032 { the terms and conditions of the license of that module. }
00033 { An independent module is a module which is not derived }
00034 { from or based on this library. If you modify this }
00035 { library, you may extend this exception to your version }
00036 { of the library, but you are not obligated to do so. }
00037 { If you do not wish to do so, delete this exception }
00038 { statement from your version. }
00039 { }
00040 { }
00041 { The project web site is located on: }
00042 { http:
00043 { http:
00044 { svn:
00045 { }
00046 { http:
00047 { http:
00048 { }
00049 { }
00050 { }
00051 { Zeos Development Group. }
00052 {********************************************************@}
00053
00054 unit ZExprParser;
00055
00056 interface
00057
00058 {$I ZCore.inc}
00059
00060 uses SysUtils, Classes, Contnrs, ZCompatibility, ZVariant,
00061 ZTokenizer;
00062
00063 type
00064 {** Define types of expression tokens. }
00065 TZExpressionTokenType = (
00066 ttUnknown, ttLeftBrace, ttRightBrace, ttLeftSquareBrace,
00067 ttRightSquareBrace, ttPlus, ttMinus, ttStar, ttSlash, ttProcent, ttPower,
00068 ttEqual, ttNotEqual, ttMore, ttLess, ttEqualMore, ttEqualLess,
00069 ttAnd, ttOr, ttXor, ttIs, ttNull, ttNot, ttLike, ttNotLike, ttIsNull,
00070 ttIsNotNull, ttComma, ttUnary, ttFunction, ttVariable, ttConstant
00071 );
00072
00073 {** Defines a parser exception. }
00074 TZParseError = class (Exception);
00075
00076 {** Defines an expression token holder. }
00077 TZExpressionToken = class (TObject)
00078 private
00079 FTokenType: TZExpressionTokenType;
00080 FValue: TZVariant;
00081 public
00082 constructor Create(TokenType: TZExpressionTokenType; const Value: TZVariant);
00083
00084 property TokenType: TZExpressionTokenType read FTokenType write FTokenType;
00085 property Value: TZVariant read FValue write FValue;
00086 end;
00087
00088 {** Implements an expression parser class. }
00089 TZExpressionParser = class (TObject)
00090 private
00091 FTokenizer: IZTokenizer;
00092 FExpression: string;
00093 FInitialTokens: TObjectList;
00094 FTokenIndex: Integer;
00095 FResultTokens: TObjectList;
00096 FVariables: TStrings;
00097
00098 function HasMoreTokens: Boolean;
00099 function GetToken: TZExpressionToken;
00100 function GetNextToken: TZExpressionToken;
00101 procedure ShiftToken;
00102 function CheckTokenTypes(
00103 TokenTypes: array of TZExpressionTokenType): Boolean;
00104
00105 procedure TokenizeExpression;
00106
00107 procedure SyntaxAnalyse;
00108 procedure SyntaxAnalyse1;
00109 procedure SyntaxAnalyse2;
00110 procedure SyntaxAnalyse3;
00111 procedure SyntaxAnalyse4;
00112 procedure SyntaxAnalyse5;
00113 procedure SyntaxAnalyse6;
00114 public
00115 constructor Create(Tokenizer: IZTokenizer);
00116 destructor Destroy; override;
00117
00118 procedure Parse(Expression: string);
00119 procedure Clear;
00120
00121 property Tokenizer: IZTokenizer read FTokenizer write FTokenizer;
00122 property Expression: string read FExpression write Parse;
00123 property ResultTokens: TObjectList read FResultTokens;
00124 property Variables: TStrings read FVariables;
00125 end;
00126
00127 implementation
00128
00129 uses ZSysUtils, ZMessages;
00130
00131 { TZExpressionToken }
00132
00133 {**
00134 Creates an expression token object.
00135 @param TokenType a type of the token.
00136 @param Value a token value.
00137 }
00138 constructor TZExpressionToken.Create(TokenType: TZExpressionTokenType;
00139 const Value: TZVariant);
00140 begin
00141 FTokenType := TokenType;
00142 FValue := Value;
00143 end;
00144
00145 const
00146 {** Defines a list of operators. }
00147 OperatorTokens: array[0..24] of string = (
00148 '(', ')', '[', ']', '+', '-', '*', '/', '%', '^',
00149 '=', '<>', '!=', '>', '<', '>=', '<=',
00150 'AND', 'OR', 'XOR', 'NOT', 'IS', 'NULL', 'LIKE', ','
00151 );
00152
00153 {** Defines a list of operator codes. }
00154 OperatorCodes: array[0..24] of TZExpressionTokenType = (
00155 ttLeftBrace, ttRightBrace, ttLeftSquareBrace, ttRightSquareBrace,
00156 ttPlus, ttMinus, ttStar, ttSlash, ttProcent, ttPower, ttEqual, ttNotEqual,
00157 ttNotEqual, ttMore, ttLess, ttEqualMore, ttEqualLess, ttAnd, ttOr, ttXor,
00158 ttNot, ttIs, ttNull, ttLike, ttComma
00159 );
00160
00161 { TZExpressionParser }
00162
00163 {**
00164 Creates this expression parser object.
00165 @param Tokenizer an expression tokenizer.
00166 }
00167 constructor TZExpressionParser.Create(Tokenizer: IZTokenizer);
00168 begin
00169 FTokenizer := Tokenizer;
00170 FExpression := '';
00171 FInitialTokens := TObjectList.Create;
00172 FTokenIndex := 0;
00173 FResultTokens := TObjectList.Create;
00174 FVariables := TStringList.Create;
00175 end;
00176
00177 {**
00178 Destroyes this object and cleanups the memory.
00179 }
00180 destructor TZExpressionParser.Destroy;
00181 begin
00182 inherited Destroy;
00183 FInitialTokens.Free;
00184 FResultTokens.Free;
00185 FVariables.Free;
00186 end;
00187
00188 {**
00189 Clears parsing result.
00190 }
00191 procedure TZExpressionParser.Clear;
00192 begin
00193 FExpression := '';
00194 FInitialTokens.Clear;
00195 FResultTokens.Clear;
00196 FTokenIndex := 0;
00197 FVariables.Clear;
00198 end;
00199
00200 {**
00201 Sets a new expression string and parses it into internal byte code.
00202 @param expression a new expression string.
00203 }
00204 procedure TZExpressionParser.Parse(Expression: string);
00205 begin
00206 Clear;
00207 FExpression := Trim(Expression);
00208 if FExpression <> '' then
00209 begin
00210 TokenizeExpression;
00211 SyntaxAnalyse;
00212 if HasMoreTokens then
00213 begin
00214 raise TZParseError.Create(
00215 Format(SSyntaxErrorNear, [SoftVarManager.GetAsString(GetToken.Value)]));
00216 end;
00217 end;
00218 end;
00219
00220 {**
00221 Checks are there more tokens for processing.
00222 @return <code>TRUE</code> if some tokens are present.
00223 }
00224 function TZExpressionParser.HasMoreTokens: Boolean;
00225 begin
00226 Result := FTokenIndex < FInitialTokens.Count;
00227 end;
00228
00229 {**
00230 Gets the current token object.
00231 @param tokens a collection of tokens.
00232 @returns the current token object.
00233 }
00234 function TZExpressionParser.GetToken: TZExpressionToken;
00235 begin
00236 if FTokenIndex < FInitialTokens.Count then
00237 Result := TZExpressionToken(FInitialTokens[FTokenIndex])
00238 else Result := nil;
00239 end;
00240
00241 {**
00242 Gets the next token object.
00243 @param tokens a collection of tokens.
00244 @returns the next token object.
00245 }
00246 function TZExpressionParser.GetNextToken: TZExpressionToken;
00247 begin
00248 if (FTokenIndex + 1) < FInitialTokens.Count then
00249 Result := TZExpressionToken(FInitialTokens[FTokenIndex + 1])
00250 else Result := nil;
00251 end;
00252
00253 {**
00254 Shifts the current token object.
00255 }
00256 procedure TZExpressionParser.ShiftToken;
00257 begin
00258 Inc(FTokenIndex);
00259 end;
00260
00261 {**
00262 Checks available token types with token types from the list.
00263 If they match it shifts the tokens.
00264 @param TokenTypes a list of token types to compare.
00265 @return <code>True</code> if token types match.
00266 }
00267 function TZExpressionParser.CheckTokenTypes(
00268 TokenTypes: array of TZExpressionTokenType): Boolean;
00269 var
00270 I: Integer;
00271 Temp: TZExpressionToken;
00272 begin
00273 Result := False;
00274 for I := Low(TokenTypes) to High(TokenTypes) do
00275 begin
00276 if (FTokenIndex + I) < FInitialTokens.Count then
00277 begin
00278 Temp := TZExpressionToken(FInitialTokens[FTokenIndex + I]);
00279 Result := Temp.TokenType = TokenTypes[I];
00280 end else
00281 Result := False;
00282
00283 if not Result then
00284 Break;
00285 end;
00286 if Result then
00287 Inc(FTokenIndex, Length(TokenTypes));
00288 end;
00289
00290 {**
00291 Tokenizes the given expression and prepares an initial tokens list.
00292 }
00293 procedure TZExpressionParser.TokenizeExpression;
00294 var
00295 I: Integer;
00296 TokenIndex: Integer;
00297 Temp: string;
00298 Tokens: TStrings;
00299 TokenType: TZExpressionTokenType;
00300 TokenValue: TZVariant;
00301 begin
00302 Tokens := FTokenizer.TokenizeBufferToList(FExpression,
00303 [toSkipWhitespaces, toSkipComments, toSkipEOF, toDecodeStrings]);
00304 try
00305 TokenIndex := 0;
00306
00307 while TokenIndex < Tokens.Count do
00308 begin
00309 TokenType := ttUnknown;
00310 TokenValue := NullVariant;
00311 case TZTokenType({$IFDEF FPC}Pointer({$ENDIF}
00312 Tokens.Objects[TokenIndex]{$IFDEF FPC}){$ENDIF}) of
00313 ttKeyword:
00314 begin
00315 Temp := UpperCase(Tokens[TokenIndex]);
00316 if Temp = 'TRUE' then
00317 begin
00318 TokenType := ttConstant;
00319 DefVarManager.SetAsBoolean(TokenValue, True);
00320 end
00321 else if Temp = 'FALSE' then
00322 begin
00323 TokenType := ttConstant;
00324 DefVarManager.SetAsBoolean(TokenValue, False);
00325 end
00326 else
00327 begin
00328 for I := Low(OperatorTokens) to High(OperatorTokens) do
00329 begin
00330 if OperatorTokens[I] = Temp then
00331 begin
00332 TokenType := OperatorCodes[I];
00333 Break;
00334 end;
00335 end;
00336 end;
00337 end;
00338 ttWord:
00339 begin
00340 TokenType := ttVariable;
00341 Temp := Tokens[TokenIndex];
00342 if FVariables.IndexOf(Temp) < 0 then
00343 FVariables.Add(Temp);
00344 DefVarManager.SetAsString(TokenValue, Temp);
00345 end;
00346 ttInteger:
00347 begin
00348 TokenType := ttConstant;
00349 DefVarManager.SetAsInteger(TokenValue, StrToInt(Tokens[TokenIndex]));
00350 end;
00351 ttFloat:
00352 begin
00353 TokenType := ttConstant;
00354 DefVarManager.SetAsFloat(TokenValue, SqlStrToFloat(Tokens[TokenIndex]));
00355 end;
00356 ttQuoted:
00357 begin
00358 TokenType := ttConstant;
00359 DefVarManager.SetAsString(TokenValue, Tokens[TokenIndex]);
00360 end;
00361 ttSymbol:
00362 begin
00363 Temp := Tokens[TokenIndex];
00364 for I := Low(OperatorTokens) to High(OperatorTokens) do
00365 begin
00366 if Temp = OperatorTokens[I] then
00367 begin
00368 TokenType := OperatorCodes[I];
00369 Break;
00370 end;
00371 end;
00372 end;
00373 end;
00374
00375 if TokenType = ttUnknown then
00376 raise TZParseError.Create(Format(SUnknownSymbol, [Tokens[TokenIndex]]));
00377
00378 Inc(TokenIndex);
00379 FInitialTokens.Add(TZExpressionToken.Create(TokenType, TokenValue));
00380 end;
00381 finally
00382 Tokens.Free;
00383 end;
00384 end;
00385
00386 {**
00387 Performs a syntax analyze at level 0.
00388 }
00389 procedure TZExpressionParser.SyntaxAnalyse;
00390 var
00391 Token: TZExpressionToken;
00392 begin
00393 if not HasMoreTokens then
00394 raise TZParseError.Create(SUnexpectedExprEnd);
00395
00396 SyntaxAnalyse1;
00397 while HasMoreTokens do
00398 begin
00399 Token := GetToken;
00400 if not (Token.TokenType in [ttAnd, ttOr, ttXor]) then
00401 Break;
00402 ShiftToken;
00403 SyntaxAnalyse1;
00404 FResultTokens.Add(TZExpressionToken.Create(Token.TokenType, NullVariant));
00405 end;
00406 end;
00407
00408 {**
00409 Performs a syntax analyze at level 1.
00410 }
00411 procedure TZExpressionParser.SyntaxAnalyse1;
00412 var
00413 Token: TZExpressionToken;
00414 begin
00415 if not HasMoreTokens then
00416 raise TZParseError.Create(SUnexpectedExprEnd);
00417
00418 Token := GetToken;
00419 if Token.TokenType = ttNot then
00420 begin
00421 ShiftToken;
00422 SyntaxAnalyse2;
00423 FResultTokens.Add(TZExpressionToken.Create(Token.TokenType, NullVariant));
00424 end else
00425 SyntaxAnalyse2;
00426 end;
00427
00428 {**
00429 Performs a syntax analyze at level 2.
00430 }
00431 procedure TZExpressionParser.SyntaxAnalyse2;
00432 var
00433 Token: TZExpressionToken;
00434 begin
00435 if not HasMoreTokens then
00436 raise TZParseError.Create(SUnexpectedExprEnd);
00437
00438 SyntaxAnalyse3;
00439 while HasMoreTokens do
00440 begin
00441 Token := GetToken;
00442 if not (Token.TokenType in [ttEqual, ttNotEqual, ttMore, ttLess,
00443 ttEqualMore, ttEqualLess]) then
00444 Break;
00445 ShiftToken;
00446 SyntaxAnalyse3;
00447 FResultTokens.Add(TZExpressionToken.Create(Token.TokenType, NullVariant));
00448 end;
00449 end;
00450
00451 {**
00452 Performs a syntax analyze at level 3.
00453 }
00454 procedure TZExpressionParser.SyntaxAnalyse3;
00455 var
00456 Token: TZExpressionToken;
00457 begin
00458 if not HasMoreTokens then
00459 raise TZParseError.Create(SUnexpectedExprEnd);
00460
00461 SyntaxAnalyse4;
00462 while HasMoreTokens do
00463 begin
00464 Token := GetToken;
00465 if Token.TokenType in [ttPlus, ttMinus, ttLike] then
00466 begin
00467 ShiftToken;
00468 SyntaxAnalyse4;
00469 FResultTokens.Add(TZExpressionToken.Create(Token.TokenType, NullVariant));
00470 end
00471 else if CheckTokenTypes([ttNot, ttLike]) then
00472 begin
00473 SyntaxAnalyse4;
00474 FResultTokens.Add(TZExpressionToken.Create(ttNotLike, NullVariant));
00475 end
00476 else if CheckTokenTypes([ttIs, ttNull]) then
00477 begin
00478 FResultTokens.Add(TZExpressionToken.Create(ttIsNull, NullVariant));
00479 end
00480 else if CheckTokenTypes([ttIs, ttNot, ttNull]) then
00481 begin
00482 FResultTokens.Add(TZExpressionToken.Create(ttIsNotNull, NullVariant));
00483 end else
00484 Break;
00485 end;
00486 end;
00487
00488 {**
00489 Performs a syntax analyze at level 4.
00490 }
00491 procedure TZExpressionParser.SyntaxAnalyse4;
00492 var
00493 Token: TZExpressionToken;
00494 begin
00495 if not HasMoreTokens then
00496 raise TZParseError.Create(SUnexpectedExprEnd);
00497
00498 SyntaxAnalyse5;
00499 while HasMoreTokens do
00500 begin
00501 Token := GetToken;
00502 if not (Token.TokenType in [ttStar, ttSlash, ttProcent]) then
00503 Break;
00504 ShiftToken;
00505 SyntaxAnalyse5;
00506 FResultTokens.Add(TZExpressionToken.Create(Token.TokenType, NullVariant));
00507 end;
00508 end;
00509
00510 {**
00511 Performs a syntax analyze at level 5.
00512 }
00513 procedure TZExpressionParser.SyntaxAnalyse5;
00514 var
00515 Token: TZExpressionToken;
00516 begin
00517 if not HasMoreTokens then
00518 raise TZParseError.Create(SUnexpectedExprEnd);
00519
00520 SyntaxAnalyse6;
00521 while HasMoreTokens do
00522 begin
00523 Token := GetToken;
00524 if Token.TokenType <> ttPower then
00525 Break;
00526 ShiftToken;
00527 SyntaxAnalyse6;
00528 FResultTokens.Add(TZExpressionToken.Create(Token.TokenType, NullVariant));
00529 end;
00530 end;
00531
00532 {**
00533 Performs a syntax analyze at level 6.
00534 }
00535 procedure TZExpressionParser.SyntaxAnalyse6;
00536 var
00537 ParamsCount: Integer;
00538 Unary, Token: TZExpressionToken;
00539 Primitive, NextToken: TZExpressionToken;
00540 Temp: TZVariant;
00541 begin
00542 if not HasMoreTokens then
00543 raise TZParseError.Create(SUnexpectedExprEnd);
00544
00545 Unary := GetToken;
00546 if Unary.TokenType = ttPlus then
00547 begin
00548 Unary := nil;
00549 ShiftToken;
00550 end
00551 else if Unary.TokenType = ttMinus then
00552 begin
00553 Unary.TokenType := ttUnary;
00554 ShiftToken;
00555 end else
00556 Unary := nil;
00557
00558 if not HasMoreTokens then
00559 raise TZParseError.Create(SUnexpectedExprEnd);
00560
00561 Primitive := GetToken;
00562 NextToken := GetNextToken;
00563 if (Primitive.TokenType = ttVariable) and (NextToken <> nil)
00564 and (NextToken.TokenType = ttLeftBrace) then
00565 Primitive.TokenType := ttFunction;
00566
00567 if Primitive.TokenType in [ttConstant, ttVariable] then
00568 begin
00569 ShiftToken;
00570 FResultTokens.Add(TZExpressionToken.Create(
00571 Primitive.TokenType, Primitive.Value));
00572 end
00573 else if Primitive.TokenType = ttLeftBrace then
00574 begin
00575 ShiftToken;
00576 SyntaxAnalyse;
00577 if not HasMoreTokens then
00578 raise TZParseError.Create(SUnexpectedExprEnd);
00579 Primitive := GetToken;
00580 if Primitive.TokenType <> ttRightBrace then
00581 raise TZParseError.Create(SRightBraceExpected);
00582 ShiftToken;
00583 end
00584 else if Primitive.TokenType = ttFunction then
00585 begin
00586 ShiftToken;
00587 Token := GetToken;
00588 if Token.TokenType <> ttLeftBrace then
00589 raise TZParseError.Create(SInternalError);
00590 ParamsCount := 0;
00591 repeat
00592 ShiftToken;
00593 Token := GetToken;
00594 if (Token = nil) or (Token.TokenType = ttRightBrace) then
00595 Break;
00596 Inc(ParamsCount);
00597 SyntaxAnalyse;
00598 Token := GetToken;
00599 until (Token = nil) or (Token.TokenType <> ttComma);
00600
00601 if not HasMoreTokens then
00602 raise TZParseError.Create(SUnexpectedExprEnd);
00603 if Token.TokenType <> ttRightBrace then
00604 raise TZParseError.Create(SRightBraceExpected);
00605 ShiftToken;
00606
00607 DefVarManager.SetAsInteger(Temp, ParamsCount);
00608 FResultTokens.Add(TZExpressionToken.Create(ttConstant, Temp));
00609 FResultTokens.Add(TZExpressionToken.Create(Primitive.TokenType,
00610 Primitive.Value));
00611 end else
00612 raise TZParseError.Create(SSyntaxError);
00613
00614 if Unary <> nil then
00615 FResultTokens.Add(TZExpressionToken.Create(Unary.TokenType, NullVariant));
00616 end;
00617
00618 end.