paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-11 02:38:16 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Patch from Darius to fix 19348

Browse Source 
git-svn-id: trunk@17440 -
This commit is contained in:
michael 2011-05-13 11:16:09 +00:00
parent b257231203
commit 94cc1eef04
6 changed files with 83 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
utils/fppkg/fprepos.pp
View File

@ -111,9 +111,11 @@ type
TFPPackage = Class(TStreamCollectionItem)
private
FAuthor: String;
FCategory: String;
FDescription: String;
FEmail: String;
FFPMakeOptionsString: string;
FKeywords: String;
FRecompileBroken: boolean;
FSourcePath: string;
FInstalledLocally: boolean;
@ -123,6 +125,7 @@ type
FHomepageURL: String;
FDownloadURL: String;
FFileName: String;
FSupport: String;
FUnusedVersion: TFPVersion;
FVersion: TFPVersion;
FDependencies : TFPDependencies;
@ -153,6 +156,9 @@ type
Property Version : TFPVersion Read FVersion Write SetVersion;
Property License : String Read FLicense Write FLicense;
Property Description : String Read FDescription Write FDescription;
Property Support : String Read FSupport Write FSupport;
Property Keywords : String Read FKeywords Write FKeywords;
Property Category : String Read FCategory Write FCategory;
Property HomepageURL : String Read FHomepageURL Write FHomepageURL;
Property DownloadURL : String Read FDownloadURL Write FDownloadURL;
Property FileName : String Read GetFileName Write FFileName;

2
utils/fppkg/pkgdownload.pp
View File

@ -169,7 +169,7 @@ begin
with DownloaderClass.Create(nil) do
try
Log(vlCommands,SLogDownloading,[PackageRemoteArchive(P),PackageLocalArchive(P)]);
pkgglobals.Log(vlProgres,SProgrDownloadPackage,[P.Name, P.Version.AsString]);
pkgglobals.log(vlProgres,SProgrDownloadPackage,[P.Name, P.Version.AsString]);
Download(PackageRemoteArchive(P),PackageLocalArchive(P));
finally
Free;

54
utils/fppkg/pkgglobals.pp
View File

@ -54,6 +54,7 @@ Const
Type
TLogLevel = (vlError,vlWarning,vlInfo,vlCommands,vlDebug,vlProgres);
TLogLevels = Set of TLogLevel;
TLogProc = procedure(Level:TLogLevel;Const Msg: String);
const
DefaultLogLevels = [vlError,vlWarning, vlProgres];
@ -61,14 +62,15 @@ const
type
EPackagerError = class(Exception);
TPkgErrorProc = Procedure(Const Msg : String);
// Logging
Function StringToLogLevels (S : String) : TLogLevels;
Function LogLevelsToString (V : TLogLevels): String;
Procedure Log(Level: TLogLevel;Msg : String);
Procedure Log(Level: TLogLevel;Fmt : String; const Args : array of const);
Procedure Error(Msg : String);
Procedure Error(Fmt : String; const Args : array of const);
Procedure log(Level:TLogLevel; Const Fmt:String; const Args:array of const);
Procedure log(Level:TLogLevel; Const Msg:String);
Procedure Error(Const Fmt : String; const Args : array of const);
Procedure Error(Const Msg : String);
// Utils
function maybequoted(const s:string):string;
@ -85,7 +87,8 @@ function IsSuperUser:boolean;
var
LogLevels : TLogLevels;
FPMKUnitDeps : array of TFPMKUnitDep;
LogHandler: TLogProc;
ErrorHandler: TPkgErrorProc;
Implementation
@ -142,7 +145,7 @@ begin
end;
procedure Log(Level:TLogLevel;Msg: String);
procedure LogCmd(Level:TLogLevel; Const Msg: String);
var
Prefix : string;
begin
@ -165,21 +168,30 @@ begin
end;
Procedure Log(Level:TLogLevel; Fmt:String; const Args:array of const);
begin
Log(Level,Format(Fmt,Args));
end;
procedure Error(Msg: String);
procedure ErrorCmd(Const Msg: String);
begin
Raise EPackagerError.Create(Msg);
end;
procedure Error(Fmt: String; const Args: array of const);
Procedure log(Level:TLogLevel; Const Msg : String);
begin
Raise EPackagerError.CreateFmt(Fmt,Args);
Loghandler(level,Msg)
end;
Procedure log(Level:TLogLevel; Const Fmt:String; const Args:array of const);
begin
LogHandler(Level,Format(Fmt,Args));
end;
Procedure Error(Const Msg : String);
begin
ErrorHandler(Msg)
end;
procedure Error(Const Fmt: String; const Args: array of const);
begin
ErrorHandler(Format(Fmt, Args));
end;
@ -240,9 +252,9 @@ Function DirectoryExistsLog(const ADir:string):Boolean;
begin
result:=SysUtils.DirectoryExists(ADir);
if result then
Log(vlDebug,SDbgDirectoryExists,[ADir,SDbgFound])
log(vlDebug,SDbgDirectoryExists,[ADir,SDbgFound])
else
Log(vlDebug,SDbgDirectoryExists,[ADir,SDbgNotFound]);
log(vlDebug,SDbgDirectoryExists,[ADir,SDbgNotFound]);
end;
@ -250,9 +262,9 @@ Function FileExistsLog(const AFileName:string):Boolean;
begin
result:=SysUtils.FileExists(AFileName);
if result then
Log(vlDebug,SDbgFileExists,[AFileName,SDbgFound])
log(vlDebug,SDbgFileExists,[AFileName,SDbgFound])
else
Log(vlDebug,SDbgFileExists,[AFileName,SDbgNotFound]);
log(vlDebug,SDbgFileExists,[AFileName,SDbgNotFound]);
end;
@ -261,7 +273,7 @@ Var
BFN : String;
begin
BFN:=AFileName+'.bak';
Log(vlDebug,SDbgBackupFile,[BFN]);
log(vlDebug,SDbgBackupFile,[BFN]);
If not RenameFile(AFileName,BFN) then
Error(SErrBackupFailed,[AFileName,BFN]);
end;
@ -384,5 +396,7 @@ end;
initialization
OnGetVendorName:=@FPPkgGetVendorName;
OnGetApplicationName:=@FPPkgGetApplicationName;
LogHandler := @LogCmd;
ErrorHandler := @ErrorCmd;
end.

