paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-02 09:19:33 +01:00
Code Issues Packages Projects Releases Wiki Activity

Opkman: Preparing OPM for the integration with the build in Package Manager. Step1.

Browse Source 
git-svn-id: trunk@56430 -
This commit is contained in:
balazs 2017-11-18 05:24:38 +00:00
parent 8cf176ad0c
commit e5b22557ad
8 changed files with 175 additions and 133 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -3506,6 +3506,7 @@ components/onlinepackagemanager/opkman_createrepositorypackagefrm.pas svneol=nat
components/onlinepackagemanager/opkman_downloader.pas svneol=native#text/pascal
components/onlinepackagemanager/opkman_fpcdef.inc svneol=native#text/pascal
components/onlinepackagemanager/opkman_installer.pas svneol=native#text/pascal
components/onlinepackagemanager/opkman_intf.pas svneol=native#text/pascal
components/onlinepackagemanager/opkman_mainfrm.lfm svneol=native#text/plain
components/onlinepackagemanager/opkman_mainfrm.pas svneol=native#text/pascal
components/onlinepackagemanager/opkman_options.pas svneol=native#text/pascal

6
components/onlinepackagemanager/onlinepackagemanager.lpk
View File

@ -20,7 +20,7 @@
<Description Value="Online package manger"/>
<License Value="GPL"/>
<Version Major="1" Release="1" Build="2"/>
<Files Count="24">
<Files Count="25">
<Item1>
<Filename Value="onlinepackagemanagerintf.pas"/>
<HasRegisterProc Value="True"/>
@ -123,6 +123,10 @@
<Filename Value="opkman_addrepositorypackagefrm.pas"/>
<UnitName Value="opkman_addrepositorypackagefrm"/>
</Item24>
<Item25>
<Filename Value="opkman_intf.pas"/>
<UnitName Value="opkman_intf"/>
</Item25>
</Files>
<i18n>
<EnableI18N Value="True"/>

2
components/onlinepackagemanager/onlinepackagemanager.pas
View File

@ -15,7 +15,7 @@ uses
opkman_createrepositorypackagefrm, opkman_categoriesfrm,
opkman_packagedetailsfrm, opkman_updates, opkman_createjsonforupdatesfrm,
opkman_uploader, opkman_repositories, opkman_createrepositoryfrm,
opkman_repositorydetailsfrm, opkman_addrepositorypackagefrm,
opkman_repositorydetailsfrm, opkman_addrepositorypackagefrm, opkman_intf,
LazarusPackageIntf;
implementation

13
components/onlinepackagemanager/onlinepackagemanagerintf.pas
View File

@ -27,12 +27,16 @@ unit onlinepackagemanagerintf;
interface
uses
Classes, MenuIntf, IDECommands, ToolBarIntf, LCLType;
Classes,
// LCL
LCLType,
// IdeIntf
MenuIntf, IDECommands, ToolBarIntf, PackageLinkIntf;
procedure Register;
implementation
uses opkman_const, opkman_mainfrm;
uses opkman_const, opkman_mainfrm, opkman_intf;
procedure IDEMenuSectionClicked(Sender: TObject);
begin
@ -62,5 +66,10 @@ begin
RegisterIDEMenuCommand(itmPkgGraphSection, 'Online Package Manager', rsLazarusPackageManager, nil, @IDEMenuSectionClicked, IDECommand);
end;
initialization
OPMInterface := TOPMInterface.Create;
finalization
OPMInterface.Free;
end.

1
components/onlinepackagemanager/opkman_downloader.pas
View File

@ -261,6 +261,7 @@ begin
begin
SetLength(JSON, FMS.Size);
FMS.Read(Pointer(JSON)^, Length(JSON));
SerializablePackages.JSONToPackages(JSON);
FOnJSONComplete(Self, JSON, FErrTyp, '');
end
else

149
components/onlinepackagemanager/opkman_installer.pas
View File

