source: trunk/Packages/ModularSystem/ModularSystem.pas

unit ModularSystem;

interface

uses
  Classes, SysUtils, RegistryEx, Generics.Collections;

type
  TModuleManager = class;
  TModule = class;
  TModules = class;

  TAPI = class(TComponent)
  end;

  TModuleCondition = (mcAll, mcEnabled, mcNotEnabled, mcInstalled, mcNotInstalled,
    mcRunning, mcNotRunning);
  TModuleConditions = set of TModuleCondition;
  TModuleAction = (maStart, maStop, maInstall, maUninstall, maUpgrade, maEnable,
    maDisable);
  TModuleActions = array of TModuleAction;

  { TModule }

  TModule = class(TComponent)
  private
    FCategory: string;
    FEnabled: Boolean;
    FOnUpdate: TNotifyEvent;
    FReleaseTime: TDateTime;
    FRunning: Boolean;
    FInstalled: Boolean;
    FManager: TModuleManager;
    FVersion: string;
    FIdentification: string;
    FTitle: string;
    FLicense: string;
    FAuthor: string;
    FDependencies: TStringList;
    FDescription: TStringList;
    FFileName: string;
    FWebSite: string;
    FStartUpTime: TDateTime;
    procedure SetEnabled(AValue: Boolean);
    procedure SetInstalled(AValue: Boolean);
    procedure SetManager(AValue: TModuleManager);
    procedure SetRunning(AValue: Boolean);
    procedure DoUpdate;
  protected
    procedure DoStart; virtual;
    procedure DoStop; virtual;
    procedure DoInstall; virtual;
    procedure DoUninstall; virtual;
    procedure DoUpgrade; virtual;
  public
    API: TAPI;
    procedure Enable;
    procedure Disable;
    procedure Start;
    procedure Stop;
    procedure Restart;
    procedure Install;
    procedure Uninstall;
    procedure Reinstall;
    procedure Upgrade;
    procedure EnumDependenciesCascade(ModuleList: TModules;
      Conditions: TModuleConditions = [mcAll]);
    procedure EnumSuperiorDependenciesCascade(ModuleList: TModules;
      Conditions: TModuleConditions = [mcAll]);
    procedure SetInstalledState(Value: Boolean);
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
    property Running: Boolean read FRunning write SetRunning;
    property Installed: Boolean read FInstalled write SetInstalled;
    property Enabled: Boolean read FEnabled write SetEnabled;
    property StartUpTime: TDateTime read FStartUpTime;
  published
    property Identification: string read FIdentification write FIdentification; // Unique system name
    property Manager: TModuleManager read FManager write SetManager;
    property Version: string read FVersion write FVersion;
    property ReleaseTime: TDateTime read FReleaseTime write FReleaseTime;
    property Title: string read FTitle write FTitle;
    property License: string read FLicense write FLicense;
    property Author: string read FAuthor write FAuthor;
    property Dependencies: TStringList read FDependencies write FDependencies;
    property Description: TStringList read FDescription write FDescription;
    property FileName: string read FFileName write FFileName;
    property Category: string read FCategory write FCategory;
    property WebSite: string read FWebSite write FWebSite;
    // Screenshots, reviews, icon, weak dependencies, ...
    property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
  end;

  { TModules }

  TModules = class(TObjectList<TModule>)
  public
    procedure Perform(Actions: array of TModuleAction; Conditions: TModuleConditions = [mcAll]);
    function FindByName(Name: string): TModule;
    function GetNames: string;
  end;

  TModuleManagerOption = (moAutoInstallOnRun, moAuto);
  TModuleManagerOptions = set of TModuleManagerOption;

  { TModuleManager }

  TModuleManager = class(TComponent)
  private
    FAPI: TAPI;
    FOnUpdate: TNotifyEvent;
    FUpdateCount: Integer;
    FOptions: TModuleManagerOptions;
    procedure SetAPI(AValue: TAPI);
    procedure DoUpdate(Sender: TObject);
  public
    Modules: TModules;
    function ModuleRunning(Name: string): Boolean;
    procedure EnumDependenciesCascade(Module: TModule; ModuleList: TModules;
      Conditions: TModuleConditions = [mcAll]);
    procedure EnumSuperiorDependenciesCascade(Module: TModule;
      ModuleList: TModules; Conditions: TModuleConditions = [mcAll]);
    procedure RegisterModule(Module: TModule);
    procedure UnregisterModule(Module: TModule);
    procedure LoadFromRegistry(Context: TRegistryContext);
    procedure SaveToRegistry(Context: TRegistryContext);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property API: TAPI read FAPI write SetAPI;
  published
    property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
    property Options: TModuleManagerOptions read FOptions write FOptions;
  end;

