Update feature, partially implemented.

git-svn-id: trunk@53528 -

.gitattributes

@@ -3325,6 +3325,7 @@ components/onlinepackagemanager/opkman_progressfrm.lfm svneol=native#text/plain
 components/onlinepackagemanager/opkman_progressfrm.pas svneol=native#text/pascal
 components/onlinepackagemanager/opkman_serializablepackages.pas svneol=native#text/pascal
 components/onlinepackagemanager/opkman_timer.pas svneol=native#text/pascal
+components/onlinepackagemanager/opkman_updates.pas svneol=native#text/pascal
 components/onlinepackagemanager/opkman_visualtree.pas svneol=native#text/pascal
 components/onlinepackagemanager/opkman_zipper.pas svneol=native#text/pascal
 components/onlinepackagemanager/vst/include/carbon/opkman_delphicompat.inc svneol=native#text/plain

components/onlinepackagemanager/onlinepackagemanager.lpk

@@ -20,7 +20,7 @@
     <Description Value="Online package manger"/>
     <License Value="GPL"/>
     <Version Major="1"/>
-    <Files Count="17">
+    <Files Count="18">
       <Item1>
         <Filename Value="onlinepackagemanagerintf.pas"/>
         <HasRegisterProc Value="True"/>
@@ -95,6 +95,10 @@
         <Filename Value="opkman_packagedetailsfrm.pas"/>
         <UnitName Value="opkman_packagedetailsfrm"/>
       </Item17>
+      <Item18>
+        <Filename Value="opkman_updates.pas"/>
+        <UnitName Value="opkman_updates"/>
+      </Item18>
     </Files>
     <i18n>
       <EnableI18N Value="True"/>

components/onlinepackagemanager/onlinepackagemanager.pas

@@ -13,7 +13,7 @@ uses
   opkman_common, opkman_progressfrm, opkman_zipper, opkman_timer, 
   opkman_installer, opkman_packagelistfrm, opkman_options, 
   opkman_createrepositorypackage, opkman_categoriesfrm, 
-  opkman_packagedetailsfrm, LazarusPackageIntf;
+  opkman_packagedetailsfrm, opkman_updates, LazarusPackageIntf;
 
 implementation
 

components/onlinepackagemanager/opkman_common.pas

@@ -75,6 +75,7 @@ const
 
 var
   LocalRepositoryConfigFile: String;
+  LocalRepositoryUpdatesFile: String;
   PackageAction: TPackageAction;
   InstallPackageList: TObjectList;
 
@@ -87,6 +88,7 @@ function FormatSpeed(Speed: LongInt): String;
 function GetDirSize(const ADirName: String; var AFileCnt, ADirCnt: Integer): Int64;
 procedure FindPackages(const ADirName: String; APackageList: TStrings);
 procedure FindAllFilesEx(const ADirName: String; AFileList: TStrings);
+function FixProtocol(const AURL: String): String;
 
 implementation
 
@@ -119,6 +121,7 @@ begin
   if not DirectoryExists(LocalRepoConfig) then
     CreateDirUTF8(LocalRepoConfig);
   LocalRepositoryConfigFile := LocalRepoConfig + cLocalRepositoryConfigFile;
+  LocalRepositoryUpdatesFile := LocalRepoConfig + cLocalRepositoryUpdatesFile;
 end;
 
 function SecToHourAndMin(const ASec: LongInt): String;
@@ -302,5 +305,12 @@ begin
   FindFiles(ADirName);
 end;
 
+function FixProtocol(const AURL: String): String;
+begin
+  Result := AURL;
+  if (Pos('http://', Result) = 0) and (Pos('https://', Result) = 0) then
+    Result := 'https://' + Result;
+end;
+
 end.
 

components/onlinepackagemanager/opkman_const.pas

@@ -40,6 +40,7 @@ const
   cLocalRepositoryUpdate = 'update';
   cLocalRepositoryConfig = 'config';
   cLocalRepositoryConfigFile = 'options.xml';
+  cLocalRepositoryUpdatesFile = 'updates.xml';
   cRestrictedExtensionDef = '*.a,*.o,*.ppu,*.compiled,*.bak,*.or,*.rsj,*.~ ';
   cRestrictedDirectoryDef = 'lib,backup';
 

components/onlinepackagemanager/opkman_downloader.pas

@@ -103,7 +103,6 @@ type
     FOnPackageUpdateProgress: TOnPackageUpdateProgress;
     FOnPackageUpdateCompleted: TOnPackageUpdateCompleted;
     function GetUpdateSize(const AURL: String; var AErrMsg: String): Int64;
-    function FixProtocol(const AURL: String): String;
     procedure DoReceivedUpdateSize(Sender: TObject; const ContentLength, {%H-}CurrentPos: int64);
     procedure DoOnTimer(Sender: TObject);
     procedure DoOnJSONProgress;
