ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/fbsql/fbsql.lpr
Revision: 143
Committed: Fri Feb 23 12:11:21 2018 UTC (6 years, 2 months ago) by tony
File size: 13051 byte(s)
Log Message:
Fixes Merged

File Contents

# User Rev Content
1 tony 37 (*
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 Tony Whyman, MWA Software
19     * (http://www.mwasoftware.co.uk).
20     *
21     * All Rights Reserved.
22     *
23     * Contributor(s): ______________________________________.
24     *
25     *)
26     program fbsql;
27    
28     {$mode objfpc}{$H+}
29    
30     uses
31     {$IFDEF UNIX}{$IFDEF UseCThreads}
32     cthreads,
33     {$ENDIF}{$ENDIF}
34 tony 47 {$IFDEF WINDOWS} Windows, {$ENDIF}
35 tony 37 Classes, SysUtils, CustApp
36     { you can add units after this }
37 tony 47 ,IBDatabase, ibxscript, IBExtract, DB, IBVersion,
38     IBDataOutput, RegExpr
39     {$IFDEF UNIX} ,TermIO, IOStream {$ENDIF}
40 tony 37
41 tony 47 ;
42 tony 37
43 tony 47 const
44     FExceptionTrapped: boolean = false;
45 tony 37
46     type
47 tony 47 TInteractiveSQLProcessor = class;
48 tony 37
49     { TFBSQL }
50    
51     TFBSQL = class(TCustomApplication)
52     private
53     FIBDatabase: TIBDatabase;
54     FIBTransaction: TIBTransaction;
55     FIBXScript: TIBXScript;
56 tony 47 FISQLProcessor: TInteractiveSQLProcessor;
57 tony 37 FExtract: TIBExtract;
58 tony 47 FOutputFile: TStream;
59     FDataOutputFormatter: TDataOutputFormatter;
60 tony 37 procedure LogHandler(Sender: TObject; Msg: string);
61     procedure ErrorLogHandler(Sender: TObject; Msg: string);
62 tony 47 procedure loginPrompt(Database: TIBDatabase; LoginParams: TStrings);
63 tony 37 protected
64     procedure DoRun; override;
65     procedure ShowException(E: Exception); override;
66     public
67     constructor Create(TheOwner: TComponent); override;
68     procedure WriteHelp; virtual;
69     end;
70    
71 tony 47 { TInteractiveSQLProcessor }
72 tony 37
73 tony 47 {This is a TCustomIBXScript descendent that uses the console for input/output.
74 tony 102 It additionally supports QUIT/EXIT Commands. The log file can either be redirected
75 tony 47 to the console or sent to a separate file.}
76 tony 37
77 tony 47 TInteractiveSQLProcessor = class(TCustomIBXScript)
78     private
79     FUseLogFile: boolean;
80     protected
81     procedure Add2Log(const Msg: string; IsError: boolean=true); override;
82     function ProcessStatement(stmt: string): boolean; override;
83     public
84     constructor Create(aOwner: TComponent); override;
85     procedure Run;
86     property UseLogFile: boolean read FUseLogFile write FUseLogFile;
87     end;
88 tony 37
89 tony 47 {$IFDEF UNIX}
90     function getpassword: string;
91     var oldattr, newattr: termios;
92     stdinStream: TIOStream;
93     c: char;
94 tony 37 begin
95 tony 47 Result := '';
96     stdinStream := TIOStream.Create(iosInput);
97 tony 37 try
98 tony 47 TCGetAttr(stdinStream.Handle, oldattr);
99     newattr := oldattr;
100     newattr.c_lflag := newattr.c_lflag and not (ICANON or ECHO);
101     TCSetAttr( stdinStream.Handle, TCSANOW, newattr );
102     try
103     repeat
104     read(c);
105     if c = #10 then break;
106     write('*');
107     Result += c;
108     until false;
109     writeln;
110     finally
111     TCSetAttr( stdinStream.Handle, TCSANOW, oldattr );
112     end;
113 tony 37 finally
114 tony 47 stdinStream.Free;
115 tony 37 end;
116     end;
117 tony 47 {$ENDIF}
118     {$IFDEF WINDOWS}
119     function getpassword: string;
120     var oldmode, newmode: DWORD;
121     c: char;
122     begin
123     Result := '';
124     GetConsoleMode(GetStdHandle(STD_INPUT_HANDLE), oldmode);
125     newmode := oldmode - ENABLE_ECHO_INPUT - ENABLE_LINE_INPUT;
126     SetConsoleMode(GetStdHandle(STD_INPUT_HANDLE),newmode);
127     try
128     repeat
129     read(c);
130     if c = #13 then break;
131     write('*');
132     Result += c;
133     until false;
134     writeln;
135     finally
136     SetConsoleMode(GetStdHandle(STD_INPUT_HANDLE),oldmode);
137     end
138     end;
139     {$ENDIF}
140 tony 37
141 tony 47 { TInteractiveSQLProcessor }
142 tony 37
143 tony 47 procedure TInteractiveSQLProcessor.Add2Log(const Msg: string; IsError: boolean);
144     begin
145     if UseLogFile then
146     inherited Add2Log(Msg,IsError)
147     else
148     if IsError then
149     writeln(stderr,msg)
150     else
151     writeln(msg);
152     end;
153 tony 37
154 tony 47 function TInteractiveSQLProcessor.ProcessStatement(stmt: string): boolean;
155     var RegexObj: TRegExpr;
156     Terminator: char;
157     ucStmt: string;
158     begin
159     Result := inherited ProcessStatement(stmt);
160     if not Result then
161 tony 37 begin
162 tony 47 Terminator := FSymbolStream.Terminator;
163     ucStmt := AnsiUpperCase(stmt);
164     RegexObj := TRegExpr.Create;
165     try
166     RegexObj.Expression := '^ *(QUIT|EXIT) *(\' + Terminator + '|)';
167     if RegexObj.Exec(ucStmt) then
168 tony 37 begin
169 tony 47 TInteractiveSymbolStream(FSymbolStream).Terminated := true;
170     Result := true;
171 tony 37 end;
172 tony 47 finally
173     RegexObj.Free;
174 tony 37 end;
175     end;
176 tony 47 end;
177    
178     constructor TInteractiveSQLProcessor.Create(aOwner: TComponent);
179 tony 37 begin
180 tony 47 inherited Create(aOwner);
181     FSymbolStream := TInteractiveSymbolStream.Create;
182 tony 37 end;
183    
184 tony 47 procedure TInteractiveSQLProcessor.Run;
185     begin
186     ProcessStream;
187     end;
188    
189     { TFBSQL }
190    
191     procedure TFBSQL.LogHandler(Sender: TObject; Msg: string);
192     begin
193     if FOutputFile <> nil then
194     FOutputFile.WriteAnsiString(Msg + LineEnding)
195     else
196     writeln( Msg);
197     end;
198    
199     procedure TFBSQL.ErrorLogHandler(Sender: TObject; Msg: string);
200     begin
201     writeln(stderr, Msg);
202     end;
203    
204     procedure TFBSQL.loginPrompt(Database: TIBDatabase; LoginParams: TStrings);
205     var password: string;
206     begin
207     write(LoginParams.Values['user_name'] + '''s Password:');
208     password := getpassword;
209     if password <> '' then
210     LoginParams.Values['password'] := password;
211     end;
212    
213 tony 37 procedure TFBSQL.DoRun;
214     var
215     ErrorMsg: String;
216     SQLFileName: string;
217     DoExtract: boolean;
218 tony 47 OutputFileName: string;
219 tony 37 i: integer;
220 tony 47 ExtractTypes: TExtractTypes;
221     Opts,NonOpts: TStrings;
222     OutputFormat: string;
223     SQLStatement: string;
224 tony 37 begin
225 tony 47 writeln(stderr,'fbsql: an SQL interpreter for Firebird');
226     writeln(stderr,'Built using IBX ' + IBX_VERSION);
227     writeln(stderr,'Copyright (c) MWA Software 2017');
228    
229 tony 37 // quick check parameters
230 tony 47 Opts := TStringList.Create;
231     NonOpts := TStringList.Create;
232     try
233 tony 143 ErrorMsg := CheckOptions('aAhbegu:i:o:p:r:s:t:',['help','user','pass','role'],Opts,NonOpts);
234 tony 47 {Database name is last parameter if given and not an option}
235     if (NonOpts.Count > 0) and ((Opts.Count = 0) or
236     ((Opts.ValueFromIndex[Opts.Count-1] <> NonOpts[NonOpts.Count-1])) or
237 tony 143 (ParamCount = 1) or (ParamStr(ParamCount-1)[2] in ['!','A','h','b','e','g']))then
238 tony 47 FIBDatabase.DatabaseName := ParamStr(ParamCount);
239     finally
240     Opts.Free;
241     NonOpts.Free;
242     end;
243 tony 37 if ErrorMsg<>'' then begin
244     ShowException(Exception.Create(ErrorMsg));
245     Terminate;
246     Exit;
247     end;
248    
249     // parse parameters
250 tony 47 if HasOption('h','help') then
251 tony 37 begin
252     WriteHelp;
253     Terminate;
254     Exit;
255     end;
256    
257     SQLFileName := '';
258 tony 47 OutputFileName := '';
259 tony 37 DoExtract := false;
260 tony 47 ExtractTypes := [];
261     FDataOutputFormatter := TIBBlockFormatOut;
262     SQLStatement := '';
263 tony 37
264     {Initialise user_name and password from environment if available}
265    
266     if GetEnvironmentVariable('ISC_USER') <> '' then
267     FIBDatabase.Params.Add('user_name=' + GetEnvironmentVariable('ISC_USER'));
268    
269     if GetEnvironmentVariable('ISC_PASSWORD') <> '' then
270     FIBDatabase.Params.Add('password=' + GetEnvironmentVariable('ISC_PASSWORD'));
271    
272     {Process Command line options}
273    
274 tony 47 if HasOption('a') then
275 tony 143 begin
276 tony 47 DoExtract := true;
277 tony 143 end;
278 tony 37
279 tony 47 if HasOption('A') then
280     begin
281     DoExtract := true;
282     ExtractTypes := [etData];
283     end;
284 tony 37
285     if not HasOption('b') then
286 tony 47 begin
287 tony 37 FIBXScript.StopOnFirstError := false;
288 tony 47 FISQLProcessor.StopOnFirstError := false;
289     end;
290 tony 37
291     if not HasOption('e') then
292     FIBXScript.Echo := false;
293    
294 tony 47 if HasOption('i') then
295     SQLFileName := GetOptionValue('i');
296 tony 37
297 tony 143 if HasOption('g')then
298     ExtractTypes += [etGrantsToUser];
299    
300 tony 47 if HasOption('o') then
301     begin
302     OutputFileName := GetOptionValue('o');
303     FISQLProcessor.UseLogFile := true;
304     end;
305 tony 37
306 tony 47 if HasOption('p','pass') then
307     FIBDatabase.Params.Values['password'] := GetOptionValue('p','pass');
308    
309     if HasOption('r','role') then
310     FIBDatabase.Params.Values['sql_role_name'] := GetOptionValue('r','role');
311    
312 tony 37 if HasOption('s') then
313 tony 47 SQLStatement := GetOptionValue('s');
314    
315     if HasOption('t') then
316 tony 37 begin
317 tony 47 OutputFormat := GetOptionValue('t');
318     if OutputFormat = 'CSV' then
319     FDataOutputFormatter := TIBCSVDataOut
320     else
321     if OutputFormat = 'INS' then
322     FDataOutputFormatter := TIBInsertStmtsOut
323     else
324     if OutputFormat = 'BLK' then
325     FDataOutputFormatter := TIBBlockFormatOut
326     else
327     raise Exception.CreateFmt('Unrecognised data output format "%s"',[OutputFormat]);
328 tony 37 end;
329    
330 tony 47 if HasOption('u','user') then
331     FIBDatabase.Params.Values['user_name'] := GetOptionValue('u','user');
332    
333 tony 37 {Validation}
334    
335 tony 47 FIBDatabase.LoginPrompt := (FIBDatabase.Params.IndexOfName('user_name') <> -1) and
336     (FIBDatabase.Params.Values['password'] = '');
337    
338 tony 37 if not DoExtract then
339     begin
340 tony 47 if (SQLStatement <> '') and (SQLFileName <> '') then
341     raise Exception.Create('An SQL Script File and text cannot be simultaneously requested');
342 tony 37
343 tony 47 if (SQLStatement = '') and (SQLFileName <> '') and not FileExists(SQLFileName) then
344 tony 37 raise Exception.CreateFmt('SQL File "%s" not found!',[SQLFileName]);
345    
346     end;
347    
348 tony 47 if DoExtract and ((SQLFileName <> '') or (SQLStatement <> '')) then
349 tony 37 raise Exception.Create('Extract and script execution cannot be simulateously requested');
350    
351     {This is where it all happens}
352    
353 tony 47 FIBXScript.DataOutputFormatter := FDataOutputFormatter.Create(self);
354     FISQLProcessor.DataOutputFormatter := FDataOutputFormatter.Create(self);
355    
356     if OutputFileName <> '' then
357     FOutputFile := TFileStream.Create(OutputFileName,fmCreate);
358    
359     FIBDatabase.Connected := FIBDatabase.DatabaseName <> '';
360 tony 37 try
361     if DoExtract then
362     begin
363 tony 47 FExtract.ExtractObject(eoDatabase,'',ExtractTypes);
364     if FOutputFile <> nil then
365     FExtract.Items.SaveToStream(FOutputFile)
366     else
367 tony 37 for i := 0 to FExtract.Items.Count - 1 do
368     writeln(FExtract.Items[i]);
369     end
370     else
371 tony 47 if SQLFileName <> '' then
372     FIBXScript.RunScript(SQLFileName)
373 tony 37 else
374 tony 47 if SQLStatement <> '' then
375     FIBXScript.ExecSQLScript(SQLStatement)
376     else
377     FISQLProcessor.Run;
378 tony 37 finally
379     FIBDatabase.Connected := false;
380 tony 47 if FOutputFile <> nil then
381     FOutputFile.Free;
382 tony 37 end;
383    
384    
385     // stop program loop
386     Terminate;
387     end;
388    
389     procedure TFBSQL.ShowException(E: Exception);
390     begin
391 tony 47 FExceptionTrapped := true;
392 tony 37 writeln(stderr,'Error: ' + E.Message);
393     end;
394    
395     constructor TFBSQL.Create(TheOwner: TComponent);
396     begin
397     inherited Create(TheOwner);
398     StopOnException:=True;
399    
400     { Create Components }
401     FIBDatabase := TIBDatabase.Create(self);
402 tony 47 FIBDatabase.OnLogin := @loginPrompt;
403     FIBDatabase.Params.Clear;
404     FIBDatabase.Params.Values['lc_ctype'] := 'UTF8';
405 tony 37 FIBTransaction := TIBTransaction.Create(self);
406     FIBTransaction.DefaultDatabase := FIBDatabase;
407     FIBXScript := TIBXScript.Create(self);
408     FIBXScript.Database := FIBDatabase;
409     FIBXScript.Transaction := FIBTransaction;
410     FIBXScript.OnOutputLog := @LogHandler;
411     FIBXScript.OnErrorLog := @ErrorLogHandler;
412 tony 47 FISQLProcessor := TInteractiveSQLProcessor.Create(self);
413     FISQLProcessor.Database := FIBDatabase;
414     FISQLProcessor.Transaction := FIBTransaction;
415     FISQLProcessor.OnOutputLog := @LogHandler;
416     FISQLProcessor.OnErrorLog := @ErrorLogHandler;
417 tony 37 FExtract := TIBExtract.Create(self);
418     FExtract.Database := FIBDatabase;
419     FExtract.Transaction := FIBTransaction;
420    
421     FIBTransaction.Params.Add('concurrency');
422     FIBTransaction.Params.Add('wait');
423    
424     end;
425    
426     procedure TFBSQL.WriteHelp;
427     begin
428     writeln(stderr,'Usage: ',ExtractFileName(ExeName),' <options> <database name>');
429     writeln(stderr,'Options:');
430     writeln(stderr,'-a write database metadata to stdout');
431 tony 47 writeln(stderr,'-A write database metadata and table data to stdout');
432 tony 37 writeln(stderr,'-b stop on first error');
433     writeln(stderr,'-e echo sql statements to stdout');
434 tony 143 writeln(stderr,'-g include grants to normal users in database metadata');
435 tony 47 writeln(stderr,'-i <filename> execute SQL script from file');
436 tony 37 writeln(stderr,'-h show this information');
437 tony 47 writeln(stderr,'-o <filename> output to this file instead of stdout');
438 tony 37 writeln(stderr,'-p <password> provide password on command line (insecure)');
439     writeln(stderr,'-r <rolename> open database with this rolename');
440     writeln(stderr,'-s <sql> Execute SQL text');
441 tony 47 writeln(stderr,'-t specify output format for SQL Statements');
442     writeln(stderr,' BLK (default) for block format');
443     writeln(stderr,' CSV (default) for CSV format');
444     writeln(stderr,' INS (default) for Insert Statement format');
445 tony 37 writeln(stderr,'-u <username> open database with this username (defaults to SYSDBA)');
446     writeln;
447     writeln(stderr,'Environment Variables:');
448     writeln(stderr,'ISC_USER Login user Name');
449     writeln(stderr,'ISC_PASSWORD Login password');
450     end;
451    
452     var
453     Application: TFBSQL;
454     begin
455     Application:=TFBSQL.Create(nil);
456     Application.Run;
457     Application.Free;
458 tony 47 if FExceptionTrapped then
459     Halt(1);
460 tony 37 end.
461