(代码如下)
我正在用 Delphi 和 Spring4d 库编写事件总线。
我的灵感来自 Spring4d 库(基于事件的架构)的示例
基本上,事件总线
- 允许添加订阅者
- 允许向订阅者发送事件
我对这里的subscribe
方法感兴趣
TEventBus.subscribe(aHandler : TInterfacedObject; aEvtGuid : TGUID);
我在查找给定的 aHandler 是否支持 IEventHandler 接口时遇到问题:
TMyClass = class(TInterfacedObject, IEventHandler<IMyEvent>) // ...
TMyOtherClass = class(TInterfacedObject, IEventHandler<IMyOtherEvent>) // ...
aEvtBus.subscribe(aMyClass, IMyEvent) // ok
aEvtBus.subscribe(aMyOtherClass, IMyOtherEvent) // ok
aEvtBus.subscribe(aMyOtherClass, IMyEvent) // should fail
aEvtBus.subscribe(aMyClass, IMyOtherEvent) // should fail
当它尝试订阅此事件时,我正在尝试检查是否aHandler
支持该接口。IEventHandler<aEvtGUid>
我现在做的是找到IEventHandler对应的RttiInterfaceType。
lRttiHandlerType := TType.FindType('IEventHandler<' + lRttiEventIntfType.QualifiedName + '>');
lRttiHandlerIntfType := TRttiInterfaceType(lRttiHandlerType);
然后,我考虑使用
SysUtils.Supports(aHandler, lRttiHandlerIntfType.GUID);
问题是RttiInterfaceType.GUID 总是指向
{97797738-9DB8-4748-92AA-355031294954}
此 GUID 对应于通用IEventHandler<T : IEvent>
接口(见下文)。因此,只要 aHandler 实现任何IEventHandler<T : IEvent>
接口,它总是会返回 true。
IEventHandler<aEvtGUid>
当 aEvtGuid 是从通用接口的 RttiInterfaceType 获得的 GUID 时,如何确定处理程序是否支持?
编辑 1
我也试过
lValue := TValue.From<TInterfacedObject>(aListener);
lValue.TryCast( lRttiHandlerIntfType.Handle, lValueCast );
也总是返回 true。
代码
unit Unit1;
interface
uses
Spring.Collections,
Spring.Collections.Lists;
type
{ Event Definitions }
IEvent = interface(IInterface)
['{45434EEC-6125-4349-A673-5077DE6F54C9}']
End;
IMyEvent = interface(IEvent)
['{C5B07E59-4459-46CF-91CC-4F9706255FCC}']
end;
IMyOtherEvent = interface(IEvent)
['{8C31AF25-711C-403E-B424-8193696DDE46}']
end;
TEvent = class(TInterfacedObject, IEvent);
TMyEvent = class(TEvent, IMyEvent);
TMyOtherEvent = class(TEvent, IMyOtherEvent);
{ Event handlers }
IEventHandler<T: IEvent> = interface(IInterface)
['{97797738-9DB8-4748-92AA-355031294954}']
procedure Handle(aEvent: T);
end;
IEventHandler = interface(IEventHandler<IEvent>)
['{C3699410-A64A-4C9F-8D87-D95841AD044C}']
end;
{ Classes that handle events }
TMyClass = class(TInterfacedObject, IEventHandler<IMyEvent>)
procedure Handle(aEvent: IMyEvent);
end;
TMyOtherClass = class(TInterfacedObject, IEventHandler<IMyOtherEvent>)
procedure Handle(aEvent: IMyOtherEvent);
end;
{ Event Bus }
TEventBus = class
private
fSuscribers: IDictionary<TGUID, IList<TObject>>;
public
constructor Create;
procedure Suscribe(
aListener : TInterfacedObject;
aEventType: TGUID);
procedure Dispatch<T: IEvent>(aEvent: T);
procedure Test;
end;
implementation
uses
VCL.Dialogs,
Rtti,
Spring.Reflection,
SysUtils;
procedure TMyClass.Handle(aEvent: IMyEvent);
begin
ShowMessage('MyClass handle IMyEvent');
end;
{ TMyOtherClass }
procedure TMyOtherClass.Handle(aEvent: IMyOtherEvent);
begin
ShowMessage('MyOtherClass handle IMyOtherEvent');
end;
constructor TEventBus.Create;
begin
inherited;
fSuscribers := TCollections.CreateDictionary<TGUID, IList<TObject>>;;
end;
procedure TEventBus.Dispatch<T>(aEvent: T);
begin
//
end;
procedure TEventBus.Suscribe(aListener : TInterfacedObject; aEventType: TGUID);
var
lRttiContext : TRttiContext;
lRttiHandlerType : TRttiType;
lEventHandlerIntfName : string;
lRttiEventIntfType, lRttiHandlerIntfType: TRttiInterfaceType;
aSuscriberList : IList<TObject>;
begin
if not TType.TryGetInterfaceType(aEventType, lRttiEventIntfType) then
raise Exception.Create('Impossible to find event type');
lRttiHandlerType := TType.FindType('IEventHandler<' + lRttiEventIntfType.QualifiedName + '>');
if lRttiHandlerType = nil then
raise Exception.Create('Impossible to find handler type');
if not (lRttiHandlerType.TypeKind = TTypeKind.tkInterface) then
raise Exception.Create('Handler type is not interface');
lRttiHandlerIntfType := TRttiInterfaceType(lRttiHandlerType);
if not Supports(aListener, lRttiHandlerIntfType.GUID) then
raise Exception.CreateFmt('Subscriber does not support interface %s with guid %s', [lRttiHandlerIntfType.QualifiedName, GUIDToString(lRttiHandlerIntfType.GUID)]);
if not fSuscribers.ContainsKey(aEventType) then
fSuscribers.Add(aEventType, TCollections.CreateList<TObject>);
aSuscriberList := fSuscribers.Items[aEventType];
if not aSuscriberList.Contains(aListener) then
aSuscriberList.Add(aListener);
end;
procedure TEventBus.Test;
var
aObj1 : TMyClass;
aObj2 : TMyOtherClass;
begin
aObj1 := TMyClass.Create;
aObj2 := TMyOtherClass.Create;
Suscribe(aObj1, IMyEvent);
Suscribe(aObj2, IMyOtherEvent);
try
Suscribe(aObj1, IMyOtherEvent);
raise Exception.Create('Should not be there');
except on E: Exception do
ShowMessage(E.Message);
end;
end;
end.