@ -59,7 +59,6 @@ type
FTotCnt: Integer;
FStarted: Boolean;
FInstallStatus: TInstallStatus;
FPackageList: TList;
FToInstall: TStringList;
FFileName: String;
FUnresolvedFileName: String;
@ -71,8 +70,6 @@ type
function HasUnresolvedDependency(AName: String): Boolean;
function CompilePackage(const AIDEPackage: TIDEPackage; ALazarusPkg: TLazarusPackage): Integer;
function InstallPackage: Boolean;
procedure OrderPackagesByDependecy;
procedure PrepareInstallList;
procedure DoOnPackageInstallProgress(const AInstallMessage: TInstallMessage; ALazarusPkg: TLazarusPackage);
procedure DoOnPackageInstallError(const AInstallMessage: TInstallMessage; ALazarusPkg: TLazarusPackage);
procedure Execute;
@ -98,13 +95,11 @@ implementation
constructor TPackageInstaller.Create;
begin
FToInstall := TStringList.Create;
FPackageList := TList.Create;
end;
destructor TPackageInstaller.Destroy;
begin
FToInstall.Free;
FPackageList.Free;
inherited Destroy;
end;
@ -325,136 +320,68 @@ begin
FOnPackageInstallCompleted(Self, FNeedToRebuild, FInstallStatus);
end;
procedure TPackageInstaller.OrderPackagesByDependecy;
procedure TPackageInstaller.StartInstall;
var
I, J, K: Integer;
SPos, EPos: Integer;
PackageDependency: TPackageDependency;
PackageDependecyList: TObjectList;
PackageList: TObjectList;
LazarusPkg, DependecyPackage: TLazarusPackage;
CanGo: Boolean;
PackageDependency: TPackageDependency;
DependencyFound: Boolean;
begin
PackageDependecyList := TObjectList.Create(True);
if FStarted then
Exit;
FStarted := True;
FTotCnt := 0;
PackageList := TObjectList.Create(True);
try
FPackageList.Clear;
for I := 0 to SerializablePackages.Count - 1 do
begin
for J := 0 to SerializablePackages.Items[I].LazarusPackages.Count - 1 do
begin
LazarusPkg := TLazarusPackage(SerializablePackages.Items[I].LazarusPackages.Items[J]);
if LazarusPkg.IsInstallable then
FPackageList.Add(LazarusPkg);
end;
end;
repeat
CanGo := True;
for I := FPackageList.Count - 1 downto 1 do
begin
if not CanGo then
Break;
for J := I - 1 downto 0 do
begin
LazarusPkg := TLazarusPackage(FPackageList.Items[J]);
PackageDependecyList.Clear;
SerializablePackages.GetPackageDependencies(LazarusPkg.Name, PackageDependecyList, True, True);
if PackageDependecyList.Count > 0 then
SerializablePackages.GetPackageDependencies(LazarusPkg.Name, PackageList, True, True);
if PackageList.Count > 0 then
begin
for K := 0 to PackageDependecyList.Count - 1 do
DependencyFound := True;
for K := 0 to PackageList.Count - 1 do
begin
PackageDependency := TPackageDependency(PackageDependecyList.Items[K]);
PackageDependency := TPackageDependency(PackageList.Items[K]);
DependecyPackage := SerializablePackages.FindLazarusPackage(PackageDependency.PkgFileName + '.lpk');
if DependecyPackage <> nil then
begin
if UpperCase(DependecyPackage.Name) = UpperCase(TLazarusPackage(FPackageList.Items[I]).Name) then
if not ((DependecyPackage.PackageState = psInstalled)
and (SerializablePackages.IsInstalledVersionOk(PackageDependency, DependecyPackage.VersionAsString))) then
begin
CanGo := False;
SPos := I;
EPos := J;
Break;
if ((DependecyPackage.IsInstallable)
and (SerializablePackages.IsDependencyOk(PackageDependency, DependecyPackage))) then
begin
if not IsPackageInTheList(DependecyPackage.Name) then
FToInstall.Add(DependecyPackage.Name);
end
else
begin
DependencyFound := False;
Break;
end;
end;
end;
end;
end;
end;
end;
if CanGo = False then
begin
LazarusPkg := TLazarusPackage(FPackageList.Items[SPos]);
FPackageList.Delete(SPos);
FPackageList.Insert(EPos, LazarusPkg);
end;
until CanGo;
finally
PackageDependecyList.Free;
end;
end;
procedure TPackageInstaller.PrepareInstallList;
var
I, J: Integer;
PackageDependency: TPackageDependency;
PackageDependecyList: TObjectList;
LazarusPkg, DependecyPackage: TLazarusPackage;
DependencyFound: Boolean;
begin
PackageDependecyList := TObjectList.Create(True);
try
for I := 0 to FPackageList.Count - 1 do
begin
LazarusPkg := TLazarusPackage(FPackageList.Items[I]);
if LazarusPkg.IsInstallable then
begin
PackageDependecyList.Clear;
SerializablePackages.GetPackageDependencies(LazarusPkg.Name, PackageDependecyList, True, True);
if PackageDependecyList.Count > 0 then
begin
DependencyFound := True;
for J := 0 to PackageDependecyList.Count - 1 do
begin
PackageDependency := TPackageDependency(PackageDependecyList.Items[J]);
DependecyPackage := SerializablePackages.FindLazarusPackage(PackageDependency.PkgFileName + '.lpk');
if DependecyPackage <> nil then
begin
if not ((DependecyPackage.PackageState = psInstalled)
and (SerializablePackages.IsInstalledVersionOk(PackageDependency, DependecyPackage.VersionAsString))) then
begin
if ((DependecyPackage.IsInstallable)
and (SerializablePackages.IsDependencyOk(PackageDependency, DependecyPackage))) then
begin
if not IsPackageInTheList(DependecyPackage.Name) then
FToInstall.Add(DependecyPackage.Name);
end
else
begin
DependencyFound := False;
Break;
end;
end;
end;
end;
if (not DependencyFound) then
begin
if (not IsPackageInTheList(LazarusPkg.Name)) then
FToInstall.Add(LazarusPkg.Name + ' ' + DependecyPackage.Name)
end
end;
if (not DependencyFound) then
begin
if (not IsPackageInTheList(LazarusPkg.Name)) then
FToInstall.Add(LazarusPkg.Name + ' ' + DependecyPackage.Name)
end
end;
if (not IsPackageInTheList(LazarusPkg.Name)) then
FToInstall.Add(LazarusPkg.Name);
if (not IsPackageInTheList(LazarusPkg.Name)) then
FToInstall.Add(LazarusPkg.Name);
end;
end;
end;
finally
PackageDependecyList.Free;
end
end;
procedure TPackageInstaller.StartInstall;
begin
if FStarted then
Exit;
FStarted := True;
FTotCnt := 0;
OrderPackagesByDependecy;
PrepareInstallList;
PackageList.Free;
end;
FTotCnt := FToInstall.Count;
Execute;
end;