procedure Register;


implementation

resourcestring
  SModuleNotFound = 'Module "%1:s" not found as dependency for module "%0:s"';

procedure Register;
begin
  RegisterComponents('ModularSystem', [TModuleManager, TModule]);
end;

{ TModules }

procedure TModules.Perform(Actions:  array of TModuleAction;
  Conditions: TModuleConditions = [mcAll]);
var
  I: Integer;
  A: Integer;
begin
  for I := 0 to Count - 1 do
  with TModule(Items[I]) do
    if (mcAll in Conditions) or
    (Running and (mcRunning in Conditions)) or
    (not Running and (mcNotRunning in Conditions)) or
    (Installed and (mcInstalled in Conditions)) or
    (not Installed and (mcNotInstalled in Conditions)) or
    (Enabled and (mcEnabled in Conditions)) or
    (not Enabled and (mcNotEnabled in Conditions)) then
    for A := 0 to High(Actions) do begin
      if Actions[A] = maStart then Start;
      if Actions[A] = maStop then Stop;
      if Actions[A] = maInstall then Install;
      if Actions[A] = maUninstall then Uninstall;
      if Actions[A] = maUpgrade then Upgrade;
      if Actions[A] = maEnable then Enable;
      if Actions[A] = maDisable then Disable;
    end;
end;

function TModules.FindByName(Name: string): TModule;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (TModule(Items[I]).Identification <> Name) do Inc(I);
  if I < Count then Result := TModule(Items[I])
    else Result := nil;
end;

function TModules.GetNames: string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to Count - 1 do
    Result := Result + ', ' + Items[I].Identification;
  Result := Copy(Result, 3, MaxInt);
end;

{ TModuleManager }

procedure TModuleManager.SetAPI(AValue: TAPI);
var
  I: Integer;
begin
  if FAPI = AValue then Exit;
  FAPI := AValue;
  for I := 0 to Modules.Count - 1 do
    TModule(Modules[I]).API := FAPI;
end;

procedure TModuleManager.DoUpdate(Sender: TObject);
begin
  if Assigned(FOnUpdate) then FOnUpdate(Self);
end;

function TModuleManager.ModuleRunning(Name: string): Boolean;
var
  Module: TModule;
begin
  Module := Modules.FindByName(Name);
  if Assigned(Module) then begin
    Result := Module.Running;
  end else Result := False;
end;

procedure TModuleManager.EnumDependenciesCascade(Module: TModule;
  ModuleList: TModules; Conditions: TModuleConditions = [mcAll]);
var
  DepModule: TModule;
  DepModuleName: string;
  I: Integer;
begin
  for I := 0 to Module.Dependencies.Count - 1 do begin
    DepModuleName := Module.Dependencies[I];
    DepModule := Modules.FindByName(DepModuleName);
    if Assigned(DepModule) then
    with DepModule do begin
      if (ModuleList.IndexOf(DepModule) = -1) and
        ((mcAll in Conditions) or
        (Running and (mcRunning in Conditions)) or
        (not Running and (mcNotRunning in Conditions)) or
        (Installed and (mcInstalled in Conditions)) or
        (not Installed and (mcNotInstalled in Conditions)) or
        (Enabled and (mcEnabled in Conditions)) or
        (not Enabled and (mcNotEnabled in Conditions))) then begin
          ModuleList.Add(DepModule);
          Self.EnumDependenciesCascade(DepModule, ModuleList);
        end;
    end else raise Exception.CreateFmt(SModuleNotFound, [Module.Dependencies[I], Module.Identification]);
  end;
