paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-10 21:49:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Added functionality to ease overriding the repository classes

Browse Source 
git-svn-id: trunk@17671 -
This commit is contained in:
joost 2011-06-06 13:48:51 +00:00
parent 068b373015
commit 75ba8f806a
5 changed files with 183 additions and 133 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
packages/fpmkunit/src/fpmkunit.pp
View File

@ -573,6 +573,7 @@ Type
Protected
procedure SetName(const AValue: String);override;
procedure LoadUnitConfigFromFile(Const AFileName: String);
procedure SaveUnitConfigToStringList(Const AStringList: TStrings;ACPU:TCPU;AOS:TOS); virtual;
procedure SaveUnitConfigToFile(Const AFileName: String;ACPU:TCPU;AOS:TOS);
Public
constructor Create(ACollection: TCollection); override;
@ -2579,20 +2580,14 @@ begin
end;
end;
procedure TPackage.SaveUnitConfigToFile(Const AFileName: String;ACPU:TCPU;AOS:TOS);
procedure TPackage.SaveUnitConfigToStringList(const AStringList: TStrings; ACPU: TCPU; AOS: TOS);
Var
F : TFileStream;
L : TStringList;
Deps : String;
i : integer;
D : TDependency;
p : TPackage;
begin
F:=TFileStream.Create(AFileName,fmCreate);
L:=TStringList.Create;
try
With L do
with AStringList do
begin
Values[KeyName]:=Name;
Values[KeyVersion]:=Version;
@ -2627,6 +2622,17 @@ begin
else
Values[KeyAddIn]:='N';
end;
end;
procedure TPackage.SaveUnitConfigToFile(Const AFileName: String;ACPU:TCPU;AOS:TOS);
Var
F : TFileStream;
L : TStringList;
begin
F:=TFileStream.Create(AFileName,fmCreate);
L:=TStringList.Create;
try
SaveUnitConfigToStringList(L,ACPU,AOS);
L.SaveToStream(F);
Finally
L.Free;

85
packages/fppkg/src/fprepos.pp
View File

@ -138,11 +138,14 @@ type
procedure SetName(const AValue: String);
procedure SetUnusedVersion(const AValue: TFPVersion);
procedure SetVersion(const AValue: TFPVersion);
protected
procedure LoadUnitConfigFromStringlist(Const AStringList: TStrings); virtual;
Public
Constructor Create(ACollection : TCollection); override;
Destructor Destroy; override;
Procedure LoadFromStream(Stream : TStream; Streamversion : Integer); override;
Procedure SaveToStream(Stream : TStream); override;
procedure LoadUnitConfigFromFile(Const AFileName: String);
Procedure Assign(Source : TPersistent); override;
Function AddDependency(Const APackageName : String; const AMinVersion : String = '') : TFPDependency;
Property Dependencies : TFPDependencies Read FDependencies;
@ -191,6 +194,7 @@ type
Property StreamVersion : Integer Read FVersion Write FVersion;
Property Packages [Index : Integer] : TFPPackage Read GetPackage Write SetPackage; default;
end;
TFPPackagesClass = class of TFPPackages;
{ TFPRepository }
@ -199,10 +203,10 @@ type
FMaxDependencyLevel : Integer;
FBackUpFiles: Boolean;
FFileName: String;
FPackages : TFPPackages;
function GetPackage(Index : Integer): TFPPackage;
function GetPackageCount: Integer;
Protected
FPackages : TFPPackages;
procedure CreatePackages; virtual;
Procedure BackupFile(const AFileName : String); virtual;
Procedure DoGetPackageDependencies(const APackageName : String; List : TStringList; Level : Integer); virtual;
@ -232,6 +236,7 @@ type
Property MaxDependencyLevel : Integer Read FMaxDependencyLevel Write FMaxDependencyLevel;
Property PackageCollection : TFPPackages Read FPackages;
end;
TFPRepositoryClass = class of TFPRepository;
{ TFPMirror }
@ -296,8 +301,22 @@ Implementation
uses
typinfo,
pkgglobals,
uriparser;
const
// Keys for unit config
KeyName = 'Name';
KeyVersion = 'Version';
KeyChecksum = 'Checksum';
KeyNeedLibC = 'NeedLibC';
KeyDepends = 'Depends';
KeyAddIn = 'FPMakeAddIn';
KeySourcePath = 'SourcePath';
KeyFPMakeOptions = 'FPMakeOptions';
KeyCPU = 'CPU';
KeyOS = 'OS';
ResourceString
SErrInvalidCPU = 'Invalid CPU name : "%s"';
SErrInvalidOS = 'Invalid OS name : "%s"';
@ -658,6 +677,70 @@ begin
FDependencies.SaveToStream(Stream);
end;
procedure TFPPackage.LoadUnitConfigFromStringlist(const AStringList: TStrings);
var
L2 : TStrings;
VOS : TOS;
VCPU : TCPU;
i,k : Integer;
DepChecksum : Cardinal;
DepName : String;
D : TFPDependency;
begin
With AStringList do
begin
Version.AsString:=Values[KeyVersion];
SourcePath:=Values[KeySourcePath];
FPMakeOptionsString:=Values[KeyFPMakeOptions];
Checksum:=Cardinal(StrToInt64Def(Values[KeyChecksum],$ffffffff));
VCPU:=StringToCPU(Values[KeyCPU]);
VOS:=StringToOS(Values[KeyOS]);
OSes:=[VOS];
CPUs:=[VCPU];
L2:=TStringList.Create;
L2.CommaText:=Values[KeyDepends];
for i:=0 to L2.Count-1 do
begin
DepName:=L2[i];
k:=Pos('|',DepName);
if k>0 then
begin
DepChecksum:=StrToInt(Copy(DepName,k+1,Length(DepName)-k));
DepName:=Copy(DepName,1,k-1);
end
else
DepChecksum:=$ffffffff;
D:=nil;
for k:=0 to Dependencies.Count-1 do
begin
D:=Dependencies[k];
if D.PackageName=DepName then
break;
D:=nil;
end;
if not assigned(D) then
D:=AddDependency(DepName,'');
D.RequireChecksum:=DepChecksum;
end;
FreeAndNil(L2);
//NeedLibC:=Upcase(Values[KeyNeedLibC])='Y';
IsFPMakeAddIn:=Upcase(Values[KeyAddIn])='Y';
end;
end;
procedure TFPPackage.LoadUnitConfigFromFile(const AFileName: String);
var
L : TStrings;
begin
L:=TStringList.Create;
Try
ReadIniFile(AFileName,L);
LoadUnitConfigFromStringlist(L);
Finally
L.Free;
end;
end;
procedure TFPPackage.Assign(Source: TPersistent);
Var

2
packages/fppkg/src/pkgcommands.pp
View File

@ -322,7 +322,7 @@ begin
UFN:=CompilerOptions.LocalUnitDir;
end;
UFN:=IncludeTrailingPathDelimiter(UFN)+S+PathDelim+UnitConfigFileName;
LoadUnitConfigFromFile(P,UFN);
P.LoadUnitConfigFromFile(UFN);
if P.IsFPMakeAddIn then
AddFPMakeAddIn(P);
end

26
packages/fppkg/src/pkgglobals.pp
View File

@ -83,6 +83,7 @@ Procedure SearchFiles(SL:TStringList;const APattern:string);
Function GetCompilerInfo(const ACompiler,AOptions:string):string; overload;
Procedure GetCompilerInfo(const ACompiler, AOptions: string; out AVersion: string; out ACPU: TCpu; out aOS:TOS); overload;
function IsSuperUser:boolean;
procedure ReadIniFile(Const AFileName: String;L:TStrings);
var
LogLevels : TLogLevels;
@ -392,6 +393,31 @@ begin
{$endif unix}
end;
procedure ReadIniFile(Const AFileName: String;L:TStrings);
Var
F : TFileStream;
Line : String;
I,P,PC : Integer;
begin
F:=TFileStream.Create(AFileName,fmOpenRead);
Try
L.LoadFromStream(F);
// Fix lines.
For I:=L.Count-1 downto 0 do
begin
Line:=L[I];
P:=Pos('=',Line);
PC:=Pos(';',Line); // Comment line.
If (P=0) or ((PC<>0) and (PC<P)) then
L.Delete(I)
else
L[i]:=Trim(System.Copy(Line,1,P-1)+'='+Trim(System.Copy(Line,P+1,Length(Line)-P)));
end;
Finally
F.Free;
end;
end;
initialization
OnGetVendorName:=@FPPkgGetVendorName;

119
packages/fppkg/src/pkgrepos.pp
View File