7
utils/fppkg/pkghandler.pp
View File

@ -90,7 +90,10 @@ begin
Log(vlDebug,'Already executed or executing action '+FullActionName);
exit;
end;
ExecutedActions.Add(FullActionName,Pointer(PtrUInt(1)));
if AAction <> 'laz_list' then //do not cache list action
ExecutedActions.Add(FullActionName,Pointer(PtrUInt(1)));
// Create action handler class
pkghandlerclass:=GetPkgHandler(AAction);
With pkghandlerclass.Create(nil,APackageName) do
@ -207,7 +210,7 @@ end;
Procedure TPackageHandler.Log(Level:TLogLevel; Fmt:String; const Args:array of const);
begin
pkgglobals.Log(Level,PackageLogPrefix+Fmt,Args);
pkgglobals.log(Level,PackageLogPrefix+Fmt,Args);
end;

50
utils/fppkg/pkgoptions.pp
View File

@ -339,7 +339,7 @@ begin
FConfigVersion:=ReadInteger(SDefaults,KeyConfigVersion,0);
if (FConfigVersion<>CurrentConfigVersion) then
begin
Log(vlDebug,SLogUpgradingConfig,[AFileName]);
log(vlDebug,SLogUpgradingConfig,[AFileName]);
FSaveInifileChanges:=true;
if FConfigVersion<1 then
begin
@ -404,16 +404,16 @@ end;
procedure TGlobalOptions.LogValues(ALogLevel: TLogLevel);
begin
Log(ALogLevel,SLogGlobalCfgHeader,[FConfigFilename]);
Log(ALogLevel,SLogGlobalCfgRemoteMirrorsURL,[FRemoteMirrorsURL]);
Log(ALogLevel,SLogGlobalCfgRemoteRepository,[FRemoteRepository]);
Log(ALogLevel,SLogGlobalCfgLocalRepository,[FLocalRepository,LocalRepository]);
Log(ALogLevel,SLogGlobalCfgBuildDir,[FBuildDir,BuildDir]);
Log(ALogLevel,SLogGlobalCfgArchivesDir,[FArchivesDir,ArchivesDir]);
Log(ALogLevel,SLogGlobalCfgCompilerConfigDir,[FCompilerConfigDir,CompilerConfigDir]);
Log(ALogLevel,SLogGlobalCfgDefaultCompilerConfig,[FDefaultCompilerConfig]);
Log(ALogLevel,SLogGlobalCfgFPMakeCompilerConfig,[FPMakeCompilerConfig]);
Log(ALogLevel,SLogGlobalCfgDownloader,[FDownloader]);
log(ALogLevel,SLogGlobalCfgHeader,[FConfigFilename]);
log(ALogLevel,SLogGlobalCfgRemoteMirrorsURL,[FRemoteMirrorsURL]);
log(ALogLevel,SLogGlobalCfgRemoteRepository,[FRemoteRepository]);
log(ALogLevel,SLogGlobalCfgLocalRepository,[FLocalRepository,LocalRepository]);
log(ALogLevel,SLogGlobalCfgBuildDir,[FBuildDir,BuildDir]);
log(ALogLevel,SLogGlobalCfgArchivesDir,[FArchivesDir,ArchivesDir]);
log(ALogLevel,SLogGlobalCfgCompilerConfigDir,[FCompilerConfigDir,CompilerConfigDir]);
log(ALogLevel,SLogGlobalCfgDefaultCompilerConfig,[FDefaultCompilerConfig]);
log(ALogLevel,SLogGlobalCfgFPMakeCompilerConfig,[FPMakeCompilerConfig]);
log(ALogLevel,SLogGlobalCfgDownloader,[FDownloader]);
end;
@ -588,7 +588,7 @@ begin
// We retrieve the real binary
if FCompilerVersion='2.2.0' then
FCompiler:=GetCompilerInfo(FCompiler,'-PB');
Log(vlDebug,SLogDetectedCompiler,[FCompiler,FCompilerVersion,MakeTargetString(FCompilerCPU,FCompilerOS)]);
log(vlDebug,SLogDetectedCompiler,[FCompiler,FCompilerVersion,MakeTargetString(FCompilerCPU,FCompilerOS)]);
// Use the same algorithm as the compiler, see options.pas
// Except that the prefix is extracted and GlobalInstallDir is set using
@ -606,12 +606,12 @@ begin
FGlobalPrefix:=ExpandFileName(FGlobalPrefix);
{$endif unix}
Log(vlDebug,SLogDetectedPrefix,['global',FGlobalPrefix]);
log(vlDebug,SLogDetectedPrefix,['global',FGlobalPrefix]);
// User writable install directory
if not IsSuperUser then
begin
FLocalPrefix:= '{LocalRepository}';
Log(vlDebug,SLogDetectedPrefix,['local',FLocalPrefix]);
log(vlDebug,SLogDetectedPrefix,['local',FLocalPrefix]);
end;
fpcdir:=FixPath(GetEnvironmentVariable('FPCDIR'));
@ -620,7 +620,7 @@ begin
{$ifndef Unix}
fpcdir:=ExpandFileName(fpcdir);
{$endif unix}
Log(vlDebug,SLogFPCDirEnv,[fpcdir]);
log(vlDebug,SLogFPCDirEnv,[fpcdir]);
FGlobalInstallDir:=fpcdir;
end;
end;
@ -638,7 +638,7 @@ begin
FConfigVersion:=ReadInteger(SDefaults,KeyConfigVersion,0);
if (FConfigVersion<>CurrentConfigVersion) then
begin
Log(vlDebug,SLogUpgradingConfig,[AFileName]);
log(vlDebug,SLogUpgradingConfig,[AFileName]);
FSaveInifileChanges:=true;
if (FConfigVersion>CurrentConfigVersion) then
Error(SErrUnsupportedConfigVersion,[AFileName]);
@ -688,15 +688,15 @@ end;
procedure TCompilerOptions.LogValues(ALogLevel: TLogLevel; const ACfgName:string);
begin
Log(ALogLevel,SLogCompilerCfgHeader,[ACfgName,FConfigFilename]);
Log(ALogLevel,SLogCompilerCfgCompiler,[FCompiler]);
Log(ALogLevel,SLogCompilerCfgTarget,[MakeTargetString(CompilerCPU,CompilerOS)]);
Log(ALogLevel,SLogCompilerCfgVersion,[FCompilerVersion]);
Log(ALogLevel,SLogCompilerCfgGlobalPrefix,[FGlobalPrefix,GlobalPrefix]);
Log(ALogLevel,SLogCompilerCfgLocalPrefix,[FLocalPrefix,LocalPrefix]);
Log(ALogLevel,SLogCompilerCfgGlobalInstallDir,[FGlobalInstallDir,GlobalInstallDir]);
Log(ALogLevel,SLogCompilerCfgLocalInstallDir,[FLocalInstallDir,LocalInstallDir]);
Log(ALogLevel,SLogCompilerCfgOptions,[Options.DelimitedText]);
log(ALogLevel,SLogCompilerCfgHeader,[ACfgName,FConfigFilename]);
log(ALogLevel,SLogCompilerCfgCompiler,[FCompiler]);
log(ALogLevel,SLogCompilerCfgTarget,[MakeTargetString(CompilerCPU,CompilerOS)]);
log(ALogLevel,SLogCompilerCfgVersion,[FCompilerVersion]);
log(ALogLevel,SLogCompilerCfgGlobalPrefix,[FGlobalPrefix,GlobalPrefix]);
log(ALogLevel,SLogCompilerCfgLocalPrefix,[FLocalPrefix,LocalPrefix]);
log(ALogLevel,SLogCompilerCfgGlobalInstallDir,[FGlobalInstallDir,GlobalInstallDir]);
log(ALogLevel,SLogCompilerCfgLocalInstallDir,[FLocalInstallDir,LocalInstallDir]);
log(ALogLevel,SLogCompilerCfgOptions,[Options.DelimitedText]);
end;

