ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/fbsql/fbsql.lpr
(Generate patch)

Comparing ibx/trunk/examples/fbsql/fbsql.lpr (file contents):
Revision 46 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 47 by tony, Mon Jan 9 15:31:51 2017 UTC

# Line 31 | Line 31 | 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, IBQuery, DB;
37 >  ,IBDatabase, ibxscript, IBExtract, DB, IBVersion,
38 >  IBDataOutput, RegExpr
39 >  {$IFDEF UNIX} ,TermIO, IOStream {$ENDIF}
40  
41 < resourcestring
41 >  ;
42  
43 <  sUnknownField = 'Unknown Field Type';
44 <  sBadGraphic   = 'Unable to generate CSV data for a Graphic Field';
42 <  sBadParadox   = 'Unable to generate CSV data for a Paradox OLE Field';
43 <  sBadDBase     = 'Unable to generate CSV data  for a DBase OLE Field';
44 <  sBadBinary    = 'Unable to generate CSV data  for a Binary Field';
45 <  sBadCursor    = 'Unable to generate CSV data  for a Cursor Field';
43 > const
44 >  FExceptionTrapped: boolean = false;
45  
46   type
47 +  TInteractiveSQLProcessor = class;
48  
49    { TFBSQL }
50  
# Line 53 | Line 53 | type
53      FIBDatabase: TIBDatabase;
54      FIBTransaction: TIBTransaction;
55      FIBXScript: TIBXScript;
56 +    FISQLProcessor: TInteractiveSQLProcessor;
57      FExtract: TIBExtract;
58 <    FQuery: TIBQuery;
59 <    FSQL: TStringStream;
58 >    FOutputFile: TStream;
59 >    FDataOutputFormatter: TDataOutputFormatter;
60      procedure LogHandler(Sender: TObject; Msg: string);
61      procedure ErrorLogHandler(Sender: TObject; Msg: string);
62 <    procedure HandleSelectSQL(Sender: TObject; SQLText: string);
62 <    procedure WriteCSV;
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    destructor Destroy; override;
68      procedure WriteHelp; virtual;
69    end;
70  
71 < { TFBSQL }
71 >  { TInteractiveSQLProcessor }
72  
73 < procedure TFBSQL.LogHandler(Sender: TObject; Msg: string);
74 < begin
75 <  writeln( Msg);
77 < end;
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 < procedure TFBSQL.ErrorLogHandler(Sender: TObject; Msg: string);
78 < begin
79 <  writeln(stderr, Msg);
80 < end;
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 < procedure TFBSQL.HandleSelectSQL(Sender: TObject; SQLText: string);
89 > {$IFDEF UNIX}
90 > function getpassword: string;
91 > var oldattr, newattr: termios;
92 >    stdinStream: TIOStream;
93 >    c: char;
94   begin
95 <  FQuery.SQL.Text := SQLText;
96 <  FQuery.Active := true;
95 >  Result := '';
96 >  stdinStream := TIOStream.Create(iosInput);
97    try
98 <    WriteCSV;
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 <    FQuery.Active := false;
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 < procedure TFBSQL.WriteCSV;
96 <
97 <  procedure WriteQuotedText(Text: string);
98 <  var Index: integer;
99 <  begin
100 <    Index := 1;
101 <    while Index <= Length(Text) do
102 <      if Text[Index] = '"' then
103 <      begin
104 <        Insert('"',Text,Index);
105 <        Inc(Index,2)
106 <      end
107 <      else
108 <        Inc(Index,1);
109 <    write('"' + Text + '"')
110 <  end;
141 > { TInteractiveSQLProcessor }
142  
143 <  procedure WriteFieldList(Fields: TFields);
144 <  var I: integer;
145 <  begin
146 <    for I := 0 to Fields.Count - 1 do
147 <    begin
148 <      if I > 0 then write(',');
149 <      write(Fields[I].FieldName)
150 <    end;
151 <    writeln;
152 <  end;
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 <  procedure WriteRecord;
155 <  var I: integer;
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 <    with FQuery do
163 <    begin
164 <      for I := 0 to FieldCount - 1 do
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 <        if I <> 0 then write(',');
170 <        case Fields[I].DataType of
132 <        ftUnknown:  raise Exception.Create(sUnknownField);
133 <        ftString:   WriteQuotedText(Fields[I].AsString);
134 <        ftSmallint,
135 <        ftInteger,
136 <        ftWord,
137 <        ftLargeInt,
138 <        ftBoolean:  write(Fields[I].DisplayText);
139 <        ftFloat,
140 <        ftCurrency,
141 <        ftFmtBCD,
142 <        ftBCD:      write(Fields[I].AsString);
143 <        ftDate,
144 <        ftTime:     write(DateTimeToStr(Fields[I].AsDateTime));
145 <        ftDateTime: WriteQuotedText(Fields[I].AsString);
146 <        ftBytes,
147 <        ftVarBytes,
148 <        ftBlob,
149 <        ftAutoInc:  write(Fields[I].AsString);
150 <        ftMemo:     WriteQuotedText(Fields[I].AsString);
151 <        ftGraphic:  raise Exception.Create(sBadGraphic);
152 <        ftFmtMemo:  WriteQuotedText(Fields[I].AsString);
153 <        ftParadoxOle: raise Exception.Create(sBadParadox);
154 <        ftDBaseOle:   raise Exception.Create(sBadDBase);
155 <        ftTypedBinary:raise Exception.Create(sBadBinary);
156 <        ftCursor:    raise Exception.Create(sBadCursor);
157 <       end
169 >         TInteractiveSymbolStream(FSymbolStream).Terminated := true;
170 >         Result := true;
171        end;
172 <      writeln;
172 >    finally
173 >      RegexObj.Free;
174      end;
175    end;
176 + end;
177 +
178 + constructor TInteractiveSQLProcessor.Create(aOwner: TComponent);
179   begin
180 <  with FQuery do
181 <  begin
182 <    WriteFieldList(Fields);
183 <    First;
184 <    while not EOF do
185 <    begin
186 <      WriteRecord;
187 <      Next
188 <    end;
189 <  end
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;
# Line 177 | Line 215 | 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: a non-interactive SQL interpreter for Firebird');
226 <  writeln(stderr,'Copyright (c) MWA Software 2016');
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 <  ErrorMsg:=CheckOptions('ahbeufprs',['help','user','pass','role']);
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;
# Line 190 | Line 247 | begin
247    end;
248  
249    // parse parameters
250 <  if HasOption('h','help') or (ParamCount = 0) then
250 >  if HasOption('h','help') then
251    begin
252      WriteHelp;
253      Terminate;
# Line 198 | Line 255 | begin
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  
# Line 210 | Line 271 | begin
271  
272    {Process Command line options}
273  
274 <  if HasOption('u','user') then
275 <    FIBDatabase.Params.Add('user_name=' + GetOptionValue('u','user'));
215 <
216 <  if HasOption('p','pass') then
217 <    FIBDatabase.Params.Add('password=' + GetOptionValue('p','pass'));
218 <
219 <  if HasOption('r','role') then
220 <    FIBDatabase.Params.Add('sql_role_name=' + GetOptionValue('r','role'));
274 >  if HasOption('a') then
275 >    DoExtract := true;
276  
277 <  if (ParamCount >= 1) and (ParamStr(ParamCount)[1] <> '-')  then
278 <    FIBDatabase.DatabaseName := ParamStr(ParamCount)
279 <  else
280 <    raise Exception.Create('Database Name Missing');
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('a') then
293 <    DoExtract := true;
292 >  if HasOption('i') then
293 >    SQLFileName := GetOptionValue('i');
294  
295 <  if HasOption('f') then
296 <    SQLFileName := GetOptionValue('f');
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 <    FSQL.WriteString(GetOptionValue('s'));
313 <    FSQL.Position := 0;
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 (SQLFileName = '') and (FSQL.DataString = '') then
336 <      raise Exception.Create('An SQL File must be provided');
251 <
252 <    if (FSQL.DataString <> '') and (SQLFileName <> '') then
253 <       raise Exception.Create('An SQL Script File and text cannot be simulateously requested');
335 >    if (SQLStatement <> '') and (SQLFileName <> '') then
336 >       raise Exception.Create('An SQL Script File and text cannot be simultaneously requested');
337  
338 <    if (FSQL.DataString = '') and not FileExists(SQLFileName) then
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 (FSQL.DataString <> '')) then
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 <  FIBDatabase.Connected := true;
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);
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 FSQL.DataString = '' then
367 <      FIBXScript.PerformUpdate(SQLFileName,true)
366 >    if SQLFileName <> '' then
367 >      FIBXScript.RunScript(SQLFileName)
368 >    else
369 >    if SQLStatement <> '' then
370 >      FIBXScript.ExecSQLScript(SQLStatement)
371      else
372 <      FIBXScript.PerformUpdate(FSQL,true);
372 >      FISQLProcessor.Run;
373    finally
374      FIBDatabase.Connected := false;
375 +    if FOutputFile <> nil then
376 +      FOutputFile.Free;
377    end;
378  
379  
# Line 286 | Line 383 | end;
383  
384   procedure TFBSQL.ShowException(E: Exception);
385   begin
386 +  FExceptionTrapped := true;
387    writeln(stderr,'Error: ' + E.Message);
388   end;
389  
# Line 293 | Line 391 | constructor TFBSQL.Create(TheOwner: TCom
391   begin
392    inherited Create(TheOwner);
393    StopOnException:=True;
296  FSQL := TStringStream.Create('');
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);
# Line 304 | Line 404 | begin
404    FIBXScript.Transaction := FIBTransaction;
405    FIBXScript.OnOutputLog := @LogHandler;
406    FIBXScript.OnErrorLog := @ErrorLogHandler;
407 <  FIBXScript.OnSelectSQL := @HandleSelectSQL;
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;
311  FQuery := TIBQuery.Create(self);
312  FQuery.AllowAutoActivateTransaction := true;
313  FQuery.Database := FIBDatabase;
314  FQuery.Transaction := FIBTransaction;
415  
416    FIBTransaction.Params.Add('concurrency');
417    FIBTransaction.Params.Add('wait');
318  FIBDatabase.Params.Add('lc_ctype=UTF8');
418  
419   end;
420  
322 destructor TFBSQL.Destroy;
323 begin
324  if assigned(FSQL) then FSQL.Free;
325  inherited Destroy;
326 end;
327
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,'-f <filename> execute SQL script from file');
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:');
# Line 348 | Line 447 | var
447    Application: TFBSQL;
448   begin
449    Application:=TFBSQL.Create(nil);
351  Application.Title:='fbsql';
450    Application.Run;
451    Application.Free;
452 +  if FExceptionTrapped then
453 +    Halt(1);
454   end.
455  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines