freepascal.compiler/utils/fppkg/pkgdownload.pp

unit pkgdownload;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, pkghandler;

Type

  { TBaseDownloader }

  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;
    Procedure FileDownload(Const URL : String; Dest : TStream); Virtual;
  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;

Var
  DownloaderClass : TBaseDownloaderClass;

procedure DownloadFile(const RemoteFile,LocalFile:String);


implementation

uses
  uriparser,
  pkgglobals,
  pkgmessages;


procedure DownloadFile(const RemoteFile,LocalFile:String);
begin
  with DownloaderClass.Create(nil) do
    try
      Download(RemoteFile,LocalFile);
    finally
      Free;
    end;
end;


{ TBaseDownloader }

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 TBaseDownloader.HTTPDownload(const URL: String; Dest: TStream);
begin
  Error(SErrNoHTTPDownload);
end;

procedure TBaseDownloader.FileDownload(const URL: String; Dest: TStream);

Var
  FN : String;
  F : TFileStream;

begin
  URIToFilename(URL,FN);
  If Not FileExists(FN) then
    Error(SErrNoSuchFile,[FN]);
  F:=TFileStream.Create(FN,fmOpenRead);
  Try
    Dest.CopyFrom(F,0);
  Finally
    F.Free;
  end;
end;

procedure TBaseDownloader.Download(const URL, DestFileName: String);

Var
  F : TFileStream;

begin
  Log(vCommands,SLogDownloading,[URL,DestFileName]);
  If FileExists(DestFileName) and BackupFiles then
    BackupFile(DestFileName);
  F:=TFileStream.Create(DestFileName,fmCreate);
  Try
    Download(URL,F);
  Finally
    F.Free;
  end;
end;

procedure TBaseDownloader.Download(const URL: String; Dest: TStream);

Var
  URI : TURI;
  P : String;

begin
  URI:=ParseURI(URL);
  P:=URI.Protocol;
  If CompareText(P,'ftp')=0 then
    FTPDownload(URL,Dest)
  else if CompareText(P,'http')=0 then
    HTTPDownload(URL,Dest)
  else if CompareText(P,'file')=0 then
    FileDownload(URL,Dest)
  else
    Error(SErrUnknownProtocol,[P]);
end;


{ TDownloadPackage }

function TDownloadPackage.Execute(const Args:TActionArgs):boolean;
begin
  with DownloaderClass.Create(nil) do
    try
      Download(PackageRemoteArchive,PackageLocalArchive);
    finally
      Free;
    end;
end;


initialization
  // Default value.
  DownloaderClass := TBaseDownloader;

  RegisterPkgHandler('downloadpackage',TDownloadPackage);
end.