segunda-feira, 31 de janeiro de 2011

Existem 1001 maneiras de preparar SINGLETON - parte2

No último post desta série mostramos como preparar um singleton que funciona tanto em Delphi como em Lazarus.

Neste post veremos como criar um singleton mais elegante que funcione sem métodos ou variáveis estáticas. Usaremos class vars e class methods para isso. Porém a lógica será a mesma do exemplo anterior.

Objeto Único:

unit uSingleton;

interface

uses
  DateUtils, SysUtils, Windows, dialogs;

type



  TObjetoUnico = class
  private
    FDataHora: string;
    class var  FObjetoUnico: TObjetoUnico;
    class var  FContador: Integer;
    class function GetObjetoUnico: TObjetoUnico; static;
    class function GetContador: integer; static;
  public
    constructor Create;
    destructor Destroy; override;
    function GetDataHora: string; virtual;

    class property ObjetoUnico:  TObjetoUnico read GetObjetoUnico;
    class property Contador: integer read GetContador;
    property DataHora: string read GetDataHora write FDataHora;
  end;

procedure VerificaObjetoUnicoCriado;

implementation


procedure VerificaObjetoUnicoCriado;
begin
  //Uso do FObjetoUnico aqui porque se usasse ObjetoUnico o método acessor
  //GetObjetoUnico seria automaticamente executado, criando o objeto
  if (TObjetoUnico.FContador >= 1) and (TObjetoUnico.FObjetoUnico <> nil) then
    ShowMessage('=========== verificação ===========' + #13#10 +
    'Nome da classe: ' + TObjetoUnico.FObjetoUnico.ClassName+ #13#10 +
    'Hora de Criação: ' + TObjetoUnico.FObjetoUnico.DataHora + #13#10 +
    'Endereço na memória: ' + IntToStr(Integer(TObjetoUnico.FObjetoUnico))
  );
end;


{ TObjetoUnico }

constructor TObjetoUnico.Create;
begin

    //essa verificação impede uma segunda chamada a create
    //se não verificar, ou se deixar crar para se disparar a excessão depois
    //da verificação corre-se o risco de ter criado mais um antes da excessão
    //e aí não será possível destruir, causando um leak
    if (FContador = 0) and (FObjetoUnico = nil) then
    begin
      inherited Create;  //aqui tudo bem usar o inherited create e destroy porque a classe base não faz nada de mais
      InterlockedIncrement(FContador);
      DataHora := FormatDateTime('yyyy-mm-dd hh:nn:ss', now);
    end
    else
      raise Exception.Create('Ei! Não use esse constructor, use o CreateUnico!');
    //o inherited fica dentro do if assim o objeto não será criado caso ja esteja o contador > 0

end;



destructor TObjetoUnico.Destroy;
begin

  FObjetoUnico := nil;
  InterlockedDecrement(FContador);
  inherited;

end;

class function TObjetoUnico.GetContador: integer;
begin
  Result := FContador;
end;

function TObjetoUnico.GetDataHora: string;
begin
  Result := FDataHora;
end;



//como a propriedade  ObjetoUnico executa esse get e esse get le o class var e
//o instancia caso seja nil a propriedade ObjetoUnico tem uma proteção
//natural contra nil e sempre será instanciada, nunca será igual a nil
class function TObjetoUnico.GetObjetoUnico: TObjetoUnico;
begin
  //aqui a mesma verificação é feita para não se executar o create duas vezes
  //mas devolver o objeto existente ou devolvê-lo assim que criado
  if (FContador = 0) and (FObjetoUnico = nil) then
    FObjetoUnico := TObjetoUnico.Create;
  Result := FObjetoUnico;
end;

initialization
  //a initilization não é necessária

finalization
  if (TObjetoUnico.FObjetoUnico <> nil) then
  try
    //leia o comentário abaixo para saber porque o campo privado FObjetoUnico
    //é usado aqui em vez da propriedade ObjetoUnico
    TObjetoUnico.FObjetoUnico.Free;
  except
    //tratamento de excessão
  end;

  //por causa da proteção "natural" contra nil você pode destruir
  //o singleton com
  //TObjetoUnico.ObjetoUnico.Free;
  //mas isso causa um overhead porque se o FObjetoUnico não estiver criado (nil)
  //ele será criado só para ser destruído.
  //É bonito de se ver, mas feio do ponto de vista do algoritmo

