1unit frmmain;
2
3{$mode objfpc}{$H+}
4
5// Define this if you want to use synapse.
6{ $DEFINE USESYNAPSE}
7
8// For 2.6.4, synapse is currently the only option.
9// You will need to add lazsynapsewebclient to the requires list.
10{$IFDEF VER2_6}
11{$DEFINE USESYNAPSE}
12{$ENDIF}
13
14interface
15
16uses
17  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
18  ComCtrls, ActnList, Menus, ListViewFilterEdit, restbase, googleclient,
19  googlediscovery, frmgenoptions, frmview;
20
21type
22
23  { TMainForm }
24
25  TMainForm = class(TForm)
26    APreViewRest: TAction;
27    AGenCode: TAction;
28    AViewHelp: TAction;
29    ASaveREST: TAction;
30    APreferredOnly: TAction;
31    AQuit: TAction;
32    AFetch: TAction;
33    ActionList1: TActionList;
34    EFilter: TEdit;
35    ILDiscovery: TImageList;
36    Label1: TLabel;
37    LVServices: TListView;
38    MainMenu1: TMainMenu;
39    MenuItem1: TMenuItem;
40    MenuItem2: TMenuItem;
41    MAPI: TMenuItem;
42    MenuItem3: TMenuItem;
43    MenuItem4: TMenuItem;
44    MenuItem5: TMenuItem;
45    MenuItem6: TMenuItem;
46    MIQuit: TMenuItem;
47    MIPreferredOnly: TMenuItem;
48    MServices: TMenuItem;
49    SDJSON: TSaveDialog;
50    SBDiscovery: TStatusBar;
51    ToolBar1: TToolBar;
52    ToolButton1: TToolButton;
53    ToolButton2: TToolButton;
54    ToolButton3: TToolButton;
55    ToolButton4: TToolButton;
56    ToolButton5: TToolButton;
57    ToolButton6: TToolButton;
58    procedure APreViewRestExecute(Sender: TObject);
59    procedure APreViewRestUpdate(Sender: TObject);
60    procedure ASaveRESTExecute(Sender: TObject);
61    procedure ASaveRESTUpdate(Sender: TObject);
62    procedure AGenCodeExecute(Sender: TObject);
63    procedure AGenCodeUpdate(Sender: TObject);
64    procedure AQuitExecute(Sender: TObject);
65    procedure AViewHelpExecute(Sender: TObject);
66    procedure AViewHelpUpdate(Sender: TObject);
67    procedure BFetchClick(Sender: TObject);
68    procedure CBPreferredOnlyChange(Sender: TObject);
69    procedure EFilterChange(Sender: TObject);
70    procedure FormCreate(Sender: TObject);
71  private
72    { private declarations }
73    FClient : TGoogleClient;
74    FDiscoveryAPI : TDiscoveryAPI;
75    FDirectory : TDirectoryList;
76    Function  CurrentAPI : TDirectoryListTypeitemsItem;
77    procedure DoFetch;
78    procedure DownLoadRestAPI(Const AName,AURL: String);
79    procedure GenerateCode(const AName, AURL: String);
80    function HttpGetBinary(AURL: String; S: TStream): Boolean;
81    procedure ShowDiscovery(PreferredOnly: Boolean; FilterOn: String);
82    procedure UpdateCaption;
83    procedure ViewFile(AFileName: String);
84    procedure ViewFile(AStream: TStream; ASyntax: TSyntax; ACaption: String);
85    procedure ViewRestAPI(const AName, AURL: String);
86  public
87    { public declarations }
88  end;
89
90var
91  MainForm: TMainForm;
92
93implementation
94
95{$R *.lfm}
96uses
97  ssl_openssl,
98  jsonparser, // needed
99  fpoauth2, lclintf,
100{$IFDEF USESYNAPSE}
101  synapsewebclient,
102  httpsend,
103{$ELSE}
104  fphttpclient,
105  fphttpwebclient,
106{$ENDIF}
107  googlediscoverytopas;
108
109{ TMainForm }
110
111procedure TMainForm.FormCreate(Sender: TObject);
112begin
113  // set up communication.
114  FClient:=TGoogleClient.Create(Self);
115{$IFDEF USESYNAPSE}
116  FClient.WebClient:=TSynapseWebClient.Create(Self);
117{$ELSE}
118  FClient.WebClient:=TFPHTTPWebClient.Create(Self);
119{$ENDIF}
120  // Register all classes so they can be streamed.
121  TDiscoveryAPI.RegisterAPIResources;
122  // create the API and hook it up to the google client.
123  FDiscoveryAPI:=TDiscoveryAPI.Create(Self);
124  FDiscoveryAPI.GoogleClient:=FClient;
125  // The code generator uses it's own objects.
126  TDiscoveryJSONToPas.RegisterAllObjects;
127  UpdateCaption;
128end;
129
130procedure TMainForm.BFetchClick(Sender: TObject);
131
132begin
133  DoFetch;
134end;
135
136procedure TMainForm.AQuitExecute(Sender: TObject);
137begin
138  Close;
139end;
140
141procedure TMainForm.AViewHelpExecute(Sender: TObject);
142begin
143  OpenURL(CurrentAPI.DocumentationLink);
144end;
145
146procedure TMainForm.AViewHelpUpdate(Sender: TObject);
147begin
148  (Sender as TAction).Enabled:=Assigned(CurrentAPI) and (CurrentAPI.documentationLink<>'');
149end;
150
151procedure TMainForm.ASaveRESTUpdate(Sender: TObject);
152begin
153  (Sender as TAction).Enabled:=Assigned(CurrentAPI) and (CurrentAPI.discoveryRestUrl<>'');
154end;
155
156procedure TMainForm.AGenCodeExecute(Sender: TObject);
157
158Var
159  DLI : TDirectoryListTypeitemsItem;
160
161begin
162  DLI:=CurrentAPI;
163  GenerateCode(DLI.Name,DLI.DiscoveryRestUrl);
164end;
165
166procedure TMainForm.AGenCodeUpdate(Sender: TObject);
167begin
168  (Sender as TAction).Enabled:=Assigned(CurrentAPI) and (CurrentAPI.discoveryRestUrl<>'')
169end;
170
171procedure TMainForm.ViewFile(AFileName : String);
172
173begin
174  With TViewForm.Create(Nil) do
175    begin
176    Caption:='Viewing file: '+AFileName;
177    FileName:=AFileName;
178    Show;
179    end;
180end;
181
182procedure TMainForm.ViewFile(AStream :  TStream; ASyntax : TSyntax; ACaption : String);
183
184begin
185  With TViewForm.Create(Nil) do
186    begin
187    AStream.POsition:=0;
188    Caption:='Viewing: '+ACaption;
189    Stream:=AStream;
190    Syntax:=ASyntax;
191    FreeStream:=True;
192    Show;
193    end;
194end;
195
196Function TMainForm.HttpGetBinary(AURL : String; S : TStream) : Boolean;
197
198begin
199{$IFDEF USESYNAPSE}
200   Result:=httpsend.HttpGetBinary(AURL,S);
201{$ELSE}
202  try
203    TFPHTTPClient.SimpleGet(AURL,S);
204    S.Position:=0;
205    Result:=True;
206  except
207    Result:=False;
208  end;
209{$ENDIF}
210end;
211
212procedure TMainForm.GenerateCode(const AName, AURL: String);
213
214Var
215  S : TMemoryStream;
216  FO : TGenCodeFormOptions;
217  DP : TDiscoveryJSONToPas;
218
219begin
220  FO:=Nil;
221  DP:=Nil;
222  S:=TMemoryStream.Create;
223  try
224    if HttpGetBinary(AURL,S) then
225      begin
226      S.Position:=0;
227      FO:=TGenCodeFormOptions.Create(Self);
228      FO.UnitName:=AName;
229      If FO.ShowModal=mrOK then
230        begin
231        DP:=TDiscoveryJSONToPas.Create(Self);
232        DP.LoadFromStream(S);
233        DP.BaseClassName:=FO.BaseClass;
234        DP.OutputUnitName:=FO.UnitName;
235        DP.ExtraUnits:=FO.ExtraUnits;
236        DP.ClassPrefix:=FO.Prefix;
237        DP.SaveToFile(FO.FileName);
238        if FO.DoPreview then
239          ViewFile(FO.FileName);
240        end;
241      end;
242  Finally
243    FO.Free;
244    DP.Free;
245    S.Free;
246  end;
247end;
248
249procedure TMainForm.DownLoadRestAPI(const AName, AURL: String);
250
251Var
252  S : TMemoryStream;
253
254begin
255  S:=TMemoryStream.Create;
256  try
257    if HttpGetBinary(AURL,S) then
258      begin
259      SDJSON.FileName:='google'+aname+'.json';
260      If SDJSON.Execute then
261        With TFileStream.Create(SDJSON.FileName,fmCreate) do
262          try
263            CopyFrom(S,0);
264          finally
265            Free;
266          end;
267      end;
268  finally
269    S.Free;
270  end;
271end;
272
273procedure TMainForm.ViewRestAPI(const AName, AURL: String);
274Var
275  S : TMemoryStream;
276
277begin
278  S:=TMemoryStream.Create;
279  try
280    if HttpGetBinary(AURL,S) then
281      begin
282      ViewFile(S,sJSON,'REST discovery for '+AName);
283      S:=Nil;
284      end;
285  finally
286    S.Free;
287  end;
288end;
289
290procedure TMainForm.ASaveRESTExecute(Sender: TObject);
291
292Var
293  DLI : TDirectoryListTypeitemsItem;
294begin
295  DLI:=CurrentAPI;
296  DownLoadRestAPI(DLI.Name,DLI.DiscoveryRestUrl);
297end;
298
299procedure TMainForm.APreViewRestUpdate(Sender: TObject);
300begin
301  (Sender as TAction).Enabled:=Assigned(CurrentAPI) and (CurrentAPI.discoveryRestUrl<>'');
302end;
303
304procedure TMainForm.APreViewRestExecute(Sender: TObject);
305
306Var
307  DLI : TDirectoryListTypeitemsItem;
308
309begin
310  DLI:=CurrentAPI;
311  ViewRestAPI(DLI.Name,DLI.DiscoveryRestUrl);
312end;
313
314procedure TMainForm.CBPreferredOnlyChange(Sender: TObject);
315begin
316  if (LVServices.Items.Count>0) then
317    ShowDiscovery(MIPreferredOnly.Checked,EFilter.Text);
318end;
319
320procedure TMainForm.EFilterChange(Sender: TObject);
321begin
322  if (LVServices.Items.Count>0) then
323    ShowDiscovery(MIPreferredOnly.Checked,EFilter.Text);
324end;
325
326procedure TMainForm.UpdateCaption;
327
328Var
329  C : Integer;
330
331begin
332  C:=LVServices.Items.Count;
333  if (C=0) then
334    Caption:='Google Discovery Service Demo'
335  else
336    Caption:=Format('Google Discovery Service Demo (%d services)',[C]);
337  SBDiscovery.Panels[0].Text:=Format('%d items',[C]);
338end;
339
340function TMainForm.CurrentAPI: TDirectoryListTypeitemsItem;
341begin
342  If Assigned(LVServices.Selected) and Assigned(LVServices.Selected.Data) then
343    Result:=TDirectoryListTypeitemsItem(LVServices.Selected.Data)
344  else
345    Result:=Nil;
346end;
347
348procedure TMainForm.ShowDiscovery(PreferredOnly : Boolean; FilterOn : String);
349
350  Function DoComma(S : TStringArray) : String;
351  Var
352    I : String;
353  begin
354    Result:='';
355    For I in S do
356      begin
357      if Result<>'' then
358        Result:=Result+',';
359      Result:=Result+I;
360      end;
361  end;
362
363  Function Contains(S: String) : Boolean; inline;
364  begin
365    Result:=Pos(FilterOn,LowerCase(S))<>0;
366  end;
367
368  Function ShowItem (DLI : TDirectoryListTypeitemsItem) : Boolean;
369
370  begin
371    Result:=DLI.Preferred or (Not PreferredOnly);
372    if Result and (FilterOn<>'') then
373      begin
374      Result:=Contains(DLI.Name)
375              or Contains(DLI.Title)
376              or Contains(DLI.kind)
377              or Contains(DLI.description)
378              or Contains(DoComma(DLI.Labels));
379      end;
380  end;
381Var
382  DLI : TDirectoryListTypeitemsItem;
383  LI : TListItem;
384
385begin
386  FilterOn:=LowerCase(Filteron);
387  LVServices.Items.BeginUpdate;
388  try
389    LVServices.Items.Clear;
390    LVServices.Column[1].Visible:=Not PreferredOnly;
391    For DLI in FDirectory.Items do
392      if ShowItem(DLI) then
393        begin
394        LI:=LVServices.Items.Add;
395        LI.Caption:=DLI.name;
396        LI.Data:=DLI;
397        With LI.SubItems,DLI do
398          begin
399          Add(BoolToStr(preferred,'True','False'));
400          Add(id);
401          Add(title);
402          Add(version);
403          Add(description);
404          Add(discoveryLink);
405          Add(discoveryRestUrl);
406          Add(documentationLink);
407          Add(icons.x16);
408          Add(icons.x32);
409          Add(DoComma(labels));
410          end;
411        end;
412    UpdateCaption;
413  finally
414    LVServices.Items.EndUpdate;
415  end;
416end;
417
418procedure TMainForm.DoFetch;
419
420begin
421  // Free any previous list.
422  FreeAndNil(FDirectory);
423  // Get the new list using a default ApisResource.
424  FDirectory:=FDiscoveryAPI.ApisResource.List();
425  ShowDiscovery(MIPreferredOnly.Checked,EFilter.Text);
426end;
427
428end.
429
430