@@ -480,12 +479,12 @@ begin
   FMS := TMemoryStream.Create;
   FHTTPClient := TFPHTTPClient.Create(nil);
   if Options.ProxyEnabled then
-    begin
-      FHTTPClient.Proxy.Host:= Options.ProxyServer;
-      FHTTPClient.Proxy.Port:= Options.ProxyPort;
-      FHTTPClient.Proxy.UserName:= Options.ProxyUser;
-      FHTTPClient.Proxy.Password:= Options.ProxyPassword;
-    end;
+  begin
+    FHTTPClient.Proxy.Host:= Options.ProxyServer;
+    FHTTPClient.Proxy.Port:= Options.ProxyPort;
+    FHTTPClient.Proxy.UserName:= Options.ProxyUser;
+    FHTTPClient.Proxy.Password:= Options.ProxyPassword;
+  end;
 end;
 
 destructor TThreadDownload.Destroy;
@@ -538,13 +537,6 @@ begin
     Abort;
 end;
 
-function TThreadDownload.FixProtocol(const AURL: String): String;
-begin
-  Result := AURL;
-  if (Pos('http://', Result) = 0) and (Pos('https://', Result) = 0) then
-    Result := 'https://' + Result;
-end;
-
 function TThreadDownload.GetUpdateSize(const AURL: String; var AErrMsg: String): Int64;
 var
   SS: TStringStream;

components/onlinepackagemanager/opkman_mainfrm.lfm

@@ -9,6 +9,7 @@ object MainFrm: TMainFrm
   Color = clBtnFace
   Constraints.MinHeight = 400
   Constraints.MinWidth = 600
+  DesignTimeDPI = 96
   KeyPreview = True
   OnCreate = FormCreate
   OnDestroy = FormDestroy

components/onlinepackagemanager/opkman_mainfrm.pas

@@ -125,7 +125,7 @@ implementation
 
 uses opkman_serializablepackages, opkman_visualtree, opkman_const, opkman_common,
      opkman_progressfrm, opkman_zipper, opkman_packagelistfrm, opkman_options,
-     opkman_optionsfrm, opkman_createrepositorypackage;
+     opkman_optionsfrm, opkman_createrepositorypackage, opkman_updates;
 {$R *.lfm}
 
 { TMainFrm }
@@ -142,6 +142,7 @@ begin
   PackageDownloader := TPackageDownloader.Create(Options.RemoteRepository);
   PackageDownloader.OnJSONProgress := @DoOnJSONProgress;
   PackageDownloader.OnJSONDownloadCompleted := @DoOnJSONDownloadCompleted;
+  Updates := TUpdates.Create(LocalRepositoryUpdatesFile);
   InstallPackageList := TObjectList.Create(True);
   FHintTimeOut := Application.HintHidePause;
   Application.HintHidePause := 1000000;
@@ -149,6 +150,8 @@ end;
 
 procedure TMainFrm.FormDestroy(Sender: TObject);
 begin
+  Updates.StopUpdate;
+  Updates.Terminate;
   PackageDownloader.Free;
   SerializablePackages.Free;
   VisualTree.Free;
@@ -287,6 +290,7 @@ begin
           MessageDlgEx(rsMainFrm_rsMessageError1 + sLineBreak + SerializablePackages.LastError, mtInformation, [mbOk], Self);
           Exit;
         end;
+        Updates.StartUpdate;
         VisualTree.PopulateTree;
         EnableDisableControls(True);
         SetupMessage;

components/onlinepackagemanager/opkman_serializablepackages.pas

@@ -132,6 +132,7 @@ type
     FPackageAbsolutePath: String;
     FInstalledFileName: String;
     FInstalledFileVersion: String;
+    FUpdateVersion: String;
     FVersion: TPackageVersion;
     FVersionAsString: String;
     FDependencies: TPackageDependencies;
@@ -152,6 +153,7 @@ type
     property PackageState: TPackageState read FPackageState write FPackageState;
     property InstalledFileName: String read FInstalledFileName write FInstalledFileName;
     property InstalledFileVersion: String read FInstalledFileVersion write FInstalledFileVersion;
+    property UpdateVersion: String read FUpdateVersion write FUpdateVersion;
     property PackageAbsolutePath: String read FPackageAbsolutePath write FPackageAbsolutePath;
     property Checked: Boolean read FChecked write FChecked;
     property IsInstallable: Boolean read GetInstallable;
@@ -186,6 +188,7 @@ type
     FPackageBaseDir: String;
     FHomePageURL: String;
     FDownloadURL: String;