end.

Objeto Único Derivado:

unit uSingletonDerivado;

interface

uses
  uSingleton, SysUtils, DateUtils, Windows, dialogs;

type


  TObjetoUnicoDerivado = class(TObjetoUnico)
  private
    class var FObjetoUnico: TObjetoUnicoDerivado;
    class var  FContador: Integer;
    class function GetContador: integer; static;
    class function GetObjetoUnico: TObjetoUnicoDerivado;  static;
  public
    destructor Destroy; override;
    constructor Create; reintroduce;   

    class property ObjetoUnico: TObjetoUnicoDerivado  read GetObjetoUnico;
    class property Contador: integer read GetContador;
    function GetDataHora: string; override;

    property DataHora: string read GetDataHora;
  end;

 

procedure VerificaObjetoUnicoDerivadoCriado;

implementation



procedure VerificaObjetoUnicoDerivadoCriado;
begin
  if (TObjetoUnicoDerivado.FContador >= 1) and (TObjetoUnicoDerivado.FObjetoUnico <> nil) then
    ShowMessage('=========== verificação ===========' + #13#10 +
    'Nome da classe: ' + TObjetoUnicoDerivado.ObjetoUnico.ClassName+ #13#10 +
    'Hora de Criação pelo método: ' + TObjetoUnicoDerivado.ObjetoUnico.GetDataHora + #13#10 +
    'Hora de Criação pela propriedade: ' + TObjetoUnicoDerivado.ObjetoUnico.DataHora + #13#10 +
    'Endereço na memória: ' + IntToStr(Integer(TObjetoUnicoDerivado.ObjetoUnico))
  );
end;


{ TObjetoUnicoDerivado }


constructor TObjetoUnicoDerivado.Create;
begin
    if (FContador = 0) and (FObjetoUnico = nil) then
    begin
      InterlockedIncrement(FContador);
      DataHora := FormatDateTime('yyyy-mm-dd hh:nn:ss', now);
    end
    else
      raise Exception.Create('Ei! Não use esse constructor, use o CreateUnico!');
end;


destructor TObjetoUnicoDerivado.Destroy;
begin
  FObjetoUnico := nil;
  InterlockedDecrement(FContador);
end;

class function TObjetoUnicoDerivado.GetContador: integer;
begin
  Result := FContador;
end;



function TObjetoUnicoDerivado.GetDataHora: string;
begin
  Result := 'acréscimo ' + inherited;
end;


class function TObjetoUnicoDerivado.GetObjetoUnico: TObjetoUnicoDerivado;
begin
  if (FContador = 0) and (FObjetoUnico = nil) then
    FObjetoUnico := TObjetoUnicoDerivado.Create;
  Result := FObjetoUnico;
end;


initialization

finalization
  //aqui há um exemplo de como o objeto único pode ser destruido
  TObjetoUnicoDerivado.FObjetoUnico.Free;

end.


Os testes podem ser feitos da mesma maneira que o exemplo anterior:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, uSingleton, uSingletonDerivado;

type


  TfrmUmaInstancia = class(TForm)
    btUnico: TButton;
    btDerivado: TButton;
    btVerificaUnico: TButton;
    btVerificaDerivado: TButton;
    procedure btUnicoClick(Sender: TObject);
    procedure btDerivadoClick(Sender: TObject);
    procedure btVerificaUnicoClick(Sender: TObject);
    procedure btVerificaDerivadoClick(Sender: TObject);
  public
  end;



var
  frmUmaInstancia: TfrmUmaInstancia;

implementation



{$R *.dfm}



