ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/fbsql/fbsql.lpr
Revision: 263
Committed: Thu Dec 6 15:55:01 2018 UTC (5 years, 4 months ago) by tony
File size: 13189 byte(s)
Log Message:
Release 2.3.2 committed

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