+    FForceUpdate: Boolean;
     FSVNURL: String;
     FUpdateSize: Int64;
     FIsDirZipped: Boolean;
@@ -203,6 +206,7 @@ type
     property IsExtractable: Boolean read GetExtractable;
     property UpdateSize: Int64 read FUpdateSize write FUpdateSize;
     property IsDirZipped: Boolean read FIsDirZipped write FIsDirZipped;
+    property ForceUpdate: Boolean read FForceUpdate write FForceUpdate;
   published
     property Name: String read FName write FName;
     property DisplayName: String read FDisplayName write FDisplayName;

components/onlinepackagemanager/opkman_updates.pas

@@ -0,0 +1,268 @@
+unit opkman_updates;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LazIDEIntf, Laz2_XMLCfg, LazFileUtils, fpjson,
+  opkman_httpclient, opkman_timer,
+
+  dialogs;
+
+const
+  OpkVersion = 1;
+  UpdateInterval = 6000;
+
+type
+  TUpdateInfo = record
+    FPackageName: String;
+    FPackageFileName: String;
+    FUpdateVersion: String;
+    FForceUpdate: Boolean;
+  end;
+
+  { TUpdates }
+
+  TUpdates = class(TThread)
+  private
+    FXML: TXMLConfig;
+    FHTTPClient: TFPHTTPClient;
+    FTimer: TThreadTimer;
+    FStarted: Boolean;
+    FVersion: Integer;
+    FNeedToBreak: Boolean;
+    FNeedToUpdate: Boolean;
+    FBusyUpdating: Boolean;
+    procedure SetUpdateInfo(const AUpdateInfo: TUpdateInfo);
+    function GetUpdateInfo(const AURL: String; var AJSON: TJSONStringType): Boolean;
+    function ParseJSON(const AJSON: TJSONStringType; var AUpdateInfo: TUpdateInfo): Boolean;
+    procedure DoOnTimer(Sender: TObject);
+  protected
+    procedure Execute; override;
+  public
+    procedure Load;
+    procedure Save;
+    constructor Create(const AFileName: String);
+    destructor Destroy; override;
+    procedure StartUpdate;
+    procedure StopUpdate;
+  end;
+
+var
+  Updates: TUpdates = nil;
+
+implementation
+
+uses opkman_serializablepackages, opkman_options, opkman_common;
+
+{ TUpdates }
+
+constructor TUpdates.Create(const AFileName: String);
+begin
+  inherited Create(True);
+  FreeOnTerminate := True;
+  FXML := TXMLConfig.Create(AFileName);
+  FHTTPClient := TFPHTTPClient.Create(nil);
+  if Options.ProxyEnabled then
+  begin
+    FHTTPClient.Proxy.Host:= Options.ProxyServer;
+    FHTTPClient.Proxy.Port:= Options.ProxyPort;
+    FHTTPClient.Proxy.UserName:= Options.ProxyUser;
+    FHTTPClient.Proxy.Password:= Options.ProxyPassword;
+  end;
+  FTimer := nil;
+end;
+
+destructor TUpdates.Destroy;
+begin
+  FXML.Free;
+  if Assigned(FTimer) then
+  begin
+    if FTimer.Enabled then
+      FTimer.StopTimer;
+    FTimer.Terminate;
+  end;
+  FHTTPClient.Free;
+  inherited Destroy;
+end;
+
+procedure TUpdates.SetUpdateInfo(const AUpdateInfo: TUpdateInfo);
+var
+  I, J: Integer;
+  Package: TPackage;
+  PackageFile: TPackageFile;
+begin
+  for I := 0 to SerializablePackages.Count - 1 do
+  begin
+    Package := SerializablePackages.Items[I];
+    for J := 0 to SerializablePackages.Items[I].PackageFiles.Count - 1 do
+    begin
+      PackageFile := TPackageFile(SerializablePackages.Items[I].PackageFiles.Items[J]);
+      if (UpperCase(Package.Name) = UpperCase(AUpdateInfo.FPackageName)) and
+        (UpperCase(PackageFile.Name) = UpperCase(AUpdateInfo.FPackageFileName)) then
+      begin
+        Package.ForceUpdate := AUpdateInfo.FForceUpdate;
+        PackageFile.UpdateVersion := AUpdateInfo.FUpdateVersion;
+        Exit;
+      end;
+    end;
+  end;
+end;
+
+procedure TUpdates.Load;
+var
+  Count: Integer;
+  I: Integer;
+  Path: String;
+  UpdateInfo: TUpdateInfo;
+begin
+  FVersion := FXML.GetValue('Version/Value', 0);
+  Count := FXML.GetValue('Count/Value', 0);
+  for I := 0 to Count - 1 do
+  begin
+    Path := 'Item' + IntToStr(I);
+    with UpdateInfo do
+    begin
+      FPackageName := FXML.GetValue('Items/' + Path + '/PackageName', '');
+      FForceUpdate :=  FXML.GetValue('Items/' + Path + '/ForceUpdate', False);
+      FPackageFileName := FXML.GetValue('Items/' + Path + '/PackageFileName', '');
+      FUpdateVersion := FXML.GetValue('Items/' + Path + '/UpdateVersion', '');
+    end;
+    SetUpdateInfo(UpdateInfo);
+  end;
+end;
+
+procedure TUpdates.Save;
+var
+  I, J: Integer;
+  Count: Integer;
+  Path: String;
+  Package: TPackage;
+  PackageFile: TPackageFile;
+begin
+  FNeedToBreak := True;
+  FXML.Clear;
+  Count := -1;
+  FXML.SetDeleteValue('Version/Value', OpkVersion, 0);
+  for I := 0 to SerializablePackages.Count - 1 do
+  begin
+    Package := SerializablePackages.Items[I];
+    for J := 0 to SerializablePackages.Items[I].PackageFiles.Count - 1 do
+    begin
+      Inc(Count);
+      Path := 'Item' + IntToStr(Count);
+      PackageFile := TPackageFile(SerializablePackages.Items[I].PackageFiles.Items[J]);
+      FXML.SetDeleteValue('Items/' + Path + '/PackageName', Package.Name, '');
+      FXML.SetDeleteValue('Items/' + Path + '/ForceUpdate', Package.ForceUpdate, False);
+      FXML.SetDeleteValue('Items/' + Path + '/PackageFileName', PackageFile.Name, '');
+      FXML.SetDeleteValue('Items/' + Path + '/UpdateVersion', PackageFile.UpdateVersion, '');
+    end;
+  end;
+  FXML.SetDeleteExtendedValue('Count/Value', Count, 0);
+  FXML.Flush;
+end;
+
+procedure TUpdates.DoOnTimer(Sender: TObject);
+begin
+  if (FTimer.Enabled) and (not FNeedToBreak) then
+    FNeedToUpdate := True;
+end;
+
+function TUpdates.GetUpdateInfo(const AURL: String; var AJSON: TJSONStringType): Boolean;
+var
+  URL: string;
+  Ms: TMemoryStream;
+begin
+  Result := False;
+  if Trim(AURL) = '' then
+    Exit;
+
+  if Pos('update.json', AURL) = 0 then
+    Exit;
+
+  URL := FixProtocol(AURL);
+  Ms := TMemoryStream.Create;
+  try
+    try
+      FHTTPClient.AllowRedirect := True;
+      FHTTPClient.HTTPMethod('GET', URL, MS, []);
+      if Ms.Size > 0 then
+      begin
+        MS.Position := 0;
+        SetLength(AJSON, MS.Size);
+        MS.Read(Pointer(AJSON)^, Length(AJSON));
+        Result := Length(AJSON) > 0;
+      end;
+    except
+      Result := False;
+    end;
+  finally
+    Ms.Free;
+  end;
+end;
+
+function TUpdates.ParseJSON(const AJSON: TJSONStringType; var AUpdateInfo: TUpdateInfo): Boolean;
+begin
+  Result := False;
+
+end;
+
+procedure TUpdates.Execute;
+var
+  I: Integer;
+  UpdateInfo: TUpdateInfo;
+  JSON: TJSONStringType;
+begin
+  Load;
+  while not Terminated do
+  begin
+    if (FNeedToUpdate) and (not FBusyUpdating) then
+    begin
+      FBusyUpdating := True;
+      try
+        for I := 0 to SerializablePackages.Count - 1  do
+        begin
+          if not FNeedToBreak then
+          begin
+            JSON := '';
+            if GetUpdateInfo(SerializablePackages.Items[I].DownloadURL, JSON) then
+            begin
+              if ParseJSON(JSON, UpdateInfo) then
+              begin
+                SetUpdateInfo(UpdateInfo);
+              end;
+            end;
+          end;
+        end;
+      finally
+        FBusyUpdating := False;
+        FNeedToUpdate := False;
+      end;
+    end;
+  end;
+end;
+
+procedure TUpdates.StartUpdate;
+begin
+  if FStarted then
+    Exit;
+  FStarted := True;
+  Load;
+  FTimer := TThreadTimer.Create;
+  FTimer.Interval := UpdateInterval;
+  FTimer.OnTimer := @DoOnTimer;
+  FTimer.StartTimer;
+  Start;
+end;
+
+procedure TUpdates.StopUpdate;
+begin
+  FNeedToBreak := True;
+  FTimer.StopTimer;
+  FHTTPClient.NeedToBreak := True;
+  Save;
+end;
+
+end.
+