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

git-svn-id: trunk@56636 -

components/onlinepackagemanager/opkman_const.pas

@@ -471,6 +471,9 @@ resourcestring
   rsAddRepositoryPackageFrm_bCancel_Caption = 'Cancel';
   rsAddRepositoryPackageFrm_bCancel_Hint = 'Close the dialog';
 
+  //OPMinterface
+  rsOPMInterfaceConf = 'Do you wish to install the following online package(s):';
+
 
 implementation
 

components/onlinepackagemanager/opkman_installer.pas

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

components/onlinepackagemanager/opkman_intf.pas

@@ -41,29 +41,37 @@ type
 
   TOPMInterfaceEx = class(TOPMInterface)
   private
-    FOPMPackageLinks: TList;
+    FPackagesToInstall: TObjectList;
+    FPackageDependecies: TObjectList;
+    FPackageLinks: TObjectList;
     FWaitForIDE: TThreadTimer;
     procedure DoWaitForIDE(Sender: TObject);
     procedure DoUpdatePackageLinks(Sender: TObject);
     procedure InitOPM;
     procedure SynchronizePackages;
-    function IsInList(const AName, AURL: String): Boolean;
+    procedure AddToInstallList(const AName, AURL: String);
+    function IsInLinkList(const AName, AURL: String): Boolean;
+    function ResolveDependencies(AParentForm: TForm): TModalResult;
+    function CanInstallPackages(APkgLinks: TList; AParentForm: TForm): TModalResult;
   public
     constructor Create;
     destructor Destroy; override;
   public
-    function InstallPackages(APkgLinks: TList): TModalResult; override;
+    function InstallPackages(APkgLinks: TList; AParentForm: TForm;
+      const AResolveDependencies: Boolean = True): TModalResult; override;
   end;
 
 implementation
 
-uses opkman_common, opkman_options;
+uses opkman_common, opkman_options, opkman_const;
 
 { TOPMInterfaceEx }
 
 constructor TOPMInterfaceEx.Create;
 begin
-  FOPMPackageLinks := TList.Create;
+  FPackageLinks := TObjectList.Create(False);
+  FPackagesToInstall := TObjectList.Create(False);
+  FPackageDependecies := TObjectList.Create(False);
   FWaitForIDE := TThreadTimer.Create;
   FWaitForIDE.Interval := 100;
   FWaitForIDE.OnTimer := @DoWaitForIDE;
@@ -72,8 +80,12 @@ end;
 
 destructor TOPMInterfaceEx.Destroy;
 begin
-  FOPMPackageLinks.Clear;
-  FOPMPackageLinks.Free;
+  FPackageLinks.Clear;
+  FPackageLinks.Free;
+  FPackagesToInstall.Clear;
+  FPackagesToInstall.Free;
+  FPackageDependecies.Clear;
+  FPackageDependecies.Free;
   PackageDownloader.Free;
   SerializablePackages.Free;
   Options.Free;
@@ -107,15 +119,15 @@ begin
   SynchronizePackages;
 end;
 
-function TOPMInterfaceEx.IsInList(const AName, AURL: String): Boolean;
+function TOPMInterfaceEx.IsInLinkList(const AName, AURL: String): Boolean;
 var
   I: Integer;
   PackageLink: TPackageLink;
 begin
   Result := False;
-  for I := 0 to FOPMPackageLinks.Count - 1 do
+  for I := 0 to FPackageLinks.Count - 1 do
   begin
-    PackageLink := TPackageLink(FOPMPackageLinks.Items[I]);
+    PackageLink := TPackageLink(FPackageLinks.Items[I]);
     if (UpperCase(PackageLink.Name) = UpperCase(AName)) and (UpperCase(PackageLink.LPKUrl) = UpperCase(AURL)) then
     begin
       Result := True;
@@ -132,6 +144,8 @@ var
   PackageLink: TPackageLink;
   FileName, Name, URL: String;
 begin
+  PkgLinks.ClearOnlineLinks;
+  FPackageLinks.Clear;
   for I := 0 to SerializablePackages.Count - 1 do
   begin
     MetaPackage := SerializablePackages.Items[I];
@@ -141,24 +155,140 @@ begin
       FileName := Options.LocalRepositoryPackages + MetaPackage.PackageBaseDir + LazPackage.PackageRelativePath + LazPackage.Name;
       Name := StringReplace(LazPackage.Name, '.lpk', '', [rfReplaceAll, rfIgnoreCase]);
       URL := Options.RemoteRepository[Options.ActiveRepositoryIndex] + MetaPackage.RepositoryFileName;
-      if not IsInList(Name, URL) then
+      if not IsInLinkList(Name, URL) then
       begin
         PackageLink := PkgLinks.AddOnlineLink(FileName, Name, URL);
         if PackageLink <> nil then
         begin
           PackageLink.Version.Assign(LazPackage.Version);
           PackageLink.LPKFileDate := MetaPackage.RepositoryDate;
-          FOPMPackageLinks.Add(PackageLink);
+          FPackageLinks.Add(PackageLink);
         end;
       end;
     end;
   end;
 end;
 
-function TOPMInterfaceEx.InstallPackages(APkgLinks: TList): TModalResult;
+procedure TOPMInterfaceEx.AddToInstallList(const AName, AURL: String);
+var
+  I, J: Integer;
+  MetaPackage: TMetaPackage;
+  LazPackage: TLazarusPackage;
 begin