procedure TfrmUmaInstancia.btDerivadoClick(Sender: TObject);
var FObjetoUnico: TObjetoUnicoDerivado;
begin
  //veja que é possivel executar o create
  //Mas dessa forma não é garantido que o objeto seja unico
  //para garantir que seja único é imprescindível o uso do método  CreateUnico

  FObjetoUnico := TObjetoUnicoDerivado.ObjetoUnico;

  //mostrando a classe do objeto, hora de criação e endereço do objeto
  //veja que é sempre igual
  ShowMessage('Nome da classe: ' + FObjetoUnico.ClassName+ #13#10 +
    'Hora de Criação: ' + FObjetoUnico.DataHora + #13#10 +
    'Endereço na memória: ' + IntToStr(Integer(FObjetoUnico))
  );

end;

procedure TfrmUmaInstancia.btUnicoClick(Sender: TObject);
var FObjetoUnico: TObjetoUnico;
begin

  //veja que é possivel executar o create
  //Mas dessa forma não é garantido que o objeto seja unico
  //para garantir que seja único é imprescindível o uso do método  CreateUnico

  FObjetoUnico := TObjetoUnico.ObjetoUnico;

  //mostrando a classe do objeto, hora de criação e endereço do objeto
  //veja que é sempre igual
  ShowMessage('Nome da classe: ' + FObjetoUnico.ClassName+ #13#10 +
    'Hora de Criação: ' + FObjetoUnico.DataHora + #13#10 +
    'Endereço na memória: ' + IntToStr(Integer(FObjetoUnico))
  );

end;




procedure TfrmUmaInstancia.btVerificaDerivadoClick(Sender: TObject);
begin
  VerificaObjetoUnicoDerivadoCriado;
end;

procedure TfrmUmaInstancia.btVerificaUnicoClick(Sender: TObject);
begin
  VerificaObjetoUnicoCriado;
end;

end.


Da mesma forma que o primeiro exemplo, todos os métodos devem ser re-escritos, e praticamente substituidos sem menção ou referência a inherited. Um override completo.
O único método que pode ser aproveitar dos dois lados do polimorfismo (herdar um método, modificá-lo com override mas ainda assim aproveitar-se de parte do código do método ancestral) e agregar alguma coisa nova no código antigo é o GetDataHora, que é público e virtual.

Também é possível que GetDataHora seja privado, como geralmente um método acessor no Delphi deve ser, mas se crie um novo na classe derivada para servir de método acessor à nova propriedade DataHora. E a DataHora do objeto ancestral pode ser obtida com inherited.
Passamos o método GetDataHora para private tanto no TObjetoUnico como no TObjetoUnicoDerivado, e este método não será mais virtual ou dinâmico nem será mais sobrescrito.

TObjetoUnico = class
  private
    FDataHora: string;
    class var  FObjetoUnico: TObjetoUnico;
    class var  FContador: Integer;
    class function GetObjetoUnico: TObjetoUnico; static;
    class function GetContador: integer; static;
    function GetDataHora: string;

  public
    constructor Create;
    destructor Destroy; override;

    class property ObjetoUnico:  TObjetoUnico read GetObjetoUnico;
    class property Contador: integer read GetContador;
    property DataHora: string read GetDataHora write FDataHora;
  end;

{...}

  TObjetoUnicoDerivado = class(TObjetoUnico)
  private
    class var FObjetoUnico: TObjetoUnicoDerivado;
    class var  FContador: Integer;
    class function GetContador: integer; static;
    class function GetObjetoUnico: TObjetoUnicoDerivado;  static;
    function GetDataHora: string;
  public
    constructor Create; reintroduce;
    destructor Destroy; override;

    class property ObjetoUnico: TObjetoUnicoDerivado  read GetObjetoUnico;
    class property Contador: integer read GetContador;
    property DataHora: string read GetDataHora;

  end;

Mas o método GetDataHora do TObjetoUnicoDerivado é diferente. E ele consegue substituir o acessor da propriedade DataHora mesmo que esta propriedade não esteja declarada no TObjetoUnicoDerivado e não tenhamos um FDataHora. Fazemos isso por usar o inherited de DataHora, onde é possível obter o valor ancestral de DataHora.

function TObjetoUnicoDerivado.GetDataHora: string;
begin
Result := 'acréscimo ' + inherited DataHora;
end;

