mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-03 04:58:48 +02:00
* Added new tool to generate fpmake.pp files from JSON-based configuration files
git-svn-id: trunk@20571 -
This commit is contained in:
joost
parent
d1b209025f
commit
df59758326
5
.gitattributes
vendored
5
.gitattributes
vendored
@ -13289,6 +13289,11 @@ utils/fpdoc/sh_pas.pp svneol=native#text/plain
|
||||
utils/fpdoc/testunit.pp svneol=native#text/plain
|
||||
utils/fpdoc/testunit.xml svneol=native#text/plain
|
||||
utils/fpdoc/unitdiff.pp svneol=native#text/plain
|
||||
utils/fpgmake/fpgmake.pp svneol=native#text/plain
|
||||
utils/fpgmake/fpmake.cft svneol=native#text/plain
|
||||
utils/fpgmake/fpmake.inc svneol=native#text/plain
|
||||
utils/fpgmake/fpmakecreatefile.pas svneol=native#text/plain
|
||||
utils/fpgmake/fpmakeparsejson.pas svneol=native#text/plain
|
||||
utils/fpmc/Makefile svneol=native#text/plain
|
||||
utils/fpmc/Makefile.fpc svneol=native#text/plain
|
||||
utils/fpmc/README.txt svneol=native#text/plain
|
||||
|
||||
211
utils/fpgmake/fpgmake.pp
Normal file
211
utils/fpgmake/fpgmake.pp
Normal file
@ -0,0 +1,211 @@
|
||||
program fpgmake;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$ifdef UNIX}
|
||||
cthreads,
|
||||
{$endif UNIX}
|
||||
Classes,
|
||||
sysutils,
|
||||
fpmkunit,
|
||||
fpTemplate,
|
||||
fpmakeParseJSon, fpmakecreatefile;
|
||||
|
||||
{
|
||||
data2inc -b -s fpmake.cft fpmake.inc fpmake
|
||||
}
|
||||
|
||||
{$i fpmake.inc}
|
||||
|
||||
Resourcestring
|
||||
SUsage00 = 'Usage: %s [options]';
|
||||
SUsage10 = 'Where options is one or more of';
|
||||
SUSage20 = ' -t filename Template file name. Default is built-in';
|
||||
SUSage30 = ' -o filename Set output file. Default is standard output.';
|
||||
SUsage40 = ' -d name=value define name=value pair.';
|
||||
SUsage50 = ' -h show this help and exit.';
|
||||
SUsage60 = ' -u name remove name from list of name/value pairs.';
|
||||
SUsage70 = ' -m show builtin macros and exit.';
|
||||
SUsage80 = ' -b show builtin template and exit.';
|
||||
SUsage90 = ' -s skip the creation of a backup-file.';
|
||||
SUsage95 = ' -p force directory creation.';
|
||||
SError = 'Error:';
|
||||
SErrUnknownOption = 'Error: Unknown option (%s).';
|
||||
SErrArgExpected = 'Error: Option "%s" requires an argument.';
|
||||
SErrIncompletePair = 'Error: Incomplete name-value pair "%s".';
|
||||
SErrNoSuchFile = 'Error: File "%s" does not exist.';
|
||||
|
||||
SWarnIgnoringFile = 'Warning: Ignoring non-existent file: ';
|
||||
SWarnIgnoringPair = 'Warning: Ignoring wrong name/value pair: ';
|
||||
SWarngccNotFound = 'Warning: Could not find gcc. Unable to determine the gcclib path.';
|
||||
SWarnCouldNotExecute= 'Warning: Could not execute command ''%s''';
|
||||
|
||||
Var
|
||||
SkipBackup : Boolean;
|
||||
CreateDir: Boolean;
|
||||
Cfg : TStringList;
|
||||
TemplateFileName,
|
||||
OutputFileName : String;
|
||||
|
||||
const
|
||||
InputFileName = 'fpmake.fpc';
|
||||
|
||||
procedure Usage;
|
||||
|
||||
begin
|
||||
Writeln(Format(SUsage00,[ExtractFileName(ApplicationName)]));
|
||||
Writeln(SUsage10);
|
||||
Writeln(SUsage20);
|
||||
Writeln(SUsage30);
|
||||
Writeln(SUsage40);
|
||||
Writeln(SUsage50);
|
||||
Writeln(SUsage60);
|
||||
Writeln(SUsage70);
|
||||
Writeln(SUsage80);
|
||||
Writeln(SUsage90);
|
||||
Writeln(SUsage95);
|
||||
end;
|
||||
|
||||
Procedure UnknownOption(Const S : String);
|
||||
|
||||
begin
|
||||
Writeln(Format(SErrUnknownOption,[S]));
|
||||
Usage;
|
||||
Halt(1);
|
||||
end;
|
||||
|
||||
procedure Init;
|
||||
|
||||
begin
|
||||
Cfg:=TStringList.Create;
|
||||
Cfg.Text:=StrPas(Addr(fpmake[0][1]));
|
||||
end;
|
||||
|
||||
procedure Done;
|
||||
|
||||
begin
|
||||
Cfg.Free;
|
||||
end;
|
||||
|
||||
Procedure ShowBuiltInMacros;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
For I:=0 to TemplateParser.ValueCount-1 do
|
||||
Writeln(TemplateParser.NamesByIndex[I]+'='+TemplateParser.ValuesByIndex[I]);
|
||||
end;
|
||||
|
||||
Procedure ShowBuiltIn;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
|
||||
begin
|
||||
For I:=0 to Cfg.Count-1 do
|
||||
Writeln(Cfg[I]);
|
||||
end;
|
||||
|
||||
|
||||
Procedure ProcessCommandline;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
S : String;
|
||||
ShowBuiltinCommand : boolean;
|
||||
|
||||
Function GetOptArg : String;
|
||||
|
||||
begin
|
||||
If I=ParamCount then
|
||||
begin
|
||||
Writeln(StdErr,Format(SErrArgExpected,[S]));
|
||||
Halt(1);
|
||||
end;
|
||||
inc(I);
|
||||
Result:=ParamStr(I);
|
||||
end;
|
||||
|
||||
procedure AddPair(const Value: String);
|
||||
var P: integer;
|
||||
N,V: String;
|
||||
begin
|
||||
P:=Pos('=',Value);
|
||||
If p=0 then
|
||||
begin
|
||||
Writeln(StdErr,Format(SErrIncompletePair,[Value]));
|
||||
Halt(1);
|
||||
end;
|
||||
V:=Value;
|
||||
N:=Copy(V,1,P-1);
|
||||
Delete(V,1,P);
|
||||
TemplateParser.Values[N] := V;
|
||||
end;
|
||||
|
||||
begin
|
||||
I:=1;
|
||||
ShowBuiltinCommand := False;
|
||||
SkipBackup := False;
|
||||
CreateDir := False;
|
||||
While( I<=ParamCount) do
|
||||
begin
|
||||
S:=Paramstr(i);
|
||||
If Length(S)<=1 then
|
||||
UnknownOption(S)
|
||||
else
|
||||
case S[2] of
|
||||
'h' : begin
|
||||
Usage;
|
||||
halt(0);
|
||||
end;
|
||||
'b' : ShowBuiltinCommand := true;
|
||||
'm' : begin
|
||||
ShowBuiltinMacros;
|
||||
halt(0);
|
||||
end;
|
||||
't' : TemplateFileName:=GetOptArg;
|
||||
'd' : AddPair(GetOptArg);
|
||||
'u' : TemplateParser.Values[GetOptArg]:='';
|
||||
'o' : OutputFileName:=GetoptArg;
|
||||
's' : SkipBackup:=True;
|
||||
'p' : CreateDir:=True;
|
||||
else
|
||||
UnknownOption(S);
|
||||
end;
|
||||
Inc(I);
|
||||
end;
|
||||
If (TemplateFileName<>'') then
|
||||
begin
|
||||
If Not FileExists(TemplateFileName) then
|
||||
begin
|
||||
Writeln(StdErr,Format(SErrNoSuchFile,[TemplateFileName]));
|
||||
Halt(1);
|
||||
end;
|
||||
Cfg.LoadFromFile(TemplateFileName);
|
||||
TemplateParser.Values['TEMPLATEFILE'] := TemplateFileName;
|
||||
end;
|
||||
if ShowBuiltinCommand then
|
||||
begin
|
||||
ShowBuiltIn;
|
||||
halt(0);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
APackages: TPackages;
|
||||
|
||||
begin
|
||||
Init;
|
||||
Try
|
||||
ProcessCommandLine;
|
||||
APackages := ParseFpmakeFile(InputFileName);
|
||||
if assigned(APackages) then
|
||||
CreateFile(OutputFileName, Cfg, APackages, SkipBackup, CreateDir);
|
||||
Finally
|
||||
APackages.Free;
|
||||
Done;
|
||||
end;
|
||||
end.
|
||||
33
utils/fpgmake/fpmake.cft
Normal file
33
utils/fpgmake/fpmake.cft
Normal file
@ -0,0 +1,33 @@
|
||||
{$ifndef ALLPACKAGES}
|
||||
{$mode objfpc}{$H+}
|
||||
program fpmake;
|
||||
|
||||
uses fpmkunit;
|
||||
|
||||
Var
|
||||
T : TTarget;
|
||||
P : TPackage;
|
||||
begin
|
||||
With Installer do
|
||||
begin
|
||||
{$endif ALLPACKAGES}
|
||||
P:=AddPackage('%packagename%');
|
||||
{$ifdef ALLPACKAGES}
|
||||
P.Directory:='%directory%';
|
||||
{$endif ALLPACKAGES}
|
||||
P.Version:='%version%';
|
||||
P.License:='%license%';
|
||||
P.Author:='%author%';
|
||||
P.Email:='%email%';
|
||||
P.Description:=%quotedstr(description)%;
|
||||
P.HomepageURL:='%homepageurl%';
|
||||
%conditionalpackageproperties%
|
||||
%packagedependencies%
|
||||
%packagesourcepaths%
|
||||
%targets%
|
||||
{$ifndef ALLPACKAGES}
|
||||
Run;
|
||||
end;
|
||||
end.
|
||||
{$endif ALLPACKAGES}
|
||||
|
||||
39
utils/fpgmake/fpmake.inc
Normal file
39
utils/fpgmake/fpmake.inc
Normal file
@ -0,0 +1,39 @@
|
||||
{$ifdef Delphi}
|
||||
const fpmake : array[0..2] of string[240]=(
|
||||
{$else Delphi}
|
||||
const fpmake : array[0..2,1..240] of char=(
|
||||
{$endif Delphi}
|
||||
'{$ifndef ALLPACKAGES}'#010+
|
||||
'{$mode objfpc}{$H+}'#010+
|
||||
'program fpmake;'#010+
|
||||
#010+
|
||||
'uses fpmkunit;'#010+
|
||||
#010+
|
||||
'Var'#010+
|
||||
' T : TTarget;'#010+
|
||||
' P : TPackage;'#010+
|
||||
'begin'#010+
|
||||
' With Installer do'#010+
|
||||
' begin'#010+
|
||||
'{$endif ALLPACKAGES}'#010+
|
||||
' P:=AddPackage('#039'%packagename%'#039');'#010+
|
||||
'{$ifdef ALLPACKAGES}'#010+
|
||||
' P.Directory:','='#039'%directory%'#039';'#010+
|
||||
'{$endif ALLPACKAGES}'#010+
|
||||
' P.Version:='#039'%version%'#039';'#010+
|
||||
' P.License:='#039'%license%'#039';'#010+
|
||||
' P.Author:='#039'%author%'#039';'#010+
|
||||
' P.Email:='#039'%email%'#039';'#010+
|
||||
' P.Description:=%quotedstr(description)%;'#010+
|
||||
' P.HomepageURL:='#039'%homepageurl%'#039';'#010+
|
||||
'%conditionalpack','ageproperties%'#010+
|
||||
'%packagedependencies%'#010+
|
||||
'%packagesourcepaths%'#010+
|
||||
'%targets%'#010+
|
||||
'{$ifndef ALLPACKAGES}'#010+
|
||||
' Run;'#010+
|
||||
' end;'#010+
|
||||
'end.'#010+
|
||||
'{$endif ALLPACKAGES}'#010+
|
||||
#010
|
||||
);
|
||||
237
utils/fpgmake/fpmakecreatefile.pas
Normal file
237
utils/fpgmake/fpmakecreatefile.pas
Normal file
@ -0,0 +1,237 @@
|
||||
unit fpmakecreatefile;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
fpmakeParseJSon,
|
||||
fpTemplate,
|
||||
fpmkunit;
|
||||
|
||||
procedure CreateFile(AOutputFileName: string; ATemplate: TStringList; APackages: TPackages; ASkipBackup, ACreateDir: boolean);
|
||||
function TemplateParser: TTemplateParser;
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
|
||||
{ TfpmakeTemplateParser }
|
||||
|
||||
TfpmakeTemplateParser = class(TTemplateParser)
|
||||
public
|
||||
constructor Create;
|
||||
Procedure OnGetParamProc(Sender : TObject; Const TagString : String; TagParams:TStringList; Out ReplaceText : String);
|
||||
end;
|
||||
|
||||
var
|
||||
GTemplateParser: TTemplateParser;
|
||||
|
||||
resourcestring
|
||||
SErrDelBackupFailed = 'Error: Delete of old backup file "%s" failed.';
|
||||
SErrCreateDirFailed = 'Error: Could not create the directory for file "%s".';
|
||||
SErrNoSuchDirectory = 'Error: Directory of file "%s" does not exists. User -p to force creation.';
|
||||
SErrBackupFailed = 'Error: Backup of file "%s" to "%s" failed.';
|
||||
SBackupCreated = 'Saved old "%s" to "%s"';
|
||||
|
||||
|
||||
function GetConditionalAdd(const Value: string; CPUs: TCPUS; OSes: TOSes; const AddName: string): string;
|
||||
begin
|
||||
if (CPUs <> AllCPUs) and (OSes <> AllOSes) then
|
||||
result := result + ' '+AddName+'('''+Value+''','+ExtCPUsToString(CPUs)+','+ExtOSesToString(OSes)+');' + LineEnding
|
||||
else if (CPUs <> AllCPUs) then
|
||||
result := result + ' '+AddName+'('''+Value+''','+ExtCPUsToString(CPUs)+');' + LineEnding
|
||||
else if (OSes <> AllOSes) then
|
||||
result := result + ' '+AddName+'('''+Value+''','+ExtOSesToString(OSes)+');' + LineEnding
|
||||
else
|
||||
result := result + ' '+AddName+'('''+Value+''');' + LineEnding;
|
||||
end;
|
||||
|
||||
function GetConditionalStringsMacro(ACondStrings: TConditionalStrings; APropName: string): string;
|
||||
var
|
||||
ADependency: TConditionalString;
|
||||
i: Integer;
|
||||
begin
|
||||
if ACondStrings.Count=0 then
|
||||
Exit;
|
||||
if ACondStrings.Count=1 then
|
||||
begin
|
||||
ADependency := ACondStrings[0];
|
||||
result := result + GetConditionalAdd(ADependency.Value, ADependency.CPUs, ADependency.OSes,APropName+'.Add');
|
||||
end
|
||||
else
|
||||
begin
|
||||
result := ' with '+APropName+' do' + LineEnding +
|
||||
' begin'+LineEnding;
|
||||
for i := 0 to ACondStrings.Count-1 do
|
||||
begin
|
||||
ADependency := ACondStrings[i];
|
||||
result := result + GetConditionalAdd(ADependency.Value, ADependency.CPUs, ADependency.OSes,' Add');
|
||||
end;
|
||||
result := result +
|
||||
' end;' + LineEnding;
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function GetConditionalPackagePropertiesMacro(APackage: TPackage): string;
|
||||
begin
|
||||
result := '';
|
||||
if APackage.CPUs<>AllCPUs then
|
||||
result := result + ' P.CPUs := '+ExtCPUSToString(APackage.CPUs)+';'+LineEnding;
|
||||
if APackage.OSes<>AllOSes then
|
||||
result := result + ' P.OSes := '+ExtOSesToString(APackage.OSes)+';'+LineEnding;
|
||||
end;
|
||||
|
||||
function GetTargetsMacro(aTargets: TTargets): string;
|
||||
var
|
||||
ATarget: TTarget;
|
||||
i: Integer;
|
||||
begin
|
||||
if aTargets.Count=0 then
|
||||
Exit;
|
||||
result := ' with P.Targets do' + LineEnding +
|
||||
' begin'+LineEnding;
|
||||
for i := 0 to aTargets.Count-1 do
|
||||
begin
|
||||
ATarget := aTargets.Items[i] as TTarget;
|
||||
result := result + GetConditionalAdd(ATarget.Name + ATarget.Extension, ATarget.CPUs, ATarget.OSes,' T := AddUnit');
|
||||
if atarget.ResourceStrings then
|
||||
result := result + ' T.Resourcestrings := True;'+LineEnding;
|
||||
end;
|
||||
result := result +
|
||||
' end;';
|
||||
end;
|
||||
|
||||
|
||||
procedure CreateFile(AOutputFileName: string; ATemplate: TStringList; APackages: TPackages; ASkipBackup, ACreateDir: boolean);
|
||||
|
||||
Var
|
||||
Fout : Text;
|
||||
S,BFN : String;
|
||||
I : Integer;
|
||||
PackageNr: Integer;
|
||||
APackage: TPackage;
|
||||
|
||||
begin
|
||||
If (AOutputFileName<>'')
|
||||
and FileExists(AOutputFileName)
|
||||
and not ASkipBackup then
|
||||
begin
|
||||
BFN:=ChangeFileExt(AOutputFileName,'.bak');
|
||||
If FileExists(BFN) and not DeleteFile(BFN) then
|
||||
begin
|
||||
Writeln(StdErr,Format(SErrDelBackupFailed,[BFN]));
|
||||
Halt(1);
|
||||
end;
|
||||
If not RenameFile(AOutputFileName,BFN) then
|
||||
begin
|
||||
Writeln(StdErr,Format(SErrBackupFailed,[AOutputFileName,BFN]));
|
||||
Halt(1);
|
||||
end
|
||||
else
|
||||
Writeln(Format(SBackupCreated,[ExtractFileName(AOutputFileName),ExtractFileName(BFN)]));
|
||||
end;
|
||||
if (AOutputFileName<>'') and (ExtractFilePath(AOutputFileName)<>'') and not DirectoryExists(ExtractFilePath(AOutputFileName)) then
|
||||
begin
|
||||
if ACreateDir then
|
||||
begin
|
||||
if not ForceDirectories(ExtractFilePath(AOutputFileName)) then
|
||||
begin
|
||||
Writeln(StdErr,Format(SErrCreateDirFailed,[AOutputFileName]));
|
||||
Halt(1);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Writeln(StdErr,Format(SErrNoSuchDirectory,[AOutputFileName]));
|
||||
Halt(1);
|
||||
end;
|
||||
end;
|
||||
Assign(Fout,AOutputFileName);
|
||||
Rewrite(FOut);
|
||||
Try
|
||||
for PackageNr := 0 to APackages.Count-1 do
|
||||
begin
|
||||
APackage := APackages.Items[PackageNr] as TPackage;
|
||||
|
||||
TemplateParser.Values['packagename'] := APackage.Name;
|
||||
TemplateParser.Values['directory'] := APackage.Directory;
|
||||
TemplateParser.Values['version'] := APackage.Version;
|
||||
TemplateParser.Values['author'] := APackage.Author;
|
||||
TemplateParser.Values['license'] := APackage.License;
|
||||
TemplateParser.Values['homepageurl'] := APackage.HomepageURL;
|
||||
TemplateParser.Values['downloadurl'] := APackage.DownloadURL;
|
||||
TemplateParser.Values['email'] := APackage.Email;
|
||||
TemplateParser.Values['description'] := APackage.Description;
|
||||
TemplateParser.Values['needlibc'] := BoolToStr(APackage.NeedLibC,'true','false');
|
||||
TemplateParser.Values['conditionalpackageproperties'] := GetConditionalPackagePropertiesMacro(APackage);
|
||||
TemplateParser.Values['packagedependencies'] := GetConditionalStringsMacro(APackage.Dependencies, 'P.Dependencies');
|
||||
TemplateParser.Values['packagesourcepaths'] := GetConditionalStringsMacro(APackage.SourcePath, 'P.SourcePath');
|
||||
TemplateParser.Values['targets'] := GetTargetsMacro(APackage.Targets);
|
||||
|
||||
For I:=0 to ATemplate.Count-1 do
|
||||
begin
|
||||
S:=ATemplate[i];
|
||||
S := TemplateParser.ParseString(S);
|
||||
Writeln(FOut,S);
|
||||
end;
|
||||
|
||||
end;
|
||||
Finally
|
||||
Close(Fout);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TemplateParser: TTemplateParser;
|
||||
begin
|
||||
if not assigned(GTemplateParser) then
|
||||
begin
|
||||
GTemplateParser := TfpmakeTemplateParser.Create;
|
||||
GTemplateParser.StartDelimiter:='%';
|
||||
GTemplateParser.EndDelimiter:='%';
|
||||
GTemplateParser.ParamStartDelimiter:='(';
|
||||
GTemplateParser.ParamEndDelimiter:=')';
|
||||
GTemplateParser.Values['PWD'] := GetCurrentDir;
|
||||
GTemplateParser.Values['BUILDDATE'] := DateToStr(Date);
|
||||
GTemplateParser.Values['BUILDTIME'] := TimeToStr(Time);
|
||||
end;
|
||||
result := GTemplateParser;
|
||||
end;
|
||||
|
||||
{ TfpmakeTemplateParser }
|
||||
|
||||
constructor TfpmakeTemplateParser.Create;
|
||||
begin
|
||||
inherited create;
|
||||
AllowTagParams := True;
|
||||
OnReplaceTag := @OnGetParamProc;
|
||||
end;
|
||||
|
||||
procedure TfpmakeTemplateParser.OnGetParamProc(Sender : TObject; Const TagString : String; TagParams:TStringList; Out ReplaceText : String);
|
||||
var
|
||||
i: Integer;
|
||||
s: string;
|
||||
begin
|
||||
if TagString = 'quotedstr' then
|
||||
begin
|
||||
i := TagParams.Count;
|
||||
ReplaceText:='';
|
||||
for i := 0 to TagParams.Count-1 do
|
||||
begin
|
||||
GetParam(TagParams[i],s);
|
||||
ReplaceText:=ReplaceText + quotedstr(s);
|
||||
end;
|
||||
end
|
||||
else
|
||||
GetParam(TagString,ReplaceText);
|
||||
end;
|
||||
|
||||
initialization
|
||||
GTemplateParser := nil
|
||||
finalization
|
||||
GTemplateParser.Free;
|
||||
end.
|
||||
|
||||
354
utils/fpgmake/fpmakeparsejson.pas
Normal file
354
utils/fpgmake/fpmakeparsejson.pas
Normal file
@ -0,0 +1,354 @@
|
||||
unit fpmakeParseJSon;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
fpmkunit,
|
||||
jsonparser, fpjson;
|
||||
|
||||
function ParseFpmake(AJsonData : TJSONData) : TPackages;
|
||||
function ParseFpmakeFile(AFileName: string) : TPackages;
|
||||
|
||||
function ExtStringToOSes(AString: String) : TOSes;
|
||||
function ExtOSesToString(AOSes: TOSes) : string;
|
||||
|
||||
function ExtStringToCPUs(AString: String) : TCpus;
|
||||
function ExtCPUsToString(ACPUs: TCPUs) : string;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
var GSetStrings: TStringList;
|
||||
|
||||
function SetStrings: TstringList;
|
||||
begin
|
||||
if not assigned(GSetStrings) then
|
||||
GSetStrings := TStringList.Create;
|
||||
result := GSetStrings;
|
||||
end;
|
||||
|
||||
function ExtStringToOSes(AString: String) : TOSes;
|
||||
var
|
||||
i: dword;
|
||||
begin
|
||||
try
|
||||
result := OSesToString(AString);
|
||||
except
|
||||
i := SetStrings.Add(AString)+1;
|
||||
result:=TOSes(dword(dword(AllOSes)+dword(i)));
|
||||
end;
|
||||
end;
|
||||
|
||||
function ExtOSesToString(AOSes: TOSes) : string;
|
||||
var
|
||||
i: dword;
|
||||
begin
|
||||
if DWord(AOSes) < DWord(AllOSes) then
|
||||
result := '[' + OSesToString(AOSes) + ']'
|
||||
else
|
||||
begin
|
||||
i := (dword(AOSes) - dword(AllOSes)) -1;
|
||||
if i < SetStrings.Count then
|
||||
result := SetStrings[i]
|
||||
else
|
||||
raise exception.Create('Invalid set of OSes.');
|
||||
end;
|
||||
end;
|
||||
|
||||
function ExtStringToCPUs(AString: String) : TCpus;
|
||||
var
|
||||
i: dword;
|
||||
begin
|
||||
try
|
||||
result := StringToCPUS(AString);
|
||||
except
|
||||
i := SetStrings.Add(AString)+1;
|
||||
result:=TCPUS(dword(dword(AllCPUs)+dword(i)));
|
||||
end;
|
||||
end;
|
||||
|
||||
function ExtCPUsToString(ACPUs: TCPUs) : string;
|
||||
var
|
||||
i: dword;
|
||||
begin
|
||||
if DWord(ACPUs) < DWord(AllCPUs) then
|
||||
result := '[' + CPUSToString(ACPUs) + ']'
|
||||
else
|
||||
begin
|
||||
i := (dword(ACPUs) - dword(AllCPUs)) -1;
|
||||
if i < SetStrings.Count then
|
||||
result := SetStrings[i]
|
||||
else
|
||||
raise exception.Create('Invalid set of CPUs.');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ParseConditionalString(ADependency: TConditionalString; AJsonData: TJSonData; ValueCaption: string);
|
||||
var
|
||||
AJsonObject: TJSONObject;
|
||||
m: Integer;
|
||||
begin
|
||||
|
||||
if AJsonData.JSONType = jtString then
|
||||
begin
|
||||
ADependency.Value := AJsonData.AsString;
|
||||
end
|
||||
else if AJsonData.JSONType = jtObject then
|
||||
begin
|
||||
AJsonObject := AJsonData as TJSONObject;
|
||||
|
||||
for m := 0 to AJsonObject.Count-1 do
|
||||
begin
|
||||
case AJsonObject.Names[m] of
|
||||
'oses' : ADependency.oses := ExtStringToOSes(AJsonObject.Items[m].AsString);
|
||||
'cpus' : ADependency.CPUs := ExtStringToCPUS(AJsonObject.Items[m].AsString);
|
||||
else if AJsonObject.Names[m] = ValueCaption then
|
||||
ADependency.Value := AJsonObject.Items[m].AsString
|
||||
else
|
||||
raise Exception.CreateFmt('Unknown dependency property ''%s''.',[AJsonObject.Names[m]]);
|
||||
end {case}
|
||||
end;
|
||||
|
||||
end
|
||||
else
|
||||
raise Exception.CreateFmt('Invalid dependency. (%s)',[AJsonData.AsString]);
|
||||
end;
|
||||
|
||||
procedure ParseConditionalArray(ACondStrings: TConditionalStrings; AJsonData: TJSonData; ValueCaption: string);
|
||||
var
|
||||
AJSonArray: TJSONArray;
|
||||
n: Integer;
|
||||
begin
|
||||
if AJsonData.JSONType <> jtArray then
|
||||
raise Exception.CreateFmt('Array expected but not found. (%s)',[AJsonData.AsString]);
|
||||
AJSonArray := AJsonData as TJSONArray;
|
||||
for n := 0 to AJSonArray.Count-1 do
|
||||
begin
|
||||
ParseConditionalString(ACondStrings.add(''), AJSonArray.Items[n], ValueCaption);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ParseUnitTarget(aTarget: TTarget; aJSONData: TJSONData);
|
||||
var
|
||||
AJsonObject: TJSONObject;
|
||||
m: Integer;
|
||||
begin
|
||||
if aJSONData.JSONType=jtString then
|
||||
aTarget.Name := aJSONData.AsString
|
||||
else if aJSONData.JSONType=jtObject then
|
||||
begin
|
||||
AJsonObject := aJSONData as TJSONObject;
|
||||
for m := 0 to AJsonObject.Count-1 do
|
||||
begin
|
||||
case AJsonObject.Names[m] of
|
||||
'name' : aTarget.name := AJsonObject.items[m].asstring;
|
||||
'resourcestrings' : atarget.ResourceStrings := (AJsonObject.items[m] as TJSONBoolean).AsBoolean;
|
||||
'oses' : aTarget.OSes := ExtStringToOSes(AJsonObject.Items[m].AsString);
|
||||
'cpus' : aTarget.cpus := ExtStringToCPUs(AJsonObject.Items[m].AsString);
|
||||
else
|
||||
raise Exception.CreateFmt('Unknown targets property ''%s''.',[AJsonObject.Names[m]]);
|
||||
end {case}
|
||||
end;
|
||||
end
|
||||
else
|
||||
raise Exception.CreateFmt('Invalid target ''%s''',[aJSONData.AsString]);
|
||||
end;
|
||||
|
||||
procedure ParseUnitTargets(aTargets: TTargets; aJSONData: TJSONData);
|
||||
var
|
||||
AJsonArray: TJSONArray;
|
||||
AJsonObject: TJSONObject;
|
||||
AResourceStrings: boolean;
|
||||
ACPUs: TCPUS;
|
||||
AOSes: TOSes;
|
||||
m: Integer;
|
||||
LastTargetItem: integer;
|
||||
ATarget: ttarget;
|
||||
begin
|
||||
if aJSONData.JSONType=jtArray then
|
||||
begin
|
||||
AJsonArray := aJSONData as TJSONArray;
|
||||
for m := 0 to AJsonArray.Count-1 do
|
||||
ParseUnitTarget(aTargets.AddUnit(''), AJsonArray.Items[m]);
|
||||
end
|
||||
else if aJSONData.JSONType=jtObject then
|
||||
begin
|
||||
AJsonObject := aJSONData as TJSONObject;
|
||||
AresourceStrings:=false;
|
||||
ACpus:=AllCPUs;
|
||||
AOses:=AllOSes;
|
||||
LastTargetItem:=aTargets.Count;
|
||||
for m := 0 to AJsonObject.Count-1 do
|
||||
begin
|
||||
case AJsonObject.Names[m] of
|
||||
'resourcestrings' : AresourceStrings := (AJsonObject.items[m] as TJSONBoolean).AsBoolean;
|
||||
'cpus' : ACPUs := ExtStringToCPUs(AJsonObject.items[m].AsString);
|
||||
'oses' : AOSes := ExtStringToOSes(AJsonObject.items[m].AsString);
|
||||
'targets' : ParseUnitTargets(aTargets, AJsonObject.items[m])
|
||||
else
|
||||
raise Exception.CreateFmt('Unknown targets property ''%s''.',[AJsonObject.Names[m]]);
|
||||
end {case}
|
||||
end;
|
||||
for m := LastTargetItem to aTargets.Count-1 do
|
||||
begin
|
||||
aTarget := aTargets.Items[m] as TTarget;
|
||||
if AresourceStrings then
|
||||
aTarget.ResourceStrings := AresourceStrings;
|
||||
if ACPUs<>AllCPUs then
|
||||
ATarget.CPUs := ACpus;
|
||||
if AOSes<>AllOSes then
|
||||
ATarget.OSes := AOses;
|
||||
end;
|
||||
end
|
||||
else
|
||||
raise Exception.CreateFmt('Invalid unit target ''%s''',[aJSONData.AsString]);
|
||||
end;
|
||||
|
||||
procedure ParseTargets(aTargets: TTargets; aJSONData: TJSONData);
|
||||
var
|
||||
AJsonObject: TJSONObject;
|
||||
m: Integer;
|
||||
begin
|
||||
if aJSONData.JSONType<>jtObject then
|
||||
raise Exception.Create('Invalid targets');
|
||||
AJsonObject := aJSONData as TJSONObject;
|
||||
for m := 0 to AJsonObject.Count-1 do
|
||||
begin
|
||||
case AJsonObject.Names[m] of
|
||||
'units' : ParseUnitTargets(aTargets, AJsonObject.items[m]);
|
||||
else
|
||||
raise Exception.CreateFmt('Unknown targets property ''%s''.',[AJsonObject.Names[m]]);
|
||||
end {case}
|
||||
end;
|
||||
end;
|
||||
|
||||
function ParseFpmakeFile(AFileName: string) : TPackages;
|
||||
var
|
||||
AJsonData : TJSONData;
|
||||
F : TFileStream;
|
||||
P: TJSONParser;
|
||||
begin
|
||||
result := nil;
|
||||
// Parse the JSON-file
|
||||
F:=TFileStream.Create(AFileName,fmopenRead);
|
||||
try
|
||||
P:=TJSONParser.Create(F);
|
||||
try
|
||||
try
|
||||
AJsonData := P.Parse;
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
writeln(Format('Error: Syntax of JSON-file %s is incorrect (%s)', [AFileName, e.Message]));
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
P.Free;
|
||||
end;
|
||||
finally
|
||||
F.Free;
|
||||
end;
|
||||
|
||||
try
|
||||
result := ParseFpmake(AJsonData);
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
writeln(Format('Error, problem in file %s: %s',[AFileName,e.Message]));
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
function ParseFpmake(AJsonData : TJSONData) : TPackages;
|
||||
Var
|
||||
P : TJSONParser;
|
||||
|
||||
MainObject : TJSONObject;
|
||||
ItemObject : TJSONObject;
|
||||
i: Integer;
|
||||
APackages: TPackages;
|
||||
n: Integer;
|
||||
|
||||
procedure AddDependencies(APackage: TPackage; AJsonDependencies: TJSONData);
|
||||
var
|
||||
AJsonDependenciesObj: TJSONObject;
|
||||
m,n,o: Integer;
|
||||
ADependency: TDependency;
|
||||
begin
|
||||
if AJsonDependencies.JSONType<>jtObject then
|
||||
raise Exception.CreateFmt('Invalid dependencies for package %s',[APackage.Name]);
|
||||
AJsonDependenciesObj := AJsonDependencies as TJSONObject;
|
||||
for m := 0 to AJsonDependenciesObj.Count-1 do
|
||||
begin
|
||||
case AJsonDependenciesObj.Names[m] of
|
||||
'packages' : ParseConditionalArray(APackage.Dependencies, AJsonDependenciesObj.items[m],'name');
|
||||
else
|
||||
raise Exception.CreateFmt('Unknown dependency property ''%s''.',[ItemObject.Names[m]]);
|
||||
end {case}
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
APackage: TPackage;
|
||||
|
||||
begin
|
||||
// Convert the JSON-Data to a packages-class
|
||||
if AJsonData.JSONType <> jtObject then
|
||||
raise Exception.Create('File does not contain any objects.');
|
||||
|
||||
APackages := TPackages.Create(TPackage);
|
||||
try
|
||||
MainObject := AJsonData as TJSONObject;
|
||||
for i := 0 to MainObject.Count-1 do
|
||||
begin
|
||||
if MainObject.Names[i]='package' then
|
||||
begin
|
||||
AJsonData := MainObject.Items[i];
|
||||
if (AJsonData.JSONType <> jtObject) then
|
||||
raise Exception.Create('File does not contain any objects.');
|
||||
ItemObject := AJsonData as TJSONObject;
|
||||
|
||||
APackage := APackages.AddPackage('');
|
||||
for n := 0 to ItemObject.Count-1 do
|
||||
begin
|
||||
case ItemObject.Names[n] of
|
||||
'title' : APackage.Name := ItemObject.items[n].AsString;
|
||||
'directory' : APackage.Directory := ItemObject.items[n].AsString;
|
||||
'version' : APackage.version := ItemObject.items[n].AsString;
|
||||
'oses' : APackage.OSes := ExtStringToOSes(ItemObject.items[n].AsString);
|
||||
'cpus' : APackage.CPUs := ExtStringToCPUs(ItemObject.items[n].AsString);
|
||||
'dependencies' : AddDependencies(APackage, ItemObject.items[n]);
|
||||
'sourcepaths' : ParseConditionalArray(APackage.SourcePath, ItemObject.items[n],'path');
|
||||
'targets' : ParseTargets(APackage.Targets, ItemObject.items[n]);
|
||||
'email' : APackage.Email := ItemObject.items[n].AsString;
|
||||
'author' : APackage.Author := ItemObject.items[n].AsString;
|
||||
'license' : APackage.License := ItemObject.items[n].AsString;
|
||||
'homepageurl' : APackage.HomepageURL := ItemObject.items[n].AsString;
|
||||
'description' : APackage.Description := ItemObject.items[n].AsString;
|
||||
'needlibc' : APackage.NeedLibC := (ItemObject.items[n] as TJSONBoolean).AsBoolean;
|
||||
else
|
||||
raise Exception.CreateFmt('Unknown package property ''%s''.',[ItemObject.Names[n]]);
|
||||
end {case}
|
||||
end;
|
||||
|
||||
end;
|
||||
end;
|
||||
Result := APackages;
|
||||
except
|
||||
APackages.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
GSetStrings := nil;
|
||||
finalization
|
||||
GSetStrings.Free;
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user