i'm not sure if title makes sense, hope can understand question code.
given following code publish/subscribe framework.
type imessage = interface ['{b1794f44-f6ee-4e7b-849a-995f05897e1c}'] end; isubscriber = interface ['{d655967e-90c6-4613-92c5-1e5b53619ee0}'] end; isubscriberof<t: imessage> = interface(isubscriber) procedure consume(const message: t); end; tmessageservice = class private fsubscribers: tlist<isubscriber>; public constructor create; destructor destroy; override; procedure sendmessage(const message: imessage); procedure subscribe(const subscriber: isubscriber); procedure unsubscribe(const subscriber: isubscriber); end;
that used this:
tmymessage = class(tinterfacedobject, imessage); tmysubscriber = class(tinterfacedobject, isubscriberof<tmymessage>) procedure consume(const message: tmymessage); end; tmyothermessage = class(tinterfacedobject, imessage); tmyothersubscriber = class(tinterfacedobject, isubscriberof<tmyothermessage>) procedure consume(const message: tothermessage); end;
how can loop subscribers list , send message proper subscribers?
the subscribers list have subscribers types of messages. sendmessage have find subscribers type of message provided param , send whom implements proper interface consume type of message.
procedure tmessageservice.sendmessage(const message: imessage); var subscriber: isubscriber; begin subscriber in fsubscribers begin // how send message subscribers of correspondent type of message end; end;
thanks!
btw, code based on blog post.
edit: found way make less convoluted (please vote on answer this; took quite while right).
note uses new rtti unit, works only delphi 2010 , (i used delphi xe developing this, did not yet verify in delphi 2010).
for supports, need store iid guids with interfaces , means query them.
since want use generics, want able query iid guid interface type, not interface reference (as hallvard vassbotn showed hack in 2006).
new rtti introduced in delphi 2010 allows that:
unit rttiunit; interface type trtti = record //1 similar http://hallvards.blogspot.com/2006/09/hack11-get-guid-of-interface-reference.html interface type, not reference class function getinterfaceiid<t: iinterface>(var iid: tguid): boolean; static; end; implementation uses typinfo, rtti; class function trtti.getinterfaceiid<t>(var iid: tguid): boolean; var typeinfooft: ptypeinfo; rtticontext: trtticontext; rttiinterfacetype: trttiinterfacetype; rttitype: trttitype; begin typeinfooft := typeinfo(t); rtticontext := trtticontext.create(); rttitype := rtticontext.gettype(typeinfooft); if rttitype trttiinterfacetype begin rttiinterfacetype := rttitype trttiinterfacetype; iid := rttiinterfacetype.guid; result := true; end else result := false; end; end.
so changed code, rearranged bit, , spread on more units keep overview.
classicmessagesubscriberunit: has non generic interfaces imessage , isubscriber (they descend iimplementedwithclass makes easier log things.
unit classicmessagesubscriberunit; interface type iimplementedwithclass = interface(iinterface) function tostring: string; end; imessage = interface(iimplementedwithclass) ['{b1794f44-f6ee-4e7b-849a-995f05897e1c}'] end; isubscriber = interface(iimplementedwithclass) ['{d655967e-90c6-4613-92c5-1e5b53619ee0}'] end; implementation end.
genericsubscriberofunit: contains generic isubscriberof interface descends generic isupporterof , generic base implementation called tsupporterof:
unit genericsubscriberofunit; interface uses classicmessagesubscriberunit; type isupporterof<t: imessage> = interface(isubscriber) ['{0905b3eb-b17e-4ad2-98e2-16f05d19484c}'] function supports(const message: t): boolean; end; isubscriberof<t: imessage> = interface(isupporterof<t>) ['{6fd82b1d-61c6-4572-ba7d-d70da9a73285}'] procedure consume(const message: t); end; type tsupporterof<t: imessage> = class(tinterfacedobject, isubscriber, isupporterof<t>) function supports(const message: t): boolean; end; implementation uses sysutils, rttiunit; function tsupporterof<t>.supports(const message: t): boolean; var iid: tguid; begin if trtti.getinterfaceiid<t>(iid) result := sysutils.supports(message, iid) else result := false; end; end.
messageserviceunit: contains tmessageservice, type aliases , actual code managing list test it.
unit messageserviceunit; interface uses generics.collections, classicmessagesubscriberunit, genericsubscriberofunit; type isubscriberofimessage = isubscriberof<imessage>; tlistisubscriber = tlist<isubscriber>; tmessageservice = class private fsubscribers: tlistisubscriber; strict protected procedure consume(const subscriberof: isubscriberofimessage; const message: imessage); virtual; public constructor create; destructor destroy; override; procedure sendmessage(const message: imessage); procedure subscribe(const subscriber: isubscriber); procedure unsubscribe(const subscriber: isubscriber); end; implementation uses sysutils; constructor tmessageservice.create; begin inherited create(); fsubscribers := tlistisubscriber.create(); end; destructor tmessageservice.destroy; begin freeandnil(fsubscribers); inherited destroy(); end; procedure tmessageservice.sendmessage(const message: imessage); var localmessage: imessage; lsubscriber: isubscriber; lsubscriberof: isubscriberof<imessage>; begin lsubscriber in fsubscribers begin localmessage := message; // prevent premature freeing of message if supports(lsubscriber, isubscriberof<imessage>, lsubscriberof) if lsubscriberof.supports(localmessage) consume(lsubscriberof, localmessage); end; end; procedure tmessageservice.subscribe(const subscriber: isubscriber); begin fsubscribers.add(subscriber); end; procedure tmessageservice.unsubscribe(const subscriber: isubscriber); begin fsubscribers.remove(subscriber); end; procedure tmessageservice.consume(const subscriberof: isubscriberofimessage; const message: imessage); begin subscriberof.consume(message); end; end.
finally unit used test (it uses bo-library @ http://bo.codeplex.com):
unit genericpublishsubscribemainformunit; interface uses windows, messages, sysutils, variants, classes, graphics, controls, forms, dialogs, stdctrls, loggerinterfaceunit, messageserviceunit, messagesubscribersunit, classicmessagesubscriberunit; type tgenericpublishsubscribemainform = class(tform) testpublisherbutton: tbutton; logmemo: tmemo; procedure testpublisherbuttonclick(sender: tobject); strict private flogger: ilogger; strict protected function getlogger: ilogger; property logger: ilogger read getlogger; public destructor destroy; override; end; type tloggingmessageservice = class(tmessageservice) strict private flogger: ilogger; strict protected procedure consume(const subscriberof: isubscriberofimessage; const message: imessage); override; public constructor create(const logger: ilogger); property logger: ilogger read flogger; end; var genericpublishsubscribemainform: tgenericpublishsubscribemainform; implementation uses loggerunit, outputdebugviewloggerunit, loggersunit, messagesunit; {$r *.dfm} destructor tgenericpublishsubscribemainform.destroy; begin inherited destroy; flogger := nil; end; function tgenericpublishsubscribemainform.getlogger: ilogger; begin if not assigned(flogger) flogger := tteelogger.create([ toutputdebugviewlogger.create(), tstringslogger.create(logmemo.lines) ]); result := flogger; end; procedure tgenericpublishsubscribemainform.testpublisherbuttonclick(sender: tobject); var loggingmessageservice: tloggingmessageservice; begin loggingmessageservice := tloggingmessageservice.create(logger); try loggingmessageservice.subscribe(tmysubscriber.create() isubscriber); loggingmessageservice.subscribe(tmyothersubscriber.create() isubscriber); loggingmessageservice.sendmessage(tmymessage.create()); loggingmessageservice.sendmessage(tmyothermessage.create()); loggingmessageservice.free; end; end; constructor tloggingmessageservice.create(const logger: ilogger); begin inherited create(); flogger := logger; end; procedure tloggingmessageservice.consume(const subscriberof: isubscriberofimessage; const message: imessage); var messageimplementedwithclass: iimplementedwithclass; messagestring: string; subscribeimplementedwithclass: iimplementedwithclass; subscriberofstring: string; begin subscribeimplementedwithclass := subscriberof; messageimplementedwithclass := message; subscriberofstring := subscribeimplementedwithclass.tostring; messagestring := messageimplementedwithclass.tostring; // wrong vmt here, delphi xe sp2 logger.log('consume(subscriberof: %s, message:%s);', [subscriberofstring, messagestring]); // [subscriberof.classtype.classname, message.classtype.classname]); inherited consume(subscriberof, message); end; end.
--jeroen
old solution:
this might it, still find solution bit convoluted.
messageserviceunit: isubscriberof has guid , supports method check if imessage in fact supported.
unit messageserviceunit; interface uses generics.collections; type imessage = interface(iinterface) ['{b1794f44-f6ee-4e7b-849a-995f05897e1c}'] end; isubscriber = interface(iinterface) ['{d655967e-90c6-4613-92c5-1e5b53619ee0}'] end; isubscriberof<t: imessage> = interface(isubscriber) ['{6fd82b1d-61c6-4572-ba7d-d70da9a73285}'] procedure consume(const message: t); function supports(const message: t): boolean; end; tmessageservice = class private fsubscribers: tlist<isubscriber>; public constructor create; destructor destroy; override; procedure sendmessage(const message: imessage); procedure subscribe(const subscriber: isubscriber); procedure unsubscribe(const subscriber: isubscriber); end; implementation uses sysutils; constructor tmessageservice.create; begin inherited create(); end; destructor tmessageservice.destroy; begin inherited destroy(); end; procedure tmessageservice.sendmessage(const message: imessage); var lsubscriber: isubscriber; lsubscriberof: isubscriberof<imessage>; begin lsubscriber in fsubscribers begin if supports(lsubscriber, isubscriberof<imessage>, lsubscriberof) if lsubscriberof.supports(message) lsubscriberof.consume(message); end; end; procedure tmessageservice.subscribe(const subscriber: isubscriber); begin fsubscribers.add(subscriber); end; procedure tmessageservice.unsubscribe(const subscriber: isubscriber); begin fsubscribers.remove(subscriber); end; end.
messagesunit: messages each have interface guid supports can check guid.
unit messagesunit; interface uses messageserviceunit; type imymessage = interface(imessage) ['{84b42ec8-cac0-44b4-97a8-05ae5b636236}'] end; tmymessage = class(tinterfacedobject, imessage, imymessage); imyothermessage = interface(imessage) ['{ab323765-ff7b-4852-91aa-b7ecc1845b41}'] end; tmyothermessage = class(tinterfacedobject, imessage, imyothermessage); implementation end.
messagesubscribersunit: subscribers have supports method checking right guid.
unit messagesubscribersunit; interface uses messagesunit, messageserviceunit; type tmysubscriber = class(tinterfacedobject, isubscriberof<imymessage>) procedure consume(const message: imymessage); function supports(const message: imymessage): boolean; end; tmyothersubscriber = class(tinterfacedobject, isubscriberof<imyothermessage>) procedure consume(const message: imyothermessage); function supports(const message: imyothermessage): boolean; end; implementation uses sysutils; procedure tmysubscriber.consume(const message: imymessage); begin // end; function tmysubscriber.supports(const message: imymessage): boolean; begin result := sysutils.supports(message, imymessage); end; procedure tmyothersubscriber.consume(const message: imyothermessage); begin // end; function tmyothersubscriber.supports(const message: imyothermessage): boolean; begin result := sysutils.supports(message, imyothermessage); end; end.
messagesunit: contains specific messages (both interface , class types), contain iid guids distinguish them supports.
unit messagesunit; interface uses messageserviceunit, classicmessagesubscriberunit; type imymessage = interface(imessage) ['{84b42ec8-cac0-44b4-97a8-05ae5b636236}'] end; tmymessage = class(tinterfacedobject, imessage, imymessage); imyothermessage = interface(imessage) ['{ab323765-ff7b-4852-91aa-b7ecc1845b41}'] end; tmyothermessage = class(tinterfacedobject, imessage, imyothermessage); implementation end.
messagesubscribersunit: contains specific subscribers (both interface , class types), not need supports method more: contain consume method.
unit messagesubscribersunit; interface uses messagesunit, messageserviceunit, genericsubscriberofunit, classicmessagesubscriberunit; type tmysubscriber = class(tsupporterof<imymessage>, isubscriber, isubscriberof<imymessage>) procedure consume(const message: imymessage); end; tmyothersubscriber = class(tsupporterof<imyothermessage>, isubscriber, isubscriberof<imyothermessage>) procedure consume(const message: imyothermessage); end; implementation uses sysutils; procedure tmysubscriber.consume(const message: imymessage); begin // end; procedure tmyothersubscriber.consume(const message: imyothermessage); begin // end; end.
--jeroen
Comments
Post a Comment