end;

procedure TModuleManager.EnumSuperiorDependenciesCascade(Module: TModule;
  ModuleList: TModules; Conditions: TModuleConditions = [mcAll]);
var
  I: Integer;
begin
  for I := 0 to Modules.Count - 1 do
  with TModule(Modules[I]) do begin
    if (Dependencies.IndexOf(Module.Identification) <> -1) and
      (ModuleList.IndexOf(TModule(Modules[I])) = -1) and
    ((mcAll in Conditions) or
    (Running and (mcRunning in Conditions)) or
    (not Running and (mcNotRunning in Conditions)) or
    (Installed and (mcInstalled in Conditions)) or
    (not Installed and (mcNotInstalled in Conditions)) or
    (Enabled and (mcEnabled in Conditions)) or
    (not Enabled and (mcNotEnabled in Conditions))) then begin
      ModuleList.Add(TModule(Modules[I]));
      Self.EnumSuperiorDependenciesCascade(TModule(Modules[I]), ModuleList);
    end;
  end;
end;

procedure TModuleManager.RegisterModule(Module: TModule);
begin
  Modules.Add(Module);
  Module.FManager := Self;
  Module.API := API;
  DoUpdate(Self);
end;

procedure TModuleManager.UnregisterModule(Module: TModule);
begin
  Modules.Remove(Module);
  DoUpdate(Self);
end;

constructor TModuleManager.Create(AOwner: TComponent);
begin
  inherited;
  Modules := TModules.Create;
  Modules.OwnsObjects := False;
end;

destructor TModuleManager.Destroy;
begin
  Modules.Perform([maStop]);
  FreeAndNil(Modules);
  inherited;
end;

procedure TModuleManager.LoadFromRegistry(Context: TRegistryContext);
var
  I: Integer;
