Агрегатор событий - приведение объекта к интерфейсу

Question

Как узнать, поддерживает ли объект IHandle <<em> T> и есть ли любой возможный обходной путь для достижения этого в delphi (2010, XE)? Также кто-нибудь видел хорошую реализацию агрегатора событий для Delphi?

IHandle<TMessage> = interface
 procedure Handle(AMessage: TMessage);
end;

EventAggregator = class
private
 FSubscribers: TList<TObject>;
public
 constructor Create;
 destructor Destroy; override;
 procedure Subscribe(AInstance: TObject);
 procedure Unsubscribe(AInstance: TObject);
 procedure Publish<T>(AMessage: T);
end;

procedure EventAggregator.Publish<T>(AMessage: T);
var
  LReference: TObject;
  LTarget: IHandle<T>;
begin
    for LReference in FSubscribers do
    begin
      LTarget:= LReference as IHandle<T>; // <-- Wish this would work
      if Assigned(LTarget) then
        LTarget.Handle(AMessage);
    end;
end;

procedure EventAggregator.Subscribe(AInstance: TObject);
begin
 FSubscribers.Add(AInstance);
end;

procedure EventAggregator.Unsubscribe(AInstance: TObject);
begin
 FSubscribers.Remove(AInstance)
end;

Обновление

Я хотел бы отметить отличную статью Малколма Гровса "Общие интерфейсы в Delphi" ссылка

, который точно описывает то, чего я хотел бы достичь.

Answer 1

Откройте этот URL и получите zip-файл http://qc.embarcadero.com/wc/qcmain.aspx?d=91796

Answer 2

Рабочий прототип.Не тестируется в производстве!

unit zEventAggregator;

interface

uses
  Classes, TypInfo, SysUtils, Generics.Collections;

type
  /// <summary>
  /// Denotes a class which can handle a particular type of message.
  /// </summary>
  /// <typeparam name="TMessage">The type of message to handle.</typeparam>
  IHandle<TMessage> = interface
    /// <summary>
    /// Handles the message.
    /// </summary>
    /// <param name="message">The message.</param>
    procedure Handle(AMessage: TMessage);
  end;

  /// <summary>
  /// Subscription token
  /// </summary>
  ISubscription = interface
    ['{3A557B05-286B-4B86-BDD4-9AC44E8389CF}']
    procedure Dispose;
    function GetSubscriptionType: string;
    property SubscriptionType: string read GetSubscriptionType;
  end;

  TSubscriber<T> = class(TInterfacedObject, ISubscription)
  strict private
    FAction: TProc<T>;
    FDisposed: Boolean;
    FHandle: IHandle<T>;
    FOwner: TList < TSubscriber < T >> ;
  public
    constructor Create(AOwner: TList < TSubscriber < T >> ; AAction: TProc<T>; AHandle: IHandle<T>);
    destructor Destroy; override;
    procedure Dispose;
    procedure Publish(AMessage: T);
    function GetSubscriptionType: string;
  end;

  TEventBroker<T> = class
  strict private
    FSubscribers: TList < TSubscriber < T >> ;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Publish(AMessage: T);
    function Subscribe(AAction: IHandle<T>): ISubscription; overload;
    function Subscribe(AAction: TProc<T>): ISubscription; overload;
  end;

  TBaseEventAggregator = class
  strict protected
    FEventBrokers: TObjectDictionary<PTypeInfo, TObject>;
  public
    constructor Create;
    destructor Destroy; override;
    function GetEvent<TMessage>: TEventBroker<TMessage>;
  end;

  /// <summary>
  /// Enables loosely-coupled publication of and subscription to events.
  /// </summary>
  TEventAggregator = class(TBaseEventAggregator)
  public
    /// <summary>
    /// Publishes a message.
    /// </summary>
    /// <typeparam name="T">The type of message being published.</typeparam>
    /// <param name="message">The message instance.</param>
    procedure Publish<TMessage>(AMessage: TMessage);
    /// <summary>
    /// Subscribes an instance class handler IHandle<TMessage> to all events of type TMessage/>
    /// </summary>
    function Subscribe<TMessage>(AAction: IHandle<TMessage>): ISubscription; overload;
    /// <summary>
    /// Subscribes a method to all events of type TMessage/>
    /// </summary>
    function Subscribe<TMessage>(AAction: TProc<TMessage>): ISubscription; overload;
  end;

implementation

{ TSubscriber<T> }

