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, 9 months ago) by tony
File size: 13051 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 procedure LogHandler(Sender: TObject; Msg: string);
61 procedure ErrorLogHandler(Sender: TObject; Msg: string);
62 procedure loginPrompt(Database: TIBDatabase; LoginParams: TStrings);
63 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 { TInteractiveSQLProcessor }
72
73 {This is a TCustomIBXScript descendent that uses the console for input/output.
74 It additionally supports QUIT/EXIT Commands. The log file can either be redirected
75 to the console or sent to a separate file.}
76
77 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
89 {$IFDEF UNIX}
90 function getpassword: string;
91 var oldattr, newattr: termios;
92 stdinStream: TIOStream;
93 c: char;
94 begin
95 Result := '';
96 stdinStream := TIOStream.Create(iosInput);
97 try
98 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 finally
114 stdinStream.Free;
115 end;
116 end;
117 {$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
141 { TInteractiveSQLProcessor }
142
143 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
154 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 begin
162 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 begin
169 TInteractiveSymbolStream(FSymbolStream).Terminated := true;
170 Result := true;
171 end;
172 finally
173 RegexObj.Free;
174 end;
175 end;
176 end;
177
178 constructor TInteractiveSQLProcessor.Create(aOwner: TComponent);
179 begin
180 inherited Create(aOwner);
181 FSymbolStream := TInteractiveSymbolStream.Create;
182 end;
183
184 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 procedure TFBSQL.DoRun;
214 var
215 ErrorMsg: String;
216 SQLFileName: string;
217 DoExtract: boolean;
218 OutputFileName: string;
219 i: integer;
220 ExtractTypes: TExtractTypes;
221 Opts,NonOpts: TStrings;
222 OutputFormat: string;
223 SQLStatement: string;
224 begin
225 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 // quick check parameters
230 Opts := TStringList.Create;
231 NonOpts := TStringList.Create;
232 try
233 ErrorMsg := CheckOptions('aAhbegu:i:o:p:r:s:t:',['help','user','pass','role'],Opts,NonOpts);
234 {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 (ParamCount = 1) or (ParamStr(ParamCount-1)[2] in ['!','A','h','b','e','g']))then
238 FIBDatabase.DatabaseName := ParamStr(ParamCount);
239 finally
240 Opts.Free;
241 NonOpts.Free;
242 end;
243 if ErrorMsg<>'' then begin
244 ShowException(Exception.Create(ErrorMsg));
245 Terminate;
246 Exit;
247 end;
248
249 // parse parameters
250 if HasOption('h','help') then
251 begin
252 WriteHelp;
253 Terminate;
254 Exit;
255 end;
256
257 SQLFileName := '';
258 OutputFileName := '';
259 DoExtract := false;
260 ExtractTypes := [];
261 FDataOutputFormatter := TIBBlockFormatOut;
262 SQLStatement := '';
263
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 if HasOption('a') then
275 begin
276 DoExtract := true;
277 end;
278
279 if HasOption('A') then
280 begin
281 DoExtract := true;
282 ExtractTypes := [etData];
283 end;
284
285 if not HasOption('b') then
286 begin
287 FIBXScript.StopOnFirstError := false;
288 FISQLProcessor.StopOnFirstError := false;
289 end;
290
291 if not HasOption('e') then
292 FIBXScript.Echo := false;
293
294 if HasOption('i') then
295 SQLFileName := GetOptionValue('i');
296
297 if HasOption('g')then
298 ExtractTypes += [etGrantsToUser];
299
300 if HasOption('o') then
301 begin
302 OutputFileName := GetOptionValue('o');
303 FISQLProcessor.UseLogFile := true;
304 end;
305
306 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 if HasOption('s') then
313 SQLStatement := GetOptionValue('s');
314
315 if HasOption('t') then
316 begin
317 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 end;
329
330 if HasOption('u','user') then
331 FIBDatabase.Params.Values['user_name'] := GetOptionValue('u','user');
332
333 {Validation}
334
335 FIBDatabase.LoginPrompt := (FIBDatabase.Params.IndexOfName('user_name') <> -1) and
336 (FIBDatabase.Params.Values['password'] = '');
337
338 if not DoExtract then
339 begin
340 if (SQLStatement <> '') and (SQLFileName <> '') then
341 raise Exception.Create('An SQL Script File and text cannot be simultaneously requested');
342
343 if (SQLStatement = '') and (SQLFileName <> '') and not FileExists(SQLFileName) then
344 raise Exception.CreateFmt('SQL File "%s" not found!',[SQLFileName]);
345
346 end;
347
348 if DoExtract and ((SQLFileName <> '') or (SQLStatement <> '')) then
349 raise Exception.Create('Extract and script execution cannot be simulateously requested');
350
351 {This is where it all happens}
352
353 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 try
361 if DoExtract then
362 begin
363 FExtract.ExtractObject(eoDatabase,'',ExtractTypes);
364 if FOutputFile <> nil then
365 FExtract.Items.SaveToStream(FOutputFile)
366 else
367 for i := 0 to FExtract.Items.Count - 1 do
368 writeln(FExtract.Items[i]);
369 end
370 else
371 if SQLFileName <> '' then
372 FIBXScript.RunScript(SQLFileName)
373 else
374 if SQLStatement <> '' then
375 FIBXScript.ExecSQLScript(SQLStatement)
376 else
377 FISQLProcessor.Run;
378 finally
379 FIBDatabase.Connected := false;
380 if FOutputFile <> nil then
381 FOutputFile.Free;
382 end;
383
384
385 // stop program loop
386 Terminate;
387 end;
388
389 procedure TFBSQL.ShowException(E: Exception);
390 begin
391 FExceptionTrapped := true;
392 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 FIBDatabase.OnLogin := @loginPrompt;
403 FIBDatabase.Params.Clear;
404 FIBDatabase.Params.Values['lc_ctype'] := 'UTF8';
405 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 FISQLProcessor := TInteractiveSQLProcessor.Create(self);
413 FISQLProcessor.Database := FIBDatabase;
414 FISQLProcessor.Transaction := FIBTransaction;
415 FISQLProcessor.OnOutputLog := @LogHandler;
416 FISQLProcessor.OnErrorLog := @ErrorLogHandler;
417 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 writeln(stderr,'-A write database metadata and table data to stdout');
432 writeln(stderr,'-b stop on first error');
433 writeln(stderr,'-e echo sql statements to stdout');
434 writeln(stderr,'-g include grants to normal users in database metadata');
435 writeln(stderr,'-i <filename> execute SQL script from file');
436 writeln(stderr,'-h show this information');
437 writeln(stderr,'-o <filename> output to this file instead of stdout');
438 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 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 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 if FExceptionTrapped then
459 Halt(1);
460 end.
461