@ -12,7 +12,6 @@ function GetRemoteRepositoryURL(const AFileName:string):string;
procedure LoadLocalAvailableMirrors;
procedure LoadLocalAvailableRepository;
procedure LoadUnitConfigFromFile(APackage:TFPPackage;const AFileName: String);
function LoadManifestFromFile(const AManifestFN:string):TFPPackage;
procedure FindInstalledPackages(ACompilerOptions:TCompilerOptions;showdups:boolean=true);
Procedure AddFPMakeAddIn(APackage: TFPPackage);
@ -29,6 +28,8 @@ procedure ListRemoteRepository;
procedure RebuildRemoteRepository;
procedure SaveRemoteRepository;
procedure SetDefaultRepositoryClass(ARepositoryClass: TFPRepositoryClass);
var
AvailableMirrors : TFPMirrors;
AvailableRepository,
@ -43,12 +44,30 @@ uses
pkgglobals,
pkgmessages;
{*****************************************************************************
Mirror Selection
*****************************************************************************}
resourcestring
SErrRepositoryClassAlreadyAssigned = 'Default repository class is already assigned.';
var
CurrentRemoteRepositoryURL : String;
RepositoryClass : TFPRepositoryClass;
procedure SetDefaultRepositoryClass(ARepositoryClass: TFPRepositoryClass);
begin
if assigned(RepositoryClass) then
raise exception.Create(SErrRepositoryClassAlreadyAssigned);
RepositoryClass:=ARepositoryClass;
end;
function GetDefaultRepositoryClass: TFPRepositoryClass;
begin
if not assigned(RepositoryClass) then
SetDefaultRepositoryClass(TFPRepository);
result := RepositoryClass;
end;
{*****************************************************************************
Mirror Selection
*****************************************************************************}
procedure LoadLocalAvailableMirrors;
var
@ -142,32 +161,6 @@ end;
Local Repository
*****************************************************************************}
procedure ReadIniFile(Const AFileName: String;L:TStrings);
Var
F : TFileStream;
Line : String;
I,P,PC : Integer;
begin
F:=TFileStream.Create(AFileName,fmOpenRead);
Try
L.LoadFromStream(F);
// Fix lines.
For I:=L.Count-1 downto 0 do
begin
Line:=L[I];
P:=Pos('=',Line);
PC:=Pos(';',Line); // Comment line.
If (P=0) or ((PC<>0) and (PC<P)) then
L.Delete(I)
else
L[i]:=Trim(System.Copy(Line,1,P-1)+'='+Trim(System.Copy(Line,P+1,Length(Line)-P)));
end;
Finally
F.Free;
end;
end;
function LoadManifestFromFile(const AManifestFN:string):TFPPackage;
var
X : TFPXMLRepositoryHandler;
@ -200,64 +193,6 @@ begin
end;
procedure LoadUnitConfigFromFile(APackage:TFPPackage;const AFileName: String);
Var
L,DepSL : TStrings;
DepName,
V : String;
DepChecksum : Cardinal;
i,j,k : integer;
D : TFPDependency;
begin
L:=TStringList.Create;
Try
ReadIniFile(AFileName,L);
{$warning TODO Maybe check also CPU-OS}
// Read fpunits.conf
V:=L.Values['version'];
APackage.Version.AsString:=V;
APackage.IsFPMakeAddIn:=Upcase(L.Values['FPMakeAddIn'])='Y';
APackage.SourcePath:=L.Values['SourcePath'];
APackage.FPMakeOptionsString:=L.Values['FPMakeOptions'];
V:=L.Values['checksum'];
if V<>'' then
APackage.Checksum:=StrToInt(V)
else
APackage.Checksum:=$ffffffff;
// Load dependencies
V:=L.Values['depends'];
DepSL:=TStringList.Create;
DepSL.CommaText:=V;
for i:=0 to DepSL.Count-1 do
begin
DepName:=DepSL[i];
k:=Pos('|',DepName);
if k>0 then
begin
DepChecksum:=StrToInt(Copy(DepName,k+1,Length(DepName)-k));
DepName:=Copy(DepName,1,k-1);
end
else
DepChecksum:=$ffffffff;
D:=nil;
for j:=0 to APackage.Dependencies.Count-1 do
begin
D:=APackage.Dependencies[j];
if D.PackageName=DepName then
break;
D:=nil;
end;
if not assigned(D) then
D:=APackage.AddDependency(DepName,'');
D.RequireChecksum:=DepChecksum;
end;
DepSL.Free;
Finally
L.Free;
end;
end;
procedure FindInstalledPackages(ACompilerOptions:TCompilerOptions;showdups:boolean=true);
function AddInstalledPackage(const AName,AFileName: String; const Local: boolean):TFPPackage;
@ -309,7 +244,7 @@ procedure FindInstalledPackages(ACompilerOptions:TCompilerOptions;showdups:boole
if FileExistsLog(UF) then
begin
P:=AddInstalledPackage(SR.Name,UF,Local);
LoadUnitConfigFromFile(P,UF);
P.LoadUnitConfigFromFile(UF);
if P.IsFPMakeAddIn then
AddFPMakeAddIn(P);
end
@ -331,7 +266,7 @@ procedure FindInstalledPackages(ACompilerOptions:TCompilerOptions;showdups:boole
begin
if assigned(InstalledRepository) then
InstalledRepository.Free;
InstalledRepository:=TFPRepository.Create(nil);
InstalledRepository:=GetDefaultRepositoryClass.Create(nil);
// First scan the global directory
// The local directory will overwrite the versions
if ACompilerOptions.GlobalUnitDir<>'' then
@ -475,7 +410,7 @@ var
begin
if assigned(AvailableRepository) then
AvailableRepository.Free;
AvailableRepository:=TFPRepository.Create(Nil);
AvailableRepository:=GetDefaultRepositoryClass.Create(Nil);
// Repository
S:=GlobalOptions.LocalPackagesFile;
log(vlDebug,SLogLoadingPackagesFile,[S]);
@ -673,7 +608,7 @@ var
begin
if assigned(InstalledRepository) then
InstalledRepository.Free;
InstalledRepository:=TFPRepository.Create(Nil);
InstalledRepository:=GetDefaultRepositoryClass.Create(Nil);
try
ManifestSL:=TStringList.Create;
ManifestSL.Add(ManifestFileName);