mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-04 06:48:15 +01:00
595 lines
17 KiB
ObjectPascal
595 lines
17 KiB
ObjectPascal
{$mode objfpc}
|
|
{$h+}
|
|
|
|
{ $DEFINE USESYNAPSE}
|
|
|
|
{$IFDEF VER2_6}
|
|
{$DEFINE USESYNAPSE}
|
|
{$ENDIF}
|
|
|
|
program googleapiconv;
|
|
|
|
uses
|
|
custapp, classes, sysutils, fpjson, jsonparser, fpwebclient,
|
|
{$IFDEF USESYNAPSE}
|
|
ssl_openssl,
|
|
synapsewebclient,
|
|
{$ELSE}
|
|
fphttpwebclient,
|
|
{$ENDIF}
|
|
googlediscoverytopas, googleservice, restbase, restcodegen;
|
|
|
|
Const
|
|
BaseDiscoveryURL = 'https://www.googleapis.com/discovery/v1/apis/';
|
|
|
|
|
|
Type
|
|
|
|
{ TGoogleAPIConverter }
|
|
|
|
{ TAPIEntry }
|
|
|
|
TAPIEntry = Class(TCollectionItem)
|
|
private
|
|
FAPIIcon: String;
|
|
FAPIName: String;
|
|
FAPIUnitName: String;
|
|
FFileName: String;
|
|
Public
|
|
Property APIName : String Read FAPIName Write FAPIName;
|
|
Property FileName : String Read FFileName Write FFileName;
|
|
Property APIUnitName : String Read FAPIUnitName Write FAPIUnitName;
|
|
Property APIIcon : String Read FAPIIcon Write FAPIIcon;
|
|
end;
|
|
|
|
{ TAPIEntries }
|
|
|
|
TAPIEntries = Class(TCollection)
|
|
private
|
|
function GetE(AIndex : Integer): TAPIEntry;
|
|
Public
|
|
Function AddEntry : TAPIEntry;
|
|
Property Entries [AIndex : Integer] : TAPIEntry Read GetE; default;
|
|
end;
|
|
|
|
TGoogleAPIConverter = CLass(TCustomApplication)
|
|
private
|
|
FDownloadOnly: Boolean;
|
|
FKeepJSON: Boolean;
|
|
FUnitPrefix: String;
|
|
FVerbose: Boolean;
|
|
procedure ConversionLog(Sender: TObject; LogType: TCodegenLogType; const Msg: String);
|
|
procedure CreateFPMake(FileName: String; L: TAPIEntries);
|
|
procedure DoAll(LocalFile, URL, OFN: String; AllVersions: Boolean);
|
|
Procedure DoConversion(JS: TStream; AEntry : TAPIEntry) ;
|
|
procedure DownloadIcon(APIEntry: TAPIentry);
|
|
function GetList(LocalFile, URL: String; AllVersions: Boolean): TJSONObject;
|
|
Function HttpGetJSON(Const URL : String; Response : TStream) : Boolean;
|
|
procedure RegisterUnit(FileName: String; L: TAPIEntries);
|
|
procedure Usage(Msg: String);
|
|
Public
|
|
Constructor Create(AOwner: TComponent); override;
|
|
Destructor Destroy; override;
|
|
Procedure DoRun; override;
|
|
Property KeepJSON : Boolean Read FKeepJSON Write FKeepJSON;
|
|
Property Verbose : Boolean Read FVerbose Write FVerbose;
|
|
Property DownloadOnly : Boolean Read FDownloadOnly Write FDownloadOnly;
|
|
Property UnitPrefix : String Read FUnitPrefix Write FUnitPrefix;
|
|
end;
|
|
|
|
{ TAPIEntries }
|
|
|
|
function TAPIEntries.GetE(AIndex : Integer): TAPIEntry;
|
|
begin
|
|
Result:=Items[AIndex] as TAPIEntry;
|
|
end;
|
|
|
|
function TAPIEntries.AddEntry: TAPIEntry;
|
|
begin
|
|
Result:=Add as TAPIEntry;
|
|
end;
|
|
|
|
Constructor TGoogleAPIConverter.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
StopOnException:=True;
|
|
TDiscoveryJSONToPas.RegisterAllObjects;
|
|
UnitPrefix:='google';
|
|
end;
|
|
|
|
Destructor TGoogleAPIConverter.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
Function TGoogleAPIConverter.HttpGetJSON(Const URL: String; Response: TStream
|
|
): Boolean;
|
|
|
|
Var
|
|
Webclient : TAbstractWebClient;
|
|
Req: TWebClientRequest;
|
|
Resp : TWebClientResponse;
|
|
|
|
begin
|
|
Result:=True;
|
|
Req:=Nil;
|
|
Resp:=Nil;
|
|
{$IFDEF USESYNAPSE}
|
|
WebClient:=TSynapseWebClient.Create(Self);
|
|
{$ELSE}
|
|
WebClient:=TFPHTTPWebClient.Create(Self);
|
|
{$ENDIF}
|
|
try
|
|
Req:=WebClient.CreateRequest;
|
|
Req.ResponseContent:=Response;
|
|
ConversionLog(Self,cltInfo,'Downloading: '+URL);
|
|
Resp:=WebClient.ExecuteRequest('GET',URL,Req);
|
|
Result:=(Resp<>Nil);
|
|
finally
|
|
Resp.Free;
|
|
Req.Free;
|
|
WebClient.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TGoogleAPIConverter.Usage(Msg : String);
|
|
|
|
begin
|
|
If (Msg<>'') then
|
|
Writeln('Error : ',Msg);
|
|
Writeln('Usage : ',ExeName,' [options] [inputfile] [outputfile]');
|
|
Writeln('Where options is one of: ');
|
|
Writeln('-a --all Download and generate code for all preferred services.');
|
|
Writeln('-A --All Download and generate code for all services.');
|
|
Writeln('if one of these options is given, then:');
|
|
Writeln(' a) The service name will be appended to the output filename.');
|
|
Writeln(' b) The --input will be used as a json which lists the services.');
|
|
Writeln('-b --baseclass=classname Class name to use as parent class for all classes.');
|
|
Writeln('-b --baseclass=classname Class name to use as parent class for all classes.');
|
|
Writeln('-m --fpmake=filename Generate fpmake program.');
|
|
Writeln('-e --extraunits=units comma separated list of units to add to uses clause.');
|
|
Writeln('-h --help this message');
|
|
Writeln('-i --input=file input filename (overrides non-option inputfile)');
|
|
Writeln('-I --icons Download service icon (size 16)');
|
|
Writeln('-L --license=licensetext Set license text to be added to the top of the unit.');
|
|
Writeln(' Use @filename to load license text from filename');
|
|
Writeln('-o --output=file output filename (overrides non-option outputfile)');
|
|
Writeln(' Default is to use input filename with extension .pp');
|
|
Writeln('-p --classprefix=prefix Prefix to use in class names for all classes.');
|
|
Writeln('-r --resourcesuffix=suffix Suffix to use for resource names. Default is Resource.');
|
|
Writeln('-R --register=unit Register unit for Lazarus.');
|
|
Writeln('-t --timestamp Add timestamp to generated unit.');
|
|
Writeln('-u --url=URL URL to download the REST description from.');
|
|
Writeln('-v --serviceversion=v Service version to download the REST description for.');
|
|
Writeln('-V --verbose Write some diagnostic messages');
|
|
Writeln('-k --keepjson Keep the downloaded JSON files');
|
|
Writeln('-d --onlydownload Just download the files, do not actually convert.');
|
|
Writeln(' Only effective if -k or --keepjson is also specified.');
|
|
Writeln('-f --unitprefix Prefix for generated unit names. Default is "google"');
|
|
Writeln('If the outputfilename is empty and cannot be determined, an error is returned');
|
|
Halt(Ord(Msg<>''));
|
|
end;
|
|
|
|
function TGoogleAPIConverter.GetList(LocalFile, URL: String;
|
|
AllVersions: Boolean): TJSONObject;
|
|
|
|
Var
|
|
D : TJSONData;
|
|
S : TStream;
|
|
|
|
begin
|
|
if (LocalFile<>'') then
|
|
S:=TFileStream.Create(LocalFile,fmOpenRead)
|
|
else
|
|
begin
|
|
S:=TMemoryStream.Create;
|
|
if (URL='') then
|
|
URL:=BaseDiscoveryURL;
|
|
If not AllVersions then
|
|
URL:=URL+'?preferred=true';
|
|
HTTPGetJSON(URL,S);
|
|
S.Position:=0;
|
|
end;
|
|
try
|
|
D:=GetJSON(S);
|
|
if Not (D is TJSONObject) then
|
|
begin
|
|
D.Free;
|
|
Raise Exception.CreateFmt('Source is not a valid JSON description',[LocalFile+URL]);
|
|
end;
|
|
Result:=D as TJSONObject;
|
|
finally
|
|
S.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TGoogleAPIConverter.RegisterUnit(FileName :String; L : TAPIEntries);
|
|
|
|
Var
|
|
I : Integer;
|
|
UN,N,V : String;
|
|
|
|
begin
|
|
UN:=ChangeFileext(ExtractFileName(FileName),'');
|
|
With TStringList.Create do
|
|
try
|
|
Add(Format('unit %s;',[un]));
|
|
Add('');
|
|
Add('interface');
|
|
Add('');
|
|
Add('{$mode objfpc}{$h+}');
|
|
Add('');
|
|
Add('uses sysutils,classes;');
|
|
Add('');
|
|
Add('procedure register;');
|
|
Add('');
|
|
Add('implementation');
|
|
Add('');
|
|
Add('uses');
|
|
if Hasoption('I','icon') then
|
|
Add(' lazres,');
|
|
Add(' restbase,');
|
|
Add(' googleservice,');
|
|
Add(' googlebase,');
|
|
Add(' googleclient,');
|
|
For I:=0 to L.Count-1 do
|
|
begin
|
|
N:=L[i].APIUnitName;
|
|
if I<L.Count-1 then
|
|
Add(' '+N+',')
|
|
else
|
|
Add(' '+N+';')
|
|
end;
|
|
Add('');
|
|
Add('');
|
|
Add('procedure register;');
|
|
Add('');
|
|
Add('begin');
|
|
if Hasoption('I','icon') then
|
|
Add('{$i '+un+'.inc}');
|
|
Add(' RegisterComponents(''Google API'',[');
|
|
Add(' TGoogleClient,');
|
|
For I:=0 to L.Count-1 do
|
|
begin
|
|
N:=L[i].APIName;
|
|
if I<L.Count-1 then
|
|
Add(' '+N+',')
|
|
else
|
|
Add(' '+N)
|
|
end;
|
|
Add(' ]);');
|
|
Add('end;');
|
|
Add('');
|
|
Add('end.');
|
|
SaveToFile(FileName);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TGoogleAPIConverter.ConversionLog(Sender: TObject;
|
|
LogType: TCodegenLogType; const Msg: String);
|
|
begin
|
|
if Verbose then
|
|
Writeln(StdErr,Msg);
|
|
end;
|
|
|
|
procedure TGoogleAPIConverter.CreateFPMake(FileName :String; L : TAPIEntries);
|
|
|
|
Var
|
|
I : Integer;
|
|
UN,N,V : String;
|
|
|
|
begin
|
|
UN:=ChangeFileext(ExtractFileName(FileName),'');
|
|
With TStringList.Create do
|
|
try
|
|
Add('program fpmake;');
|
|
Add('');
|
|
Add('{$mode objfpc}{$h+}');
|
|
Add('');
|
|
Add('uses sysutils,classes, fpmkunit;');
|
|
Add('');
|
|
Add('');
|
|
Add('function StdDep(T : TTarget) : TTarget;');
|
|
Add('begin');
|
|
Add(' T.Dependencies.AddUnit(''googlebase'');');
|
|
Add(' T.Dependencies.AddUnit(''googleservice'');');
|
|
Add(' Result:=T;');
|
|
Add('end;');
|
|
Add('');
|
|
Add('Procedure AddGoogle;');
|
|
Add('');
|
|
Add('Var');
|
|
Add(' P : TPackage;');
|
|
Add(' T : TTarget;');
|
|
Add('');
|
|
Add('begin');
|
|
Add(' With Installer do');
|
|
Add(' begin');
|
|
Add(' P:=AddPackage(''googleapis'');');
|
|
Add(' P.ShortName:=''googleap'';');
|
|
Add(' T:=P.Targets.AddUnit(''googlebase.pp'');');
|
|
Add(' T:=P.Targets.AddUnit(''googleclient.pp'');');
|
|
Add(' T:=P.Targets.AddUnit(''googleservice.pp'');');
|
|
Add(' T.Dependencies.AddUnit(''googleclient'');');
|
|
Add(' T.Dependencies.AddUnit(''googlebase'');');
|
|
For I:=0 to L.Count-1 do
|
|
begin
|
|
N:=L[i].APIUnitName;
|
|
Add(Format(' T:=StdDep(P.Targets.AddUnit(''%s''));',[ExtractFileName(L[i].FAPIUnitName)]));
|
|
end;
|
|
Add(' end;');
|
|
Add('end;');
|
|
Add('');
|
|
Add('{$ifndef ALLPACKAGES}');
|
|
Add('begin');
|
|
Add(' AddGoogle;');
|
|
Add(' Installer.Run;');
|
|
Add('end.');
|
|
Add('{$endif ALLPACKAGES}');
|
|
Add('');
|
|
Add('procedure register;');
|
|
Add('');
|
|
Add('begin');
|
|
SaveToFile(FileName);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TGoogleAPIConverter.DoAll(LocalFile, URL, OFN : String; AllVersions : Boolean);
|
|
|
|
Var
|
|
D,O : TJSONObject;
|
|
RS : TStringStream;
|
|
A : TJSONArray;
|
|
S : TJSONEnum;
|
|
LFN,RU,E : String;
|
|
UL : TAPIEntries;
|
|
U : TAPIEntry;
|
|
I : Integer;
|
|
|
|
begin
|
|
E:=ExtractFileExt(OFN);
|
|
if (E='') then
|
|
E:='.pp';
|
|
UL:=Nil;
|
|
D:=GetList(LocalFile,URL,ALlVersions);
|
|
try
|
|
UL:=TAPIEntries.Create(TAPIEntry);
|
|
A:=D.Get('items',TJSONArray(Nil));
|
|
For S in A do
|
|
begin
|
|
O:=S.Value as TJSONObject;
|
|
if AllVersions or O.Get('preferred',false) then
|
|
begin
|
|
RU:=O.get('discoveryRestUrl');
|
|
LFN:=UnitPrefix+O.get('name');
|
|
if AllVersions then
|
|
LFN:=LFN+'_'+StringReplace(O.get('version'),'.','',[rfReplaceAll]);
|
|
if (OFN='') then
|
|
LFN:=LFN+E
|
|
else
|
|
LFN:=ChangeFileExt(OFN,LFN+E);
|
|
RS:=TStringStream.Create('');
|
|
try
|
|
if not HttpGetJSON(RU,RS) then
|
|
Raise Exception.Create('Could not download rest description from URL: '+RU);
|
|
ConversionLog(Self,cltInfo,Format('Converting service "%s" to unit: %s',[O.get('name'),LFN]));
|
|
if KeepJSON then
|
|
With TFIleStream.Create(ChangeFileExt(LFN,'.json'),fmCreate) do
|
|
try
|
|
CopyFrom(RS,0);
|
|
finally
|
|
Free;
|
|
end;
|
|
RS.Position:=0;
|
|
U:=UL.AddEntry;
|
|
U.FileName:=LFN;
|
|
if not DownloadOnly then
|
|
DoConversion(RS,U);
|
|
finally
|
|
RS.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
if not DownloadOnly then
|
|
begin
|
|
if HasOption('R','register') then
|
|
RegisterUnit(GetOptionValue('R','register'),UL);
|
|
if HasOption('m','fpmake') then
|
|
CreateFpMake(GetOptionValue('m','fpmake'),UL);
|
|
end;
|
|
if HasOption('I','icon') then
|
|
For I:=0 to UL.Count-1 do
|
|
DownloadIcon(UL[i]);
|
|
finally
|
|
UL.Free;
|
|
D.Free;
|
|
end;
|
|
end;
|
|
|
|
Procedure TGoogleAPIConverter.DoRun;
|
|
|
|
Const
|
|
MyO : Array[1..21] of ansistring
|
|
= ('help','input:','output:','extraunits:','baseclass:','classprefix:',
|
|
'url:','service:','serviceversion:','resourcesuffix:','license:',
|
|
'All','all','register','icon','fpmake:','timestamp','verbose','keepjson',
|
|
'onlydownload','unitprefix');
|
|
|
|
Var
|
|
O,NonOpts : TStrings;
|
|
URL, S, IFN, OFN : AnsiString;
|
|
JS : TStream;
|
|
DoAllServices : Boolean;
|
|
APIEntry : TAPIEntry;
|
|
|
|
begin
|
|
JS:=Nil;
|
|
O:=Nil;
|
|
NonOpts:=TStringList.Create;
|
|
try
|
|
O:=TStringList.Create;
|
|
For S in MyO do O.Add(S);
|
|
S:=Checkoptions('hi:o:e:b:p:u:s:v:r:L:aAR:Im:tVkdf',O,TStrings(Nil),NonOpts,True);
|
|
if NonOpts.Count>0 then
|
|
IFN:=NonOpts[0];
|
|
if NonOpts.Count>1 then
|
|
OFN:=NonOpts[1];
|
|
finally
|
|
O.Free;
|
|
NonOpts.Free;
|
|
end;
|
|
FVerbose:=HasOption('V','verbose');
|
|
FKeepJSON:=HasOption('k','keepjson');
|
|
if HasOption('f','unitprefix') then
|
|
UnitPrefix:=GetOptionValue('f','unitprefix');
|
|
If FKeepJSON Then
|
|
FDownLoadOnly:=HasOption('d','onlydownload');
|
|
if (S<>'') or HasOption('h','help') then
|
|
Usage(S);
|
|
DoAllServices:=HasOption('a','all') or HasOption('A','All');
|
|
if HasOption('i','input') then
|
|
IFN:=GetOptionValue('i','input');
|
|
if HasOption('o','output') then
|
|
OFN:=GetOptionValue('o','output');
|
|
if HasOption('u','url') then
|
|
URL:=GetOptionValue('u','url')
|
|
else if hasOption('s','service') then
|
|
begin
|
|
URL:=BaseDiscoveryURL+getOptionValue('s','service');
|
|
if (pos('/',getOptionValue('s','service'))= 0) and
|
|
HasOption('v','serviceversion') then
|
|
URL:=URL+getOptionValue('v','serviceversion');
|
|
if (URL[Length(URL)]<>'/') then
|
|
URL:=URL+'/';
|
|
URL:=URL+'rest';
|
|
end;
|
|
if (not DoAllServices) and (IFN='') and (URL='') then
|
|
Usage('Need an input filename or URL');
|
|
if (OFN='') then
|
|
if (IFN<>'') then
|
|
OFN:=ChangeFileExt(IFN,'.pp')
|
|
else if getOptionValue('s','service')<>'' then
|
|
OFN:=UnitPrefix+getOptionValue('s','service')+'.pp';
|
|
if (OFN='') and Not DoAllServices then
|
|
Usage('Need an output filename');
|
|
if DoAllServices then
|
|
DoAll(IFN,URL,OFN,HasOption('A','All'))
|
|
else
|
|
begin
|
|
APIEntry:=Nil;
|
|
if (IFN='') and (URL<>'') then
|
|
begin
|
|
JS:=TMemoryStream.Create;
|
|
if not HttpGetJSON(URL,JS) then
|
|
Raise Exception.Create('Could not download from URL: '+URL);
|
|
if KeepJSON then
|
|
With TFIleStream.Create(ChangeFileExt(OFN,'.json'),fmCreate) do
|
|
try
|
|
CopyFrom(JS,0);
|
|
finally
|
|
Free;
|
|
end;
|
|
JS.POsition:=0;
|
|
end
|
|
else
|
|
JS:=TFileStream.Create(IFN,fmOpenRead or fmShareDenyWrite);
|
|
try
|
|
if not DownLoadOnly then
|
|
APIEntry:=TAPIEntry.Create(Nil);
|
|
try
|
|
APIEntry.FileName:=OFN;
|
|
DoConversion(JS,APIEntry);
|
|
if HasOption('I','icon') then
|
|
DownloadIcon(APIEntry);
|
|
finally
|
|
APIEntry.Free;
|
|
end;
|
|
finally
|
|
JS.Free;
|
|
end;
|
|
end;
|
|
Terminate;
|
|
end;
|
|
|
|
procedure TGoogleAPIConverter.DownloadIcon(APIEntry : TAPIentry);
|
|
|
|
Var
|
|
FN : String;
|
|
FS : TFileStream;
|
|
|
|
begin
|
|
if (APIEntry.APIIcon<>'') then
|
|
begin
|
|
FN:=ExtractFilePath(APIEntry.FileName)+APIEntry.APIName+ExtractFileExt(APIEntry.APIIcon);
|
|
FS:=TFileStream.Create(FN,fmCreate);
|
|
try
|
|
if HasOption('V','verbose') then
|
|
Writeln(Format('Downloading icon %s to %s',[APIEntry.APIIcon,FN]));
|
|
HttpGetJSON(APIEntry.APIIcon,FS);
|
|
finally
|
|
FS.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
Procedure TGoogleAPIConverter.DoConversion(JS: TStream; AEntry: TAPIEntry);
|
|
|
|
Var
|
|
L: String;
|
|
O : TGoogleIcons;
|
|
|
|
begin
|
|
With TDiscoveryJSONToPas.Create(Nil) do
|
|
try
|
|
L:=GetOptionValue('L','license');
|
|
if (L<>'') then
|
|
begin
|
|
if (L[1]<>'@') then
|
|
LicenseText.Text:=L
|
|
else
|
|
begin
|
|
Delete(L,1,1);
|
|
LicenseText.LoadFromFile(L);
|
|
end;
|
|
end;
|
|
OnLog:=@ConversionLog;
|
|
ExtraUnits:=GetOptionValue('e','extraunits');
|
|
if HasOption('b','baseclass') then
|
|
BaseClassName:=GetOptionValue('b','baseclass');
|
|
if HasOption('p','classprefix') then
|
|
ClassPrefix:=GetOptionValue('p','classprefix');
|
|
if HasOption('r','resourcesuffix') then
|
|
ResourceSuffix:=GetOptionValue('r','resourcesuffix');
|
|
AddTimeStamp:=HasOption('t','timestamp');
|
|
LoadFromStream(JS);
|
|
AEntry.APIUnitName:=ChangeFileExt(ExtractFileName(AEntry.FileName),'');
|
|
AEntry.APIName:=APIClassName;
|
|
O:=Description.icons;
|
|
if Assigned(O) then
|
|
AEntry.APIIcon:=O.x16;
|
|
SaveToFile(AEntry.FileName);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
Var
|
|
Application : TGoogleAPIConverter;
|
|
begin
|
|
{$if declared(Heaptrc)}
|
|
printleakedblock:=true;
|
|
printfaultyblock:=true;
|
|
add_tail:=true;
|
|
SetHeapTraceOutput('heaptrc.txt');
|
|
{$endif}
|
|
Application:=TGoogleAPIConverter.Create(Nil);
|
|
Application.Initialize;
|
|
Application.Run;
|
|
end.
|
|
|