diff --git a/.gitattributes b/.gitattributes index dc483e617d..9dfb170b24 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/utils/fpgmake/fpgmake.pp b/utils/fpgmake/fpgmake.pp new file mode 100644 index 0000000000..0cef7bba59 --- /dev/null +++ b/utils/fpgmake/fpgmake.pp @@ -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. diff --git a/utils/fpgmake/fpmake.cft b/utils/fpgmake/fpmake.cft new file mode 100644 index 0000000000..5d062b78b2 --- /dev/null +++ b/utils/fpgmake/fpmake.cft @@ -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} + diff --git a/utils/fpgmake/fpmake.inc b/utils/fpgmake/fpmake.inc new file mode 100644 index 0000000000..c8ce462d8b --- /dev/null +++ b/utils/fpgmake/fpmake.inc @@ -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 +); diff --git a/utils/fpgmake/fpmakecreatefile.pas b/utils/fpgmake/fpmakecreatefile.pas new file mode 100644 index 0000000000..c9298446ab --- /dev/null +++ b/utils/fpgmake/fpmakecreatefile.pas @@ -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. + diff --git a/utils/fpgmake/fpmakeparsejson.pas b/utils/fpgmake/fpmakeparsejson.pas new file mode 100644 index 0000000000..09deb6b42a --- /dev/null +++ b/utils/fpgmake/fpmakeparsejson.pas @@ -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. +