Browse Source

* Added ability to add a repository with available packages which does not
need to be installed. (Instead another repository with installed
packages is added to the same location.
* Added the ability to couple a repository with available packages
to a repository in which the packages should be installed

git-svn-id: trunk@34865 -

joost 8 năm trước cách đây
mục cha
commit
89b471a8d6

+ 30 - 0
packages/fppkg/src/fprepos.pp

@@ -29,19 +29,27 @@ Const
 
 type
   TFPRepositoryType = (fprtUnknown, fprtInstalled, fprtAvailable);
+  TFPInstallationNeeded = (fpinInstallationNeeded, fpinNoInstallationNeeded, fpinInstallationImpossible);
   TFPRepository = class;
   TFPPackage = class;
 
   { TFPCustomPackagesStructure }
 
   TFPCustomPackagesStructure = Class(TComponent)
+  private
+    FInstallRepositoryName: string;
+    function GetInstallRepositoryName: string;
+    procedure SetInstallRepositoryName(AValue: string);
   public
     function AddPackagesToRepository(ARepository: TFPRepository): Boolean; virtual; abstract;
     function GetUnitDirectory(APackage: TFPPackage): string; virtual;
     function GetBuildPathDirectory(APackage: TFPPackage): string; virtual;
     function GetPrefix: string; virtual;
     function GetBaseInstallDir: string; virtual;
+    function GetConfigFileForPackage(APackageName: string): string; virtual;
     function UnzipBeforeUse: Boolean; virtual;
+    function IsInstallationNeeded(APackage: TFPPackage): TFPInstallationNeeded; virtual;
+    property InstallRepositoryName: string read GetInstallRepositoryName write SetInstallRepositoryName;
   end;
 
   { TFPDependency }
@@ -353,11 +361,32 @@ begin
   raise Exception.Create('It is not possible to install into this repository.');
 end;
 
+function TFPCustomPackagesStructure.GetConfigFileForPackage(APackageName: string): string;
+begin
+  Result := IncludeTrailingPathDelimiter(GetBaseInstallDir)+
+    'fpmkinst'+PathDelim+GFPpkg.CompilerOptions.CompilerTarget+PathDelim+APackageName+FpmkExt;
+end;
+
 function TFPCustomPackagesStructure.UnzipBeforeUse: Boolean;
 begin
   Result := False;
 end;
 
+function TFPCustomPackagesStructure.IsInstallationNeeded(APackage: TFPPackage): TFPInstallationNeeded;
+begin
+  result := fpinInstallationNeeded;
+end;
+
+function TFPCustomPackagesStructure.GetInstallRepositoryName: string;
+begin
+  Result := FInstallRepositoryName;
+end;
+
+procedure TFPCustomPackagesStructure.SetInstallRepositoryName(AValue: string);
+begin
+  FInstallRepositoryName := AValue;
+end;
+
 { TFPPackage }
 
 procedure TFPPackage.SetVersion(const AValue: TFPVersion);
@@ -525,6 +554,7 @@ var
 begin
   With AStringList do
     begin
+      Name:=Values[KeyName];
       Version.AsString:=Values[KeyVersion];
       SourcePath:=Values[KeySourcePath];
       FPMakeOptionsString:=Values[KeyFPMakeOptions];

+ 39 - 7
packages/fppkg/src/pkgcommands.pp

@@ -80,10 +80,20 @@ type
   { TCommandInstall }
 
   TCommandInstall = Class(TPackagehandler)
+  protected
+    function ForceInstall: Boolean; virtual;
   Public
     Procedure Execute;override;
   end;
 
+  { TCommandInstallForced }
+
+  TCommandInstallForced = Class(TCommandInstall)
+  protected
+    function ForceInstall: Boolean; override;
+  end;
+
+
   { TCommandUnInstall }
 
   TCommandUnInstall = Class(TPackagehandler)
@@ -136,6 +146,13 @@ type
 var
   DependenciesDepth: integer;
 
+{ TCommandInstallForced }
+
+function TCommandInstallForced.ForceInstall: Boolean;
+begin
+  Result := True;
+end;
+
 { TCommandInfo }
 
 procedure TCommandInfo.Execute;
@@ -360,6 +377,10 @@ begin
   ExecuteAction(PackageName,'fpmakebuild');
 end;
 
+function TCommandInstall.ForceInstall: Boolean;
+begin
+  Result := False;
+end;
 
 procedure TCommandInstall.Execute;
 
@@ -375,8 +396,7 @@ var
     Result := '';
     if Assigned(InstallRepo.DefaultPackagesStructure) then
       begin
-        Result := InstallRepo.DefaultPackagesStructure.GetBaseInstallDir;
-        ConfFile := IncludeTrailingPathDelimiter(Result)+'fpmkinst'+PathDelim+GFPpkg.CompilerOptions.CompilerTarget+PathDelim+s+FpmkExt;
+        ConfFile := InstallRepo.DefaultPackagesStructure.GetConfigFileForPackage(s);
         if not FileExistsLog(ConfFile) then
           begin
             // If there is no fpm-file, search for an (obsolete, pre-2.7.x)
@@ -392,11 +412,23 @@ var
 
 var
   UFN : String;
+  AvailPackage: TFPPackage;
 begin
   if PackageName<>'' then
     begin
       ExecuteAction(PackageName,'build');
-      ExecuteAction(PackageName,'fpmakeinstall');
+
+      AvailPackage := GFPpkg.FindPackage(PackageName, pkgpkAvailable);
+      InstallRepo := GFPpkg.GetInstallRepository(AvailPackage);
+      case InstallRepo.DefaultPackagesStructure.IsInstallationNeeded(AvailPackage) of
+        fpinInstallationNeeded:
+          ExecuteAction(PackageName,'fpmakeinstall');
+        fpinInstallationImpossible:
+          Error(SErrInstallationImpossible,[PackageName, InstallRepo.RepositoryName]);
+        else if ForceInstall then
+          ExecuteAction(PackageName,'fpmakeinstall');
+      end;
+
       if (PackageName=CmdLinePackageName) or (PackageName=CurrentDirPackageName) or
          (PackageName=URLPackageName) then
         begin
@@ -410,7 +442,6 @@ begin
       else
         S:=PackageName;
 
-      InstallRepo := GFPpkg.RepositoryByName(GFPpkg.Options.CommandLineSection.InstallRepository);
       if Assigned(InstallRepo) then
         begin
           P := InstallRepo.FindPackage(S);
@@ -563,7 +594,7 @@ begin
       inc(DependenciesDepth);
 
       for i:=0 to L.Count-1 do
-        ExecuteAction(L[i],'install');
+        ExecuteAction(L[i],'install-req');
 
       dec(DependenciesDepth);
       if DependenciesDepth=0 then
@@ -589,7 +620,7 @@ begin
     for i:=0 to SL.Count-1 do
       begin
         ExecuteAction(SL[i],'build');
-        ExecuteAction(SL[i],'install');
+        ExecuteAction(SL[i],'install-req');
       end;
   until false;
   FreeAndNil(SL);
@@ -605,7 +636,8 @@ initialization
   RegisterPkgHandler('unzip',TCommandUnzip);
   RegisterPkgHandler('compile',TCommandCompile);
   RegisterPkgHandler('build',TCommandBuild);
-  RegisterPkgHandler('install',TCommandInstall);
+  RegisterPkgHandler('install',TCommandInstallForced);
+  RegisterPkgHandler('install-req',TCommandInstall);
   RegisterPkgHandler('uninstall',TCommandUnInstall);
   RegisterPkgHandler('clean',TCommandClean);
   RegisterPkgHandler('archive',TCommandArchive);

+ 20 - 0
packages/fppkg/src/pkgfppkg.pp

@@ -46,6 +46,8 @@ type
     function FindRepository(ARepositoryName: string): TFPRepository;
     function RepositoryByName(ARepositoryName: string): TFPRepository;
 
+    function GetInstallRepository(APackage: TFPPackage): TFPRepository;
+
     procedure ScanInstalledPackagesForAvailablePackages;
 
     property Options: TFppkgOptions read FOptions;
@@ -327,6 +329,24 @@ begin
     Raise EPackage.CreateFmt(SErrMissingInstallRepo,[ARepositoryName]);
 end;
 
+function TpkgFPpkg.GetInstallRepository(APackage: TFPPackage): TFPRepository;
+var
+  InstRepositoryName: string;
+  Repo: TFPRepository;
+begin
+  Result := GFPpkg.RepositoryByName(GFPpkg.Options.CommandLineSection.InstallRepository);
+  if Assigned(APackage) and Assigned(APackage.Repository) and Assigned(APackage.Repository.DefaultPackagesStructure) then
+    begin
+      InstRepositoryName := APackage.Repository.DefaultPackagesStructure.InstallRepositoryName;
+      if (InstRepositoryName<>'') then
+        begin
+          Repo := FindRepository(InstRepositoryName);
+          if Assigned(Repo) then
+            Result := Repo;
+        end;
+    end;
+end;
+
 procedure TpkgFPpkg.ScanInstalledPackagesForAvailablePackages;
 var
   i: Integer;

+ 3 - 1
packages/fppkg/src/pkgmessages.pp

@@ -56,6 +56,7 @@ Resourcestring
   SErrManifestNoSinglePackage = 'Manifest file "%s" does not contain exactly one package';
   SErrCannotModifyRepository = 'The repository of an TFPPackages-instance can not be changed.';
   SErrRepositoryNotAssigned  = 'Repository not assigned';
+  SErrInstallationImpossible = 'It is not possible to install the package "%s" in repository "%s".';
 
   SLogGeneratingFPMake       = 'Generating fpmake.pp';
   SLogNotCompilingFPMake     = 'Skipping compiling of fpmake.pp, fpmake executable already exists';
@@ -76,7 +77,7 @@ Resourcestring
   SLogGeneratingCompilerConfig  = 'Generating default compiler configuration in "%s"';
   SLogLoadingPackagesFile    = 'Loading available packages from "%s"';
   SLogLoadingMirrorsFile     = 'Loading available mirrors from "%s"';
-  SLogFindInstalledPackages  = 'Finding installed packages in "%s"';
+  SLogFindInstalledPackages  = 'Searching for installed packages in "%s"';
   SLogFoundFPMakeAddin       = 'Found FPMake-AddIn "%s"';
   SLogSavingStatusFile       = 'Saving local status to "%s"';
   SLogFPMKUnitDepVersion     = 'Checking for %s %s, installed %s, available %s';
@@ -115,6 +116,7 @@ Resourcestring
   SLogRepositoryDescription       = '  Description:      "%s"';
   SLogRepositoryPath              = '  Dir:              "%s" -> "%s"';
   SLogRepositoryPrefix            = '  Prefix:           "%s" -> "%s"';
+  SLogInstallRepository           = '  InstallRepository:"%s"';
 
   SLogIncludeFile                 = '  IncludeFile:           "%s" -> "\%s"';
   SLogIncludeFileMask             = '  IncludeFileMask:       "%s" -> "\%s"';

+ 10 - 0
packages/fppkg/src/pkgoptions.pp

@@ -115,6 +115,7 @@ Type
   TFppkgRepositoryOptionSection = class(TFppkgOptionSection)
   private
     FDescription: string;
+    FInstallRepositoryName: string;
     FPath: string;
     FPrefix: string;
     FRepositoryName: string;
@@ -136,6 +137,7 @@ Type
     property Description: string read FDescription write SetDescription;
     property Path: string read GetPath write SetPath;
     property Prefix: string read GetPrefix write SetPrefix;
+    property InstallRepositoryName: string read FInstallRepositoryName write FInstallRepositoryName;
   end;
 
   { TFppkgIncludeFilesOptionSection }
@@ -280,6 +282,7 @@ Const
   KeyGlobalSection         = 'Global';
   KeyRepositorySection     = 'Repository';
   KeySrcRepositorySection  = 'UninstalledSourceRepository';
+  KeyUninstalledRepository = 'UninstalledRepository';
   KeyIncludeFilesSection   = 'IncludeFiles';
   KeyRemoteMirrorsURL      = 'RemoteMirrors';
   KeyRemoteRepository      = 'RemoteRepository';
@@ -297,6 +300,7 @@ Const
   KeyRepositoryDescription = 'Description';
   KeyRepositoryPath        = 'Path';
   KeyRepositoryPrefix      = 'Prefix';
+  KeyInstallRepositoryName = 'InstallRepository';
 
   KeyIncludeFile           = 'File';
   KeyIncludeFileMask       = 'FileMask';
@@ -442,6 +446,8 @@ begin
     Path := AValue
   else if SameText(AKey,KeyRepositoryPrefix) then
     Prefix := AValue
+  else if SameText(AKey,KeyInstallRepositoryName) then
+    InstallRepositoryName := AValue
 end;
 
 procedure TFppkgRepositoryOptionSection.LogValues(ALogLevel: TLogLevel);
@@ -451,6 +457,7 @@ begin
   log(ALogLevel,SLogRepositoryDescription,[FDescription]);
   log(ALogLevel,SLogRepositoryPath,[FPath,Path]);
   log(ALogLevel,SLogRepositoryPrefix,[FPrefix,Prefix]);
+  log(ALogLevel,SLogInstallRepository,[FInstallRepositoryName]);
 end;
 
 function TFppkgRepositoryOptionSection.AllowDuplicate: Boolean;
@@ -475,6 +482,7 @@ begin
       Result.RepositoryName := RepositoryName;
       Result.Description := Description;
       InstPackages := TFPInstalledPackagesStructure.Create(AParent, Path, ACompilerOptions);
+      InstPackages.InstallRepositoryName := InstallRepositoryName;
       Result.DefaultPackagesStructure := InstPackages;
       InstPackages.Prefix:=Prefix;
     end;
@@ -808,6 +816,8 @@ begin
                   CurrentSection := TFppkgUninstalledSourceRepositoryOptionSection.Create(FOptionParser)
                 else if SameText(s, KeyIncludeFilesSection) then
                   CurrentSection := TFppkgIncludeFilesOptionSection.Create(FOptionParser, Self, ExtractFileDir(AFileName))
+                else if SameText(s, KeyUninstalledRepository) then
+                  CurrentSection := TFppkgUninstalledRepositoryOptionSection.Create(FOptionParser)
                 else
                   CurrentSection := TFppkgCustomOptionSection.Create(FOptionParser);
                 FSectionList.Add(CurrentSection);

+ 145 - 10
packages/fppkg/src/pkguninstalledsourcesrepository.pp

@@ -22,10 +22,8 @@ type
   { TFppkgUninstalledSourceRepositoryOptionSection }
 
   TFppkgUninstalledSourceRepositoryOptionSection = class(TFppkgRepositoryOptionSection)
-  private
   public
     constructor Create(AnOptionParser: TTemplateParser); override;
-    procedure AddKeyValue(const AKey, AValue: string); override;
     function InitRepository(AParent: TComponent; ACompilerOptions: TCompilerOptions): TFPRepository; override;
 
     function GetRepositoryType: TFPRepositoryType; override;
@@ -39,22 +37,159 @@ type
     function GetBuildPathDirectory(APackage: TFPPackage): string; override;
   end;
 
+
+  { TFppkgUninstalledRepositoryOptionSection }
+
+  TFppkgUninstalledRepositoryOptionSection = class(TFppkgRepositoryOptionSection)
+  private
+    FSourceRepositoryName: string;
+  public
+    function InitRepository(AParent: TComponent; ACompilerOptions: TCompilerOptions): TFPRepository; override;
+
+    procedure AddKeyValue(const AKey, AValue: string); override;
+    procedure LogValues(ALogLevel: TLogLevel); override;
+    function GetRepositoryType: TFPRepositoryType; override;
+    property SourceRepositoryName: string read FSourceRepositoryName write FSourceRepositoryName;
+  end;
+
+  { TFPUninstalledSourcesPackagesStructure }
+
+  TFPUninstalledSourcesPackagesStructure = class(TFPCustomFileSystemPackagesStructure)
+  private
+    FSourceRepositoryName: string;
+  public
+    function AddPackagesToRepository(ARepository: TFPRepository): Boolean; override;
+    function IsInstallationNeeded(APackage: TFPPackage): TFPInstallationNeeded; override;
+    function GetBaseInstallDir: string; override;
+    function GetConfigFileForPackage(APackageName: string): string; override;
+    property SourceRepositoryName: string read FSourceRepositoryName write FSourceRepositoryName;
+  end;
+
+
 implementation
 
 const
-  KeyScanForUnits = 'ScanForUnits';
-  KeyUnitPath     = 'UnitPath';
+  KeyScanForUnits      = 'ScanForUnits';
+  KeyUnitPath          = 'UnitPath';
+  KeySourceRepository  = 'SourceRepository';
 
-{ TFppkgUninstalledSourceRepositoryOptionSection }
+  SLogSourceRepository = '  SourceRepository:%s';
 
-constructor TFppkgUninstalledSourceRepositoryOptionSection.Create(AnOptionParser: TTemplateParser);
+{ TFPUninstalledSourcesPackagesStructure }
+
+function TFPUninstalledSourcesPackagesStructure.AddPackagesToRepository(ARepository: TFPRepository): Boolean;
+
+  procedure LoadPackagefpcFromFile(APackage:TFPPackage;const AFileName: String);
+  Var
+    L : TStrings;
+    V : String;
+  begin
+    L:=TStringList.Create;
+    Try
+      ReadIniFile(AFileName,L);
+      V:=L.Values['version'];
+      APackage.Version.AsString:=V;
+    Finally
+      L.Free;
+    end;
+  end;
+
+var
+  SRD : TSearchRec;
+  SRF : TSearchRec;
+  P  : TFPPackage;
+  UF,UD : String;
 begin
-  inherited Create(AnOptionParser);
+  Result:=false;
+  log(llDebug,SLogFindInstalledPackages,[FPath]);
+  if FindFirst(FPath+AllFiles,faDirectory,SRD)=0 then
+    begin
+      repeat
+          // Try new .fpm-file
+          UD:=FPath+SRD.Name+PathDelim;
+
+          if FindFirst(UD+'*'+FpmkExt,faAnyFile,SRF)=0 then
+            begin
+              repeat
+                UF := UD+SRF.Name;
+                P:=ARepository.AddPackage(ChangeFileExt(SRF.Name,''));
+                P.LoadUnitConfigFromFile(UF);
+                P.PackagesStructure:=Self;
+                if P.IsFPMakeAddIn then
+                  AddFPMakeAddIn(P);
+              until FindNext(SRF)<>0;
+            end;
+          FindClose(SRF);
+      until FindNext(SRD)<>0;
+    end;
+  FindClose(SRF);
+
+  Result:=true;
+end;
+
+function TFPUninstalledSourcesPackagesStructure.IsInstallationNeeded(APackage: TFPPackage): TFPInstallationNeeded;
+begin
+  if APackage.Repository.RepositoryName=SourceRepositoryName then
+    Result := fpinNoInstallationNeeded
+  else
+    Result := fpinInstallationImpossible;
+end;
+
+function TFPUninstalledSourcesPackagesStructure.GetBaseInstallDir: string;
+begin
+  Result := FPath;
+end;
+
+function TFPUninstalledSourcesPackagesStructure.GetConfigFileForPackage(APackageName: string): string;
+begin
+  Result := IncludeTrailingPathDelimiter(GetBaseInstallDir)+
+    APackageName+PathDelim+APackageName+'-'+GFPpkg.CompilerOptions.CompilerTarget+FpmkExt;
+end;
+
+{ TFppkgUninstalledRepositoryOptionSection }
+
+function TFppkgUninstalledRepositoryOptionSection.InitRepository(AParent: TComponent;
+  ACompilerOptions: TCompilerOptions): TFPRepository;
+var
+  InstPackages: TFPUninstalledSourcesPackagesStructure;
+begin
+  if Path <> '' then
+    begin
+      Result := TFPRepository.Create(AParent);
+      Result.RepositoryType := GetRepositoryType;
+      Result.RepositoryName := RepositoryName;
+      Result.Description := Description;
+      InstPackages := TFPUninstalledSourcesPackagesStructure.Create(AParent, Path, ACompilerOptions);
+      InstPackages.InstallRepositoryName := InstallRepositoryName;
+      InstPackages.SourceRepositoryName := SourceRepositoryName;
+      Result.DefaultPackagesStructure := InstPackages;
+    end;
+end;
+
+procedure TFppkgUninstalledRepositoryOptionSection.AddKeyValue(const AKey, AValue: string);
+begin
+   if SameText(AKey,KeySourceRepository) then
+    SourceRepositoryName := AValue
+  else
+    inherited AddKeyValue(AKey, AValue);
 end;
 
-procedure TFppkgUninstalledSourceRepositoryOptionSection.AddKeyValue(const AKey, AValue: string);
+procedure TFppkgUninstalledRepositoryOptionSection.LogValues(ALogLevel: TLogLevel);
 begin
-  inherited AddKeyValue(AKey, AValue);
+  inherited LogValues(ALogLevel);
+  log(ALogLevel,SLogSourceRepository,[FSourceRepositoryName]);
+end;
+
+function TFppkgUninstalledRepositoryOptionSection.GetRepositoryType: TFPRepositoryType;
+begin
+  Result := fprtInstalled;
+end;
+
+{ TFppkgUninstalledSourceRepositoryOptionSection }
+
+constructor TFppkgUninstalledSourceRepositoryOptionSection.Create(AnOptionParser: TTemplateParser);
+begin
+  inherited Create(AnOptionParser);
 end;
 
 function TFppkgUninstalledSourceRepositoryOptionSection.InitRepository(AParent: TComponent;
@@ -69,6 +204,7 @@ begin
       Result.RepositoryName := RepositoryName;
       Result.Description := Description;
       InstPackages := TFPUninstalledSourcesAvailablePackagesStructure.Create(AParent, Path, ACompilerOptions);
+      InstPackages.InstallRepositoryName := InstallRepositoryName;
       Result.DefaultPackagesStructure := InstPackages;
     end;
 end;
@@ -156,6 +292,5 @@ begin
     Result := FPath+APackage.Name
 end;
 
-
 end.