ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/fbsql/fbsql.lpr
Revision: 47
Committed: Mon Jan 9 15:31:51 2017 UTC (7 years, 2 months ago) by tony
File size: 12881 byte(s)
Log Message:
Committing updates for Release R2-0-1

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 suported 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('aAhbeu: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']))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 DoExtract := true;
276
277 if HasOption('A') then
278 begin
279 DoExtract := true;
280 ExtractTypes := [etData];
281 end;
282
283 if not HasOption('b') then
284 begin
285 FIBXScript.StopOnFirstError := false;
286 FISQLProcessor.StopOnFirstError := false;
287 end;
288
289 if not HasOption('e') then
290 FIBXScript.Echo := false;
291
292 if HasOption('i') then
293 SQLFileName := GetOptionValue('i');
294
295 if HasOption('o') then
296 begin
297 OutputFileName := GetOptionValue('o');
298 FISQLProcessor.UseLogFile := true;
299 end;
300
301 if HasOption('p','pass') then
302 FIBDatabase.Params.Values['password'] := GetOptionValue('p','pass');
303
304 if HasOption('r','role') then
305 FIBDatabase.Params.Values['sql_role_name'] := GetOptionValue('r','role');
306
307 if HasOption('s') then
308 SQLStatement := GetOptionValue('s');
309
310 if HasOption('t') then
311 begin
312 OutputFormat := GetOptionValue('t');
313 if OutputFormat = 'CSV' then
314 FDataOutputFormatter := TIBCSVDataOut
315 else
316 if OutputFormat = 'INS' then
317 FDataOutputFormatter := TIBInsertStmtsOut
318 else
319 if OutputFormat = 'BLK' then
320 FDataOutputFormatter := TIBBlockFormatOut
321 else
322 raise Exception.CreateFmt('Unrecognised data output format "%s"',[OutputFormat]);
323 end;
324
325 if HasOption('u','user') then
326 FIBDatabase.Params.Values['user_name'] := GetOptionValue('u','user');
327
328 {Validation}
329
330 FIBDatabase.LoginPrompt := (FIBDatabase.Params.IndexOfName('user_name') <> -1) and
331 (FIBDatabase.Params.Values['password'] = '');
332
333 if not DoExtract then
334 begin
335 if (SQLStatement <> '') and (SQLFileName <> '') then
336 raise Exception.Create('An SQL Script File and text cannot be simultaneously requested');
337
338 if (SQLStatement = '') and (SQLFileName <> '') and not FileExists(SQLFileName) then
339 raise Exception.CreateFmt('SQL File "%s" not found!',[SQLFileName]);
340
341 end;
342
343 if DoExtract and ((SQLFileName <> '') or (SQLStatement <> '')) then
344 raise Exception.Create('Extract and script execution cannot be simulateously requested');
345
346 {This is where it all happens}
347
348 FIBXScript.DataOutputFormatter := FDataOutputFormatter.Create(self);
349 FISQLProcessor.DataOutputFormatter := FDataOutputFormatter.Create(self);
350
351 if OutputFileName <> '' then
352 FOutputFile := TFileStream.Create(OutputFileName,fmCreate);
353
354 FIBDatabase.Connected := FIBDatabase.DatabaseName <> '';
355 try
356 if DoExtract then
357 begin
358 FExtract.ExtractObject(eoDatabase,'',ExtractTypes);
359 if FOutputFile <> nil then
360 FExtract.Items.SaveToStream(FOutputFile)
361 else
362 for i := 0 to FExtract.Items.Count - 1 do
363 writeln(FExtract.Items[i]);
364 end
365 else
366 if SQLFileName <> '' then
367 FIBXScript.RunScript(SQLFileName)
368 else
369 if SQLStatement <> '' then
370 FIBXScript.ExecSQLScript(SQLStatement)
371 else
372 FISQLProcessor.Run;
373 finally
374 FIBDatabase.Connected := false;
375 if FOutputFile <> nil then
376 FOutputFile.Free;
377 end;
378
379
380 // stop program loop
381 Terminate;
382 end;
383
384 procedure TFBSQL.ShowException(E: Exception);
385 begin
386 FExceptionTrapped := true;
387 writeln(stderr,'Error: ' + E.Message);
388 end;
389
390 constructor TFBSQL.Create(TheOwner: TComponent);
391 begin
392 inherited Create(TheOwner);
393 StopOnException:=True;
394
395 { Create Components }
396 FIBDatabase := TIBDatabase.Create(self);
397 FIBDatabase.OnLogin := @loginPrompt;
398 FIBDatabase.Params.Clear;
399 FIBDatabase.Params.Values['lc_ctype'] := 'UTF8';
400 FIBTransaction := TIBTransaction.Create(self);
401 FIBTransaction.DefaultDatabase := FIBDatabase;
402 FIBXScript := TIBXScript.Create(self);
403 FIBXScript.Database := FIBDatabase;
404 FIBXScript.Transaction := FIBTransaction;
405 FIBXScript.OnOutputLog := @LogHandler;
406 FIBXScript.OnErrorLog := @ErrorLogHandler;
407 FISQLProcessor := TInteractiveSQLProcessor.Create(self);
408 FISQLProcessor.Database := FIBDatabase;
409 FISQLProcessor.Transaction := FIBTransaction;
410 FISQLProcessor.OnOutputLog := @LogHandler;
411 FISQLProcessor.OnErrorLog := @ErrorLogHandler;
412 FExtract := TIBExtract.Create(self);
413 FExtract.Database := FIBDatabase;
414 FExtract.Transaction := FIBTransaction;
415
416 FIBTransaction.Params.Add('concurrency');
417 FIBTransaction.Params.Add('wait');
418
419 end;
420
421 procedure TFBSQL.WriteHelp;
422 begin
423 writeln(stderr,'Usage: ',ExtractFileName(ExeName),' <options> <database name>');
424 writeln(stderr,'Options:');
425 writeln(stderr,'-a write database metadata to stdout');
426 writeln(stderr,'-A write database metadata and table data to stdout');
427 writeln(stderr,'-b stop on first error');
428 writeln(stderr,'-e echo sql statements to stdout');
429 writeln(stderr,'-i <filename> execute SQL script from file');
430 writeln(stderr,'-h show this information');
431 writeln(stderr,'-o <filename> output to this file instead of stdout');
432 writeln(stderr,'-p <password> provide password on command line (insecure)');
433 writeln(stderr,'-r <rolename> open database with this rolename');
434 writeln(stderr,'-s <sql> Execute SQL text');
435 writeln(stderr,'-t specify output format for SQL Statements');
436 writeln(stderr,' BLK (default) for block format');
437 writeln(stderr,' CSV (default) for CSV format');
438 writeln(stderr,' INS (default) for Insert Statement format');
439 writeln(stderr,'-u <username> open database with this username (defaults to SYSDBA)');
440 writeln;
441 writeln(stderr,'Environment Variables:');
442 writeln(stderr,'ISC_USER Login user Name');
443 writeln(stderr,'ISC_PASSWORD Login password');
444 end;
445
446 var
447 Application: TFBSQL;
448 begin
449 Application:=TFBSQL.Create(nil);
450 Application.Run;
451 Application.Free;
452 if FExceptionTrapped then
453 Halt(1);
454 end.
455