ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/runtime/nongui/ibxscript.pas
Revision: 363
Committed: Tue Dec 7 13:30:05 2021 UTC (8 months ago) by tony
File size: 36800 byte(s)
Log Message:
add fbintf
Line File contents
1 (*
2 * IBX For Lazarus (Firebird Express)
3 *
4 * The contents of this file are subject to the Initial Developer's
5 * Public License Version 1.0 (the "License"); you may not use this
6 * file except in compliance with the License. You may obtain a copy
7 * of the License here:
8 *
9 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
10 *
11 * Software distributed under the License is distributed on an "AS
12 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13 * implied. See the License for the specific language governing rights
14 * and limitations under the License.
15 *
16 * The Initial Developer of the Original Code is Tony Whyman.
17 *
18 * The Original Code is (C) 2014-2017 Tony Whyman, MWA Software
19 * (http://www.mwasoftware.co.uk).
20 *
21 * All Rights Reserved.
22 *
23 * Contributor(s): ______________________________________.
24 *
25 *)
26 unit ibxscript;
27
28 {$mode objfpc}{$H+}
29
30 {$codepage UTF8}
31
32 interface
33
34 uses Classes, IBDatabase, IBSQL, IB, IBDataOutput, IBUtils;
35
36 type
37
38 TOnNextLine = procedure(Sender: TObject; Line: string) of object;
39
40 { TSQLStatementReader }
41
42 TSQLStatementReader = class(TSQLXMLReader)
43 private
44 type
45 TSQLState = (stDefault, stInStmt, stInBlock, stInArrayDim, stInDeclare);
46 private
47 FDatabase: TIBDatabase;
48 FHasBegin: boolean;
49 FOnNextLine: TOnNextLine;
50 FTerminator: char;
51 FTransaction: TIBTransaction;
52 protected
53 procedure EchoNextLine(aLine: string);
54 function GetAttachment: IAttachment; override;
55 function GetTransaction: ITransaction; override;
56 public
57 constructor Create;
58 function GetNextStatement(var stmt: string) : boolean; virtual;
59 property HasBegin: boolean read FHasBegin;
60 property Terminator: char read FTerminator write FTerminator default DefaultTerminator;
61 property OnNextLine: TOnNextLine read FOnNextLine write FOnNextLine;
62 property Database: TIBDatabase read FDatabase write FDatabase;
63 property Transaction: TIBTransaction read FTransaction write FTransaction;
64 end;
65
66
67 { TBatchSQLStatementReader }
68
69 {This SQL Reader supports non-interactive parsing of a text file, stream or
70 lines of text.}
71
72 TBatchSQLStatementReader = class(TSQLStatementReader)
73 private
74 FInStream: TStream;
75 FOwnsInStream: boolean;
76 FLineIndex: integer;
77 FIndex: integer;
78 FCurLine: string;
79 protected
80 function GetChar: char; override;
81 function GetErrorPrefix: string; override;
82 public
83 procedure Reset; override;
84 procedure SetStreamSource(Lines: TStrings); overload;
85 procedure SetStreamSource(S: TStream); overload;
86 procedure SetStreamSource(FileName: string); overload;
87 procedure SetStringStreamSource(S: string);
88 end;
89
90 { TInteractiveSQLStatementReader }
91
92 {This SQL reader supports interactive parsing of commands and
93 SQL statements entered at a console}
94
95 TInteractiveSQLStatementReader = class(TSQLStatementReader)
96 private
97 FPrompt: string;
98 FContinuePrompt: string;
99 FTerminated: boolean;
100 FLine: string;
101 FLineIndex: integer;
102 FNextStatement: boolean;
103 function GetNextLine(var Line: string):boolean;
104 protected
105 function GetChar: char; override;
106 function GetErrorPrefix: string; override;
107 public
108 constructor Create(aPrompt: string='SQL>'; aContinue: string = 'CON>');
109 function GetNextStatement(var stmt: string) : boolean; override;
110 property Terminated: boolean read FTerminated write FTerminated;
111 end;
112
113 TGetParamValue = procedure(Sender: TObject; ParamName: string; var BlobID: TISC_QUAD) of object;
114 TLogEvent = procedure(Sender: TObject; Msg: string) of Object;
115 TOnSelectSQL = procedure (Sender: TObject; SQLText: string) of object;
116 TOnSetStatement = procedure(Sender: TObject; command, aValue, stmt: string; var Done: boolean) of object;
117 TOnCreateDatabase = procedure (Sender: TObject; var DatabaseFileName: string) of object;
118
119 { TCustomIBXScript }
120
121 {This is the main script processing engine and can be customised by subclassing
122 and defining the symbol stream appropriate for use.
123
124 The RunScript function is used to invoke the processing of a symbol stream. Each
125 SQL statement is extracted one by one. If it is recognised as a built in command
126 by "ProcessStatement" then it is actioned directly. Otherwise, it is executed
127 using the TIBSQL component. Note that SQL validation by this class is only partial
128 and is sufficient only to parse the SQL into statements. The Firebird engine does
129 the rest when the statement is executed.}
130
131 TCustomIBXScript = class(TComponent)
132 private
133 FEcho: boolean;
134 FSQLReader: TSQLStatementReader;
135 FDatabase: TIBDatabase;
136 FDataOutputFormatter: TIBCustomDataOutput;
137 FIgnoreCreateDatabase: boolean;
138 FIgnoreGrants: boolean;
139 FOnCreateDatabase: TOnCreateDatabase;
140 FOnErrorLog: TLogEvent;
141 FOnSelectSQL: TOnSelectSQL;
142 FOnSetStatement: TOnSetStatement;
143 FShowAffectedRows: boolean;
144 FShowPerformanceStats: boolean;
145 FStopOnFirstError: boolean;
146 FTransaction: TIBTransaction;
147 FInternalTransaction: TIBTransaction;
148 FISQL: TIBSQL;
149 FGetParamValue: TGetParamValue;
150 FOnOutputLog: TLogEvent;
151 FAutoDDL: boolean;
152 procedure DoCommit;
153 procedure DoReconnect;
154 function GetOnProgressEvent: TOnProgressEvent;
155 function GetTransaction: TIBTransaction;
156 procedure SetDatabase(AValue: TIBDatabase);
157 procedure SetDataOutputFormatter(AValue: TIBCustomDataOutput);
158 procedure SetOnProgressEvent(AValue: TOnProgressEvent);
159 procedure SetParamValue(SQLVar: ISQLParam);
160 procedure SetShowPerformanceStats(AValue: boolean);
161 procedure SetTransaction(AValue: TIBTransaction);
162 protected
163 procedure Add2Log(const Msg: string; IsError: boolean=true); virtual;
164 procedure ExecSQL(stmt: string);
165 procedure EchoNextLine(Sender: TObject; Line: string);
166 procedure Notification(AComponent: TComponent; Operation: TOperation); override;
167 function ProcessStatement(stmt: string): boolean; virtual;
168 function ProcessStream: boolean;
169 procedure SetSQLStatementReader(SQLStatementReader: TSQLStatementReader);
170 public
171 constructor Create(aOwner: TComponent); override;
172 destructor Destroy; override;
173 procedure DefaultSelectSQLHandler(aSQLText: string);
174 property SQLStatementReader: TSQLStatementReader read FSQLReader;
175 published
176 property Database: TIBDatabase read FDatabase write SetDatabase;
177 property DataOutputFormatter: TIBCustomDataOutput read FDataOutputFormatter
178 write SetDataOutputFormatter;
179 property AutoDDL: boolean read FAutoDDL write FAutoDDL default true;
180 property Echo: boolean read FEcho write FEcho default true; {Echo Input to Log}
181 property IgnoreGrants: boolean read FIgnoreGrants write FIgnoreGrants;
182 property IgnoreCreateDatabase: boolean read FIgnoreCreateDatabase write FIgnoreCreateDatabase;
183 property Transaction: TIBTransaction read GetTransaction write SetTransaction;
184 property ShowAffectedRows: boolean read FShowAffectedRows write FShowAffectedRows;
185 property ShowPerformanceStats: boolean read FShowPerformanceStats write SetShowPerformanceStats;
186 property StopOnFirstError: boolean read FStopOnFirstError write FStopOnFirstError default true;
187 property GetParamValue: TGetParamValue read FGetParamValue write FGetParamValue; {resolve parameterized queries}
188 property OnOutputLog: TLogEvent read FOnOutputLog write FOnOutputLog; {Log handler}
189 property OnErrorLog: TLogEvent read FOnErrorLog write FOnErrorLog;
190 property OnProgressEvent: TOnProgressEvent read GetOnProgressEvent write SetOnProgressEvent; {Progress Bar Support}
191 property OnSelectSQL: TOnSelectSQL read FOnSelectSQL write FOnSelectSQL; {Handle Select SQL Statements}
192 property OnSetStatement: TOnSetStatement read FOnSetStatement write FOnSetStatement;
193 property OnCreateDatabase: TOnCreateDatabase read FOnCreateDatabase write FOnCreateDatabase;
194 end;
195
196 {
197 TIBXScript: runs an SQL script in the specified file or stream. The text is parsed
198 into SQL statements which are executed in turn. The intention is to be ISQL
199 compatible but with extensions:
200
201 * All DML and DDL Statements are supported.
202
203 * CREATE DATABASE, DROP DATABASE, CONNECT and COMMIT are supported.
204
205 * The following SET statements are supported:
206 SET SQL DIALECT
207 SET TERM
208 SET AUTODDL
209 SET BAIL
210 SET ECHO
211 SET COUNT
212 SET STATS
213 SET NAMES <character set>
214
215 * New Command: RECONNECT. Performs a commit followed by disconnecting and
216 reconnecting to the database.
217
218 * Procedure Bodies (BEGIN .. END blocks) are self-delimiting and do not need
219 an extra terminator. If a terminator is present, this is treated as an
220 empty statement. The result is ISQL compatible, but does not require the
221 use of SET TERM.
222
223 * DML statements may have arguments in IBX format (e.g UPDATE MYTABLE Set data = :mydata).
224 Arguments are valid only for BLOB columns and are resolved using the GetParamValue
225 event. This returns the blobid to be used. A typical use of the event is to
226 read binary data from a file, save it in a blob stream and return the blob id.
227
228 Select SQL statements are not directly supported but can be handled by an external
229 handler (OnSelectSQL event). If the handler is not present then an exception
230 is raised if a Select SQL statement is found.
231
232 Properties:
233
234 * Database: Link to TIBDatabase component
235 * Transaction: Link to Transaction. Defaults to internaltransaction (concurrency, wait)
236 * AutoDDL: When true DDL statements are automatically committed after execution
237 * Echo: boolean. When true, all SQL statements are echoed to log
238 * StopOnFirstError: boolean. When true the script engine terminates on the first
239 SQL Error.
240 * IgnoreGrants: When true, grant statements are silently discarded. This can be
241 useful when applying a script using the Embedded Server.
242 * ShowPerformanceStats: When true, performance statistics (in ISQL format) are
243 written to the log after a DML statement is executed
244 * DataOutputFormatter: Identifies a Data Output Formatter component used to format
245 the results of executing a Select Statement
246
247
248 Events:
249
250 * GetParamValue: called when an SQL parameter is found (in PSQL :name format).
251 This is only called for blob fields. Handler should return the BlobID to be
252 used as the parameter value. If not present an exception is raised when a
253 parameter is found.
254 * OnOutputLog: Called to write SQL Statements to the log (stdout)
255 * OnErrorLog: Called to write all other messages to the log (stderr)
256 * OnProgressEvent: Progress bar support. If Reset is true the value is maximum
257 value of progress bar. Otherwise called to step progress bar.
258 * OnSelectSQL: handler for select SQL statements. If not present, select SQL
259 statements result in an exception.
260 * OnSetStatement: called to process a SET command that has not already been
261 handled by TIBXScript.
262
263 The RunScript function is used to execute an SQL Script and may be called
264 multiple times.
265 }
266
267 { TIBXScript }
268
269 TIBXScript = class(TCustomIBXScript)
270 public
271 constructor Create(aOwner: TComponent); override;
272 {use RunScript instead of PerformUpdate}
273 function PerformUpdate(SQLFile: string; aAutoDDL: boolean): boolean; overload; deprecated;
274 function PerformUpdate(SQLStream: TStream; aAutoDDL: boolean): boolean; overload; deprecated;
275 function RunScript(SQLFile: string): boolean; overload;
276 function RunScript(SQLStream: TStream): boolean; overload;
277 function RunScript(SQLLines: TStrings): boolean; overload;
278 function ExecSQLScript(sql: string): boolean;
279 end;
280
281
282 resourcestring
283 sInvalidSetStatement = 'Invalid %s Statement - %s';
284 sInvalidCharacterSet = 'Unrecognised character set name - "%s"';
285 sOnLineError = 'On Line %d Character %d: ';
286
287 implementation
288
289 uses Sysutils, RegExpr;
290
291 resourcestring
292 sNoSelectSQL = 'Select SQL Statements are not supported';
293 sNoParamQueries = 'Parameterised Queries are not supported';
294 sResolveQueryParam = 'Resolving Query Parameter: %s';
295 sStatementError = 'Error processing SQL statement: %s %s - for statement "%s"';
296
297 { TSQLStatementReader }
298
299 procedure TSQLStatementReader.EchoNextLine(aLine: string);
300 begin
301 if assigned(FOnNextLine) then
302 OnNextLine(self,aLine);
303 end;
304
305 function TSQLStatementReader.GetAttachment: IAttachment;
306 begin
307 if FDatabase <> nil then
308 Result := FDatabase.Attachment
309 else
310 Result := nil;
311 end;
312
313 function TSQLStatementReader.GetTransaction: ITransaction;
314 begin
315 if FTransaction <> nil then
316 Result := FTransaction.TransactionIntf
317 else
318 Result := nil;
319 end;
320
321 constructor TSQLStatementReader.Create;
322 begin
323 inherited Create;
324 Terminator := DefaultTerminator;
325 end;
326
327 function TSQLStatementReader.GetNextStatement(var stmt: string): boolean;
328 var State: TSQLState;
329 Nested: integer;
330 token: TSQLTokens;
331 EndOfStatement: boolean;
332 begin
333 FHasBegin := false;
334 EndOfStatement := false;
335 Nested := 0;
336 stmt := '';
337 State := stDefault;
338 while not EOF and not EndOfStatement do
339 begin
340 token := GetNextToken;
341 // writeln(token,' ',TokenText,' ',Terminator);
342 case State of
343 stDefault:
344 {ignore everything before a reserved word}
345 if (token <= high(TSQLReservedWords)) or (token = sqltIdentifier) then
346 begin
347 State := stInStmt;
348 stmt += TokenText;
349 end;
350
351 stInStmt:
352 begin
353 case token of
354 sqltBegin:
355 begin
356 FHasBegin := true;
357 State := stInBlock;
358 Nested := 1;
359 stmt += TokenText;
360 end;
361
362 sqltDeclare:
363 begin
364 State := stInDeclare;
365 stmt += TokenText;
366 end;
367
368 sqltOpenSquareBracket:
369 begin
370 State := stInArrayDim;
371 stmt += TokenText;
372 end;
373
374 sqltComment:
375 stmt += '/*' + TokenText + '*/';
376
377 sqltCommentLine:
378 stmt += '/*' + TokenText + ' */' + LineEnding;
379
380 sqltQuotedString:
381 stmt += '''' + SQLSafeString(TokenText) + '''';
382
383 sqltIdentifierInDoubleQuotes:
384 stmt += '"' + TokenText + '"';
385
386 sqltEOL:
387 stmt += LineEnding;
388
389 else
390 begin
391 if (tokentext = Terminator) and (Nested = 0) then
392 begin
393 EndOfStatement := true;
394 State := stDefault;
395 end
396 else
397 stmt += TokenText;
398 end;
399 end;
400 end;
401
402 {ignore begin..end blocks for Terminator detection }
403
404 stInBlock:
405 begin
406 case token of
407 sqltBegin:
408 begin
409 Inc(Nested);
410 stmt += TokenText;
411 end;
412
413 sqltEnd:
414 begin
415 Dec(Nested);
416 stmt += TokenText;
417 if Nested = 0 then
418 begin
419 State := stDefault;
420 EndOfStatement := true;
421 end;
422 end;
423
424 sqltCase:
425 {case constructs can appear within select statement in nested blocks.
426 We need to match the case constructs END token in order to parse the
427 block correctly. This is a simple parser and the only objective is
428 to determine the correct end of block. We therefore do not check to
429 ensure that the next end properly matches the case. The CASE is thus
430 treated the same as BEGIN. The Firebird SQL Parser will flag any errors
431 due to mismatched CASE/BEGIN END}
432 begin
433 Inc(Nested);
434 stmt += TokenText;
435 end;
436
437 sqltComment:
438 stmt += '/*' + TokenText + '*/';
439
440 sqltCommentLine:
441 stmt += '/* ' + TokenText + ' */' + LineEnding;
442
443 sqltQuotedString:
444 stmt += '''' + SQLSafeString(TokenText) + '''';
445
446 sqltIdentifierInDoubleQuotes:
447 stmt += '"' + TokenText + '"';
448
449 sqltEOL:
450 stmt += LineEnding;
451
452 else
453 stmt += TokenText;
454 end;
455 end;
456
457 {ignore array dimensions for Terminator detection }
458
459 stInArrayDim:
460 begin
461 case token of
462
463 sqltComment:
464 stmt += '/*' + TokenText + '*/';
465
466 sqltCommentLine:
467 stmt += '/* ' + TokenText + ' */' + LineEnding;
468
469 sqltCloseSquareBracket:
470 begin
471 stmt += TokenText;
472 State := stInStmt;
473 end;
474
475 sqltEOL:
476 stmt += LineEnding;
477
478 else
479 stmt += TokenText;
480 end;
481 end;
482
483 {ignore Declare statement for terminator - semi-colon terminates declaration}
484
485 stInDeclare:
486 begin
487 case token of
488
489 sqltComment:
490 stmt += '/*' + TokenText + '*/';
491
492 sqltCommentLine:
493 stmt += '/* ' + TokenText + ' */' + LineEnding;
494
495 sqltQuotedString:
496 stmt += '''' + SQLSafeString(TokenText) + ''''; {exists some DECLARE with cursor having SELECT ...\... rc.rdb$constraint_type = 'PRIMARY KEY');}
497
498 sqltSemiColon:
499 begin
500 State := stInStmt;
501 stmt += TokenText;
502 end;
503
504 sqltEOL:
505 stmt += LineEnding;
506
507 else
508 stmt += TokenText;
509 end;
510 end;
511 end;
512 end;
513 Result := stmt <> '';
514 end;
515
516
517
518 { TIBXScript }
519
520 constructor TIBXScript.Create(aOwner: TComponent);
521 begin
522 inherited Create(aOwner);
523 SetSQLStatementReader(TBatchSQLStatementReader.Create);
524 end;
525
526 function TIBXScript.PerformUpdate(SQLFile: string; aAutoDDL: boolean): boolean;
527 begin
528 FAutoDDL := aAutoDDL;
529 Result := RunScript( SQLFile);
530 end;
531
532 function TIBXScript.PerformUpdate(SQLStream: TStream; aAutoDDL: boolean
533 ): boolean;
534 begin
535 FAutoDDL := aAutoDDL;
536 Result := RunScript(SQLStream);
537 end;
538
539 function TIBXScript.RunScript(SQLFile: string): boolean;
540 begin
541 TBatchSQLStatementReader(FSQLReader).SetStreamSource(SQLFile);
542 Result := ProcessStream;
543 end;
544
545 function TIBXScript.RunScript(SQLStream: TStream): boolean;
546 begin
547 TBatchSQLStatementReader(FSQLReader).SetStreamSource(SQLStream);
548 Result := ProcessStream;
549 end;
550
551 function TIBXScript.RunScript(SQLLines: TStrings): boolean;
552 begin
553 TBatchSQLStatementReader(FSQLReader).SetStreamSource(SQLLines);
554 Result := ProcessStream;
555 end;
556
557 function TIBXScript.ExecSQLScript(sql: string): boolean;
558 begin
559 TBatchSQLStatementReader(FSQLReader).SetStringStreamSource(sql);
560 Result := ProcessStream;
561 end;
562
563 { TCustomIBXScript }
564
565 procedure TCustomIBXScript.Add2Log(const Msg: string; IsError: boolean);
566 begin
567 if IsError then
568 begin
569 if assigned(OnErrorLog) then OnErrorLog(self,Msg)
570 end
571 else
572 if assigned(FOnOutputLog) then FOnOutputLog(self,Msg)
573 end;
574
575 procedure TCustomIBXScript.DoCommit;
576 begin
577 with GetTransaction do
578 if InTransaction then Commit;
579 end;
580
581 procedure TCustomIBXScript.DoReconnect;
582 begin
583 with GetTransaction do
584 if InTransaction then Commit;
585 Database.Reconnect;
586 end;
587
588 procedure TCustomIBXScript.ExecSQL(stmt: string);
589 var DDL: boolean;
590 I: integer;
591 begin
592 Database.Connected := true;
593 FISQL.SQL.Text := stmt;
594 FISQL.Transaction := GetTransaction;
595 FISQL.Transaction.Active := true;
596 // FISQL.ParamCheck := not FSQLReader.HasBegin; {Probably PSQL}
597 FISQL.Prepare;
598 FISQL.Statement.EnableStatistics(ShowPerformanceStats);
599
600 if FISQL.SQLStatementType in [SQLInsert, SQLUpdate, SQLDelete] then
601 begin
602 {Interpret parameters}
603 for I := 0 to FISQL.Params.Count - 1 do
604 SetParamValue(FISQL.Params[I]);
605 end;
606
607 if FISQL.SQLStatementType = SQLSelect then
608 begin
609 if assigned(OnSelectSQL) then
610 OnSelectSQL(self,stmt)
611 else
612 DefaultSelectSQLHandler(stmt);
613 end
614 else
615 begin
616 DDL := FISQL.SQLStatementType = SQLDDL;
617 if not DDL or not FIgnoreGrants or (Pos('GRANT',AnsiUpperCase(Trim(stmt))) <> 1) then
618 begin
619 FISQL.ExecQuery;
620 if ShowAffectedRows and not DDL then
621 Add2Log('Rows Affected: ' + IntToStr(FISQL.RowsAffected));
622 if not DDL then
623 TIBCustomDataOutput.ShowPerfStats(FISQL.Statement,@Add2Log);
624 end;
625
626 if FAutoDDL and DDL then
627 FISQL.Transaction.Commit;
628 FISQL.Close;
629 end;
630 FISQL.SQL.Clear;
631 end;
632
633 function TCustomIBXScript.GetOnProgressEvent: TOnProgressEvent;
634 begin
635 Result := FSQLReader.OnProgressEvent;
636 end;
637
638 function TCustomIBXScript.GetTransaction: TIBTransaction;
639 begin
640 if not (csDesigning in ComponentState) and (FTransaction = nil) then
641 Result := FInternalTransaction
642 else
643 Result := FTransaction;
644 end;
645
646 procedure TCustomIBXScript.EchoNextLine(Sender: TObject; Line: string);
647 begin
648 if Echo then Add2Log(Line);
649 end;
650
651 procedure TCustomIBXScript.Notification(AComponent: TComponent;
652 Operation: TOperation);
653 begin
654 inherited Notification(AComponent, Operation);
655 if (AComponent = FDatabase) and (Operation = opRemove) then
656 FDatabase := nil;
657 if (AComponent = FTransaction) and (Operation = opRemove) then
658 FTransaction := nil;
659 if (AComponent = DataOutputFormatter) and (Operation = opRemove) then
660 FDataOutputFormatter := nil;
661 end;
662
663 procedure TCustomIBXScript.SetDatabase(AValue: TIBDatabase);
664 begin
665 if not (csLoading in ComponentState) and (FDatabase = AValue) then Exit;
666 FDatabase := AValue;
667 FISQL.Database := AValue;
668 FInternalTransaction.Active := false;
669 FInternalTransaction.DefaultDatabase := AValue;
670 end;
671
672 procedure TCustomIBXScript.SetDataOutputFormatter(AValue: TIBCustomDataOutput);
673 begin
674 if FDataOutputFormatter = AValue then Exit;
675 if (FDataOutputFormatter <> nil) and (AValue <> nil) then
676 AValue.Assign(FDataOutputFormatter);
677 FDataOutputFormatter := AValue;
678 if FDataOutputFormatter <> nil then
679 FDataOutputFormatter.Database := Database;
680 end;
681
682 procedure TCustomIBXScript.SetOnProgressEvent(AValue: TOnProgressEvent);
683 begin
684 FSQLReader.OnProgressEvent := AValue;
685 end;
686
687 procedure TCustomIBXScript.SetParamValue(SQLVar: ISQLParam);
688 var BlobID: TISC_QUAD;
689 ix: integer;
690 begin
691 if (SQLVar.SQLType = SQL_BLOB) and (Pos(TSQLXMLReader.ibx_blob,SQLVar.Name) = 1) then
692 begin
693 ix := StrToInt(system.copy(SQLVar.Name,length(TSQLXMLReader.ibx_blob)+1,length(SQLVar.Name)-length(TSQLXMLReader.ibx_blob)));
694 SQLVar.AsBlob := FSQLReader.BlobData[ix].BlobIntf;
695 Exit;
696 end
697 else
698 if (SQLVar.SQLType = SQL_ARRAY) and (Pos(TSQLXMLReader.ibx_array,SQLVar.Name) = 1) then
699 begin
700 ix := StrToInt(system.copy(SQLVar.Name,length(TSQLXMLReader.ibx_array)+1,length(SQLVar.Name)-length(TSQLXMLReader.ibx_array)));
701 SQLVar.AsArray := FSQLReader.ArrayData[ix].ArrayIntf;
702 Exit;
703 end;
704
705 if assigned(FGetParamValue) and (SQLVar.SQLType = SQL_BLOB) then
706 begin
707 Add2Log(Format(sResolveQueryParam,[SQLVar.Name]));
708 GetParamValue(self,SQLVar.Name,BlobID);
709 if (BlobID.gds_quad_high = 0) and (BlobID.gds_quad_low = 0) then
710 SQLVar.Clear
711 else
712 SQLVar.AsQuad := BlobID
713 end
714 else
715 raise Exception.Create(sNoParamQueries);
716 end;
717
718 procedure TCustomIBXScript.SetShowPerformanceStats(AValue: boolean);
719 begin
720 if FShowPerformanceStats = AValue then Exit;
721 FShowPerformanceStats := AValue;
722 if assigned(DataOutputFormatter) then
723 DataOutputFormatter.ShowPerformanceStats := AValue;
724 end;
725
726 function TCustomIBXScript.ProcessStream: boolean;
727 var stmt: string;
728 begin
729 Result := false;
730 FSQLReader.Database := Database;
731 if FTransaction = nil then
732 FSQLReader.Transaction := FInternalTransaction
733 else
734 FSQLReader.Transaction := FTransaction;
735 while FSQLReader.GetNextStatement(stmt) do
736 try
737 stmt := trim(stmt);
738 // writeln('stmt = "',stmt,'"');
739 if stmt = '' then continue;
740 if not ProcessStatement(stmt) then
741 ExecSQL(stmt);
742
743 except on E:Exception do
744 begin
745 with GetTransaction do
746 if InTransaction then Rollback;
747 FSQLReader.Terminator := TSQLStatementReader.DefaultTerminator;
748 if assigned(OnErrorLog) then
749 begin
750 Add2Log(Format(sStatementError,[FSQLReader.GetErrorPrefix,
751 E.Message,stmt]),true);
752 if StopOnFirstError then Exit;
753 end
754 else
755 raise;
756 end
757 end;
758 Result := true;
759 end;
760
761 procedure TCustomIBXScript.SetSQLStatementReader(
762 SQLStatementReader: TSQLStatementReader);
763 begin
764 FSQLReader := SQLStatementReader;
765 FSQLReader.OnNextLine := @EchoNextLine;
766 end;
767
768 function TCustomIBXScript.ProcessStatement(stmt: string): boolean;
769 var command: string;
770
771 function Toggle(aValue: string): boolean;
772 begin
773 aValue := AnsiUpperCase(aValue);
774 if aValue = 'ON' then
775 Result := true
776 else
777 if aValue = 'OFF' then
778 Result := false
779 else
780 raise Exception.CreateFmt(sInvalidSetStatement, [command,stmt]);
781 end;
782
783 procedure ExtractUserInfo;
784 var RegexObj: TRegExpr;
785 begin
786 RegexObj := TRegExpr.Create;
787 try
788 RegexObj.ModifierG := false; {turn off greedy matches}
789 RegexObj.Expression := ' +USER +''(.+)''';
790 if RegexObj.Exec(stmt) then
791 FDatabase.Params.Values['user_name'] := RegexObj.Match[1];
792
793 RegexObj.Expression := ' +PASSWORD +''(.+)''';
794 if RegexObj.Exec(stmt) then
795 FDatabase.Params.Values['password'] :=
796 system.copy(stmt,RegexObj.MatchPos[1],RegexObj.MatchLen[1]);
797 finally
798 RegexObj.Free;
799 end;
800 end;
801
802 procedure ExtractConnectInfo;
803 var RegexObj: TRegExpr;
804 begin
805 ExtractUserInfo;
806 RegexObj := TRegExpr.Create;
807 try
808 RegexObj.ModifierG := false; {turn off greedy matches}
809 RegexObj.ModifierI := true; {case insensitive}
810 RegexObj.Expression := '^ *CONNECT +''(.*)''';
811 if RegexObj.Exec(stmt) then
812 begin
813 FDatabase.DatabaseName := system.copy(stmt,RegexObj.MatchPos[1],RegexObj.MatchLen[1]);
814 end;
815
816 RegexObj.Expression := ' +ROLE +''(.+)''';
817 if RegexObj.Exec(stmt) then
818 FDatabase.Params.Values['sql_role_name'] := RegexObj.Match[1]
819 else
820 with FDatabase.Params do
821 if IndexOfName('sql_role_name') <> -1 then
822 Delete(IndexOfName('sql_role_name'));
823
824 RegexObj.Expression := ' +CACHE +([0-9]+)';
825 if RegexObj.Exec(stmt) then
826 FDatabase.Params.Values['cache_manager'] := RegexObj.Match[1]
827 else
828 with FDatabase.Params do
829 if IndexOfName('cache_manager') <> -1 then
830 Delete(IndexOfName('cache_manager'));
831 finally
832 RegexObj.Free;
833 end;
834 end;
835
836 procedure UpdateUserPassword;
837 var RegexObj: TRegExpr;
838 begin
839 RegexObj := TRegExpr.Create;
840 try
841 RegexObj.ModifierG := false; {turn off greedy matches}
842 RegexObj.ModifierI := true; {case insensitive}
843 RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +(''.*'') +USER +''(.+)''';
844 if not RegexObj.Exec(stmt) and (FDatabase.Params.IndexOfName('user_name') <> -1) then
845 begin
846 RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +(''.*'')';
847 if RegexObj.Exec(stmt) then
848 begin
849 system.Insert(' USER ''' + FDatabase.Params.Values['user_name'] +'''',stmt,
850 RegexObj.MatchPos[2] + RegexObj.MatchLen[2]);
851 end;
852 end;
853
854 RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''.*'' +USER +''.+'' PASSWORD +''(.+)''';
855 if not RegexObj.Exec(stmt) and (FDatabase.Params.IndexOfName('password') <> -1) then
856 begin
857 RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''.*'' +(USER +''.+'')';
858 if RegexObj.Exec(stmt) then
859 begin
860 system.Insert(' PASSWORD ''' + FDatabase.Params.Values['password'] +'''',stmt,
861 RegexObj.MatchPos[2] + RegexObj.MatchLen[2]);
862 end;
863 end;
864 finally
865 RegexObj.Free;
866 end;
867 end;
868
869 var RegexObj: TRegExpr;
870 n: integer;
871 charsetid: integer;
872 param: string;
873 Terminator: char;
874 FileName: string;
875 DBConnected: boolean;
876 LoginPrompt: boolean;
877 begin
878 Result := false;
879 Terminator := FSQLReader.Terminator;
880 RegexObj := TRegExpr.Create;
881 try
882 {process create database}
883 RegexObj.ModifierI := true; {case insensitive}
884 RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''(.*)''(.*)(\' + Terminator + '|)';
885 if RegexObj.Exec(stmt) then
886 begin
887 if IgnoreCreateDatabase then
888 begin
889 Result := true;
890 Exit;
891 end;
892 FileName := system.copy(stmt,RegexObj.MatchPos[2], RegexObj.MatchLen[2]);
893 if assigned(FOnCreateDatabase) then
894 OnCreateDatabase(self,FileName);
895 stmt := 'CREATE DATABASE ''' + FileName + '''' + system.copy(stmt,RegexObj.MatchPos[3], RegexObj.MatchLen[3]);
896 UpdateUserPassword;
897 if FDatabase.Connected then
898 FDatabase.Dropdatabase;
899 FDatabase.CreateDatabase(stmt);
900 Result := true;
901 Exit;
902 end;
903
904 {process connect statement}
905 RegexObj.Expression := '^ *CONNECT +.*(\' + Terminator + '|)';
906 if RegexObj.Exec(stmt) then
907 begin
908 ExtractConnectInfo;
909 FDatabase.Connected := false;
910 FDatabase.Connected := true;
911 Result := true;
912 Exit;
913 end;
914
915 {Process Drop Database}
916 RegexObj.Expression := '^ *DROP +DATABASE *(\' + Terminator + '|)';
917 if RegexObj.Exec(stmt) then
918 begin
919 FDatabase.DropDatabase;
920 Result := true;
921 Exit;
922 end;
923
924 {process commit statement}
925 RegexObj.Expression := '^ *COMMIT *(\' + Terminator + '|)';
926 if RegexObj.Exec(stmt) then
927 begin
928 DoCommit;
929 Result := true;
930 Exit;
931 end;
932
933 {process Reconnect statement}
934 RegexObj.Expression := '^ *RECONNECT *(\' + Terminator + '|)';
935 if RegexObj.Exec(stmt) then
936 begin
937 DoReconnect;
938 Result := true;
939 Exit;
940 end;
941
942
943 {Process Set Term}
944 RegexObj.Expression := '^ *SET +TERM +(.) *(\' + Terminator + '|)';
945 if RegexObj.Exec(stmt) then
946 begin
947 FSQLReader.Terminator := RegexObj.Match[1][1];
948 Result := true;
949 Exit;
950 end;
951
952 {process Set SQL Dialect}
953 RegexObj.Expression := '^ *SET +SQL +DIALECT +([0-9]) *(\' + Terminator + '|)';
954 if RegexObj.Exec(stmt) then
955 begin
956 n := StrToInt(RegexObj.Match[1]);
957 if Database.SQLDialect <> n then
958 begin
959 Database.SQLDialect := n;
960 if Database.Connected then
961 DoReconnect;
962 end;
963 Result := true;
964 Exit;
965 end;
966
967 {Process Remaining Set statements}
968 RegexObj.Expression := '^ *SET +([A-Z]+)( +[A-Z0-9]+|) *(\' + Terminator + '|)';
969 if RegexObj.Exec(stmt) then
970 begin
971 command := AnsiUpperCase(RegexObj.Match[1]);
972 param := trim(RegexObj.Match[2]);
973 if command = 'GENERATOR' then
974 begin
975 Result := false;
976 Exit;
977 end;
978 if command = 'AUTODDL' then
979 AutoDDL := ((RegexObj.MatchLen[2] = 0) and not AutoDDL) or
980 (RegexObj.MatchLen[2] > 0) and Toggle(param)
981 else
982 if command = 'BAIL' then
983 StopOnFirstError := ((RegexObj.MatchLen[2] = 0) and not StopOnFirstError) or
984 (RegexObj.MatchLen[2] > 0) and Toggle(param)
985 else
986 if command = 'ECHO' then
987 Echo := ((RegexObj.MatchLen[2] = 0) and not Echo) or
988 (RegexObj.MatchLen[2] > 0) and Toggle(param)
989 else
990 if command = 'COUNT' then
991 ShowAffectedRows := ((RegexObj.MatchLen[2] = 0) and not ShowAffectedRows) or
992 (RegexObj.MatchLen[2] > 0) and Toggle(param)
993 else
994 if command = 'STATS' then
995 ShowPerformanceStats := ((RegexObj.MatchLen[2] = 0) and not FShowPerformanceStats) or
996 (RegexObj.MatchLen[2] > 0) and Toggle(param)
997 else
998 if command = 'NAMES' then
999 begin
1000 if Database.Attachment.CharSetName2CharSetID(param,charsetid) then
1001 begin
1002 DBConnected := Database.Connected;
1003 LoginPrompt := Database.LoginPrompt;
1004 Database.LoginPrompt := false;
1005 Database.Connected := false;
1006 Database.Params.Values['lc_ctype'] := param;
1007 Database.Connected := DBConnected;
1008 Database.LoginPrompt := LoginPrompt;
1009 end
1010 else
1011 raise Exception.CreateFmt(sInvalidCharacterSet, [param,stmt]);
1012 end
1013 else
1014 begin
1015 if assigned(DataOutputFormatter) then
1016 DataOutputFormatter.SetCommand(command,param,stmt,Result);
1017 if not Result then
1018 begin
1019 if assigned(OnSetStatement) then
1020 OnSetStatement(self,command,param,stmt,Result)
1021 else
1022 raise Exception.CreateFmt(sInvalidSetStatement, [command,stmt]);
1023 end;
1024 Exit;
1025 end;
1026 Result := true;
1027 Exit;
1028 end;
1029
1030 finally
1031 RegexObj.Free;
1032 end;
1033 end;
1034
1035 procedure TCustomIBXScript.SetTransaction(AValue: TIBTransaction);
1036 begin
1037 if FTransaction = AValue then Exit;
1038 FTransaction := AValue;
1039 end;
1040
1041 constructor TCustomIBXScript.Create(aOwner: TComponent);
1042 begin
1043 inherited Create(aOwner);
1044 FStopOnFirstError := true;
1045 FEcho := true;
1046 FAutoDDL := true;
1047 FISQL := TIBSQL.Create(self);
1048 FISQL.ParamCheck := true;
1049 FInternalTransaction := TIBTransaction.Create(self);
1050 FInternalTransaction.Params.Clear;
1051 FInternalTransaction.Params.Add('concurrency');
1052 FInternalTransaction.Params.Add('wait');
1053 end;
1054
1055 destructor TCustomIBXScript.Destroy;
1056 begin
1057 if FSQLReader <> nil then FSQLReader.Free;
1058 if FISQL <> nil then FISQL.Free;
1059 if FInternalTransaction <> nil then FInternalTransaction.Free;
1060 inherited Destroy;
1061 end;
1062
1063 procedure TCustomIBXScript.DefaultSelectSQLHandler(aSQLText: string);
1064 begin
1065 if assigned(DataOutputFormatter) then
1066 DataOutputFormatter.DataOut(aSQLText,@Add2Log)
1067 else
1068 FSQLReader.ShowError(sNoSelectSQL);
1069 end;
1070
1071 { TInteractiveSQLStatementReader }
1072
1073 function TInteractiveSQLStatementReader.GetErrorPrefix: string;
1074 begin
1075 Result := '';
1076 end;
1077
1078 function TInteractiveSQLStatementReader.GetNextLine(var Line: string): boolean;
1079 begin
1080 if FNextStatement then
1081 write(FPrompt)
1082 else
1083 write(FContinuePrompt);
1084 Result := not system.EOF;
1085 if Result then
1086 begin
1087 readln(Line);
1088 EchoNextLine(Line);
1089 end;
1090 end;
1091
1092 function TInteractiveSQLStatementReader.GetChar: char;
1093 begin
1094 if Terminated then
1095 Result := #0
1096 else
1097 if FLineIndex > Length(FLine) then
1098 begin
1099 Result := LF;
1100 FLineIndex := 0;
1101 end
1102 else
1103 if FLineIndex = 0 then
1104 begin
1105 if not GetNextLine(FLine) then
1106 Result := #0
1107 else
1108 if Length(FLine) = 0 then
1109 Result := LF
1110 else
1111 begin
1112 Result := FLine[1];
1113 FLineIndex := 2;
1114 end
1115 end
1116 else
1117 begin
1118 Result := FLine[FLineIndex];
1119 Inc(FLineIndex);
1120 end;
1121 end;
1122
1123 constructor TInteractiveSQLStatementReader.Create(aPrompt: string; aContinue: string);
1124 begin
1125 inherited Create;
1126 FPrompt := aPrompt;
1127 FLineIndex := 0;
1128 FNextStatement := true;
1129 FContinuePrompt := aContinue;
1130 end;
1131
1132 function TInteractiveSQLStatementReader.GetNextStatement(var stmt: string
1133 ): boolean;
1134 begin
1135 Result := inherited GetNextStatement(stmt);
1136 FNextStatement := Result;
1137 end;
1138
1139 { TBatchSQLStatementReader }
1140
1141 function TBatchSQLStatementReader.GetChar: char;
1142 begin
1143 if not EOF and assigned(FInStream) and not (FInStream.Position = FInStream.Size) then
1144 begin
1145 Result := char(FInStream.ReadByte);
1146 if Result = LF then
1147 begin
1148 EchoNextLine(FCurLine);
1149 FCurLine := '';
1150 if assigned(OnProgressEvent) then
1151 OnProgressEvent(self,false,FIndex+1);
1152 Inc(FLineIndex);
1153 FIndex := 1;
1154 end
1155 else
1156 if Result <> CR then
1157 begin
1158 FCurLine += Result;
1159 Inc(FIndex);
1160 end;
1161 end
1162 else
1163 Result := #0;
1164 end;
1165
1166 function TBatchSQLStatementReader.GetErrorPrefix: string;
1167 begin
1168 Result := Format(sOnLineError,[FLineIndex,FIndex]);
1169 end;
1170
1171 procedure TBatchSQLStatementReader.Reset;
1172 begin
1173 inherited Reset;
1174 if FOwnsInStream and assigned(FInStream) then
1175 FInStream.Free;
1176 FInStream := nil;
1177 FOwnsInStream := false;
1178 FLineIndex := 1;
1179 FIndex := 1;
1180 FCurLine := '';
1181 end;
1182
1183 procedure TBatchSQLStatementReader.SetStreamSource(Lines: TStrings);
1184 begin
1185 Reset;
1186 FInStream := TMemoryStream.Create;
1187 FOwnsInStream := true;
1188 Lines.SaveToStream(FInStream);
1189 FInStream.Position := 0;
1190 if assigned(OnProgressEvent) then
1191 OnProgressEvent(self,true,FInStream.Size);
1192 end;
1193
1194 procedure TBatchSQLStatementReader.SetStreamSource(S: TStream);
1195 begin
1196 Reset;
1197 FInStream := S;
1198 if assigned(OnProgressEvent) then
1199 OnProgressEvent(self,true,S.Size - S.Position);
1200 end;
1201
1202 procedure TBatchSQLStatementReader.SetStreamSource(FileName: string);
1203 begin
1204 Reset;
1205 FInStream := TFileStream.Create(FileName,fmShareCompat);
1206 FOwnsInStream := true;
1207 if assigned(OnProgressEvent) then
1208 OnProgressEvent(self,true,FInStream.Size);
1209 end;
1210
1211 procedure TBatchSQLStatementReader.SetStringStreamSource(S: string);
1212 begin
1213 Reset;
1214 FInStream := TStringStream.Create(S);
1215 FOwnsInStream := true;
1216 if assigned(OnProgressEvent) then
1217 OnProgressEvent(self,true,FInStream.Size);
1218 end;
1219
1220 end.
1221