108
components/onlinepackagemanager/opkman_intf.pas Normal file
View File

@ -0,0 +1,108 @@
{
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
* *
***************************************************************************
Author: Balázs Székely
Abstract:
This unit allows OPM to interact with the Lazarus package system}
unit opkman_intf;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, contnrs, fpjson,
// IdeIntf
LazIDEIntf, PackageIntf, PackageLinkIntf, PackageDependencyIntf,
// OPM
opkman_timer, opkman_downloader;
type
{ TOPMMain }
//just a dummy class for now, it must be inherited from ideintf(packagelinkintf.pas)
//it will allow the communication between OPM and the IDE
TOPMInterface = class
private
FWaitForIDE: TThreadTimer;
procedure DoWaitForIDE(Sender: TObject);
procedure InitOPM;
public
constructor Create;
destructor Destroy; override;
public
end;
var
OPMInterface: TOPMInterface;
implementation
uses opkman_serializablepackages, opkman_common, opkman_options;
{ TOPMMain }
constructor TOPMInterface.Create;
begin
FWaitForIDE := TThreadTimer.Create;
FWaitForIDE.Interval := 100;
FWaitForIDE.OnTimer := @DoWaitForIDE;
FWaitForIDE.StartTimer;
end;
procedure TOPMInterface.DoWaitForIDE(Sender: TObject);
begin
if Assigned(LazarusIDE) and Assigned(PackageEditingInterface) then
begin
InitOPM;
FWaitForIDE.StopTimer;
FWaitForIDE.Terminate;
FWaitForIDE := nil;
end;
end;
procedure TOPMInterface.InitOPM;
begin
InitLocalRepository;
Options := TOptions.Create(LocalRepositoryConfigFile);
SerializablePackages := TSerializablePackages.Create;
PackageDownloader := TPackageDownloader.Create(Options.RemoteRepository[Options.ActiveRepositoryIndex]);
InstallPackageList := TObjectList.Create(True);
PackageDownloader.DownloadJSON(Options.ConTimeOut*1000);
end;
destructor TOPMInterface.Destroy;
begin
if Assigned(FWaitForIDE) then
begin
FWaitForIDE.StopTimer;
FWaitForIDE.Terminate;
end;
PackageDownloader.Free;
SerializablePackages.Free;
Options.Free;
InstallPackageList.Free;
inherited Destroy;
end;
end.

