886 lines
24 KiB
ObjectPascal
886 lines
24 KiB
ObjectPascal
{
|
|
********************************************************************************
|
|
|
|
SPackGui
|
|
Copyright (C) 2012-2013 Geoffray Levasseur <geoffray.levasseurbrandin@numericable.fr>.
|
|
Copyright (C) <date> <add your name and mail address here>
|
|
|
|
http://www.geoffray-levasseur.org/
|
|
http://0.tuxfamilly.org/
|
|
|
|
This software is governed by the CeCILL license under French law and
|
|
abiding by the rules of distribution of free software. You can use,
|
|
modify and/ or redistribute the software under the terms of the CeCILL
|
|
license as circulated by CEA, CNRS and INRIA at the following URL
|
|
"http://www.cecill.info".
|
|
|
|
As a counterpart to the access to the source code and rights to copy,
|
|
modify and redistribute granted by the license, users are provided only
|
|
with a limited warranty and the software's author, the holder of the
|
|
economic rights, and the successive licensors have only limited
|
|
liability.
|
|
|
|
In this respect, the user's attention is drawn to the risks associated
|
|
with loading, using, modifying and/or developing or reproducing the
|
|
software by the user in light of its specific status of free software,
|
|
that may mean that it is complicated to manipulate, and that also
|
|
therefore means that it is reserved for developers and experienced
|
|
professionals having in-depth computer knowledge. Users are therefore
|
|
encouraged to load and test the software's suitability as regards their
|
|
requirements in conditions enabling the security of their systems and/or
|
|
data to be ensured and, more generally, to use and operate it in the
|
|
same conditions as regards security.
|
|
|
|
The fact that you are presently reading this means that you have had
|
|
knowledge of the CeCILL license and that you accept its terms.
|
|
|
|
********************************************************************************
|
|
|
|
Description:
|
|
Package manager class
|
|
|
|
********************************************************************************
|
|
}
|
|
unit uPackageManager;
|
|
|
|
{$include defines.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, uDownloadManager, uSpackPackage;
|
|
|
|
type
|
|
TPackageList = class;
|
|
|
|
TPackageListSortCompare = function(List: TPackageList;
|
|
Index1, Index2: Integer): Integer;
|
|
TSortType = (stName, stVersion, stBuild, stDesc, stState, stCat, stSize,
|
|
stInstSize, stSource, stSourceType);
|
|
|
|
PPkgItem = ^TPkgItem;
|
|
TPkgItem = record
|
|
FPkg: TSPackPackage;
|
|
FObject: TObject;
|
|
end;
|
|
|
|
PPkgItemList = ^TPkgItemList;
|
|
TPkgItemList = array[0..MaxListSize] of TPkgItem; //maxlistsize depends on arch
|
|
|
|
TProgressProc = procedure(const Min, Max, Pos: LongInt; const Msg: string);
|
|
|
|
TPackageList = class(TPersistent)
|
|
private
|
|
FList: PPkgItemList;
|
|
FCount: Integer;
|
|
FCapacity: Integer;
|
|
FOwnsObjects: Boolean;
|
|
FUpdateCount: Integer;
|
|
FOnChange: TNotifyEvent;
|
|
FOnChanging: TNotifyEvent;
|
|
FUpdating: Boolean;
|
|
FCaseSensitive: Boolean;
|
|
FInstPackageDir: string;
|
|
FInstPackageLoaded: Boolean;
|
|
FProgressProc: TProgressProc;
|
|
FDistantRepoList: TStringList;
|
|
FLocalRepoList: TStringList;
|
|
FDownloadManager: TDownloadManager;
|
|
FConfigDir: string;
|
|
procedure Grow;
|
|
procedure InternalClear;
|
|
procedure SetInstPackageDir(const ADir: string);
|
|
procedure Error(Msg: string; Index: Integer);
|
|
procedure DwlManProgress(AOwner: TObject);
|
|
procedure DwlManError(AOwner: TObject);
|
|
procedure DwlManNewFile(AOwner: TObject);
|
|
procedure DwlManNextFile(AOwner: TObject);
|
|
procedure DwlManStartDownload(AOwner: TObject);
|
|
function DoCompareText(const S1, S2 : string) : PtrInt;
|
|
procedure GetDistantRepoInfo(const Repo: string; out Name, Address: string);
|
|
protected
|
|
procedure SetUpdateState(Updating: Boolean);
|
|
procedure Changed; virtual;
|
|
procedure Changing; virtual;
|
|
function GetCapacity: Integer; virtual;
|
|
function GetCount: Integer; virtual;
|
|
procedure SetCapacity(NewCapacity: Integer); virtual;
|
|
function GetObject(Index: Integer): TObject; virtual;
|
|
procedure PutObject(Index: Integer; AObject: TObject); virtual;
|
|
function GetPackage(Index: Integer): TSPackPackage;
|
|
procedure PutPackage(Index: Integer; const Pkg: TSPackPackage); virtual;
|
|
procedure InsertItem(Index: Integer; const Pkg: TSPackPackage);
|
|
procedure InsertItem(Index: Integer; const Pkg: TSPackPackage;
|
|
Obj: TObject);
|
|
procedure SetCaseSensitive(B: Boolean);
|
|
public
|
|
procedure BeginUpdate; //usefull if threaded
|
|
procedure EndUpdate;
|
|
destructor Destroy; override;
|
|
constructor Create;
|
|
function Add(const Pkg: TSPackPackage): Integer;
|
|
function Find(const S: string; Out Index: Integer): Boolean;
|
|
procedure Clear;
|
|
procedure Delete(Index: Integer);
|
|
function GetPkgFromName(const Name: string): TSPackPackage;
|
|
procedure GetInstalledPackages;
|
|
function GetInstalledCount: integer;
|
|
procedure LoadLocalRepo;
|
|
function LoadLocalRepoCount: Integer;
|
|
procedure DownloadDistantRepo;
|
|
function DownloadDistantRepoCount: integer;
|
|
procedure LoadDistantRepo(const Name: string);
|
|
function LoadDistantRepoCount(const Name: string): Integer;
|
|
procedure SetDeprecated(DeprecatedList: TStrings);
|
|
property Capacity: Integer read GetCapacity write SetCapacity;
|
|
property Packages[Index: Integer]: TSPackPackage read GetPackage
|
|
write PutPackage;
|
|
property Objects[Index: Integer]: TObject read GetObject write PutObject;
|
|
property Count: Integer read GetCount;
|
|
property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
|
|
property InstPackageLoaded: Boolean read FInstPackageLoaded;
|
|
property InstPackageDir: string read FInstPackageDir write SetInstPackageDir;
|
|
property OwnsObjects: Boolean read FOwnsObjects write FOwnsObjects;
|
|
property DistantRepoList: TStringList read FDistantRepoList
|
|
write FDistantRepoList;
|
|
property LocalRepoList: TStringList read FLocalRepoList write FLocalRepoList;
|
|
property ConfigDir: string read FConfigDir write FConfigDir;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
|
|
property OnProgress: TProgressProc read FProgressProc write FProgressProc;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
uDebug, uStrings, uCommon, uUtils, FileUtil, Forms, uDownload;
|
|
|
|
const
|
|
WordRatio = SizeOf(Pointer) div SizeOf(Word);
|
|
|
|
///////////////////////////////////////////////////////////// TPackageList class
|
|
//______________________________________________________________________________
|
|
|
|
procedure TPackageList.Error(Msg: string; Index: Integer);
|
|
begin
|
|
{$warning Error management to be done}
|
|
end;
|
|
|
|
|
|
procedure TPackageList.SetUpdateState(Updating: Boolean);
|
|
begin
|
|
FUpdating := Updating;
|
|
end;
|
|
|
|
|
|
procedure TPackageList.BeginUpdate;
|
|
begin
|
|
if FUpdateCount = 0 then
|
|
SetUpdateState(True);
|
|
Inc(FUpdateCount);
|
|
end;
|
|
|
|
|
|
procedure TPackageList.EndUpdate;
|
|
begin
|
|
if FUpdateCount > 0 then
|
|
Dec(FUpdateCount);
|
|
if FUpdateCount = 0 then
|
|
SetUpdateState(False);
|
|
end;
|
|
|
|
|
|
procedure TPackageList.InternalClear;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if FOwnsObjects then
|
|
begin
|
|
for I := 0 to FCount - 1 do
|
|
begin
|
|
FreeAndNil(FList^[I].FPkg);
|
|
FreeAndNil(FList^[I].FObject);
|
|
end;
|
|
end else
|
|
begin
|
|
for I := 0 to FCount - 1 do
|
|
FreeAndNil(FList^[I].FPkg);
|
|
end;
|
|
FCount := 0;
|
|
SetCapacity(0);
|
|
end;
|
|
|
|
|
|
function TPackageList.GetCapacity: Integer;
|
|
begin
|
|
Result := FCapacity;
|
|
end;
|
|
|
|
|
|
procedure TPackageList.SetCapacity(NewCapacity: Integer);
|
|
var
|
|
NewList: Pointer;
|
|
MSize: Longint;
|
|
begin
|
|
if (NewCapacity < 0) then
|
|
Error(rsErrorCapacity, NewCapacity);
|
|
if NewCapacity > FCapacity then
|
|
begin
|
|
GetMem(NewList, NewCapacity * SizeOf(TPkgItem));
|
|
if NewList = nil then
|
|
Error(rsErrorCapacity, NewCapacity);
|
|
if Assigned(FList) then
|
|
begin
|
|
MSize := FCapacity * Sizeof(TPkgItem);
|
|
System.Move(FList^, NewList^, MSize);
|
|
FillWord(Pchar(NewList)[MSize], (NewCapacity - FCapacity) * WordRatio, 0);
|
|
FreeMem(Flist, MSize);
|
|
end;
|
|
Flist := NewList;
|
|
FCapacity := NewCapacity;
|
|
end else
|
|
if NewCapacity<FCapacity then
|
|
begin
|
|
if NewCapacity = 0 then
|
|
begin
|
|
FreeMem(FList);
|
|
FList := nil;
|
|
end else
|
|
begin
|
|
GetMem(NewList, NewCapacity * SizeOf(TPkgItem));
|
|
System.Move(FList^, NewList^, NewCapacity * SizeOf(TPkgItem));
|
|
FreeMem(FList);
|
|
FList := NewList;
|
|
end;
|
|
FCapacity := NewCapacity;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TPackageList.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
|
|
function TPackageList.GetObject(Index: Integer): TObject;
|
|
begin
|
|
if (Index < 0) or (Index >= FCount) then
|
|
Error(rsErrorPkgListIndex, Index);
|
|
Result := Flist^[Index].FObject;
|
|
end;
|
|
|
|
|
|
procedure TPackageList.PutObject(Index: Integer; AObject: TObject);
|
|
begin
|
|
If (Index < 0) or (Index >= FCount) then
|
|
Error(rsErrorPkgListIndex, Index);
|
|
Changing;
|
|
Flist^[Index].FObject := AObject;
|
|
Changed;
|
|
end;
|
|
|
|
|
|
procedure TPackageList.Grow;
|
|
var
|
|
NewCapacity: Integer;
|
|
begin
|
|
NewCapacity := FCapacity;
|
|
if NewCapacity >= 256 then
|
|
NewCapacity := NewCapacity + (NewCapacity div 4)
|
|
else
|
|
if NewCapacity = 0 then
|
|
NewCapacity := 4
|
|
else
|
|
NewCapacity := NewCapacity * 4;
|
|
SetCapacity(NewCapacity);
|
|
end;
|
|
|
|
|
|
function TPackageList.GetPackage(Index: Integer): TSPackPackage;
|
|
begin
|
|
if (Index < 0) or (Index >= FCount) then
|
|
Error(rsErrorPkgListIndex, Index);
|
|
Result := FList^[Index].FPkg;
|
|
end;
|
|
|
|
|
|
procedure TPackageList.PutPackage(Index: Integer; const Pkg: TSPackPackage);
|
|
var
|
|
I: integer;
|
|
PSt: TPkgState;
|
|
begin
|
|
if (Index < 0) or (Index >= FCount) then
|
|
Error(rsErrorPkgListIndex, Index);
|
|
Changing;
|
|
Flist^[Index].FPkg := Pkg;
|
|
//get global state
|
|
PSt := Pkg.State;
|
|
for I := 0 to FCount - 1 do
|
|
if Pkg.Name = FList^[I].FPkg.Name then
|
|
if Pkg.State <> FList^[I].FPkg.State then
|
|
PSt := PSt + FList^[I].FPkg.State;
|
|
//dispatch it
|
|
for I := 0 to FCount - 1 do
|
|
if Pkg.Name = FList^[I].FPkg.Name then
|
|
FList^[I].FPkg.State := PSt;
|
|
Changed;
|
|
end;
|
|
|
|
|
|
procedure TPackageList.Changing;
|
|
begin
|
|
if FUpdateCount = 0 then
|
|
if Assigned(FOnChanging) then
|
|
FOnChanging(Self);
|
|
end;
|
|
|
|
|
|
procedure TPackageList.Changed;
|
|
begin
|
|
if (FUpdateCount = 0) Then
|
|
begin
|
|
if Assigned(FOnChange) then
|
|
FOnChange(Self);
|
|
SetUpdateState(False);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TPackageList.InsertItem(Index: Integer; const Pkg: TSPackPackage);
|
|
begin
|
|
Changing;
|
|
if FCount = FCapacity then
|
|
Grow;
|
|
if Index < FCount then
|
|
System.Move(FList^[Index], FList^[Index + 1],
|
|
(FCount - Index) * SizeOf(TPkgItem));
|
|
Pointer(FList^[Index].FPkg) := nil; // Needed to initialize...
|
|
FList^[Index].FPkg := Pkg;
|
|
FList^[Index].FObject := nil;
|
|
Inc(FCount);
|
|
Changed;
|
|
end;
|
|
|
|
|
|
procedure TPackageList.InsertItem(Index: Integer; const Pkg: TSPackPackage;
|
|
Obj: TObject);
|
|
begin
|
|
Changing;
|
|
if FCount = FCapacity then
|
|
Grow;
|
|
if Index < FCount then
|
|
System.Move(FList^[Index], FList^[Index + 1],
|
|
(FCount - Index) * SizeOf(TStringItem));
|
|
Pointer(Flist^[Index].FPkg) := nil; // Needed to initialize...
|
|
FList^[Index].FPkg := Pkg;
|
|
FList^[Index].FObject := Obj;
|
|
Inc(FCount);
|
|
Changed;
|
|
end;
|
|
|
|
|
|
constructor TPackageList.Create;
|
|
begin
|
|
FProgressProc := nil;
|
|
FLocalRepoList := TStringList.Create;
|
|
FDistantRepoList := TStringList.Create;
|
|
inherited Create;
|
|
end;
|
|
|
|
destructor TPackageList.Destroy;
|
|
begin
|
|
InternalClear;
|
|
FreeAndNil(FLocalRepoList);
|
|
FreeAndNil(FDistantRepoList);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
|
|
function TPackageList.Add(const Pkg: TSPackPackage): Integer;
|
|
begin
|
|
Result := Count;
|
|
InsertItem(Result, Pkg);
|
|
end;
|
|
|
|
|
|
procedure TPackageList.SetCaseSensitive(B: boolean);
|
|
begin
|
|
if B <> FCaseSensitive then
|
|
begin
|
|
FCaseSensitive := B;
|
|
{$warning ask here for a reload of package list}
|
|
end;
|
|
end;
|
|
|
|
|
|
function TPackageList.DoCompareText(const S1, S2 : string) : PtrInt;
|
|
begin
|
|
if FCaseSensitive then
|
|
Result := AnsiCompareStr(S1, S2)
|
|
else
|
|
Result := AnsiCompareText(S1, S2);
|
|
end;
|
|
|
|
|
|
function TPackageList.Find(const S: string; out Index: Integer): Boolean;
|
|
var
|
|
L, R, I: Integer;
|
|
CompareRes: PtrInt;
|
|
begin
|
|
Result := false;
|
|
// Use binary search.
|
|
L := 0;
|
|
R := Count - 1;
|
|
while (L <= R) do
|
|
begin
|
|
I := L + (R - L) div 2;
|
|
CompareRes := DoCompareText(S, Flist^[I].FPkg.Name);
|
|
if (CompareRes > 0) then
|
|
L := I + 1
|
|
else begin
|
|
R := I - 1;
|
|
if (CompareRes = 0) then
|
|
Result := true;
|
|
end;
|
|
end;
|
|
Index := L;
|
|
end;
|
|
|
|
|
|
procedure TPackageList.Clear;
|
|
begin
|
|
if FCount = 0 then
|
|
Exit;
|
|
Changing;
|
|
InternalClear;
|
|
Changed;
|
|
end;
|
|
|
|
|
|
procedure TPackageList.Delete(Index: Integer);
|
|
begin
|
|
if (Index < 0) or (Index >= FCount) then
|
|
Error(rsErrorPkgListIndex, Index);
|
|
Changing;
|
|
FreeAndNil(Flist^[Index].FPkg);
|
|
if FOwnsObjects then
|
|
FreeAndNil(Flist^[Index].FObject);
|
|
Dec(FCount);
|
|
if Index < FCount then
|
|
System.Move(Flist^[Index + 1], Flist^[Index],
|
|
(Fcount - Index) * SizeOf(TStringItem));
|
|
Changed;
|
|
end;
|
|
|
|
|
|
function TPackageList.GetPkgFromName(const Name: string): TSPackPackage;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := nil;
|
|
for I := 0 to FCount - 1 do
|
|
if Packages[I].Name = Name then
|
|
begin
|
|
Result := Packages[I];
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TPackageList.SetInstPackageDir(const ADir: string);
|
|
begin
|
|
FInstPackageDir := ADir;
|
|
if FInstPackageLoaded then
|
|
begin
|
|
Clear;
|
|
GetInstalledPackages;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TPackageList.GetInstalledPackages;
|
|
var
|
|
Dir: TSearchRec;
|
|
Pkg: TSPackPackage;
|
|
I: integer;
|
|
N: Integer;
|
|
begin
|
|
I := 0;
|
|
if FProgressProc <> nil then
|
|
N := GetInstalledCount;
|
|
PrintLnDbg(Format(rsInfoLoadingPackages, [FInstPackageDir, N]), vlLow);
|
|
if FindFirst(FInstPackageDir + '/*', faAnyFile, Dir) = 0 then
|
|
begin
|
|
repeat
|
|
if Dir.Name[1] <> '.' then //exlude hidden and '.' and '..'
|
|
begin
|
|
Pkg := GetPkgFromName(Dir.Name);
|
|
if Pkg = nil then
|
|
begin
|
|
Pkg := TSPackPackage.Create;
|
|
Add(Pkg);
|
|
end;
|
|
Pkg.ReadInstalledPackage(FInstPackageDir + '/' + Dir.Name);
|
|
Inc(I);
|
|
if FProgressProc <> nil then
|
|
FProgressProc(0, N, I, Pkg.Name);
|
|
end;
|
|
until FindNext(Dir) <> 0;
|
|
FInstPackageLoaded := True;
|
|
end else
|
|
FInstPackageLoaded := False;
|
|
FindClose(Dir);
|
|
end;
|
|
|
|
|
|
function TPackageList.GetInstalledCount: integer;
|
|
begin
|
|
Result := GetNumberOfFiles(FInstPackageDir, []);
|
|
end;
|
|
|
|
|
|
procedure TPackageList.LoadLocalRepo;
|
|
var
|
|
Dir: TSearchRec;
|
|
I, J, N: Integer;
|
|
Path: string;
|
|
|
|
procedure LoadDir(const S: string);
|
|
var
|
|
Rec: TSearchRec;
|
|
Pkg: TSPackPackage;
|
|
begin
|
|
if FindFirst(S + '/*', faAnyFile, Rec) = 0 then
|
|
repeat
|
|
if (Rec.Name[1] <> '.') then //no hidden things or '.' and '..' dirs
|
|
//load subdirectoies if any
|
|
if (Rec.Attr and faDirectory) = faDirectory then
|
|
begin
|
|
PrintLnDbg(Format(rsInfoDirLoadingPackages, [S + Rec.Name]), vlFull);
|
|
LoadDir(S + Rec.Name + '/'); //recursive
|
|
end else
|
|
begin
|
|
if UpperCase(ExtractFileExt(Rec.Name)) = rsSpackExt then
|
|
begin
|
|
if FileExists(S + Rec.Name) then
|
|
begin
|
|
Pkg := GetPkgFromName(ExtractPackageName(Rec.Name));
|
|
if (not Assigned(Pkg)) or (Pkg = nil) then
|
|
begin
|
|
Pkg := TSPackPackage.Create;
|
|
Add(Pkg);
|
|
end;
|
|
Pkg.ReadPackageFile(Path, S + Rec.Name);
|
|
end;
|
|
end;
|
|
Inc(J);
|
|
if FProgressProc <> nil then
|
|
FProgressProc(0, N, J, Pkg.Name);
|
|
end;
|
|
until FindNext(Rec) <> 0;
|
|
end;
|
|
|
|
begin
|
|
if FLocalRepoList.Count <= 0 then
|
|
begin
|
|
PrintLnDbg(rsWarningNoLocalRepository, vlLow);
|
|
Exit;
|
|
end;
|
|
if FProgressProc <> nil then
|
|
N := LoadLocalRepoCount;
|
|
Path := '';
|
|
for I := 0 to FLocalRepoList.Count - 1 do
|
|
begin
|
|
Path := Copy(FLocalRepoList[I], Pos('=', FLocalRepoList[I]) + 1,
|
|
Length(FLocalRepoList[I]) - Pos('=', FLocalRepoList[I]));
|
|
J := 0;
|
|
if not DirectoryExists(Path) then
|
|
begin
|
|
PrintLnDbg(rsErrorLocalRepoNotFound + Path, vlLow);
|
|
Continue;
|
|
end;
|
|
if FindFirst(Path + '/*', faDirectory, Dir) = 0 then
|
|
repeat
|
|
if Dir.Name[1] <> '.' then //ignore hidden, '.' and '..' dirs
|
|
begin
|
|
PrintLnDbg(Format(rsInfoDirLoadingPackages, [Path + Dir.Name]), vlFull);
|
|
LoadDir(Path + Dir.Name + '/');
|
|
end;
|
|
until FindNext(Dir) <> 0;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TPackageList.LoadLocalRepoCount: Integer;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 0 to FLocalRepoList.Count - 1 do
|
|
Result := Result + GetNumberOfFiles(Copy(FLocalRepoList[I],
|
|
Pos('=', FLocalRepoList[I]) + 1,
|
|
Length(FLocalRepoList[I]) - Pos('=', FLocalRepoList[I])),
|
|
[fcIncludeSubdirs]);
|
|
end;
|
|
|
|
|
|
procedure TPackageList.DwlManProgress(AOwner: TObject);
|
|
begin
|
|
// if Assigned(FProgressProc) then
|
|
// FProgressProc(0, FDownloadManager.TotalSize,
|
|
// FDownloadManager.TotalDownloadedSize, Format('Downloading %s (%d / %d)...',
|
|
// [FDownloadManager.DownloadList[FDownloadManager.DownloadIndex],
|
|
// FDownloadManager.TotalDownloadedSize, FDownloadManager.TotalSize]));
|
|
end;
|
|
|
|
|
|
procedure TPackageList.DwlManError(AOwner: TObject);
|
|
begin
|
|
PrintLnDbg(Format(rsErrorDownloadRepoFailed,
|
|
[FDownloadManager.DownloadList[FDownloadManager.DownloadIndex]]), vlLow);
|
|
FDownloadManager.DownloadIndex := FDownloadManager.DownloadIndex + 1;
|
|
end;
|
|
|
|
|
|
procedure TPackageList.DwlManNewFile(AOwner: TObject);
|
|
var
|
|
S: string;
|
|
I, N: Integer;
|
|
begin
|
|
PrintLnDbg(Format(rsDebugInitializingNewFileForDownload,
|
|
[FDownloadManager.DownloadList[FDownloadManager.DownloadIndex]]));
|
|
S := ExtractFilePath(FDownloadManager.DownloadList[FDownloadManager.DownloadIndex]);
|
|
if S[Length(S)] = '/' then
|
|
S := Copy(S, 1, Length(S) - 1);
|
|
for I := 0 to FDistantRepoList.Count - 1 do
|
|
begin
|
|
if Pos(S, FDistantRepoList[I]) <> 0 then
|
|
begin
|
|
N := Pos('=', DistantRepoList[I]);
|
|
if N <> 0 then
|
|
FDownloadManager.Destination := sConfDir + '/' +
|
|
Copy(FDistantRepoList[I], 1, N - 1) + '/' +
|
|
ExtractFileName(FDownloadManager.DownloadList[FDownloadManager.DownloadIndex])
|
|
else
|
|
FDownloadManager.Destination := sConfDir +
|
|
ExtractFileName(FDownloadManager.DownloadList[FDownloadManager.DownloadIndex]);
|
|
end;
|
|
end;
|
|
if Trim(FDownloadManager.Destination) = '' then
|
|
FDownloadManager.Destination := sConfDir + '/' + ExtractHostName(S) + '/' +
|
|
ExtractFileName(FDownloadManager.DownloadList[FDownloadManager.DownloadIndex]);
|
|
PrintLnDbg(Format(rsInfoDownloadingFile,
|
|
[FDownloadManager.DownloadList[FDownloadManager.DownloadIndex],
|
|
FDownloadManager.Destination]), vlLow);
|
|
{$I-}
|
|
if not DirectoryExists(ExtractFilePath(FDownloadManager.Destination)) then
|
|
MkDir(ExtractFilePath(FDownloadManager.Destination));
|
|
{$I+}
|
|
end;
|
|
|
|
|
|
procedure TPackageList.DwlManNextFile(AOwner: TObject);
|
|
begin
|
|
FDownloadManager.DownloadIndex := FDownloadManager.DownloadIndex + 1;
|
|
PrintLnDbg(Format(rsDebugSwitchedToNextFileForDownload,
|
|
[FDownloadManager.DownloadIndex]));
|
|
end;
|
|
|
|
|
|
procedure TPackageList.DwlManStartDownload(AOwner: TObject);
|
|
begin
|
|
FDownloadManager.DownloadIndex := 0;
|
|
end;
|
|
|
|
|
|
procedure TPackageList.GetDistantRepoInfo(const Repo: string;
|
|
out Name, Address: string);
|
|
var
|
|
P: integer;
|
|
begin
|
|
Name := '';
|
|
Address := '';
|
|
P := Pos('=', Repo);
|
|
if P = 0 then
|
|
begin
|
|
PrintLnDbg(Format(rsErrorMalformedRepoDecl, [Repo]), vlLow);
|
|
Exit;
|
|
end;
|
|
Name := Copy(Repo, 1, P);
|
|
Address := Copy(Repo, P + 1, Length(Repo) - P);
|
|
FDownloadManager.DownloadList.Add(Address + rsPackageListFile);
|
|
PrintLnDbg(Format(rsDebugAddedToDownloadList, [Address + rsPackageListFile]));
|
|
FDownloadManager.DownloadList.Add(Address + rsAppListFile);
|
|
PrintLnDbg(Format(rsDebugAddedToDownloadList, [Address + rsAppListFile]));
|
|
FDownloadManager.DownloadList.Add(Address + rsDeprecatedFile);
|
|
PrintLnDbg(Format(rsDebugAddedToDownloadList, [Address + rsDeprecatedFile]));
|
|
end;
|
|
|
|
|
|
procedure TPackageList.DownloadDistantRepo;
|
|
var
|
|
I: Integer;
|
|
Name: string;
|
|
Address: string;
|
|
begin
|
|
if FDistantRepoList.Count <= 0 then
|
|
begin
|
|
PrintLnDbg(rsWarningNoDistantRepository, vlLow);
|
|
Exit;
|
|
end;
|
|
FDownloadManager := TDownloadManager.Create(nil);
|
|
FDownloadManager.OnProgress := @DwlManProgress;
|
|
FDownloadManager.OnNewDownload := @DwlManNewFile;
|
|
FDownloadManager.OnNextFile := @DwlManNextFile;
|
|
FDownloadManager.OnError := @DwlManError;
|
|
for I := 0 to FDistantRepoList.Count - 1 do
|
|
GetDistantRepoInfo(FDistantRepoList[I], Name, Address);
|
|
if FDownloadManager.DownloadList.Count <= 0 then
|
|
begin
|
|
PrintLnDbg(rsWarningNoPackageInfo, vlLow);
|
|
FreeAndNil(FDownloadManager);
|
|
Exit;
|
|
end;
|
|
FDownloadManager.GetTotalSize;
|
|
FDownloadManager.StartDownload;
|
|
repeat
|
|
if (FProgressProc <> nil) and
|
|
(FDownloadManager.DownloadIndex < FDownloadManager.DownloadList.Count) then
|
|
FProgressProc(1, 0, FDownloadManager.GetFileSize(FDownloadManager.DownloadIndex),
|
|
Format(rsDownloadingFile,
|
|
[FDownloadManager.DownloadList[FDownloadManager.DownloadIndex]]));
|
|
Application.ProcessMessages;
|
|
until (FDownloadManager.Status = drDone) or
|
|
(FDownloadManager.Status = drCanceled);
|
|
FDownloadManager.Free;
|
|
end;
|
|
|
|
|
|
function TPackageList.DownloadDistantRepoCount: integer;
|
|
var
|
|
I: Integer;
|
|
Name: string;
|
|
Address: string;
|
|
begin
|
|
FDownloadManager := TDownloadManager.Create(nil);
|
|
for I := 0 to FDistantRepoList.Count - 1 do
|
|
GetDistantRepoInfo(FDistantRepoList[I], Name, Address);
|
|
if FDownloadManager.DownloadList.Count <= 0 then
|
|
begin
|
|
PrintLnDbg(rsWarningNoPackageInfo, vlLow);
|
|
FreeAndNil(FDownloadManager);
|
|
Exit;
|
|
end;
|
|
FDownloadManager.GetTotalSize;
|
|
Result := FDownloadManager.TotalSize;
|
|
FDownloadManager.Free;
|
|
end;
|
|
|
|
|
|
procedure TPackageList.LoadDistantRepo(const Name: string);
|
|
var
|
|
I: Integer;
|
|
Txt: Text;
|
|
FName, S: string;
|
|
Pkg: TSPackPackage;
|
|
Line, N: Integer;
|
|
begin
|
|
I := 0;
|
|
while (I < slRepoList.Count) and
|
|
(Copy(slRepoList[I], 1, Length(Name)) <> Name) do
|
|
Inc(I);
|
|
if Copy(slRepoList[I], 1, Length(Name)) = Name then
|
|
begin
|
|
FName := sConfDir + '/' + Name + '/' + rsPackageListFile;
|
|
N := LoadDistantRepoCount(Name);
|
|
PrintLnDbg(Format(rsInfoLoadingDistPackageInfo, [FName]));
|
|
if FileExists(FName) then
|
|
begin
|
|
AssignFile(Txt, FName);
|
|
Reset(Txt);
|
|
Line := 0;
|
|
while not EOF(Txt) do
|
|
begin
|
|
Inc(Line);
|
|
Readln(Txt, S);
|
|
Pkg := GetPkgFromName(ExtractPackageName(S));
|
|
if (not Assigned(Pkg)) or (Pkg = nil) then
|
|
begin
|
|
Pkg := TSPackPackage.Create;
|
|
Add(Pkg);
|
|
end;
|
|
Pkg.ReadDistRepoPackage(Copy(slRepoList[I], Pos(slRepoList[I], '=') + 1,
|
|
Length(slRepoList[I]) - Pos(slRepoList[I], '=')), S);
|
|
if Trim(Pkg.Name) = '' then
|
|
PrintLnDbg(Format(rsErrorInvalidLine, [FName, Line]));
|
|
if FProgressProc <> nil then
|
|
FProgressProc(1, N, Line, Pkg.Name);
|
|
end;
|
|
CloseFile(Txt);
|
|
end;
|
|
if Name = sDefaultRepo then
|
|
begin
|
|
FName := sConfDir + '/' + Name + '/' + rsDeprecatedFile;
|
|
if FileExists(FName) then
|
|
begin
|
|
PrintLnDbg(Format(rsInfoLoadingDeprecated, [Name, FName]), vlLow);
|
|
if not Assigned(slDeprecated) or (slDeprecated = nil) then
|
|
slDeprecated := TStringList.Create
|
|
else
|
|
slDeprecated.Clear;
|
|
AssignFile(Txt, FName);
|
|
Reset(Txt);
|
|
while not EOF(Txt) do
|
|
begin
|
|
ReadLn(Txt, S);
|
|
slDeprecated.Add(Trim(S));
|
|
end;
|
|
CloseFile(Txt);
|
|
end else
|
|
PrintLnDbg(Format(rsErrorCantFindDeprecationFile, [Name, FName]), vlLow);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TPackageList.LoadDistantRepoCount(const Name: string): Integer;
|
|
var
|
|
I: Integer;
|
|
FName: string;
|
|
Txt: Text;
|
|
begin
|
|
I := 0;
|
|
FName := sConfDir + '/' + Name + '/' + rsPackageListFile;
|
|
if FileExists(FName) then
|
|
begin
|
|
AssignFile(Txt, FName);
|
|
Reset(Txt);
|
|
while not EOF(Txt) do
|
|
begin
|
|
Readln(Txt);
|
|
Inc(I);
|
|
end;
|
|
CloseFile(Txt);
|
|
end;
|
|
Result := I;
|
|
end;
|
|
|
|
|
|
procedure TPackageList.SetDeprecated(DeprecatedList: TStrings);
|
|
var
|
|
I: Integer;
|
|
Pkg: TSPackPackage;
|
|
begin
|
|
if Assigned(DeprecatedList) and (DeprecatedList <> nil) then
|
|
for I := 0 to DeprecatedList.Count - 1 do
|
|
begin
|
|
Pkg := GetPkgFromName(DeprecatedList[I]);
|
|
if Pkg <> nil then
|
|
Pkg.State := Pkg.State + [psDeprecated];
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|