{ ******************************************************************************** SPackGui Copyright (C) 2012-2013 Geoffray Levasseur . Copyright (C) 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= 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.