constructor TSubscriber<T>.Create(AOwner: TList < TSubscriber < T >> ; AAction: TProc<T>; AHandle: IHandle<T>);
begin
  FAction := AAction;
  FDisposed := False;
  FHandle := AHandle;
  FOwner := AOwner;
end;

destructor TSubscriber<T>.Destroy;
begin
  Dispose;
  inherited;
end;

procedure TSubscriber<T>.Dispose;
begin
  if not FDisposed then
  begin
    TMonitor.Enter(Self);
    try
      if not FDisposed then
      begin
        FAction := nil;
        FHandle := nil;
        FOwner.Remove(Self);
        FDisposed := true;
      end;
    finally
      TMonitor.Exit(Self);
    end;
  end;
end;

function TSubscriber<T>.GetSubscriptionType: string;
begin
  Result:= GetTypeName(TypeInfo(T));
end;

procedure TSubscriber<T>.Publish(AMessage: T);
var
  a: TProc<T>;
begin
  if Assigned(FAction) then
    TProc<T>(FAction)(AMessage)
  else if Assigned(FHandle) then
    FHandle.Handle(AMessage);
end;

{ TEventBroker<T> }

constructor TEventBroker<T>.Create;
begin
  FSubscribers := TList < TSubscriber < T >> .Create;
end;

destructor TEventBroker<T>.Destroy;
begin
  FreeAndNil(FSubscribers);
  inherited;
end;

procedure TEventBroker<T>.Publish(AMessage: T);
var
  LTarget: TSubscriber<T>;
begin
  TMonitor.Enter(Self);
  try
    for LTarget in FSubscribers do
    begin
      LTarget.Publish(AMessage);
    end;
  finally
    TMonitor.Exit(Self);
  end;
end;

function TEventBroker<T>.Subscribe(AAction: IHandle<T>): ISubscription;
var
  LSubscriber: TSubscriber<T>;
begin
  TMonitor.Enter(Self);
  try
    LSubscriber := TSubscriber<T>.Create(FSubscribers, nil, AAction);
    FSubscribers.Add(LSubscriber);
    Result := LSubscriber;
  finally
    TMonitor.Exit(Self);
  end;
end;

function TEventBroker<T>.Subscribe(AAction: TProc<T>): ISubscription;
var
  LSubscriber: TSubscriber<T>;
begin
  TMonitor.Enter(Self);
  try
    LSubscriber := TSubscriber<T>.Create(FSubscribers, AAction, nil);
    FSubscribers.Add(LSubscriber);
    Result := LSubscriber;
  finally
    TMonitor.Exit(Self);
  end;
end;

{ TBaseEventAggregator }

constructor TBaseEventAggregator.Create;
begin
  FEventBrokers := TObjectDictionary<PTypeInfo, TObject>.Create([doOwnsValues]);
end;

destructor TBaseEventAggregator.Destroy;
begin
  FreeAndNil(FEventBrokers);
  inherited;
end;

function TBaseEventAggregator.GetEvent<TMessage>: TEventBroker<TMessage>;
var
  LEventBroker: TObject;
  LEventType: PTypeInfo;
  s: string;
begin
  LEventType := TypeInfo(TMessage);
  s:= GetTypeName(LEventType);

  if not FEventBrokers.TryGetValue(LEventType, LEventBroker) then
  begin
    TMonitor.Enter(Self);
    try
      if not FEventBrokers.TryGetValue(LEventType, LEventBroker) then
      begin
        LEventBroker := TEventBroker<TMessage>.Create;
        FEventBrokers.Add(LEventType, LEventBroker);
      end;
    finally
      TMonitor.Exit(Self);
    end;
  end;

  Result := TEventBroker<TMessage>(LEventBroker);
end;

{ TEventAggregator }

procedure TEventAggregator.Publish<TMessage>(AMessage: TMessage);
begin
  GetEvent<TMessage>.Publish(AMessage);
end;

function TEventAggregator.Subscribe<TMessage>(AAction: IHandle<TMessage>): ISubscription;
begin
  Result := GetEvent<TMessage>.Subscribe(AAction);
end;

function TEventAggregator.Subscribe<TMessage>(AAction: TProc<TMessage>): ISubscription;
begin
  Result := GetEvent<TMessage>.Subscribe(AAction);
end;

end.

Комментарии?

Answer 3

Чтобы иметь возможность проверить, реализует ли экземпляр данный интерфейс, этот интерфейс должен иметь определенный GUID. Итак, добавьте guid к вашему интерфейсу (вам также понадобится этот guid в const или переменной, чтобы вы могли ссылаться на него позже в коде):

