fpc/packages/fppkg/src/pkgpackagesstructure.pp

{
    This file is part of the fppkg package manager
    Copyright (c) 1999-2022 by the Free Pascal development team

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
{$IFNDEF FPC_DOTTEDUNITS}
unit pkgPackagesStructure;
{$ENDIF FPC_DOTTEDUNITS}

{$mode objfpc}{$H+}

interface

{$IFDEF FPC_DOTTEDUNITS}
uses
  System.Classes,
  System.SysUtils,
  FpPkg.Repos,
  FpPkg.XmlRep,
  FpPkg.Options;
{$ELSE FPC_DOTTEDUNITS}
uses
  Classes,
  SysUtils,
  fprepos,
  fpxmlrep,
  pkgoptions;
{$ENDIF FPC_DOTTEDUNITS}

type

  { TFPRemotePackagesStructure }

  TFPRemotePackagesStructure = class(TFPCustomPackagesStructure)
  public
    class function GetRepositoryOptionSectionClass: TFppkgRepositoryOptionSectionClass; override;

    function UnzipBeforeUse: Boolean; override;
    function AddPackagesToRepository(ARepository: TFPRepository): Boolean; override;
  end;

  { TFPCustomFileSystemPackagesStructure }

  TFPCustomFileSystemPackagesStructure = class(TFPCustomPackagesStructure)
  private
    FPath: string;
  protected
    function GetPath: string; virtual;
    procedure SetPath(AValue: string); virtual;
    procedure AddPackageToRepository(ARepository: TFPRepository; APackageName: string; APackageFilename: string);
  public
    property Path: string read GetPath write SetPath;
  end;

  { TFPInstalledPackagesStructure }

  TFPInstalledPackagesStructure = class(TFPCustomFileSystemPackagesStructure)
  private
    FPrefix: string;
  public
    class function GetRepositoryOptionSectionClass: TFppkgRepositoryOptionSectionClass; override;
    procedure InitializeWithOptions(ARepoOptionSection: TFppkgRepositoryOptionSection; AnOptions: TFppkgOptions; ACompilerOptions: TCompilerOptions); override;
    function AddPackagesToRepository(ARepository: TFPRepository): Boolean; override;
    function GetUnitDirectory(APackage: TFPPackage): string; override;
    function GetPrefix: string; override;
    function GetBaseInstallDir: string; override;
    // The prefix is used on installing packages
    property Prefix: string read FPrefix write FPrefix;
  end;

  { TFPCurrentDirectoryPackagesStructure }

  TFPCurrentDirectoryPackagesStructure = class(TFPCustomFileSystemPackagesStructure)
  protected
    procedure SetPath(AValue: string); override;
  public
    function AddPackagesToRepository(ARepository: TFPRepository): Boolean; override;
    function GetBuildPathDirectory(APackage: TFPPackage): string; override;
  end;

  { TFPArchiveFilenamePackagesStructure }

  TFPArchiveFilenamePackagesStructure = class(TFPCustomPackagesStructure)
  private
    FArchiveFileName: string;
  public
    function AddPackagesToRepository(ARepository: TFPRepository): Boolean; override;
    function UnzipBeforeUse: Boolean; override;
    property ArchiveFileName: string read FArchiveFileName write FArchiveFileName;
  end;

  { TFPOriginalSourcePackagesStructure }

  TFPOriginalSourcePackagesStructure = class(TFPCustomPackagesStructure)
  private
    FOriginalRepository: TFPRepository;
  public
    constructor Create(AOwner: TComponent; OriginalRepository: TFPRepository);
    function AddPackagesToRepository(ARepository: TFPRepository): Boolean; override;
    function GetBuildPathDirectory(APackage: TFPPackage): string; override;
  end;

  { TFPTemporaryDirectoryPackagesStructure }

  TFPTemporaryDirectoryPackagesStructure = class(TFPCustomFileSystemPackagesStructure)
  private
    FPackage: TFPPackage;
    function GetTempPackageName: string;
    procedure SetTempPackageName(AValue: string);
  public
    function AddPackagesToRepository(ARepository: TFPRepository): Boolean; override;
    function GetBuildPathDirectory(APackage: TFPPackage): string; override;
    procedure SetTempPath(APath: string);
    property TempPackageName: string read GetTempPackageName write SetTempPackageName;
  end;

implementation

{$IFDEF FPC_DOTTEDUNITS}
uses
  Fpmkunit,
  FpPkg.Messages,
  FpPkg.PackageRepos,
  FpPkg.Globals;
{$ELSE FPC_DOTTEDUNITS}
uses
  fpmkunit,
  pkgmessages,
  pkgrepos,
  pkgglobals;
{$ENDIF FPC_DOTTEDUNITS}

{ TFPArchiveFilenamePackagesStructure }

function TFPArchiveFilenamePackagesStructure.AddPackagesToRepository(ARepository: TFPRepository): Boolean;
var
  Package: TFPPackage;
begin
  Result := True;
  Package := ARepository.AddPackage(CmdLinePackageName);
  Package.LocalFileName := FArchiveFileName;
  Package.PackagesStructure := Self;
end;

function TFPArchiveFilenamePackagesStructure.UnzipBeforeUse: Boolean;
begin
  Result := True;
end;

{ TFPCustomFileSystemPackagesStructure }

function TFPCustomFileSystemPackagesStructure.GetPath: string;
begin
  Result := FPath;
end;

procedure TFPCustomFileSystemPackagesStructure.SetPath(AValue: string);
begin
  FPath := AValue;
end;

procedure TFPCustomFileSystemPackagesStructure.AddPackageToRepository(ARepository: TFPRepository; APackageName: string; APackageFilename: string);
var
  P: TFPPackage;
begin
  P:=ARepository.AddPackage(APackageName);
  try
    P.LoadUnitConfigFromFile(APackageFilename);
    P.PackagesStructure:=Self;
    log(llDebug,SLogFoundPackageInFile,[P.Name, APackageFilename]);
    if P.IsFPMakeAddIn then
      AddFPMakeAddIn(P);
  except
    on E: Exception do
      begin
      log(llWarning,SLogFailedLoadingPackage,[APackageName, APackageFilename, E.Message]);
      P.Free;
      end;
  end;
end;

{ TFPTemporaryDirectoryPackagesStructure }

function TFPTemporaryDirectoryPackagesStructure.GetTempPackageName: string;
begin
  Result := FPackage.Name;
end;

procedure TFPTemporaryDirectoryPackagesStructure.SetTempPackageName(AValue: string);
begin
  FPackage.Name := AValue;
end;

function TFPTemporaryDirectoryPackagesStructure.AddPackagesToRepository(ARepository: TFPRepository): Boolean;
begin
  Result := True;
  FPackage := ARepository.AddPackage('');
  FPackage.PackagesStructure := Self;
end;

function TFPTemporaryDirectoryPackagesStructure.GetBuildPathDirectory(APackage: TFPPackage): string;
begin
  Result := FPath;
end;

procedure TFPTemporaryDirectoryPackagesStructure.SetTempPath(APath: string);
begin
  FPath := APath;
end;

{ TFPOriginalSourcePackagesStructure }

constructor TFPOriginalSourcePackagesStructure.Create(AOwner: TComponent;
  OriginalRepository: TFPRepository);
begin
  inherited Create(Owner);
  FOriginalRepository := OriginalRepository;
end;

function TFPOriginalSourcePackagesStructure.AddPackagesToRepository(
  ARepository: TFPRepository): Boolean;
var
  i: Integer;
  OrgPackage: TFPPackage;
  P: TFPPackage;
begin
  Result := True;
  for i := 0 to FOriginalRepository.PackageCount -1 do
    begin
      OrgPackage := FOriginalRepository.Packages[i];
      if (OrgPackage.SourcePath<>'') and DirectoryExists(OrgPackage.SourcePath) then
        begin
          P:=ARepository.AddPackage(OrgPackage.Name);
          P.PackagesStructure:=Self;
          P.Assign(OrgPackage);
        end;
    end;
end;

function TFPOriginalSourcePackagesStructure.GetBuildPathDirectory(
  APackage: TFPPackage): string;
begin
  Result:=APackage.SourcePath;
end;

{ TFPCurrentDirectoryPackagesStructure }

procedure TFPCurrentDirectoryPackagesStructure.SetPath(AValue: string);
begin
  if AValue = '' then
    AValue := GetCurrentDir;
  inherited SetPath(AValue);
end;

function TFPCurrentDirectoryPackagesStructure.AddPackagesToRepository(
  ARepository: TFPRepository): Boolean;
var
  Package: TFPPackage;
begin
  Result := True;
  Package := ARepository.AddPackage(CurrentDirPackageName);
  Package.PackagesStructure := Self;
end;

function TFPCurrentDirectoryPackagesStructure.GetBuildPathDirectory(APackage: TFPPackage): string;
begin
  Result := FPath;
end;

{ TFPRemotePackagesStructure }

class function TFPRemotePackagesStructure.GetRepositoryOptionSectionClass: TFppkgRepositoryOptionSectionClass;
begin
  Result := nil;
end;

function TFPRemotePackagesStructure.UnzipBeforeUse: Boolean;
begin
  Result := True;
end;

function TFPRemotePackagesStructure.AddPackagesToRepository(ARepository: TFPRepository): Boolean;
var
  S : String;
  X : TFPXMLRepositoryHandler;
  i: Integer;
begin
  Result := True;
  // Repository
  S:=FOptions.GlobalSection.LocalPackagesFile;
  log(llDebug,SLogLoadingPackagesFile,[S]);
  if not FileExists(S) then
    exit;
  try
    X:=TFPXMLRepositoryHandler.Create;
    With X do
      try
        LoadFromXml(ARepository,S);
      finally
        Free;
      end;
    for i := 0 to ARepository.PackageCount -1 do
      ARepository.Packages[i].PackagesStructure := Self;
  except
    on E : Exception do
      begin
        Log(llError,E.Message);
        Error(SErrCorruptPackagesFile,[S]);
      end;
  end;
end;

{ TFPInstalledPackagesStructure }

class function TFPInstalledPackagesStructure.GetRepositoryOptionSectionClass: TFppkgRepositoryOptionSectionClass;
begin
  Result := TFppkgRepositoryOptionSection;
end;

procedure TFPInstalledPackagesStructure.InitializeWithOptions(
  ARepoOptionSection: TFppkgRepositoryOptionSection; AnOptions: TFppkgOptions;
  ACompilerOptions: TCompilerOptions);
var
  RepoOptSection: TFppkgRepositoryOptionSection;
begin
  inherited InitializeWithOptions(ARepoOptionSection, AnOptions, ACompilerOptions);
  RepoOptSection := ARepoOptionSection as TFppkgRepositoryOptionSection;
  Prefix := RepoOptSection.Prefix;
  InstallRepositoryName := RepoOptSection.InstallRepositoryName;
  Path := RepoOptSection.Path;
end;

function TFPInstalledPackagesStructure.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
  SR : TSearchRec;
  P  : TFPPackage;
  UF,UD : String;
  FpmkDir : String;
  UnitDir: String;
begin
  Result:=false;
  FpmkDir:=IncludeTrailingPathDelimiter(FPath)+'fpmkinst'+PathDelim+FCompilerOptions.CompilerTarget+PathDelim;
  DirectoryExistsLog(FpmkDir);
  if FindFirst(IncludeTrailingPathDelimiter(FpmkDir)+'*'+FpmkExt,faDirectory,SR)=0 then
    begin
      log(llDebug,SLogFindInstalledPackages,[FpmkDir]);
      repeat
        if ((SR.Attr and faDirectory)=0) then
          begin
            // Try new .fpm-file
            AddPackageToRepository(ARepository, ChangeFileExt(SR.Name,''), FpmkDir+SR.Name);
          end;
      until FindNext(SR)<>0;
    end;
  FindClose(SR);

  // Search for non-fpmkunit packages
  UnitDir:=IncludeTrailingPathDelimiter(FPath)+'units'+PathDelim+FCompilerOptions.CompilerTarget+PathDelim;
  DirectoryExistsLog(UnitDir);
  if FindFirst(IncludeTrailingPathDelimiter(UnitDir)+AllFiles,faDirectory,SR)=0 then
    begin
      log(llDebug,SLogFindInstalledPackages,[UnitDir]);
      repeat
        if ((SR.Attr and faDirectory)=faDirectory) and (SR.Name<>'.') and (SR.Name<>'..') then
          begin
            UD:=IncludeTrailingPathDelimiter(IncludeTrailingPathDelimiter(UnitDir)+SR.Name);
            // Try new fpunits.cfg
            UF:=UD+UnitConfigFileName;
            if FileExists(UF) then
              begin
                if not Assigned(ARepository.FindPackage(SR.Name)) then
                  begin
                    AddPackageToRepository(ARepository, SR.Name, UF);
                  end;
              end
            else
              begin
                // Try Old style Package.fpc
                UF:=UD+'Package.fpc';
                if FileExists(UF) then
                  begin
                    if not Assigned(ARepository.FindPackage(SR.Name)) then
                      begin
                        P:=ARepository.AddPackage(SR.Name);
                        P.PackagesStructure:=Self;
                        LoadPackagefpcFromFile(P,UF);
                        log(llDebug,SLogFoundPackageInFile,[P.Name, UF]);
                      end;
                  end;
              end;
          end;
      until FindNext(SR)<>0;
    end;
  FindClose(SR);

  Result:=true;
end;

function TFPInstalledPackagesStructure.GetUnitDirectory(APackage: TFPPackage): string;
begin
  Result:=IncludeTrailingPathDelimiter(FPath)+'units'+PathDelim+FCompilerOptions.CompilerTarget+PathDelim+APackage.Name+PathDelim;
end;

function TFPInstalledPackagesStructure.GetPrefix: string;
begin
  Result:=IncludeTrailingPathDelimiter(FPrefix);
end;

function TFPInstalledPackagesStructure.GetBaseInstallDir: string;
begin
  Result:=FPath;
end;

initialization
  TFPCustomPackagesStructure.RegisterPackagesStructureClass(TFPRemotePackagesStructure);
  TFPCustomPackagesStructure.RegisterPackagesStructureClass(TFPInstalledPackagesStructure);
end.