[ top ] [ prev ] [ up ] [ next ]

[Delphi][PofEAA] Plugin Factory

class の依存性を除去します。 
{ 適用前 }
uses uCustomer;

var
  Customer: ICustomer;

{ if production then }
  Customer := TCustomer.Create;
{ if test then }
  Customer := TCustomerMock.Create;

{ 適用後 }
uses uPluginFactory;

var
  Customer: ICustomer;

  Customer := PluginFactory.GetPlugin('ICustomer') as ICustomer;

production.properties:
ICustomer=TCustomer

test.properties:
ICustomer=TCustomerMock
interface や継承を使えば constructor や setter (write メソッド) で mock object を差し込むことができます。
でもまだ問題が残っています。それは、この例のように、内部で生成する object の class を差し替えるにはどうすればいいのかという問題です。

まず思いつくのは、factory class とその interface を用意して、factory class を差し替えることで、内部で生成する object の class を差し替えるという方法です。 
type
  ICustomerFactory = interface
    function CreateCustomer: ICustomer;
  end;

type
  TCustomerFactory = class(TInterfacedObject, ICustomerFactory)
  public
    function CreateCustomer: ICustomer;
  end;

{ TCustomerFactory }

function TCustomerFactory.CreateCustomer: ICustomer;
begin
  Result := TCustomer.Create;
end;

type
  TCustomerMockFactory = class(TInterfacedObject, ICustomerFactory)
  public
    function CreateCustomer: ICustomer;
  end;

{ TCustomerMockFactory }

function TCustomerMockFactory.CreateCustomer: ICustomer;
begin
  Result := TCustomerMock.Create;
end;
この方法は間違いなく動作します。でも、Create するだけなのに、いちいち factory を書くのは面倒です。

というわけで、ここでは Plugin Factory というパターンを使います。

TPersistent な class だけ扱えたらいいということにして、FindClass 関数を使って Plugin Factory を実装します。
FindClass 関数は、class 名を使って class を検索します。 
unit uPluginFactory;

interface

uses SysUtils, Classes, uInterfacedPersistentRC;

type
  TPluginFactory = class
  private
    FProperties: TStringList;
  public
    constructor Create;
    destructor Destroy; override;
    function GetPlugin(const InterfaceName: string): TInterfacedPersistentRC;
  end;

var
  PluginFactory: TPluginFactory;

implementation

{ TPluginFactory }

constructor TPluginFactory.Create;

  function GetExeName: string;
  begin
    Result := ParamStr(0);
  end;

var
  ExeName: string;
begin
  FProperties:=TStringList.Create;
  ExeName:=GetExeName;
  FProperties.LoadFromFile( ExtractFilePath(Exename) + ChangeFileExt(ExtractFileName(Exename), '.properties') );
end;

destructor TPluginFactory.Destroy;
begin
  FProperties.Free;
end;

function TPluginFactory.GetPlugin(const InterfaceName: string): TInterfacedPersistentRC;
var
  ClassName: string;
  AClass: TInterfacedPersistentRCClass;
begin
  ClassName := FProperties.Values[ InterfaceName ];
  AClass := TInterfacedPersistentRCClass(FindClass(ClassName));
  Result := TInterfacedPersistentRC(AClass.Create);
end;

initialization
  PluginFactory:=TPluginFactory.Create;
finalization
  PluginFactory.Free;
end.
GetPlugin の内部では、プロパティファイル (実行ファイル名の拡張子を .properties に置き換えた名前のファイルを用意します) を基に interface 名から class 名を得て、FindClass 関数を呼んでいます。

ここで出てくる TInterfacedPersistentRC は TInterfacedPersistent の替わりとなる class です。
TInterfacedPersistent は reference count (RC) を無効にしていて都合が悪いので、
TInterfacedObject を参考にして、TPersistent から継承した class TInterfacedPersistentRC を新たに用意しました。 
unit uInterfacedPersistentRC;

interface

uses Windows, SysUtils, SysConst, Classes;

type
  TInterfacedPersistentRC = class(TPersistent, IInterface)
  protected
    FRefCount: Integer;
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  public
    constructor Create; virtual;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    class function NewInstance: TObject; override;
    property RefCount: Integer read FRefCount;
  end;

  TInterfacedPersistentRCClass = class of TInterfacedPersistentRC;

implementation

constructor TInterfacedPersistentRC.Create;
begin

end;

procedure TInterfacedPersistentRC.AfterConstruction;
begin
// Release the constructor's implicit refcount
  InterlockedDecrement(FRefCount);
end;

procedure TInterfacedPersistentRC.BeforeDestruction;
begin
  if RefCount <> 0 then
    raise EInvalidPointer.CreateRes(@SInvalidPointer);
end;

// Set an implicit refcount so that refcounting
// during construction won't destroy the object.
class function TInterfacedPersistentRC.NewInstance: TObject;
begin
  Result := inherited NewInstance;
  TInterfacedPersistentRC(Result).FRefCount := 1;
end;

function TInterfacedPersistentRC.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

function TInterfacedPersistentRC._AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TInterfacedPersistentRC._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  if Result = 0 then
    Destroy;
end;

end.
FindClass で見つけられるように、対象となる class の initialization 節では、RegisterClass 関数を使ってクラスを登録しておきます。 
uCustomer.pas:
initialization
  RegisterClass(TCustomer);

uCustomerMock.pas:
initialization
  RegisterClass(TCustomerMock);

参考文献

開発環境

author: YOSHIDA Kazuhiro
[ top ] [ prev ] [ up ] [ next ]