const
  IID_Handle: TGUID = '{0D3599E1-2E1B-4BC1-ABC9-B654817EC6F1}';

type
  IHandle<TMessage> = interface
    ['{0D3599E1-2E1B-4BC1-ABC9-B654817EC6F1}']
    procedure Handle(AMessage: TMessage);
  end;

(Вы не должны использовать мой guid, это всего лишь пример. Нажмите ctrl + shift + G, чтобы сгенерировать новый guid в IDE).

Затем проверьте, поддерживает ли зарегистрированный подписчик этот интерфейс:

//      LTarget:= LReference as IHandle; // <-- Wish this would work
      if Supports(LReference, IID_Handle, LTarget) then
        LTarget.Handle(AMessage);

Однако это не учитывает общую часть интерфейса, а только проверяет GUID.

Так что вам понадобится больше логики, чтобы проверить, действительно ли цель поддерживает тип сообщения.

Кроме того, поскольку вы имеете дело с классами, которые будут реализовывать интерфейс и, следовательно, должны наследоваться от TInterfacedObject (или совместимого интерфейса с этим классом), вы должны хранить все ссылки на созданный объект в переменных интерфейса, таким образом изменяя список подписчиков из ссылки на объекты TObjects для одного из интерфейсов. И для этого тоже есть специальный класс:

FSubscribers: TInterfaceList;

Конечно, вам придется изменить подпись и на функции подписки / отмены подписки:

procedure Subscribe(AInstance: IInterface);
procedure Unsubscribe(AInstance: IInterface);

Я думаю, что лучшим способом было бы взять универсальный интерфейс IHandle. Таким образом, вы можете обеспечить, чтобы все подписчики внедряли базовый интерфейс IHandler, изменив подпись подписки / отмены подписки, чтобы принимать IHandler вместо IInterface.

IHandler может хранить функциональность, необходимую для определения, поддерживает ли подписчик данный тип сообщения.

Это будет оставлено в качестве упражнения для читателя. Возможно, вы захотите начать с моего маленького тестового приложения (D2010), которое вы можете загрузить с My Test App .

N.B. Тестовое приложение исследует возможность использования обобщенных элементов в интерфейсе и, скорее всего, приведет к сбою при публикации событий. Используйте отладчик для одного шага, чтобы увидеть, что происходит. Я не сбой при публикации целого 0, который, кажется, работает. Причина в том, что и Int, и String обработчик будут вызываться независимо от типа ввода для публикации (как обсуждалось ранее).

Answer 4

Другой подход заключается в том, чтобы пропустить интерфейсы altogheter и перейти к функции отправки TObject.

Для этого нам понадобится запись сообщения:

  TMessage = record
    MessageId: Word;
    Value: TValue;
  end;

, а также некоторые идентификаторы событий:

const
  EVENT_BASE = WM_USER;
  MY_EVENT = EVENT_BASE;
  OTHER_EVENT = MY_EVENT + 1;

и обновите процедуру публикации:

procedure TEventAggregator.Publish<T>(MsgId: Word; const Value: T);
var
  LReference: TObject;
  Msg: TMessage;
begin
  Msg.MessageId := MsgId;
  Msg.Value := TValue.From(Value);

  for LReference in FSubscribers do begin
    LReference.Dispatch(Msg);
  end;
end;

Тогда ЛЮБОЙ объект может быть подписчиком на события.Для обработки события обработчику нужно только указать, какой идентификатор события обрабатывать (или перехватывать его в DefaultHandler).

Чтобы обработать сообщение MY_EVENT, просто добавьте его в класс:

procedure HandleMyEvent(var Msg: TMessage); message MY_EVENT;

См. Также пример отправки из документации Delphi: TObjectDispatch

Таким образом, мы можем публиковать сообщения и позволять подписчику выбирать, какие из них обрабатывать.Также тип можно определить в обработчике.Кроме того, можно заявить (в документации, а не в коде), что данный идентификатор события должен быть заданного типа, поэтому обработчик события для MY_EVENT может просто получить доступ к значению как Msg.Value.AsInteger.

NB. Сообщениепередается как var, поэтому подписчики могут изменять его.Если это неприемлемо, запись Msg должна повторно инициализироваться перед каждой отправкой.

Answer 5

Я думаю, что возможный обходной путь - использовать неуниверсальный интерфейс с GUID:

IMessageHandler = interface
  ['...']
  procedure Handle(const AMessage: TValue);
end;