O ponto fraco dessa abordagem é que se você tiver um objeto TObjetoUnicoDerivado instanciado em uma variável TObjetoUnico, o GetDataHora que será executado é o do TObjetoUnico e não o do TObjetoUnicoDerivado. A única forma de se resolver isso é tornar GetDataHora público e virtual. Assim ele pode ser "sobrescrito" e mesmo uma variável TObjetoUnico pode referenciar o método GetDataHora correto caso este seja um TObjetoUnicoDerivado. Mas a única maneira de se fazer isso sem gerar um access violation caso o método ou propriedade referenciados ainda não estejam na memória ou ainda não tenham sido sobrescritos é retirar do singleton derivado a propriedade DataHora e sobrescrever o método GetDataHora. Somente assim a propriedade DataHora lerá o acessor GetDataHora mesmo em um TObjetoUnicoDerivado instanciado em uma variável do tipo TObjetoUnico.

Ou seja, o final da brincadeira ficará assim:

unit uSingleton;

interface

uses
  DateUtils, SysUtils, Windows, dialogs;

type



  TObjetoUnico = class
  private
    FDataHora: string;
    class var  FObjetoUnico: TObjetoUnico;
    class var  FContador: Integer;
    class function GetObjetoUnico: TObjetoUnico; static;
    class function GetContador: integer; static;


  public
    constructor Create;
    destructor Destroy; override;
    function GetDataHora: string; virtual;

    class property ObjetoUnico:  TObjetoUnico read GetObjetoUnico;
    class property Contador: integer read GetContador;
    property DataHora: string read GetDataHora write FDataHora;
  end;

procedure VerificaObjetoUnicoCriado;

implementation


procedure VerificaObjetoUnicoCriado;
begin
  //Uso do FObjetoUnico aqui porque se usasse ObjetoUnico o método acessor
  //GetObjetoUnico seria automaticamente executado, criando o objeto
  if (TObjetoUnico.FContador >= 1) and (TObjetoUnico.FObjetoUnico <> nil) then
    ShowMessage('=========== verificação ===========' + #13#10 +
    'Nome da classe: ' + TObjetoUnico.FObjetoUnico.ClassName+ #13#10 +
    'Hora de Criação pelo método: ' + TObjetoUnico.FObjetoUnico.GetDataHora + #13#10 +
    'Hora de Criação pela propriedade: ' + TObjetoUnico.FObjetoUnico.DataHora + #13#10 +
    'Endereço na memória: ' + IntToStr(Integer(TObjetoUnico.FObjetoUnico))
  );
end;


{ TObjetoUnico }

constructor TObjetoUnico.Create;
begin

    //essa verificação impede uma segunda chamada a create
    //se não verificar, ou se deixar crar para se disparar a excessão depois
    //da verificação corre-se o risco de ter criado mais um antes da excessão
    //e aí não será possível destruir, causando um leak
    if (FContador = 0) and (FObjetoUnico = nil) then
    begin
      inherited Create;  //aqui tudo bem usar o inherited create e destroy porque a classe base não faz nada de mais
      InterlockedIncrement(FContador);
      DataHora := FormatDateTime('yyyy-mm-dd hh:nn:ss', now);
    end
    else
      raise Exception.Create('Ei! Não use esse constructor, use o CreateUnico!');
    //o inherited fica dentro do if assim o objeto não será criado caso ja esteja o contador > 0

end;



destructor TObjetoUnico.Destroy;
begin

  FObjetoUnico := nil;
  InterlockedDecrement(FContador);
  inherited;

end;

class function TObjetoUnico.GetContador: integer;
begin
  Result := FContador;
end;

function TObjetoUnico.GetDataHora: string;
begin
  Result := FDataHora;
end;



//como a propriedade  ObjetoUnico executa esse get e esse get le o class var e
//o instancia caso seja nil a propriedade ObjetoUnico tem uma proteção
//natural contra nil e sempre será instanciada, nunca será igual a nil
class function TObjetoUnico.GetObjetoUnico: TObjetoUnico;
begin
  //aqui a mesma verificação é feita para não se executar o create duas vezes
  //mas devolver o objeto existente ou devolvê-lo assim que criado
  if (FContador = 0) and (FObjetoUnico = nil) then
    FObjetoUnico := TObjetoUnico.Create;
  Result := FObjetoUnico;