28
components/onlinepackagemanager/opkman_mainfrm.pas
View File

@ -178,18 +178,13 @@ implementation
procedure TMainFrm.FormCreate(Sender: TObject);
begin
InitLocalRepository;
Options := TOptions.Create(LocalRepositoryConfigFile);
VisualTree := TVisualTree.Create(pnMain, imTree, pmTree);
VisualTree.OnChecking := @DoOnChecking;
VisualTree.OnChecked := @DoOnChecked;
SerializablePackages := TSerializablePackages.Create;
SerializablePackages.OnProcessJSON := @DoOnProcessJSON;
PackageDownloader := TPackageDownloader.Create(Options.RemoteRepository[Options.ActiveRepositoryIndex]);
PackageDownloader.OnJSONProgress := @DoOnJSONProgress;
PackageDownloader.OnJSONDownloadCompleted := @DoOnJSONDownloadCompleted;
StartUpdates;
InstallPackageList := TObjectList.Create(True);
FHintTimeOut := Application.HintHidePause;
Application.HintHidePause := 1000000;
{$IF LCL_FULLVERSION >= 1070000}
@ -220,12 +215,11 @@ end;
procedure TMainFrm.FormDestroy(Sender: TObject);
begin
SerializablePackages.OnProcessJSON := nil;
PackageDownloader.OnJSONProgress := nil;
PackageDownloader.OnJSONDownloadCompleted := nil;
StopUpdates;
PackageDownloader.Free;
SerializablePackages.Free;
VisualTree.Free;
Options.Free;
InstallPackageList.Free;
Application.HintHidePause := FHintTimeOut;
end;
@ -255,9 +249,6 @@ begin
begin
SetupMessage(rsMainFrm_rsMessageChangingRepository);
Sleep(1500);
StopUpdates;
SerializablePackages.Clear;
StartUpdates;
end
else
Updates.PauseUpdate;
@ -365,7 +356,7 @@ begin
etNone:
begin
SetupMessage(rsMainFrm_rsMessageParsingJSON);
if (not SerializablePackages.JSONToPackages(AJSON)) or (SerializablePackages.Count = 0) then
if (SerializablePackages.Count = 0) then
begin
EnableDisableControls(True);
SetupMessage(rsMainFrm_rsMessageNoPackage);
@ -399,6 +390,12 @@ begin
end;
end;
procedure TMainFrm.DoOnJSONProgress(Sender: TObject);
begin
Application.ProcessMessages;
end;
procedure TMainFrm.DoOnProcessJSON(Sender: TObject);
begin
Application.ProcessMessages;
@ -506,11 +503,6 @@ begin
EnableDisableControls(True);
end;
procedure TMainFrm.DoOnJSONProgress(Sender: TObject);
begin
Application.ProcessMessages;
end;
procedure TMainFrm.cbAllClick(Sender: TObject);
begin
VisualTree.CheckNodes(cbAll.Checked);