paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2026-01-16 19:41:50 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Downlaoder class is not a pkghandler anymore

Browse Source 
* New downloadpackage handler that creates a Downloader class

git-svn-id: trunk@6467 -
This commit is contained in:
peter 2007-02-13 08:06:31 +00:00
parent b1cecc7773
commit 83fa4de83b
8 changed files with 70 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
utils/fppkg/pkgcommands.pp
View File

@ -14,7 +14,7 @@ type
Public
Function Execute(const Args:TActionArgs):boolean;override;
end;
{ TCommandDownload }
TCommandDownload = Class(TPackagehandler)
@ -45,7 +45,7 @@ uses
fpmktype,
fprepos,
fpxmlrep;
function TCommandUpdate.Execute(const Args:TActionArgs):boolean;
Var
X : TFPXMLRepositoryHandler;
@ -83,10 +83,13 @@ function TCommandBuild.Execute(const Args:TActionArgs):boolean;
begin
ActionStack.Push(CurrentPackage,'fpmakebuild',Args);
ActionStack.Push(CurrentPackage,'compilefpmake',Args);
if not DirectoryExists(PackageBuildPath) then
ActionStack.Push(CurrentPackage,'unziparchive',Args);
if not FileExists(PackageArchive) then
ActionStack.Push(CurrentPackage,'downloadpackage',Args);
if assigned(CurrentPackage) then
begin
if not DirectoryExists(PackageBuildPath) then
ActionStack.Push(CurrentPackage,'unziparchive',Args);
if not FileExists(PackageArchive) then
ActionStack.Push(CurrentPackage,'downloadpackage',Args);
end;
end;

57
utils/fppkg/pkgdownload.pp
View File

@ -9,10 +9,13 @@ uses
Type
{ TBasePackageDownloader }
{ TBaseDownloader }
TBasePackageDownloader = Class(TPackageHandler)
TBaseDownloader = Class(TComponent)
Private
FBackupFile : Boolean;
Protected
Procedure BackupFile(Const FileName : String);
// Needs overriding.
Procedure FTPDownload(Const URL : String; Dest : TStream); Virtual;
Procedure HTTPDownload(Const URL : String; Dest : TStream); Virtual;
@ -20,29 +23,46 @@ Type
Public
Procedure Download(Const URL,DestFileName : String);
Procedure Download(Const URL : String; Dest : TStream);
Property BackupFiles : Boolean Read FBackupFile Write FBackupFile;
end;
TBaseDownloaderClass = Class of TBaseDownloader;
{ TDownloadPackage }
TDownloadPackage = Class(TPackagehandler)
Public
Function Execute(const Args:TActionArgs):boolean;override;
end;
TBasePackageDownloaderClass = Class of TBasePackageDownloader;
Var
DownloaderClass : TBasePackageDownloaderClass;
DownloaderClass : TBaseDownloaderClass;
implementation
uses pkgmessages,uriparser;
{ TBasePackageDownloader }
{ TBaseDownloader }
procedure TBasePackageDownloader.FTPDownload(const URL: String; Dest: TStream);
procedure TBaseDownloader.BackupFile(const FileName: String);
Var
BFN : String;
begin
BFN:=FileName+'.bak';
If not RenameFile(FileName,BFN) then
Error(SErrBackupFailed,[FileName,BFN]);
end;
procedure TBaseDownloader.FTPDownload(const URL: String; Dest: TStream);
begin
Error(SErrNoFTPDownload);
end;
procedure TBasePackageDownloader.HTTPDownload(const URL: String; Dest: TStream);
procedure TBaseDownloader.HTTPDownload(const URL: String; Dest: TStream);
begin
Error(SErrNoHTTPDownload);
end;
procedure TBasePackageDownloader.FileDownload(const URL: String; Dest: TStream);
procedure TBaseDownloader.FileDownload(const URL: String; Dest: TStream);
Var
URI : TURI;
@ -62,7 +82,7 @@ begin
end;
end;
procedure TBasePackageDownloader.Download(const URL, DestFileName: String);
procedure TBaseDownloader.Download(const URL, DestFileName: String);
Var
F : TFileStream;
@ -78,7 +98,7 @@ begin
end;
end;
procedure TBasePackageDownloader.Download(const URL: String; Dest: TStream);
procedure TBaseDownloader.Download(const URL: String; Dest: TStream);
Var
URI : TURI;
@ -97,9 +117,24 @@ begin
Error(SErrUnknownProtocol,[P]);
end;
{ TDownloadPackage }
function TDownloadPackage.Execute(const Args:TActionArgs):boolean;
begin
with DownloaderClass.Create(nil) do
try
Download(CurrentPackage.URL,PackageArchive);
finally
Free;
end;
end;
initialization
// Default value.
DownloaderClass := TBasePackageDownloader;
DownloaderClass := TBaseDownloader;
RegisterPkgHandler('downloadpackage',TDownloadPackage);
end.

13
utils/fppkg/pkghandler.pp
View File