end;

initialization
  //a initilization não é necessária

finalization
  if (TObjetoUnico.FObjetoUnico <> nil) then
  try
    //leia o comentário abaixo para saber porque o campo privado FObjetoUnico
    //é usado aqui em vez da propriedade ObjetoUnico
    TObjetoUnico.FObjetoUnico.Free;
  except
    //tratamento de excessão
  end;

  //por causa da proteção "natural" contra nil você pode destruir
  //o singleton com
  //TObjetoUnico.ObjetoUnico.Free;
  //mas isso causa um overhead porque se o FObjetoUnico não estiver criado (nil)
  //ele será criado só para ser destruído.
  //É bonito de se ver, mas feio do ponto de vista do algoritmo

end.


unit uSingletonDerivado;

interface

uses
  uSingleton, SysUtils, DateUtils, Windows, dialogs;

type


  TObjetoUnicoDerivado = class(TObjetoUnico)
  private
    class var FObjetoUnico: TObjetoUnicoDerivado;
    class var  FContador: Integer;
    class function GetContador: integer; static;
    class function GetObjetoUnico: TObjetoUnicoDerivado;  static;
  public
    constructor Create; reintroduce;
    destructor Destroy; override;
    function GetDataHora: string; override;

    class property ObjetoUnico: TObjetoUnicoDerivado  read GetObjetoUnico;
    class property Contador: integer read GetContador;

  end;

procedure VerificaObjetoUnicoDerivadoCriado;

implementation



procedure VerificaObjetoUnicoDerivadoCriado;
begin
  if (TObjetoUnicoDerivado.FContador >= 1) and (TObjetoUnicoDerivado.FObjetoUnico <> nil) then
    ShowMessage('=========== verificação ===========' + #13#10 +
    'Nome da classe: ' + TObjetoUnicoDerivado.FObjetoUnico.ClassName+ #13#10 +
    'Hora de Criação pelo método: ' + TObjetoUnicoDerivado.FObjetoUnico.GetDataHora + #13#10 +
    'Hora de Criação pela propriedade: ' + TObjetoUnicoDerivado.FObjetoUnico.DataHora + #13#10 +
    'Endereço na memória: ' + IntToStr(Integer(TObjetoUnicoDerivado.FObjetoUnico))
  );
end;


{ TObjetoUnicoDerivado }


constructor TObjetoUnicoDerivado.Create;
begin
    if (FContador = 0) and (FObjetoUnico = nil) then
    begin
      InterlockedIncrement(FContador);
      DataHora := FormatDateTime('yyyy-mm-dd hh:nn:ss', now);
    end
    else
      raise Exception.Create('Ei! Não use esse constructor, use o CreateUnico!');
end;


destructor TObjetoUnicoDerivado.Destroy;
begin
  FObjetoUnico := nil;
  InterlockedDecrement(FContador);
end;

class function TObjetoUnicoDerivado.GetContador: integer;
begin
  Result := FContador;
end;



function TObjetoUnicoDerivado.GetDataHora: string;
begin
  Result := 'acréscimo ' + inherited GetDataHora;
end;


class function TObjetoUnicoDerivado.GetObjetoUnico: TObjetoUnicoDerivado;
begin
  if (FContador = 0) and (FObjetoUnico = nil) then
    FObjetoUnico := TObjetoUnicoDerivado.Create;
  Result := FObjetoUnico;
end;


initialization

finalization
  //aqui há um exemplo de como o objeto único pode ser destruido
  TObjetoUnicoDerivado.FObjetoUnico.Free;

end.

A maior lição aprendida aqui é que se desejamos sobrescrever os métodos acessores, para poder usufruir de todos os recursos da herança e do polimorfismo e poder agregar código ao método da classe base ainda usando parte do código da classe base devemos fazer como no Java e em outras linguagens Orientadas a Objetos e criar métodos acessores públicos e virtuais.

