Custom Constructor /DI bei factory-basierter Objekterstellung

[Stevie]

Die Interfaces sollten in einem Package sein (allein aus dem Grund, damit alle beteiligten Module, dieselbe Typeinfo nutzen, sonst funktioniert das mit dem Container per RTTI nicht).

Und Parameter finden musst du selber dann gar nicht. Du sagst dem Container, es gibt X, Y und Z und dann weiß er, was er zusammen tackern muss, wenn du ein IX brauchst (nämlich nen IY und IZ, die er auch allein baut).
Für weitere Informationen einfach mal Dependency Injection in Delphi lesen

[Sequitar]

Zitat von Stevie:

Die Interfaces sollten in einem Package sein (allein aus dem Grund, damit alle beteiligten Module, dieselbe Typeinfo nutzen, sonst funktioniert das mit dem Container per RTTI nicht).

Und Parameter finden musst du selber dann gar nicht. Du sagst dem Container, es gibt X, Y und Z und dann weiß er, was er zusammen tackern muss, wenn du ein IX brauchst (nämlich nen IY und IZ, die er auch allein baut).
Für weitere Informationen einfach mal Dependency Injection in Delphi lesen

OK so hab ichs bisher gemacht, Registrierung und interfaces in ein gemeinsames package.

Nachfrage:Ich hab nur noch nicht ganz verstanden, wie ich denn den container mit iy,iz füttere (das meinte ich mit parametern) damit er n ix ausgibt.(ausser er würde den spezifischen konstruktor für die implementierende klasse kennen,was sich bei einigen wohl machen liesse,bei denen ich genau weiss ich kann ein class of ....einsetzen, weil die basisklasse schon mit im ReGpackage steckt aber nicht als OSFA). ich mein wahrscheinlich wärs am einfachsten mit setter injection nur wärs mir am liebsten ich wüsste direkt dass ich alles komplett hab wenn das objekt erstellt wird.
ich guck mir mmal das buch an, vlt find ich da ja was passendes....merci

[Stevie]

Hier mal ein kleines Beispiel:

Delphi-Quellcode:

program Simple_DI;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  SimpleContainer in 'SimpleContainer.pas';

type
  IX = interface
    ['{E2D88E1C-AE7D-491A-B456-84B134749890}']
  end;

  IY = interface
    ['{3D1256AB-CDDE-49B2-94CF-E9FA82314206}']
  end;

  IZ = interface
    ['{4F51DE5D-B65B-4776-B25B-5B2868DC34AC}']
  end;

  TX = class(TInterfacedObject, IX)
  private
    fy: IY;
    fz: IZ;
  public
    constructor Create(const y: IY; const z: IZ);
  end;

  TY = class(TInterfacedObject, IY)
    constructor Create;
  end;

  TZ = class(TInterfacedObject, IZ)
    constructor Create;
  end;

{ TX }

constructor TX.Create(const y: IY; const z: IZ);
begin
  Writeln('creating ', ClassName);
  Writeln('injected ', (y as TObject).ClassName, ' for y');
  Writeln('injected ', (z as TObject).ClassName, ' for z');

  fy := y;
  fz := z;
end;

{ TY }

constructor TY.Create;
begin
  Writeln('creating ', ClassName);
end;

{ TZ }

constructor TZ.Create;
begin
  Writeln('creating ', ClassName);
end;

var
  container: TSimpleContainer;
  x: IX;
begin
  // showing the so called register, resole, release (RRR) pattern
  // see http://blog.ploeh.dk/2010/09/29/TheRegisterResolveReleasepattern/

  container := TSimpleContainer.Create;
  try
    // register
    container.Add<IX, TX>;
    container.Add<IY, TY>;
    container.Add<IZ, TZ>;

    // resolve
    x := container.Get<IX>;
  finally
    // release
    x := nil;
    container.Free;
  end;
end.

[Sequitar]

Zwischenzeitlich woanders weitergebaut, bin heute wieder drüber gestolpert.
Hab mir folgendes überlegt. Man kann doch methoden oder constructors auch über die RTTI aufrufen.
Damit hätte ich genau was ich ursprünglich wollte....
Ein Beispiel hab ich hier gefunden:

Delphi-Quellcode:

Function NewFromClassInfo(Const ATypeInfo: PTypeInfo;{Params: Array Of Tvalue}): Tobject;
  Var
    Ctx: TRttiContext;
    RType: TRttiType;
    AMethCreate: TRttiMethod;
    InstanceType: TRttiInstanceType;
    Fvalue: Rtti.Tvalue;
  Begin
    Ctx := TRttiContext.Create;
    RType := Ctx.GetType(ATypeInfo);
    For AMethCreate In RType.GetMethods Do
    Begin
{$MESSAGE 'TODO Handle constructors with params.'}
      If Assigned(AMethCreate)
      Then
        If (AMethCreate.IsConstructor) And
          (Length(AMethCreate.GetParameters) = 0)//müsste dann entfernt werden
        Then
        Begin
          InstanceType := RType.AsInstance;
          FValue := AMethCreate.Invoke(InstanceType.MetaclassType, [{params}]);
{hatte überlegt, params hier zu übergeben. das führt jedoch zu access violation 
ODER zur meldung ("parameter count mismatch"). 
Und JA, ich übergebe (nur anscheinend) die richtige parameterzahl.


(Also wenn create(anint:integer)>>tx.create(5);
>>newfromclassinfo(tx.classinfo,[5]);
}
          Result := Fvalue.AsObject;
          Exit;
        End;
    End;
  End;

Kann man das verbessern? Obiges beheben?
Merci.

Zitat von Stevie:

Hier mal ein kleines Beispiel:

Delphi-Quellcode:

program Simple_DI;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  SimpleContainer in 'SimpleContainer.pas';

type
  IX = interface
    ['{E2D88E1C-AE7D-491A-B456-84B134749890}']
  end;

  IY = interface
    ['{3D1256AB-CDDE-49B2-94CF-E9FA82314206}']
  end;

  IZ = interface
    ['{4F51DE5D-B65B-4776-B25B-5B2868DC34AC}']
  end;

  TX = class(TInterfacedObject, IX)
  private
    fy: IY;
    fz: IZ;
  public
    constructor Create(const y: IY; const z: IZ);
  end;

  TY = class(TInterfacedObject, IY)
    constructor Create;
  end;

  TZ = class(TInterfacedObject, IZ)
    constructor Create;
  end;

{ TX }

constructor TX.Create(const y: IY; const z: IZ);
begin
  Writeln('creating ', ClassName);
  Writeln('injected ', (y as TObject).ClassName, ' for y');
  Writeln('injected ', (z as TObject).ClassName, ' for z');

  fy := y;
  fz := z;
end;

{ TY }

constructor TY.Create;
begin
  Writeln('creating ', ClassName);
end;

{ TZ }

constructor TZ.Create;
begin
  Writeln('creating ', ClassName);
end;

var
  container: TSimpleContainer;
  x: IX;
begin
  // showing the so called register, resole, release (RRR) pattern
  // see http://blog.ploeh.dk/2010/09/29/TheRegisterResolveReleasepattern/

  container := TSimpleContainer.Create;
  try
    // register
    container.Add<IX, TX>;
    container.Add<IY, TY>;
    container.Add<IZ, TZ>;

    // resolve
    x := container.Get<IX>;
  finally
    // release
    x := nil;
    container.Free;
  end;
end.

[Sequitar]

Bisschen weiter, und ich habe bisher folgendes - soweit auch funktionierend - implementiert:

Delphi-Quellcode:

Type
 Tfactory = Class(Tinterfacedobject)
  Strict Private
    Class Function Getclass(Classname: String; Out Index: Tcount;
      Out Constr: Pointer): TClass; Overload; Static; //user may register / use a custom constructor to create objects>>not fully //implemented
    Class Var Fclassregister: Iclassregister;//central register for classes and constructors, concrete impl may be changed later
  Public
    Class Constructor Create; Reintroduce;
    Class Destructor Destroy; Reintroduce;
    // Class Procedure Reg(Cl: TClass; Aconstr: Pointer = Nil); Overload; Virtual;
    Class Procedure Reg(Cl: Tclass); Overload; Virtual;
    Class Procedure Reg(Classes: Array Of TClass); Overload; Static;
    Class Procedure UnReg(Cl: TClass); Overload; Virtual;
    Class Procedure UnReg(Classes: Array Of TClass); Overload; Static;
    Class Procedure Unregall; Virtual;
    Class Function New<T: Iinterface>(Classname: String;
      Parameters: Array Of Tvalue; Customconstructorname: String = 'create')
      : T; Overload; //creation of new objects via rtti's ability to call custom methods and constructors
    Class Function New<T: Iinterface>(Classname: String): T; Overload; //create via standard "create" constructor
    Class Function IsRegistered(Classname: String): Boolean; Virtual; //check if centrally registered
    Class Function Getclass(Classname: String): TClass; Overload; Static;
    Class Function GetDecendents(Classname: String;
      Childrenonly: Boolean = True): Tstringlist; Static; //get registered decendents of a given class
  End;

Um noch mehr Flexiblität zu erhalten und später ggf die factories austauschen, oder spezielle factories definieren zu können (zur zeit alles zentral über Tfactory.DoSomething (class procedure), würde ich das ganze gerne auf ein interface umstellen.

Das interface soll ca so aussehen, für den Nutzr reicht das an funktionalität...

Delphi-Quellcode:

 type
Ifactory<T: Iinterface> = Interface
    ['{2DA05708-FB1B-426E-8FED-02A46A7F57B7}']
    Procedure Reg(Cl: Tclass); Overload;
    Procedure Reg(Classes: Array Of TClass); Overload;
    Procedure UnReg(Cl: TClass); Overload;
    Procedure UnReg(Classes: Array Of TClass); Overload;
    // Function New<T: Iinterface>(Classname: String; Parameters: Array Of Tvalue;
    // Customconstructorname: String = 'create'): T; Overload;
    // Function New<T: Iinterface>(Classname: String): T; Overload;//<<not possible
    Function IsRegistered(Classname: String): Boolean;
    // Function Getclass(Classname: String): TClass; Overload;
  End;

Das Problem dabei ist die Nutzung der Constraints/Parameterisierung (NEW), die in der konkreten Klasse bisher ganz gut funktioniert und auch sehr nützlich ist..
>>"Interface methods must not have parameterized methods"
Wenn einer Tips hat, wie man das am besten umbaut / flexibel hält //und obige fehlermeldung elegant umschifft, wäre ich sehr dankbar.

Merci

[Sequitar]

Lösung soweit:

Delphi-Quellcode:

interface
Type
  Tfactory = Class(TInterfacedObject)
  Strict Private
    Class Function Getclass(Classname: String; Out Index: Tcount;
      Out Constr: Pointer): TClass; Overload; Static;
    Class Var Fclassregister: Iclassregister;
    // implementation of ifactory interface
  Public
    Class Constructor Create; Reintroduce;
    Class Destructor Destroy; Reintroduce;
    // Class Procedure Reg(Cl: TClass; Aconstr: Pointer = Nil); Overload; Virtual;
    Class Procedure Reg(Cl: Tclass); Overload; Static;
    Class Procedure Reg(Classes: Array Of TClass); Overload; Static;
    Class Procedure UnReg(Cl: TClass); Overload; Static;
    Class Procedure UnReg(Classes: Array Of TClass); Overload; Static;
    Class Procedure Unregall; Virtual;
    Class Function New<T: Iinterface>(Classname: String;
      Parameters: Array Of Tvalue; Customconstructorname: String = 'create')
      : T; Overload;
    Class Function New<T: Iinterface>(Classname: String): T; Overload;
    Class Function IsRegistered(Classname: String): Boolean; Virtual;
    Class Function Getclass(Classname: String): TClass; Overload; Static;
    Class Function GetDecendents(Classname: String;
      Childrenonly: Boolean = True): Tstringlist; Static;
  End;
 {
    ============================================================================
    Instantiated factory and interface
    ============================================================================
  }
  Ifactory<T: Iinterface> = Interface
    ['{2DA05708-FB1B-426E-8FED-02A46A7F57B7}']
    Procedure Reg(Cl: Tclass); Overload;
    Procedure Reg(Classes: Array Of Tclass); Overload;
    Procedure UnReg(Cl: Tinterfacedclass); Overload;
    Procedure UnReg(Classes: Array Of Tclass); Overload;
    Function New(Classname: String; Parameters: Array Of Tvalue;
      Customconstructorname: String = 'create'): T; Overload;
    Function New(Classname: String): T; Overload;
    Function IsRegistered(Classname: String): Boolean;
    // Function Getclass(Classname: String): TClass; Overload;
  End;

  // instantiable Tfactory class
  TFactory<T: Iinterface> = Class(Tfactory, Ifactory<T>)
  Private
    Procedure Reg(Cl: Tclass); Overload;
    Procedure Reg(Classes: Array Of Tclass); Overload;
    Procedure UnReg(Cl: Tinterfacedclass); Overload;
    Procedure UnReg(Classes: Array Of Tclass); Overload;
    Function New(Classname: String; Parameters: Array Of Tvalue;
      Customconstructorname: String = 'create'): T; Overload;
    Function New(Classname: String): T; Overload;
    Function IsRegistered(Classname: String): Boolean;
  End;

 {
    ============================================================================
   A sample class to be created
    ============================================================================

 Ihello = Interface

    Procedure Hello;
  End;

  Thelloworld = Class(TInterfacedObject, Ihello)
    Procedure Hello;
  End;
  }

 implementation
//Base class and class register
{...}
Class Function Tfactory.New<T>(Classname: String; Parameters: Array Of Tvalue;
  Customconstructorname: String = 'create'): T;
  Var
    Ctx: TRttiContext;
    Method: Trttimethod;
    Aclass: Tclass;
    Atype: Trttitype;
  Begin
    Result := Nil;
    Try
      Aclass := Getclass(Classname);
      Atype := Ctx.GetType(Aclass);
      Method := Atype.GetMethod(Customconstructorname);
      If Assigned(Method)
      Then
        Result := Method.Invoke(Aclass, Parameters).AsType<T>;
    Except
      On E: Exception Do
        Showmessage(Self.Classname + ': Error constructing <' + Aclass.ClassName
          + '> - ' + E.Message + '.')
    End;
  End;

{...}

//instantiated
Function TFactory<T>.IsRegistered(Classname: String): Boolean;
  Begin
    Result := Inherited IsRegistered(Classname);
  End;

Function TFactory<T>.New(Classname: String; Parameters: Array Of Tvalue;
  Customconstructorname: String): T;
  Begin
    Result := Inherited New<T>(Classname, Parameters, Customconstructorname)
  End;

Function TFactory<T>.New(Classname: String): T;
  Begin
    Result := Inherited New<T>(Classname);
  End;

Procedure TFactory<T>.Reg(Cl: Tclass);
  Begin
    Inherited Reg(Cl);
  End;

Procedure TFactory<T>.Reg(Classes: Array Of Tclass);
  Begin
    Inherited Reg(Classes);
  End;

Procedure TFactory<T>.UnReg(Cl: Tinterfacedclass);
  Begin
    Inherited UnReg(Cl);
  End;

Procedure TFactory<T>.UnReg(Classes: Array Of Tclass);
  Begin
    Inherited UnReg(Classes);
  End;

wenn ich die class function normal aufrufe, kein problem. Leider knallts bei folgendem aufruf;

Delphi-Quellcode:

Procedure Testfactoryinterfacedconstraint;
  Var
    Factory: Ifactory<Ihello>; // beliebiges interface was von der zu generierenden klasse implementiert ist
    X: Ihello;//result object
  Begin
    Factory := TFactory<Ihello>.Create;
    Factory.Reg([Thelloworld, TAnotherHelloObject]); //zentral registriert
    X := Factory.New('thelloworld');//<< hier wird also obige function new aufgerufen, die das dann an die class function weiterleited.
//in der class function knallts dann an der folgenden stelle: (aclass korrekt gefunden,ebenso wie method)
{ If Assigned(Method)
      Then
        Result := Method.Invoke(Aclass, Parameters).AsType<T>; //hier beim ASType<T> conversion prozess>>invalid type cast}
    X.Hello;

  End;

Wieso wird denn da ein Typecast error ausgeworfen??





>>>>>Nachtrag: Der typecast lag an der fehlenden Interface identifikation via GUID.
Kann mir das "method.invoke().astype<t> keine entsprechende fehlermeldung ausgeben, wenn keine GUID oder ein nicht unterstütztes Interface angegeben? So ählnlich wie bei dem AS und IS operator?

Und kann ich evlt verhindern, dass mit  ifactory<t:interface>.reg(aclass:tclass) eine Klasse registriert wird, die T nicht unterstützt?

[Sequitar]

Delphi-Quellcode:

  
 Var
    Guid: Tguid;
begin 
{...}    
Guid := GetTypeData(TypeInfo(T))^.Guid;
      If Not Supports(Cl, Guid)
{...}
end;

[freimatz]

Führst Du Selbstgespräche?

Warum verwendest Du denn keinen existierenden DI-Container wie Spring4D?