@ -44,7 +44,6 @@ Type
TPackageHandler = Class(TComponent)
private
FBackupFile : Boolean;
FDefaults : TPackagerOptions;
FCurrentPackage : TFPPackage;
Protected
@ -52,7 +51,6 @@ Type
Procedure Log(Level: TVerbosity;Fmt : String; const Args : array of const);
Procedure Error(Msg : String);
Procedure Error(Fmt : String; const Args : array of const);
Procedure BackupFile(Const FileName : String);
Function ExecuteProcess(Const Prog,Args:String):Integer;
Procedure SetCurrentDir(Const ADir:String);
function PackageBuildPath:String;
@ -61,7 +59,6 @@ Type
Constructor Create(AOwner: TComponent;ADefaults:TPackagerOptions;APackage:TFPPackage); virtual;
function PackageLogPrefix:String;
Function Execute(const Args:TActionArgs):boolean; virtual; abstract;
Property BackupFiles : Boolean Read FBackupFile Write FBackupFile;
Property Defaults:TPackagerOptions Read FDefaults;
Property CurrentPackage:TFPPackage Read FCurrentPackage Write FCurrentPackage;
end;
@ -215,16 +212,6 @@ begin
FCurrentPackage:=APackage;
end;
procedure TPackageHandler.BackupFile(const FileName: String);
Var
BFN : String;
begin
BFN:=FileName+'.bak';
If not RenameFile(FileName,BFN) then
Error(SErrBackupFailed,[FileName,BFN]);
end;
Function TPackageHandler.ExecuteProcess(Const Prog,Args:String):Integer;
begin
Log(vCommands,SLogExecute,[Prog,Args]);

2
utils/fppkg/pkglibcurl.pp
View File

@ -7,7 +7,7 @@ interface
uses Classes,pkgdownload,pkghandler;
Type
TLibCurlDownloader = Class(TBasePackageDownloader)
TLibCurlDownloader = Class(TBaseDownloader)
Protected
Procedure LibCurlDownload(Const URL : String; Dest : TStream);
Procedure FTPDownload(Const URL : String; Dest : TStream); override;

18
utils/fppkg/pkglnet.pas
View File

@ -12,7 +12,7 @@ Type
{ TLNetDownloader }
TLNetDownloader = Class(TBasePackageDownloader)
TLNetDownloader = Class(TBaseDownloader)
private
FQuit: Boolean;
FFTP: TLFTPClient;
@ -33,7 +33,7 @@ Type
procedure FTPDownload(Const URL : String; Dest : TStream); override;
procedure HTTPDownload(Const URL : String; Dest : TStream); override;
public
constructor Create(AOwner : TComponent;ADefaults:TPackagerOptions; APackage:TFPPackage); override;
constructor Create(AOwner : TComponent); override;
end;
implementation
@ -105,14 +105,14 @@ begin
Try
{ parse URL }
URI:=ParseURI(URL);
if URI.Port = 0 then
URI.Port := 21;
FFTP.Connect(URI.Host, URI.Port);
while not FFTP.Connected and not FQuit do
FFTP.CallAction;
if not FQuit then begin
FFTP.Authenticate(URI.Username, URI.Password);
FFTP.ChangeDirectory(URI.Path);
@ -133,7 +133,7 @@ begin
Try
{ parse aURL }
URI := ParseURI(URL);
if URI.Port = 0 then
URI.Port := 80;
@ -146,14 +146,14 @@ begin
FQuit:=False;
while not FQuit do
FHTTP.CallAction;
Finally
Finally
FOutStream:=nil; // to be sure
end;
end;
constructor TLNetDownloader.Create(AOwner: TComponent;ADefaults:TPackagerOptions; APackage:TFPPackage);
constructor TLNetDownloader.Create(AOwner: TComponent);
begin
inherited Create(AOwner,ADefaults,APackage);
inherited;
FFTP:=TLFTPClient.Create(Self);
FFTP.Timeout:=1000;

2
utils/fppkg/pkgocurl.pp
View File

@ -7,7 +7,7 @@ interface
uses Classes,pkgdownload;
Type
TOCurlDownloader = Class(TBasePackageDownloader)
TOCurlDownloader = Class(TBaseDownloader)
Private
FCurl : String;
Protected

2
utils/fppkg/pkgsynapse.pp
View File

@ -7,7 +7,7 @@ interface
uses Classes,pkgdownload;
Type
TSynapseDownloader = Class(TBasePackageDownloader)
TSynapseDownloader = Class(TBaseDownloader)
Protected
Procedure FTPDownload(Const URL : String; Dest : TStream); override;
Procedure HTTPDownload(Const URL : String; Dest : TStream); override;

6
utils/fppkg/pkgwget.pp
View File

@ -7,11 +7,11 @@ interface
uses Classes,pkgdownload,pkgropts,fprepos;
Type
TWGetDownloader = Class(TBasePackageDownloader)
TWGetDownloader = Class(TBaseDownloader)
Private
FWGet : String;
Protected
Constructor Create(AOwner: TComponent; ADefaults:TPackagerOptions; APackage: TFPPackage); override;
Constructor Create(AOwner: TComponent); override;
Procedure WGetDownload(Const URL : String; Dest : TStream); virtual;
Procedure FTPDownload(Const URL : String; Dest : TStream); override;
Procedure HTTPDownload(Const URL : String; Dest : TStream); override;
@ -23,7 +23,7 @@ implementation
uses process,pkghandler,pkgmessages;
Constructor TWGetDownloader.Create(AOwner: TComponent; ADefaults:TPackagerOptions; APackage: TFPPackage);
Constructor TWGetDownloader.Create(AOwner: TComponent);
begin
Inherited;