+  for I := 0 to SerializablePackages.Count - 1 do
+  begin
+    MetaPackage := SerializablePackages.Items[I];
+    for J := 0 to MetaPackage.LazarusPackages.Count - 1 do
+    begin
+      LazPackage := TLazarusPackage(MetaPackage.LazarusPackages.Items[J]);
+      if (UpperCase(LazPackage.Name) = UpperCase(AName)) and
+         (UpperCase(Options.RemoteRepository[Options.ActiveRepositoryIndex] + MetaPackage.RepositoryFileName) = UpperCase(AURL)) then
+      begin
+        MetaPackage.Checked := True;
+        LazPackage.Checked := True;
+        FPackagesToInstall.Add(LazPackage);
+        Break;
+      end;
+    end;
+  end;
+end;
+
+function TOPMInterfaceEx.ResolveDependencies(AParentForm: TForm): TModalResult;
+var
+  I, J: Integer;
+  PackageList: TObjectList;
+  PkgFileName: String;
+  DependencyPkg: TLazarusPackage;
+  Msg: String;
+begin
+  Result := mrNone;
+  FPackageDependecies.Clear;
+  for I := 0 to FPackagesToInstall.Count - 1 do
+  begin
+    PackageList := TObjectList.Create(True);
+    try
+      SerializablePackages.GetPackageDependencies(TLazarusPackage(FPackagesToInstall.Items[I]).Name, PackageList, True, True);
+      for J := 0 to PackageList.Count - 1 do
+      begin
+        PkgFileName := TPackageDependency(PackageList.Items[J]).PkgFileName + '.lpk';
+        DependencyPkg := SerializablePackages.FindLazarusPackage(PkgFileName);
+        if DependencyPkg <> nil then
+        begin
+          if (not DependencyPkg.Checked) and
+              ((SerializablePackages.IsDependencyOk(TPackageDependency(PackageList.Items[I]), DependencyPkg)) and
+               ((not (DependencyPkg.PackageState = psInstalled)) or ((DependencyPkg.PackageState = psInstalled) and (not (SerializablePackages.IsInstalledVersionOk(TPackageDependency(PackageList.Items[I]), DependencyPkg.InstalledFileVersion)))))) then
+          begin
+            if (Result = mrNone) or (Result = mrYes) then
+              begin
+                Msg := Format(rsMainFrm_rsPackageDependency0, [TLazarusPackage(FPackagesToInstall.Items[I]).Name, DependencyPkg.Name]);
+                Result := MessageDlgEx(Msg, mtConfirmation, [mbYes, mbYesToAll, mbNo, mbNoToAll, mbCancel], AParentForm);
+                if Result in [mrNo, mrNoToAll] then
+                  MessageDlgEx(rsMainFrm_rsPackageDependency1, mtInformation, [mbOk], AParentForm);
+                if (Result = mrNoToAll) or (Result = mrCancel) then
+                  Exit;
+              end;
+              if Result in [mrYes, mrYesToAll] then
+              begin
+                DependencyPkg.Checked := True;
+                FPackageDependecies.Add(DependencyPkg);
+              end;
+          end;
+        end;
+      end;
+    finally
+      PackageList.Free;
+    end;
+  end;
+end;
+
+function TOPMInterfaceEx.CanInstallPackages(APkgLinks: TList;
+  AParentForm: TForm): TModalResult;
+var
+  PkgListStr: String;
+  I: Integer;
+  PackageLink: TPackageLink;
+begin
+  Result := mrOK;
+  PkgListStr := '';
+  for I := 0 to APkgLinks.Count - 1 do
+  begin
+    PackageLink := TPackageLink(APkgLinks.Items[I]);
+    if PkgListStr = '' then
+      PkgListStr := '"' + PackageLink.Name + '"'
+    else
+      PkgListStr := PkgListStr + ', "' + PackageLink.Name + '"';
+  end;
+  if Trim(PkgListStr) <> '' then
+    if MessageDlgEx(rsOPMInterfaceConf + ' ' + PkgListStr + ' ?', mtConfirmation, [mbYes, mbNo], AParentForm) <> mrYes then
+      Result := mrCancel;
+end;
+
+function TOPMInterfaceEx.InstallPackages(APkgLinks: TList; AParentForm: TForm;
+  const AResolveDependencies: Boolean = True): TModalResult;
+var
+  I: Integer;
+begin
+  Result := CanInstallPackages(APkgLinks, AParentForm);
+  if Result = mrCancel then
+    Exit;
+
+  FPackagesToInstall.Clear;
+  for I := 0 to APkgLinks.Count - 1 do
+    AddToInstallList(TPackageLink(APkgLinks.Items[I]).Name + '.lpk', TPackageLink(APkgLinks.Items[I]).LPKUrl);
+
+  if AResolveDependencies then
+  begin
+    if ResolveDependencies(AParentForm) = mrCancel then
+      Exit;
+    for I := 0 to FPackageDependecies.Count - 1 do
+      FPackagesToInstall.Insert(0, FPackageDependecies.Items[I]);
+  end;
+
+  MessageDlgEx('Not yet implemented!', mtInformation, [mbOk], AParentForm);
+ { for I := 0 to FPackagesToInstall.Count - 1 do
+    MessageDlgEx(TLazarusPackage(FPackagesToInstall.Items[I]).Name + sLineBreak +
+                TLazarusPackage(FPackagesToInstall.Items[I]).Author, mtInformation, [mbOk], AParentForm);}
   Result := mrOk;
-  MessageDlg('Not yet implemented!', mtInformation, [mbOk], 0)
 end;
 
 end.