ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/fbsql/fbsql.lpr
Revision: 229
Committed: Tue Apr 10 13:32:36 2018 UTC (6 years ago) by tony
File size: 13145 byte(s)
Log Message:
Fixes Merged

File Contents

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