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

git-svn-id: trunk@56451 -

components/onlinepackagemanager/opkman_intf.pas

@@ -33,7 +33,7 @@ uses
   // IdeIntf
   LazIDEIntf, PackageIntf, PackageLinkIntf, PackageDependencyIntf,
   // OPM
-  opkman_timer, opkman_downloader;
+  opkman_timer, opkman_downloader, opkman_serializablepackages;
 
 type
 
@@ -41,29 +41,46 @@ type
 
   TOPMInterfaceEx = class(TOPMInterface)
   private
+    FOPMPackageLinks: TList;
     FWaitForIDE: TThreadTimer;
     procedure DoWaitForIDE(Sender: TObject);
+    procedure DoUpdatePackageLinks(Sender: TObject);
     procedure InitOPM;
+    procedure SynchronizePackages;
+    function IsInList(const AName, AURL: String): Boolean;
   public
     constructor Create;
     destructor Destroy; override;
   public
+
   end;
 
 implementation
 
-uses opkman_serializablepackages, opkman_common, opkman_options;
+uses opkman_common, opkman_options;
 
-{ TOPMMain }
+{ TOPMInterfaceEx }
 
 constructor TOPMInterfaceEx.Create;
 begin
+  FOPMPackageLinks := TList.Create;
   FWaitForIDE := TThreadTimer.Create;
   FWaitForIDE.Interval := 100;
   FWaitForIDE.OnTimer := @DoWaitForIDE;
   FWaitForIDE.StartTimer;
 end;
 
+destructor TOPMInterfaceEx.Destroy;
+begin
+  FOPMPackageLinks.Clear;
+  FOPMPackageLinks.Free;
+  PackageDownloader.Free;
+  SerializablePackages.Free;
+  Options.Free;
+  InstallPackageList.Free;
+  inherited Destroy;
+end;
+
 procedure TOPMInterfaceEx.DoWaitForIDE(Sender: TObject);
 begin
   if Assigned(LazarusIDE) and Assigned(PackageEditingInterface) then
@@ -79,19 +96,65 @@ begin
   InitLocalRepository;
   Options := TOptions.Create(LocalRepositoryConfigFile);
   SerializablePackages := TSerializablePackages.Create;
+  SerializablePackages.OnUpdatePackageLinks := @DoUpdatePackageLinks;
   PackageDownloader := TPackageDownloader.Create(Options.RemoteRepository[Options.ActiveRepositoryIndex]);
   InstallPackageList := TObjectList.Create(True);
   PackageDownloader.DownloadJSON(Options.ConTimeOut*1000);
 end;
 
-destructor TOPMInterfaceEx.Destroy;
+procedure TOPMInterfaceEx.DoUpdatePackageLinks(Sender: TObject);
 begin
-  PackageDownloader.Free;
-  SerializablePackages.Free;
-  Options.Free;
-  InstallPackageList.Free;
-  inherited Destroy;
+  SynchronizePackages;
 end;
 
+function TOPMInterfaceEx.IsInList(const AName, AURL: String): Boolean;
+var
+  I: Integer;
+  PackageLink: TPackageLink;
+begin
+  Result := False;
+  for I := 0 to FOPMPackageLinks.Count - 1 do
+  begin
+    PackageLink := TPackageLink(FOPMPackageLinks.Items[I]);
+    if (UpperCase(PackageLink.Name) = UpperCase(AName)) and (UpperCase(PackageLink.LPKUrl) = UpperCase(AURL)) then
+    begin
+      Result := True;
+      Break;
+    end;
+  end;
+end;
+
+procedure TOPMInterfaceEx.SynchronizePackages;
+var
+  I, J: Integer;
+  MetaPackage: TMetaPackage;
+  LazPackage: TLazarusPackage;
+  PackageLink: TPackageLink;
+  URL, Name: String;
+  Version: TPkgVersion;
+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]);
+      URL := Options.RemoteRepository[Options.ActiveRepositoryIndex] + MetaPackage.RepositoryFileName;
+      Name := StringReplace(LazPackage.Name, '.lpk', '', [rfReplaceAll, rfIgnoreCase]);
+      Version := Lazpackage.Version;
+      if not IsInList(Name, URL) then
+      begin
+        PackageLink := PkgLinks.AddOnlineLink(Url, Name, Version);
+        PackageLink.Name := Name;
+        PackageLink.LPLFileDate := MetaPackage.RepositoryDate;
+        PackageLink.LPKFilename := Options.LocalRepositoryPackages + MetaPackage.PackageBaseDir + LazPackage.PackageRelativePath + LazPackage.Name;
+        PackageLink.LPKUrl := URL;
+        FOPMPackageLinks.Add(PackageLink);
+      end;
+    end;
+  end;
+end;
+
+
 end.
 

components/onlinepackagemanager/opkman_mainfrm.pas