24
utils/fppkg/pkgrepos.pp
View File

@ -61,7 +61,7 @@ begin
// Repository
S:=GlobalOptions.LocalMirrorsFile;
Log(vlDebug,SLogLoadingMirrorsFile,[S]);
log(vlDebug,SLogLoadingMirrorsFile,[S]);
if not FileExists(S) then
exit;
try
@ -117,7 +117,7 @@ begin
end;
if assigned(M) then
begin
Log(vlInfo,SLogSelectedMirror,[M.Name]);
log(vlInfo,SLogSelectedMirror,[M.Name]);
Result:=M.URL;
end
else
@ -270,7 +270,7 @@ procedure FindInstalledPackages(ACompilerOptions:TCompilerOptions;showdups:boole
result.UnusedVersion:=result.Version;
// Log packages found in multiple locations (local and global) ?
if showdups then
Log(vlDebug,SDbgPackageMultipleLocations,[result.Name,ExtractFilePath(AFileName)]);
log(vlDebug,SDbgPackageMultipleLocations,[result.Name,ExtractFilePath(AFileName)]);
end;
result.InstalledLocally:=Local;
end;
@ -299,7 +299,7 @@ procedure FindInstalledPackages(ACompilerOptions:TCompilerOptions;showdups:boole
Result:=false;
if FindFirst(IncludeTrailingPathDelimiter(AUnitDir)+AllFiles,faDirectory,SR)=0 then
begin
Log(vlDebug,SLogFindInstalledPackages,[AUnitDir]);
log(vlDebug,SLogFindInstalledPackages,[AUnitDir]);
repeat
if ((SR.Attr and faDirectory)=faDirectory) and (SR.Name<>'.') and (SR.Name<>'..') then
begin
@ -343,7 +343,7 @@ end;
Procedure AddFPMakeAddIn(APackage: TFPPackage);
begin
Log(vlDebug,SLogFoundFPMakeAddin,[APackage.Name]);
log(vlDebug,SLogFoundFPMakeAddin,[APackage.Name]);
setlength(FPMKUnitDeps,length(FPMKUnitDeps)+1);
FPMKUnitDeps[high(FPMKUnitDeps)].package:=APackage.Name;
FPMKUnitDeps[high(FPMKUnitDeps)].reqver:=APackage.Version.AsString;
@ -372,7 +372,7 @@ begin
begin
if (DepPackage.Checksum<>D.RequireChecksum) then
begin
Log(vlInfo,SLogPackageChecksumChanged,[APackage.Name,D.PackageName]);
log(vlInfo,SLogPackageChecksumChanged,[APackage.Name,D.PackageName]);
result:=true;
if MarkForReInstall then
begin
@ -401,7 +401,7 @@ begin
end;
end
else
Log(vlDebug,SDbgObsoleteDependency,[D.PackageName]);
log(vlDebug,SDbgObsoleteDependency,[D.PackageName]);
end;
end;
end;
@ -452,14 +452,14 @@ begin
AvailVerStr:='<not available>';
ReqVer:=TFPVersion.Create;
ReqVer.AsString:=FPMKUnitDeps[i].ReqVer;
Log(vlDebug,SLogFPMKUnitDepVersion,[P.Name,ReqVer.AsString,P.Version.AsString,AvailVerStr]);
log(vlDebug,SLogFPMKUnitDepVersion,[P.Name,ReqVer.AsString,P.Version.AsString,AvailVerStr]);
if ReqVer.CompareVersion(P.Version)<=0 then
FPMKUnitDeps[i].available:=true
else
Log(vlDebug,SLogFPMKUnitDepTooOld,[FPMKUnitDeps[i].package]);
log(vlDebug,SLogFPMKUnitDepTooOld,[FPMKUnitDeps[i].package]);
end
else
Log(vlDebug,SLogFPMKUnitDepTooOld,[FPMKUnitDeps[i].package]);
log(vlDebug,SLogFPMKUnitDepTooOld,[FPMKUnitDeps[i].package]);
end;
end;
@ -478,7 +478,7 @@ begin
AvailableRepository:=TFPRepository.Create(Nil);
// Repository
S:=GlobalOptions.LocalPackagesFile;
Log(vlDebug,SLogLoadingPackagesFile,[S]);
log(vlDebug,SLogLoadingPackagesFile,[S]);
if not FileExists(S) then
exit;
try
@ -689,7 +689,7 @@ begin
{ Unzip manifest.xml }
With TUnZipper.Create do
try
Log(vlCommands,SLogUnzippping,[ArchiveSL[i]]);
log(vlCommands,SLogUnzippping,[ArchiveSL[i]]);
OutputPath:='.';
UnZipFiles(ArchiveSL[i],ManifestSL);
Finally