initial commit from lost SVN repo
This commit is contained in:
fatalerrors
885
common/upackagemanager.pas
Normal file
885
common/upackagemanager.pas
Normal file
@@ -0,0 +1,885 @@
|
||||
{
|
||||
********************************************************************************
|
||||
|
||||
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.
|
||||
|
||||
Reference in New Issue
Block a user