Além disso, isso é extremamente necessário, indispensável, para se criar interfaces com propriedades. Em interfaces as propriedades só podem ler e escrever métodos, e nunca campos privados, mas os métodos de uma interface, mesmo que acessores, PRECISAM SER PÚBLICOS E VIRTUAIS para que possam ser implementados.

Essa última alteração pode ser testada com mais um botão que cria uma instância de TObjetoUnicoDerivado dentro de uma variável ancestral, do tipo TObjetoUnico.

procedure TfrmUmaInstancia.brCriaDerivadoEmAncestralClick(Sender: TObject);
var FObjetoUnico: TObjetoUnico;
begin


  FObjetoUnico := TObjetoUnicoDerivado.ObjetoUnico;

  ShowMessage('Nome da classe: ' + FObjetoUnico.ClassName+ #13#10 +
    'Hora de Criação: ' + FObjetoUnico.DataHora + #13#10 +
    'Endereço na memória: ' + IntToStr(Integer(FObjetoUnico))
  );

end;

Quem quiser conferir esse exemplo é só baixá-lo aqui: http://www.vitorrubio.com.br/downloads/Exemplo_Singleton_2.7z

Have fun ;)

Links úteis, leia todos ;)



Existem 1001 maneiras de preparar SINGLETON, invente uma! - Parte 1

http://blog.vitorrubio.com.br/2010/11/existem-1001-maneiras-de-preparar.html

Existem 1001 maneiras de preparar SINGLETON, invente uma! - Parte 2

http://blog.vitorrubio.com.br/2011/01/existem-1001-maneiras-de-preparar.html

Existem 1001 maneiras de preparar SINGLETON, invente uma! - Parte 3

http://blog.vitorrubio.com.br/2011/02/existem-1001-maneiras-de-preparar.html

Existem 1001 maneiras de preparar SINGLETON, invente uma! - Parte 4
http://blog.vitorrubio.com.br/2011/02/existem-1001-maneiras-de-preparar_08.html

Criando uma classe singleton verdadeira em delphi

http://www.comofazertudo.com.br/computadores-e-internet/criando-uma-classe-singleton-verdadeira-em-delphi

Creating a real singleton class in Delphi 5

http://edn.embarcadero.com/article/22576

Introdução: Singleton - Design Pattern Delphi - Parte 1

http://www.devmedia.com.br/post-17889-Introducao--Singleton-Design-Pattern-Delphi-Parte-1.html

Tentativa de Singleton usando Delphi

http://www.marcosdellantonio.net/2006/12/01/tentativa-de-singleton-usando-delphi/

Implementing the Singleton pattern in delphi

http://www.delphi3000.com/articles/article_1736.asp?SK=

Essa é uma abordagem nova que eu nunca imaginei:

http://stackoverflow.com/questions/1409593/creating-a-singleton-in-delphi-using-the-new-features-of-d2009-and-d2010

Class (, Static, or Shared) Constructors (and Destructors)

http://blogs.embarcadero.com/abauer/2009/09/03/38898

Design Patterns in Delphi

http://delphi.about.com/od/oopindelphi/a/aa010201a.htm

No forum antigo:

Tópico no forum devmedia sobre singleton

no forum novo:

http://www.devmedia.com.br/forum/viewtopic.asp?id=374670

Nenhum comentário:

Postar um comentário

Postagens populares

Marcadores

delphi (60) C# (31) poo (21) Lazarus (19) Site aos Pedaços (15) sql (13) Reflexões (10) .Net (9) Humor (9) javascript (9) ASp.Net (8) api (8) Básico (6) Programação (6) ms sql server (5) Web (4) banco de dados (4) HTML (3) PHP (3) Python (3) design patterns (3) jQuery (3) livros (3) metaprogramação (3) Ajax (2) Debug (2) Dicas Básicas Windows (2) Pascal (2) games (2) linguagem (2) música (2) singleton (2) tecnologia (2) Anime (1) Api do Windows (1) Assembly (1) Eventos (1) Experts (1) GNU (1) Inglês (1) JSON (1) SO (1) datas (1) developers (1) dicas (1) easter egg (1) firebird (1) interfaces (1) introspecção (1) memo (1) oracle (1) reflexão (1)