From c4eca70656384f12dfb2c542c06ad3760a9dca41 Mon Sep 17 00:00:00 2001 From: Tomas Hajny Date: Mon, 8 Dec 2014 17:58:34 +0000 Subject: [PATCH] + added new command 'pkglist' for listing of packages in format compatible with 'install.dat' file used by the text-mode installer - primarily for GO32v2 and OS/2 targets git-svn-id: trunk@29221 - --- packages/fpmkunit/src/fpmkunit.pp | 167 +++++++++++++++++++++++++++--- 1 file changed, 153 insertions(+), 14 deletions(-) diff --git a/packages/fpmkunit/src/fpmkunit.pp b/packages/fpmkunit/src/fpmkunit.pp index a97b9710ef..75894785fc 100644 --- a/packages/fpmkunit/src/fpmkunit.pp +++ b/packages/fpmkunit/src/fpmkunit.pp @@ -146,7 +146,7 @@ Type TLogEvent = Procedure (Level : TVerboseLevel; Const Msg : String) of Object; TNotifyProcEvent = procedure(Sender: TObject); - TRunMode = (rmCompile,rmBuild,rmInstall,rmArchive,rmClean,rmDistClean,rmManifest,rmZipInstall); + TRunMode = (rmCompile,rmBuild,rmInstall,rmArchive,rmClean,rmDistClean,rmManifest,rmZipInstall,rmPkgList); TBuildMode = (bmOneByOne, bmBuildUnit{, bmSkipImplicitUnits}); TBuildModes = set of TBuildMode; @@ -234,6 +234,8 @@ Const FPMakePPFile = 'fpmake.pp'; ManifestFile = 'manifest.xml'; + PkgListFileBase = 'pkg-'; + PkgListFileExt = '.lst'; DirNotFound = ''; @@ -703,6 +705,8 @@ Type FAfterInstallProc: TNotifyProcEvent; FAfterManifest: TNotifyEvent; FAfterManifestProc: TNotifyProcEvent; + FAfterPkgList: TNotifyEvent; + FAfterPkgListProc: TNotifyProcEvent; FBeforeArchive: TNotifyEvent; FBeforeArchiveProc: TNotifyProcEvent; FBeforeClean: TNotifyEvent; @@ -713,6 +717,8 @@ Type FBeforeInstallProc: TNotifyProcEvent; FBeforeManifest: TNotifyEvent; FBeforeManifestProc: TNotifyProcEvent; + FBeforePkgList: TNotifyEvent; + FBeforePkgListProc: TNotifyProcEvent; FBuildMode: TBuildMode; FFlags: TStrings; FFPDocFormat: TFPDocFormats; @@ -792,6 +798,7 @@ Type Procedure GetArchiveFiles(List : TStrings; ACPU:TCPU; AOS : TOS); virtual; Procedure GetArchiveSourceFiles(List : TStrings); virtual; Procedure GetManifest(Manifest : TStrings); + Procedure ListPackage(PkgList : TStrings); Procedure AddPackageVariant(APackageVariant: TPackageVariants); procedure ApplyPackageVariantToCompilerOptions(ACompilerOptions: tstrings); procedure SetDefaultPackageVariant; @@ -856,6 +863,10 @@ Type Property BeforeManifestProc : TNotifyProcEvent Read FBeforeManifestProc Write FBeforeManifestProc; Property AfterManifest : TNotifyEvent Read FAfterManifest Write FAfterManifest; Property AfterManifestProc : TNotifyProcEvent Read FAfterManifestProc Write FAfterManifestProc; + Property BeforePkgList : TNotifyEvent Read FBeforePkgList Write FBeforePkgList; + Property BeforePkgListProc : TNotifyProcEvent Read FBeforePkgListProc Write FBeforePkgListProc; + Property AfterPkgList : TNotifyEvent Read FAfterPkgList Write FAfterPkgList; + Property AfterPkgListProc : TNotifyProcEvent Read FAfterPkgListProc Write FAfterPkgListProc; end; { TPackages } @@ -909,6 +920,7 @@ Type FNoFPCCfg: Boolean; FUseEnvironment: Boolean; FZipPrefix: String; + FExplicitOSNone: Boolean; function GetBuildCPU: TCpu; function GetBuildOS: TOS; function GetBuildString: String; @@ -955,6 +967,7 @@ Type Property Target : String Read FTarget Write SetTarget; Property OS : TOS Read FOS Write SetOS; Property CPU : TCPU Read FCPU Write SetCPU; + Property ExplicitOSNone: Boolean read FExplicitOSNone Write FExplicitOSNone; Property BuildString : String read GetBuildString; Property BuildOS : TOS read GetBuildOS; Property BuildCPU : TCpu read GetBuildCPU; @@ -1040,11 +1053,13 @@ Type FAfterCompile: TNotifyEvent; FAfterInstall: TNotifyEvent; FAfterManifest: TNotifyEvent; + FAfterPkgList: TNotifyEvent; FBeforeArchive: TNotifyEvent; FBeforeClean: TNotifyEvent; FBeforeCompile: TNotifyEvent; FBeforeInstall: TNotifyEvent; FBeforeManifest: TNotifyEvent; + FBeforePkgList: TNotifyEvent; FOnCopyFile: TCopyFileProc; FOnFinishCopy: TNotifyEvent; @@ -1140,6 +1155,7 @@ Type Procedure Install(APackage : TPackage; AnArchiveFiles: boolean); Procedure Archive(APackage : TPackage); Procedure Manifest(APackage : TPackage); + Procedure PkgList(PkgList: TStrings; APackage : TPackage); Procedure Clean(APackage : TPackage; AllTargets: boolean); Procedure Clean(APackage : TPackage; ACPU:TCPU; AOS : TOS); Procedure CompileDependencies(APackage : TPackage); @@ -1152,6 +1168,7 @@ Type Procedure ZipInstall(Packages : TPackages); Procedure Archive(Packages : TPackages); procedure Manifest(Packages: TPackages); + procedure PkgList(Packages: TPackages); Procedure Clean(Packages : TPackages; AllTargets: boolean); Procedure Log(Level : TVerboseLevel; Msg : String); @@ -1172,6 +1189,8 @@ Type Property AfterArchive : TNotifyEvent Read FAfterArchive Write FAfterArchive; Property BeforeManifest : TNotifyEvent Read FBeforeManifest Write FBeforeManifest; Property AfterManifest : TNotifyEvent Read FAfterManifest Write FAfterManifest; + Property BeforePkgList : TNotifyEvent Read FBeforePkgList Write FBeforePkgList; + Property AfterPkgList : TNotifyEvent Read FAfterPkgList Write FAfterPkgList; Property OnLog : TLogEvent Read FOnLog Write FOnlog; end; @@ -1204,6 +1223,7 @@ Type Procedure ZipInstall; virtual; Procedure Archive; virtual; Procedure Manifest; virtual; + Procedure PkgList; virtual; Public Constructor Create(AOwner : TComponent); virtual; Destructor destroy; override; @@ -1328,6 +1348,13 @@ Implementation uses typinfo, rtlconsts; +const +{$ifdef CREATE_TAR_FILE} + ArchiveExtension = '.tar.gz'; +{$else CREATE_TAR_FILE} + ArchiveExtension = '.zip'; +{$endif CREATE_TAR_FILE} + {----------------- from strutils ---------------------} function FindPart(const HelpWilds, inputStr: string): Integer; @@ -1537,6 +1564,7 @@ ResourceString SInfoArchivingPackage = 'Archiving package %s in "%s"'; SInfoCleaningPackage = 'Cleaning package %s'; SInfoManifestPackage = 'Creating manifest for package %s'; + SInfoPkgListPackage = 'Adding package %s to the package list'; SInfoCopyingFile = 'Copying file "%s" to "%s"'; SInfoDeletedFile = 'Deleted file "%s"'; SInfoRemovedDirectory = 'Removed directory "%s"'; @@ -1563,6 +1591,7 @@ ResourceString SDbgExternalDependency = 'External dependency %s found in "%s"'; SDbgBuildEngineArchiving = 'Build engine archiving'; SDbgBuildEngineGenerateManifests = 'Build engine generating manifests'; + SDbgBuildEngineGeneratePkgList = 'Build engine generating package list'; SDbgBuildEngineCleaning = 'Build engine cleaning'; SDbgGenerating = 'Generating "%s"'; SDbgLoading = 'Loading "%s"'; @@ -1600,6 +1629,7 @@ ResourceString SHelpArchive = 'Create archive (zip) with all units in the package(s).'; SHelpHelp = 'This message.'; SHelpManifest = 'Create a manifest suitable for import in repository.'; + SHelpPkgList = 'Create list of all packages suitable for FPC installer.'; SHelpZipInstall = 'Install all units in the package(s) into an archive.'; SHelpCmdOptions = 'Where options is one or more of the following:'; SHelpCPU = 'Compile for indicated CPU.'; @@ -2138,17 +2168,23 @@ begin end; -Function MakeTargetString(CPU : TCPU;OS: TOS) : String; +Function MakeTargetString(CPU : TCPU;OS: TOS;ALimit83: boolean) : String; begin - if (Defaults.BuildOS in AllLimit83fsOses) or - (OS in AllLimit83fsOses) then + if ALimit83 then Result := OSToString(OS) else Result:=CPUToString(CPU)+'-'+OSToString(OS); end; -function MakeZipSuffix(CPU : TCPU;OS: TOS) : String; +Function MakeTargetString(CPU : TCPU;OS: TOS) : String; + +begin + Result := MakeTargetString (CPU, OS, + (Defaults.BuildOS in AllLimit83fsOses) or (OS in AllLimit83fsOses)); +end; + +function MakeZipSuffix(CPU : TCPU;OS: TOS;ALimit83: boolean) : String; begin case OS of @@ -2158,17 +2194,23 @@ begin emx: result := 'emx'; osNone: begin - if (Defaults.BuildOS in AllLimit83fsOses) or - (OS in AllLimit83fsOses) then + if ALimit83 then result := 'src' else result := '.source' end else - result := '.' + MakeTargetString(CPU, OS); + result := '.' + MakeTargetString(CPU, OS, ALimit83); end; end; +function MakeZipSuffix(CPU : TCPU;OS: TOS) : String; + +begin + Result := MakeZipSuffix (CPU, OS, + (Defaults.BuildOS in AllLimit83fsOses) or (OS in AllLimit83fsOses)); +end; + Procedure StringToCPUOS(const S : String; Var CPU : TCPU; Var OS: TOS); Var @@ -3496,6 +3538,44 @@ begin end; end; +Procedure TPackage.ListPackage(PkgList : TStrings); + + function GetArchiveName (const APackage: TPackage; ALimit83: boolean): string; + begin +{ Special hack to allow both long and short source files being recognized } + if ALimit83 and (Defaults.ZipPrefix = 'units-') then + result := 'u' + else + result := Defaults.ZipPrefix; + if ALimit83 then + result := result + APackage.ShortName + else + result := result + APackage.Name; + result := result + MakeZipSuffix(Defaults.CPU, Defaults.OS, ALimit83); + end; + +Var + S : String; +begin + if OSes = AllOSes then + Exit; + if ({(OSes = AllOSes) or }(Defaults.OS = osNone) or + (Defaults.OS in OSes)) and + ((Defaults.CPU in CPUs) or (Defaults.CPU = cpuNone)) then + begin + if Defaults.OS = osNone then + PkgList.Add (Format ('# Source %d', [Succ (PkgList.Count div 2)])) + else {if OSes <> AllOSes then} + PkgList.Add (Format ('# ' + OSToString(Defaults.OS) + ' %d', [Succ (PkgList.Count div 2)])); + S := 'package=' + GetArchiveName (Self, false) + ArchiveExtension; + if ((ShortName <> Name) or (Defaults.ZipPrefix = 'units-')) and + ((Defaults.OS in AllLimit83fsOSes) or (Defaults.OS = osNone)) then + S := S + '[' + GetArchiveName (Self, true) + ArchiveExtension + ']'; + S := S + ',' + Description; + PkgList.Add(S); + end; +end; + procedure TPackage.AddPackageVariant(APackageVariant: TPackageVariants); begin if not assigned(APackageVariant.FMasterPackage) then @@ -4083,7 +4163,8 @@ var infoSL : TStringList; {$endif HAS_UNIT_PROCESS} begin - if (CPU=cpuNone) or (OS=osNone) or (FCompilerVersion='') then + if (CPU=cpuNone) or ((OS=osNone) and not ExplicitOSNone) or + (FCompilerVersion='') then begin {$ifdef HAS_UNIT_PROCESS} // Detect compiler version/target from -i option @@ -4096,13 +4177,13 @@ begin FCompilerVersion:=infosl[0]; if CPU=cpuNone then CPU:=StringToCPU(infosl[1]); - if OS=osNone then + if (OS=osNone) and not ExplicitOSNone then OS:=StringToOS(infosl[2]); {$else HAS_UNIT_PROCESS} // Defaults taken from compiler used to build fpmake if CPU=cpuNone then CPU:=StringToCPU({$I %FPCTARGETCPU%}); - if OS=osNone then + if (OS=osNone) and not ExplicitOSNone then OS:=StringToOS({$I %FPCTARGETOS%}); if FCompilerVersion='' then FCompilerVersion:={$I %FPCVERSION%}; @@ -4524,12 +4605,17 @@ begin FRunMode:=rmarchive else if CheckCommand(I,'M','manifest') then FRunMode:=rmManifest + else if CheckCommand(I,'l','pkglist') then + FRunMode:=rmPkgList else if CheckOption(I,'h','help') then Usage('',[]) else if Checkoption(I,'C','cpu') then Defaults.CPU:=StringToCPU(OptionArg(I)) else if Checkoption(I,'O','os') then - Defaults.OS:=StringToOS(OptionArg(I)) + begin + Defaults.OS:=StringToOS(OptionArg(I)); + Defaults.ExplicitOSNone := OptionArg(I) = OSToString(osNone); + end else if Checkoption(I,'t','target') then Defaults.Target:=OptionArg(I) else if CheckOption(I,'l','list-commands') then @@ -4631,6 +4717,7 @@ begin LogCmd('archive',SHelpArchive); LogCmd('manifest',SHelpManifest); LogCmd('zipinstall',SHelpZipInstall); + LogCmd('pkglist',SHelpPkgList); Log(vlInfo,SHelpCmdOptions); LogOption('h','help',SHelpHelp); LogOption('l','list-commands',SHelpList); @@ -4708,6 +4795,12 @@ begin end; +procedure TCustomInstaller.PkgList; +begin + BuildEngine.PkgList(Packages); +end; + + procedure TCustomInstaller.CheckPackages; begin If (Packages.Count=0) then @@ -4731,6 +4824,7 @@ begin rmClean : Clean(False); rmDistClean: Clean(True); rmManifest : Manifest; + rmPkgList : PkgList; end; except On E : Exception do @@ -4824,7 +4918,7 @@ begin {$ifdef HAS_TAR_SUPPORT} if not assigned(FTarWriter) then begin - FGZFileStream := TGZFileStream.create(GetArchiveName +'.tar.gz', gzopenwrite); + FGZFileStream := TGZFileStream.create(GetArchiveName + ArchiveExtension, gzopenwrite); try FTarWriter := TTarWriter.Create(FGZFileStream); FTarWriter.Permissions := [tpReadByOwner, tpWriteByOwner, tpReadByGroup, tpReadByOther]; @@ -4855,7 +4949,7 @@ begin if not assigned(FZipper) then begin FZipper := TZipper.Create; - FZipper.FileName := GetArchiveName + '.zip'; + FZipper.FileName := GetArchiveName + ArchiveExtension; end; FZipper.Entries.AddFileEntry(ASourceFileName, ADestFileName); @@ -7046,6 +7140,13 @@ begin end; +Procedure TBuildEngine.PkgList(PkgList: TStrings; APackage : TPackage); +begin + Log(vlInfo, Format(SInfoPkgListPackage,[APackage.Name])); + APackage.ListPackage(PkgList); +end; + + procedure TBuildEngine.Compile(Packages: TPackages); function IsReadyToCompile(APackage:TPackage): boolean; @@ -7286,6 +7387,44 @@ begin end; +procedure TBuildEngine.PkgList(Packages: TPackages); +Var + I : Integer; + P : TPackage; + L : TStrings; + PKGL : String; +begin + L:=TStringList.Create; + If Assigned(BeforePkgList) then + BeforePkgList(Self); + Log(vlDebug, SDbgBuildEngineGeneratePkgList); +{ Consider only the target OS, because the installer would be run there } + if Defaults.OS in AllLimit83fsOSes then + PKGL := PkgListFileBase + OSToString (Defaults.OS) + PkgListFileExt + else if Defaults.OS = osNone then + PKGL := PkgListFileBase + 'src' + PkgListFileExt + else + PKGL := PkgListFileBase + CPUToString (Defaults.CPU) + '-' + + OSToString (Defaults.OS) + PkgListFileExt; + + Try + Log(vlDebug, Format(SDbgGenerating, [PKGL])); + + For I:=0 to Packages.Count-1 do + begin + P:=Packages.PackageItems[i]; + PkgList(L, P); + end; + + L.SaveToFile(PKGL); + Finally + L.Free; + end; + + If Assigned(AfterPkgList) then + AfterPkgList(Self); +end; + procedure TBuildEngine.Clean(Packages: TPackages; AllTargets: boolean); Var I : Integer;