begin
  with TRegistryEx.Create do
  try
    RootKey := Context.RootKey;
    for I := 0 to Modules.Count - 1 do
    with Modules[I] do begin
      OpenKey(Context.Key + '\' + Identification, True);
      Installed := ReadBoolWithDefault('Installed', Installed);
      Enabled := ReadBoolWithDefault('Enabled', Enabled);
    end;
  finally
    Free;
  end;
end;

procedure TModuleManager.SaveToRegistry(Context: TRegistryContext);
var
  I: Integer;
begin
  with TRegistryEx.Create do
  try
    RootKey := Context.RootKey;
    for I := 0 to Modules.Count - 1 do
    with Modules[I] do begin
      OpenKey(Context.Key + '\' + Identification, True);
      WriteBool('Enabled', Enabled);
      WriteBool('Installed', Installed);
    end;
  finally
    Free;
  end;
end;

{ TModule }

procedure TModule.SetRunning(AValue: Boolean);
begin
  if FRunning = AValue then Exit;
  if AValue then Start else Stop;
end;

procedure TModule.DoStart;
begin
end;

procedure TModule.DoStop;
begin
end;

procedure TModule.DoInstall;
begin
end;

procedure TModule.DoUninstall;
begin
end;

procedure TModule.DoUpgrade;
begin
end;

procedure TModule.DoUpdate;
begin
  if Assigned(FOnUpdate) then FOnUpdate(Self);
end;

procedure TModule.Enable;
var
  List: TModules;
begin
  if Enabled then Exit;
  FEnabled := True;
  try
    List := TModules.Create;
    List.OwnsObjects := False;
    EnumDependenciesCascade(List, [mcNotEnabled]);
    List.Perform([maEnable], [mcNotEnabled]);
  finally
    List.Free;
  end;
  Start; // Auto start enabled modules
  //Manager.Update;
end;

procedure TModule.Disable;
var
  List: TModules;
begin
  if not Enabled then Exit;
  if FRunning then Stop; // Auto stop running modules
  FEnabled := False;
  try
    List := TModules.Create;
    List.OwnsObjects := False;
    EnumSuperiorDependenciesCascade(List, [mcEnabled]);
    List.Perform([maDisable], [mcEnabled]);
  finally
    List.Free;
  end;
  DoUpdate;
end;

procedure TModule.SetInstalled(AValue: Boolean);
begin
  if FInstalled = AValue then Exit;
  if AValue then Install else Uninstall;
end;

procedure TModule.SetManager(AValue: TModuleManager);
begin
  if FManager = AValue then Exit;
  if Assigned(FManager) then FManager.UnregisterModule(Self);
  FManager := AValue;
  if Assigned(FManager) then AValue.RegisterModule(Self);
end;

procedure TModule.SetEnabled(AValue: Boolean);
begin
  if FEnabled = AValue then Exit;
  if AValue then Enable else Disable;
end;

procedure TModule.Start;
var
  List: TModules;
  StartTime: TDateTime;
begin
  if not Enabled or Running then Exit;
  if not Installed then Install;  // Auto install not installed modules
  try
    List := TModules.Create;
    List.OwnsObjects := False;
    EnumDependenciesCascade(List, [mcNotRunning]);
    List.Perform([maStart], [mcNotRunning]);
  finally
    List.Free;
  end;
  StartTime := Now;
  DoStart;
  FStartUpTime := Now - StartTime;
  FRunning := True;
  DoUpdate;
end;

procedure TModule.Stop;
var
  List: TModules;
begin
  if not Running then Exit;
  FRunning := False;
  try
    List := TModules.Create;
    List.OwnsObjects := False;
    EnumSuperiorDependenciesCascade(List, [mcRunning]);
    List.Perform([maStop], [mcRunning]);
  finally
    List.Free;
  end;
  DoStop;
  DoUpdate;
end;

procedure TModule.Restart;
begin
  Stop;
  Start;
end;

procedure TModule.Install;
var
  List: TModules;
begin
  if Installed then Exit;
  try
    List := TModules.Create;
    List.OwnsObjects := False;
    EnumDependenciesCascade(List, [mcNotInstalled]);
    List.Perform([maInstall], [mcNotInstalled]);
  finally
    List.Free;
  end;
  FInstalled := True;
  DoInstall;
  Enable; // Auto enable installed module
  DoUpdate;
end;

procedure TModule.Uninstall;
var
  List: TModules;
begin
  if not Installed then Exit;
  if Enabled then Disable; // Auto disable uninstalled module
  try
    List := TModules.Create;
    List.OwnsObjects := False;
    EnumSuperiorDependenciesCascade(List, [mcInstalled]);
    List.Perform([maUninstall], [mcInstalled]);
  finally
    List.Free;
  end;
  FInstalled := False;
  DoUninstall;
  DoUpdate;
end;

procedure TModule.Reinstall;
begin
  Uninstall;
  Install;
end;

procedure TModule.Upgrade;
begin
  if not Enabled or not Installed then Exit;
  if Running then
  try
    Stop;
    DoUpgrade;
  finally
    Start;
  end else DoUpgrade;
  DoUpdate;
end;

procedure TModule.EnumDependenciesCascade(ModuleList: TModules;
  Conditions: TModuleConditions = [mcAll]);
begin
  ModuleList.Clear;
  Manager.EnumDependenciesCascade(Self, ModuleList, Conditions);
end;

procedure TModule.EnumSuperiorDependenciesCascade(ModuleList: TModules;
  Conditions: TModuleConditions = [mcAll]);
begin
  ModuleList.Clear;
  Manager.EnumSuperiorDependenciesCascade(Self, ModuleList, Conditions);
end;

procedure TModule.SetInstalledState(Value: Boolean);
begin
  FInstalled := Value;
  DoUpdate;
end;

constructor TModule.Create(Owner: TComponent);
begin
  inherited;
  Dependencies := TStringList.Create;
  Description := TStringList.Create;
end;

destructor TModule.Destroy;
begin
  Running := False;
  FreeAndNil(FDescription);
  FreeAndNil(FDependencies);
  inherited;
end;

end.