@@ -154,7 +154,6 @@ type
     procedure DoOnJSONProgress(Sender: TObject);
     procedure DoOnJSONDownloadCompleted(Sender: TObject; AJSON: TJSONStringType; AErrTyp: TErrorType; const AErrMsg: String = '');
     procedure DoOnProcessJSON(Sender: TObject);
-    procedure DoOnUpdate(Sender: TObject);
     function IsSomethingChecked(const AResolveDependencies: Boolean = True): Boolean;
     function Download(const ADstDir: String; var ADoExtract: Boolean): TModalResult;
     function Extract(const ASrcDir, ADstDir: String; var ADoOpen: Boolean; const AIsUpdate: Boolean = False): TModalResult;
@@ -198,7 +197,6 @@ var
 begin
   FileName := Format(LocalRepositoryUpdatesFile, [MD5Print(MD5String(Options.RemoteRepository[Options.ActiveRepositoryIndex]))]);
   Updates := TUpdates.Create(FileName);
-  Updates.OnUpdate := @DoOnUpdate;
   Updates.StartUpdate;
   Updates.PauseUpdate;
 end;
@@ -401,27 +399,6 @@ begin
   Application.ProcessMessages;
 end;
 
-procedure TMainFrm.DoOnUpdate(Sender: TObject);
-var
-  I, J: Integer;
-  MetaPkg: TMetaPackage;
-  LazarusPkg: TLazarusPackage;
-begin
-  VisualTree.UpdatePackageUStatus;
-  // Pass the online package info as package links to IDE.
-  for I := 0 to SerializablePackages.Count - 1 do
-  begin
-    MetaPkg := SerializablePackages.Items[I];
-    for J := 0 to MetaPkg.LazarusPackages.Count - 1 do
-    begin
-      LazarusPkg := TLazarusPackage(MetaPkg.LazarusPackages.Items[J]);
-      //DebugLn(['OPM DoOnUpdate: Package.Name=', MetaPkg.Name,
-      //         ', Package.DisplayName=', MetaPkg.DisplayName]);
-      PkgLinks.AddOnlineLink(MetaPkg.DownloadZipURL, MetaPkg.Name, LazarusPkg.Version);
-    end;
-  end;
-end;
-
 procedure TMainFrm.ShowOptions(const AActivePageIndex: Integer = 0);
 var
   OldIndex: Integer;

components/onlinepackagemanager/opkman_serializablepackages.pas

@@ -241,6 +241,7 @@ type
     FMetaPackages: TCollection;
     FLastError: String;
     FOnProcessJSON: TNotifyEvent;
+    FOnUpdatePackageLinks: TNotifyEvent;
     function GetCount: Integer;
     function GetDownloadCount: Integer;
     function GetExtractCount: Integer;
@@ -291,6 +292,7 @@ type
     property Items[Index: Integer]: TMetaPackage read GetItem write SetItem;
     property LastError: String read FlastError;
     property OnProcessJSON: TNotifyEvent read FOnProcessJSON write FOnProcessJSON;
+    property OnUpdatePackageLinks: TNotifyEvent read FOnUpdatePackageLinks write FOnUpdatePackageLinks;
   end;
 
 var
@@ -939,6 +941,9 @@ begin
   finally
     Parser.Free;
   end;
+  if Result then
+    if Assigned(FOnUpdatePackageLinks) then
+      FOnUpdatePackageLinks(Self);
 end;
 
 function TSerializablePackages.LazarusPackagesToJSON(AMetaPackage: TMetaPackage;

components/onlinepackagemanager/opkman_updates.pas

@@ -112,7 +112,6 @@ type
     FPaused: Boolean;
     function GetUpdateInfo(const AURL: String; var AJSON: TJSONStringType): Boolean;
     procedure DoOnTimer(Sender: TObject);
-    procedure DoOnUpdate;
     procedure Load;
     procedure Save;
     procedure AssignPackageData(AMetaPackage: TMetaPackage);
@@ -127,8 +126,6 @@ type
     procedure StartUpdate;
     procedure StopUpdate;
     procedure PauseUpdate;
-  published
-    property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
   end;
 
 var
@@ -311,7 +308,6 @@ begin
       MetaPkg.HasUpdate := HasUpdate;
     end;
   end;
-  Synchronize(@DoOnUpdate);
 end;
 
 procedure TUpdates.Save;
@@ -497,12 +493,6 @@ begin
   end;
 end;
 
-procedure TUpdates.DoOnUpdate;
-begin
-  if Assigned(FOnUpdate) then
-    FOnUpdate(Self);
-end;
-
 procedure TUpdates.Execute;
 var
   I: Integer;
@@ -538,8 +528,6 @@ begin
           else
             FHTTPClient.Terminate;
         end;
-        if Assigned(FOnUpdate) and (not FNeedToBreak) and (not FPaused) then
-          Synchronize(@DoOnUpdate);
       finally
         FBusyUpdating := False;
         FNeedToUpdate := False;