00001 {*********************************************************}
00002 { }
00003 { Zeos SQL Shell }
00004 { Script Parsing Classes }
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 ZScriptParser;
00055
00056 interface
00057
00058 {$I ZParseSql.inc}
00059
00060 uses Classes, SysUtils, ZTokenizer;
00061
00062 type
00063 {** Defines a SQL delimiter type. }
00064 TZDelimiterType = (dtDefault, dtGo, dtSetTerm, dtEmptyLine);
00065
00066 {** Implements a SQL script parser. }
00067 TZSQLScriptParser = class
00068 private
00069 FDelimiter: string;
00070 FDelimiterType: TZDelimiterType;
00071 FCleanupStatements: Boolean;
00072 FTokenizer: IZTokenizer;
00073 FUncompletedStatement: string;
00074 FStatements: TStrings;
00075
00076 function GetStatementCount: Integer;
00077 function GetStatement(Index: Integer): string;
00078
00079 public
00080 constructor Create;
00081 constructor CreateWithTokenizer(Tokenizer: IZTokenizer);
00082 destructor Destroy; override;
00083
00084 procedure Clear;
00085 procedure ClearCompleted;
00086 procedure ClearUncompleted;
00087
00088 procedure ParseText(const Text: string);
00089 procedure ParseLine(const Line: string);
00090
00091 property Delimiter: string read FDelimiter write FDelimiter;
00092 property DelimiterType: TZDelimiterType read FDelimiterType
00093 write FDelimiterType default dtDefault;
00094 property CleanupStatements: Boolean read FCleanupStatements
00095 write FCleanupStatements default True;
00096 property Tokenizer: IZTokenizer read FTokenizer write FTokenizer;
00097 property UncompletedStatement: string read FUncompletedStatement;
00098 property StatementCount: Integer read GetStatementCount;
00099 property Statements[Index: Integer]: string read GetStatement;
00100 end;
00101
00102 implementation
00103
00104 uses ZMessages, ZSysUtils;
00105
00106 { TZSQLScriptParser }
00107
00108 {**
00109 Constructs this script parser class.
00110 }
00111 constructor TZSQLScriptParser.Create;
00112 begin
00113 FStatements := TStringList.Create;
00114 FDelimiter := ';';
00115 FDelimiterType := dtDefault;
00116 FCleanupStatements := True;
00117 end;
00118
00119 {**
00120 Creates this object and assignes a tokenizer object.
00121 @param Tokenizer a tokenizer object.
00122 }
00123 constructor TZSQLScriptParser.CreateWithTokenizer(Tokenizer: IZTokenizer);
00124 begin
00125 Create;
00126 FTokenizer := Tokenizer;
00127 end;
00128
00129 {**
00130 Destroys this class and cleanups the memory.
00131 }
00132 destructor TZSQLScriptParser.Destroy;
00133 begin
00134 FStatements.Free;
00135 inherited Destroy;
00136 end;
00137
00138 {**
00139 Gets SQL statements number.
00140 @returns SQL statements number.
00141 }
00142 function TZSQLScriptParser.GetStatementCount: Integer;
00143 begin
00144 Result := FStatements.Count;
00145 end;
00146
00147 {**
00148 Gets a parsed SQL statement by it's index.
00149 @param Index a statement index.
00150 @returns a SQL statement string.
00151 }
00152 function TZSQLScriptParser.GetStatement(Index: Integer): string;
00153 begin
00154 Result := FStatements[Index];
00155 end;
00156
00157 {**
00158 Clears all completed and uncompleted statements and line delimiter.
00159 }
00160 procedure TZSQLScriptParser.Clear;
00161 begin
00162 FStatements.Clear;
00163 FDelimiter := ';';
00164 FUncompletedStatement := '';
00165 end;
00166
00167 {**
00168 Clears only completed statements.
00169 }
00170 procedure TZSQLScriptParser.ClearCompleted;
00171 begin
00172 FStatements.Clear;
00173 end;
00174
00175 {**
00176 Clears completed and uncompleted statements.
00177 }
00178 procedure TZSQLScriptParser.ClearUncompleted;
00179 begin
00180 FStatements.Clear;
00181 FUncompletedStatement := '';
00182 end;
00183
00184 {**
00185 Parses incrementaly only one single line.
00186 The line appends with EOL character.
00187 @param Line a line to be parsed.
00188 }
00189 procedure TZSQLScriptParser.ParseLine(const Line: string);
00190 begin
00191 ParseText(#10 + Line + #10);
00192 end;
00193
00194 {**
00195 Parses a complete text with several lines.
00196 @oaram Text a text of the SQL script to be parsed.
00197 }
00198 procedure TZSQLScriptParser.ParseText(const Text: string);
00199 var
00200 Tokens: TStrings;
00201 TokenType: TZTokenType;
00202 TokenValue: string;
00203 TokenIndex: Integer;
00204 SQL, Temp: string;
00205 EndOfStatement: Boolean;
00206 Extract: Boolean;
00207
00208 function CountChars(const Str: string; Chr: Char): Integer;
00209 var
00210 I: Integer;
00211 begin
00212 Result := 0;
00213 for I := 1 to Length(Str) do
00214 begin
00215 if Str[I] = Chr then
00216 Inc(Result);
00217 end;
00218 end;
00219
00220 begin
00221 if Tokenizer = nil then
00222 raise Exception.Create(STokenizerIsNotDefined);
00223
00224 if CleanupStatements then
00225 Tokens := Tokenizer.TokenizeBufferToList(Text, [toSkipComments])
00226 else Tokens := Tokenizer.TokenizeBufferToList(Text, []);
00227
00228 TokenIndex := 0;
00229 SQL := FUncompletedStatement;
00230 if SQL <> '' then
00231 begin
00232 if CleanupStatements then
00233 SQL := SQL + ' '
00234 else SQL := SQL + #10;
00235 end;
00236 FUncompletedStatement := '';
00237 FStatements.Clear;
00238
00239 try
00240 repeat
00241 TokenValue := Tokens[TokenIndex];
00242 TokenType := TZTokenType({$IFDEF FPC}Pointer({$ENDIF}
00243 Tokens.Objects[TokenIndex]{$IFDEF FPC}){$ENDIF});
00244 Inc(TokenIndex);
00245
00246 case DelimiterType of
00247 dtDefault:
00248 EndOfStatement := (TokenValue = ';');
00249 dtGo:
00250 EndOfStatement := (UpperCase(TokenValue) = 'GO');
00251 dtEmptyLine:
00252 begin
00253 EndOfStatement := False;
00254 if TokenType = ttWhitespace then
00255 begin
00256 Temp := TokenValue;
00257 while (CountChars(Temp, #10) < 2) and (TokenType = ttWhitespace) do
00258 begin
00259 TokenValue := Tokens[TokenIndex];
00260 TokenType := TZTokenType({$IFDEF FPC}Pointer({$ENDIF}
00261 Tokens.Objects[TokenIndex]{$IFDEF FPC}){$ENDIF});
00262 Inc(TokenIndex);
00263
00264 if TokenType = ttWhitespace then
00265 Temp := Temp + TokenValue;
00266 end;
00267 EndOfStatement := (TokenType = ttWhitespace) or EndsWith(Sql, #10);
00268 if not EndOfStatement then
00269 begin
00270 if SQL <> '' then
00271 SQL := Trim(SQL) + ' ';
00272 end;
00273 end;
00274 end;
00275 dtSetTerm:
00276 begin
00277 EndOfStatement := False;
00278 if not (TokenType in [ttWhitespace, ttEOF]) then
00279 begin
00280 Temp := TokenValue;
00281 Extract := True;
00282 while (Delimiter[1]=Temp[1]) and
00283 (Length(Delimiter) > Length(Temp))
00284 and not (TokenType in [ttWhitespace, ttEOF]) do
00285 begin
00286 TokenValue := Tokens[TokenIndex];
00287 TokenType := TZTokenType({$IFDEF FPC}Pointer({$ENDIF}
00288 Tokens.Objects[TokenIndex]{$IFDEF FPC}){$ENDIF});
00289 Inc(TokenIndex);
00290
00291 if not (TokenType in [ttWhitespace, ttEOF]) then
00292 begin
00293 Temp := Temp + TokenValue;
00294 Extract := True;
00295 end else
00296 Extract := False;
00297 end;
00298 EndOfStatement := (Delimiter = Temp);
00299 if not EndOfStatement then
00300 begin
00301 if Extract then
00302 Temp := Copy(Temp, 1, Length(Temp) - Length(TokenValue));
00303 SQL := SQL + Temp;
00304 end;
00305 end;
00306 end;
00307 else
00308 EndOfStatement := False;
00309 end;
00310
00311 if TokenType = ttEOF then Break;
00312
00313 { Processes the end of statements. }
00314 if EndOfStatement then
00315 begin
00316 if CleanupStatements then
00317 SQL := Trim(SQL);
00318 if SQL <> '' then
00319 begin
00320 if not CleanupStatements then
00321 Temp := Trim(SQL)
00322 else Temp := SQL;
00323 if (DelimiterType = dtSetTerm)
00324 and StartsWith(UpperCase(Temp), 'SET TERM ') then
00325 begin
00326 Delimiter := Copy(Temp, 10, Length(Temp) - 9);
00327 end
00328 else
00329 begin
00330 if (DelimiterType = dtEmptyLine) and EndsWith(SQL, ';') then
00331 SQL := Copy(SQL, 1, Length(SQL) - 1);
00332 if CleanupStatements then
00333 SQL := Trim(SQL);
00334 FStatements.Add(SQL);
00335 end;
00336 end;
00337 SQL := '';
00338 end
00339 { Adds a whitespace token. }
00340 else if CleanupStatements and (TokenType = ttWhitespace) then
00341 begin
00342 if SQL <> '' then
00343 SQL := Trim(SQL) + ' ';
00344 end
00345 { Adds a default token. }
00346 else
00347 begin
00348 // --> ms, 20/10/2005
00349 // TokenValue is not a ttWhitespace (#32)
00350 if (TokenType = ttWhitespace) and (TokenValue > '') then begin
00351 // SQL is not emtyp
00352 if (SQL <> '') then begin
00353 // is last token:
00354 if (Tokenindex = Tokens.count-1) then
00355 TokenValue := '';
00356 // next(!) token is also ttWhitespace or delimiter
00357 // (TokenIndex was already incremented!)
00358 if (Tokenindex < Tokens.count-1) then
00359 if ((TZTokenType({$IFDEF FPC}Pointer({$ENDIF}
00360 Tokens.Objects[TokenIndex]{$IFDEF FPC}){$ENDIF}) = ttWhitespace) or
00361 (Tokens[TokenIndex] = Delimiter)) then
00362 TokenValue := '';
00363 end
00364 // SQL is empty
00365 else
00366 TokenValue := '';
00367 end;
00368 if ((SQL = '') and (trim(TokenValue) = '')) then
00369 TokenValue := '';
00370 // <-- ms
00371 SQL := SQL + TokenValue;
00372 end;
00373 until TokenType = ttEOF;
00374 finally
00375 Tokens.Free;
00376 end;
00377
00378 if CleanupStatements then
00379 SQL := Trim(SQL);
00380 if SQL <> '' then
00381 FUncompletedStatement := SQL;
00382 end;
00383
00384 end.