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, 3 months ago) by tony
File size: 12881 byte(s)
Log Message:
Committing updates for Release R2-0-1

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     It additionally suported QUIT/EXIT Commands. The log file can either be redirected
75     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     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 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     DoExtract := true;
276 tony 37
277 tony 47 if HasOption('A') then
278     begin
279     DoExtract := true;
280     ExtractTypes := [etData];
281     end;
282 tony 37
283     if not HasOption('b') then
284 tony 47 begin
285 tony 37 FIBXScript.StopOnFirstError := false;
286 tony 47 FISQLProcessor.StopOnFirstError := false;
287     end;
288 tony 37
289     if not HasOption('e') then
290     FIBXScript.Echo := false;
291    
292 tony 47 if HasOption('i') then
293     SQLFileName := GetOptionValue('i');
294 tony 37
295 tony 47 if HasOption('o') then
296     begin
297     OutputFileName := GetOptionValue('o');
298     FISQLProcessor.UseLogFile := true;
299     end;
300 tony 37
301 tony 47 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 tony 37 if HasOption('s') then
308 tony 47 SQLStatement := GetOptionValue('s');
309    
310     if HasOption('t') then
311 tony 37 begin
312 tony 47 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 tony 37 end;
324    
325 tony 47 if HasOption('u','user') then
326     FIBDatabase.Params.Values['user_name'] := GetOptionValue('u','user');
327    
328 tony 37 {Validation}
329    
330 tony 47 FIBDatabase.LoginPrompt := (FIBDatabase.Params.IndexOfName('user_name') <> -1) and
331     (FIBDatabase.Params.Values['password'] = '');
332    
333 tony 37 if not DoExtract then
334     begin
335 tony 47 if (SQLStatement <> '') and (SQLFileName <> '') then
336     raise Exception.Create('An SQL Script File and text cannot be simultaneously requested');
337 tony 37
338 tony 47 if (SQLStatement = '') and (SQLFileName <> '') and not FileExists(SQLFileName) then
339 tony 37 raise Exception.CreateFmt('SQL File "%s" not found!',[SQLFileName]);
340    
341     end;
342    
343 tony 47 if DoExtract and ((SQLFileName <> '') or (SQLStatement <> '')) then
344 tony 37 raise Exception.Create('Extract and script execution cannot be simulateously requested');
345    
346     {This is where it all happens}
347    
348 tony 47 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 tony 37 try
356     if DoExtract then
357     begin
358 tony 47 FExtract.ExtractObject(eoDatabase,'',ExtractTypes);
359     if FOutputFile <> nil then
360     FExtract.Items.SaveToStream(FOutputFile)
361     else
362 tony 37 for i := 0 to FExtract.Items.Count - 1 do
363     writeln(FExtract.Items[i]);
364     end
365     else
366 tony 47 if SQLFileName <> '' then
367     FIBXScript.RunScript(SQLFileName)
368 tony 37 else
369 tony 47 if SQLStatement <> '' then
370     FIBXScript.ExecSQLScript(SQLStatement)
371     else
372     FISQLProcessor.Run;
373 tony 37 finally
374     FIBDatabase.Connected := false;
375 tony 47 if FOutputFile <> nil then
376     FOutputFile.Free;
377 tony 37 end;
378    
379    
380     // stop program loop
381     Terminate;
382     end;
383    
384     procedure TFBSQL.ShowException(E: Exception);
385     begin
386 tony 47 FExceptionTrapped := true;
387 tony 37 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 tony 47 FIBDatabase.OnLogin := @loginPrompt;
398     FIBDatabase.Params.Clear;
399     FIBDatabase.Params.Values['lc_ctype'] := 'UTF8';
400 tony 37 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 tony 47 FISQLProcessor := TInteractiveSQLProcessor.Create(self);
408     FISQLProcessor.Database := FIBDatabase;
409     FISQLProcessor.Transaction := FIBTransaction;
410     FISQLProcessor.OnOutputLog := @LogHandler;
411     FISQLProcessor.OnErrorLog := @ErrorLogHandler;
412 tony 37 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 tony 47 writeln(stderr,'-A write database metadata and table data to stdout');
427 tony 37 writeln(stderr,'-b stop on first error');
428     writeln(stderr,'-e echo sql statements to stdout');
429 tony 47 writeln(stderr,'-i <filename> execute SQL script from file');
430 tony 37 writeln(stderr,'-h show this information');
431 tony 47 writeln(stderr,'-o <filename> output to this file instead of stdout');
432 tony 37 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 tony 47 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 tony 37 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 tony 47 if FExceptionTrapped then
453     Halt(1);
454 tony 37 end.
455