Existem 1001 maneiras de preparar SINGLETON - parte 4

Se você ler o livro Padrões de Projeto  verá que há uma crítica quanto ao uso indiscriminado de Herança. Na verdade o livro mostra que existem outras maneiras de se incorporar ou agregar várias funcionalidades e depois conseguir incorporar ainda outras sem  o uso de herança.

Lendo este livro você verá que há uma discrepância grande entre a Análise Orientada a Objeto (AOO) e a Programação Orientada a Objeto (POO).

Enquanto a AOO defende que não pode existir em código nenhum objeto que não seja representante ou modelo de um objeto do "mundo real" a POO, por restrições e questões técnicas, apresenta as figuras das classes de persistência (inexistentes no mundo real) dos DTO (data transfer objects, também inexistentes) dentre outros modelos e padrões. Além disso, em POO você pode ver coisas como sobrecarga de operadores, caso em que a AOO nem sequer cita.

Enquanto o livro Padrões de Projeto foca na POO, ignorando algumas premissas da AOO, ele também põe a herança em seu devido lugar: NEM TODA ESPECIALIZAÇÃO OU INCREMENTO SE RESOLVE COM HERANÇA.

Particularmente no caso de singletons, a herança é desnecessária, visto que o singleton, geralmente, é um objeto cheio de métodos estáticos que nada mais fazem do que prestar serviços. Sim, o singleton sequer faria parte da AOO porque ele é um objeto artificial, existente apenas no domínio da POO por razões técnicas, seja a leitura/escrita de arquivos de configuração seja a criação de objetos de conexão com bancos de dados.

Isto posto, não é necessário se criar heranças de singletons, até porque elas não vão funcionar corretamente e reimplementar todos os métodos de um singleton anula o propósito da Herança. Se precisar de um outro singleton muito parecido você pode:

1. Simplesmente criar outro copiando a maior parte do código e lógica de funcionamento (não é recomendável fazer isso se forem vários, se você quer fazer um código limpo com duplicação zero ou se deseja apenas atualizar um código para corrigir todos os singletons dependentes dele)
2. Se for o caso de manter a manutenção em um único ponto (recomendado) crie classes privadas, em pacotes, invisíveis aos programadores consumidores da sua biblioteca, que isolem todo o mecanismo e regras de funcionamento do singleton e implemente-o em forma de façade (fachada). 

No exemplo 5 veremos como fazer singletons flexíveis, reutilizáveis e intercambiáveis mesclando o padrão singleton com o padrão façade.

Wazlawick, em seu livro , menciona que a aplicação, ou o objeto aplicação, que é o programa em si, sua "casca" mais externa que vai criar os outros objetos e interfaces deveria ser um singleton, e de fato o é. Mesmo que se executem várias instâncias da aplicação, no ambiente de uma única instância a aplicação em si é um singleton, e qualquer entidade ou artefato que prestasse algum serviço para a aplicação também deveria ser um singleton.

Como o singleton não faz parte das regras de negócio e da AOO aqui abordaremos ele do ponto de vista da POO e faremos uma tentativa de herança do mesmo, para demonstrar as confusões que podem ocorrer.

Neste 4° exemplo, analogamente ao exemplo 2, usamos o recurso de class vars (variáveis estáticas de classe, privadas) e acessores estáticos para criar class properties, coisa que só é possível nas modernas versões do Delphi, por isso perderemos a compatibilidade com o Lazarus.

Primeiro a classe singleton

unit uSingleton;

interface

uses Dialogs, Classes;

type


  TMySingleton = class(TObject)
  private
    class var _MySingletonInstance: TObject;
    class var _PreparadoParaLiberar: Boolean;

    FHello: TstringList;
    FDateTime: string;

  protected
    //se executar isso o objeto pode ser destruido
    class procedure PrepararParaLiberar; virtual;

    class function GetInstance: TMySingleton; static;

    //para criar ou destruir os componentes do objeto
    procedure InicializarObjeto; virtual;
    procedure FinalizarObjeto; virtual;
  public
    procedure SetHello(vHello: string);
    procedure SayHello; virtual;
    constructor Create;  virtual;
    //esses caras misticos abaixo que realmente criam, alocam memoria, destroem e desalocam memoria por tráz dos constructor e destructor que conhecemos
    class function NewInstance: TObject; override;
    procedure FreeInstance; override;
    destructor Destroy; override;
    class property Instance: TMySingleton  read GetInstance;
  end;

implementation

uses SysUtils;




{ TMySingleton }


procedure TMySingleton.SayHello;
begin
  //um metodo bobo pra testar
  ShowMessage('Classe: ' + Self.ClassName + #13#10 +
    'Mensagem: ' + FHello.Text + #13#10 +
    'Data: ' + FDateTime + #13#10 +
    'Instância: ' + inttostr(integer(self)));
end;

procedure TMySingleton.SetHello(vHello: string);
begin
  //um outro metodo bobo pra setar a mensagem
  FHello.Text := vHello;
end;




constructor TMySingleton.Create;
begin
  //antes de tudo, antes mesmo do inherited, newinstance já é chamado por padrão
  inherited; //faz o que for preciso de seu ancestral, eu tenho certeza aqui que o NewInstance está sendo executado
  InicializarObjeto; //inicializo o que precisa
end;

destructor TMySingleton.Destroy;
begin
  FinalizarObjeto;  //destruo as partes ou objetos criados pela minha classe, como stringlists
  inherited;    //a destruição normal do objeto, depois disso freeinstance é chamado normalmente
end;



class function TMySingleton.GetInstance: TMySingleton;
begin

  //isso é apenas um atalho em uma class function

  if _MySingletonInstance = nil then
    _MySingletonInstance := TMySingleton.Create;

  Result := _MySingletonInstance as TMySingleton;

end;





procedure TMySingleton.FreeInstance;
begin

  //no destructor não vai acontecer nada se _PreparadoParaLiberar for false, e eu não preciso disparar uma excessão

  //  agora se _PreparadoParaLiberar for true
  //eu faço o que um FreeInstance sempre deveria fazer, uso o inherited,
  if _PreparadoParaLiberar then
  begin
    inherited;
    //bloqueio a liberação  novamente
    _PreparadoParaLiberar := False;
    //atribuo nil
    _MySingletonInstance := nil;
  end;

  //agora se precisar pode criar de novo

end;

class function TMySingleton.NewInstance: TObject;
begin

  if (_MySingletonInstance = nil)  then
  begin
    //_MySingletonInstance := inherited NewInstance as TMySingleton;
    //_MySingletonInstance.FDateTime := FormatDateTime('yyyy-mm-dd hh:nn:ss', now);
    _MySingletonInstance := inherited NewInstance;
    (_MySingletonInstance as TMySingleton).FDateTime := FormatDateTime('yyyy-mm-dd hh:nn:ss', now);
  end;

  Result := _MySingletonInstance;

end;

class procedure TMySingleton.PrepararParaLiberar;
begin
  //esse método só faz isso
  _PreparadoParaLiberar := True;
end;

procedure TMySingleton.FinalizarObjeto;
begin
  //aqui você poe somente as coisas que devem acontecer da destruição verdadeira do objeto
  if _PreparadoParaLiberar then
  begin
    FHello.Free;
  end;
end;

procedure TMySingleton.InicializarObjeto;
begin
  //aqui você poe tudo o que precisa que aconteça depois do create
  //lembrando que se o NewInstance já retornar o objeto criado, então
  //Self.FHello vai ser o Fhello dessa instancia, e vai ser <> de nil
  if (FHello = nil) then
  begin
    FHello := TStringList.Create;
  end;
end;



initialization
  //inicializo minhas variáveis publicas, porque vou mecher nelas posteriormente
  TMySingleton._MySingletonInstance := nil;
  TMySingleton._PreparadoParaLiberar := False;



finalization
  if (TMySingleton._MySingletonInstance <> nil) then
  try
    TMySingleton.PrepararParaLiberar;
    TMySingleton._MySingletonInstance.Free;
  except
    //tratamento de exceção, se precisar
  end;


end.

Depois o singleton derivado. Observe que é inútil criar overrides para métodos que fazem apenas "inherited".

unit uSingletonDerivado;

interface

uses uSingleton, Dialogs, Classes;

  type
    TMySingletonDerivado = class(TMySingleton)
  private
    class var _MySingletonDerivadoInstance: TObject;
    class var _PreparadoParaLiberarDerivado: Boolean;
  protected
    class procedure PrepararParaLiberar;  override;
    class function GetInstance: TMySingleton; reintroduce; static;  //não usamos TMySingletonDerivado para não dar invalid typecast caso já exista um singleton base criado

//****************************************************************************
//* métodos que fazem basicamente inherited não precisam ser sobrecarregados *
//****************************************************************************
    //procedure InicializarObjeto; override;
    //procedure FinalizarObjeto;   override;
  public

//****************************************************************************
//* métodos que fazem basicamente inherited não precisam ser sobrecarregados *
//****************************************************************************
    //constructor Create;  override;
    //destructor Destroy; override;

    class function NewInstance: TObject; override;
    procedure FreeInstance; override;

     class property Instance: TMySingleton read GetInstance;
    end;

implementation




{ TMySingletonDerivado }

//****************************************************************************
//* métodos que fazem basicamente inherited não precisam ser sobrecarregados *
//****************************************************************************

{
constructor TMySingletonDerivado.Create;
begin
  inherited;
  InicializarObjeto;
end;

destructor TMySingletonDerivado.Destroy;
begin
  FinalizarObjeto;
  inherited;
end;

procedure TMySingletonDerivado.FinalizarObjeto;
begin
  inherited;
end;

procedure TMySingletonDerivado.InicializarObjeto;
begin
  inherited;
end;
}


{ TMySingletonDerivado }

procedure TMySingletonDerivado.FreeInstance;
begin
  if _PreparadoParaLiberarDerivado then
  begin
    _PreparadoParaLiberarDerivado := False;
    _MySingletonDerivadoInstance := nil;
    inherited;
  end;
end;

class function TMySingletonDerivado.GetInstance: TMySingleton;
begin
  //não usamos TMySingletonDerivado para não dar invalid typecast caso já exista um singleton base criado
  if _MySingletonDerivadoInstance = nil then
    _MySingletonDerivadoInstance := TMySingletonDerivado.Create;

  Result := _MySingletonDerivadoInstance as TMySingleton;
end;

class function TMySingletonDerivado.NewInstance: TObject;
begin
  if (_MySingletonDerivadoInstance = nil) then
  begin
    //_MySingletonDerivadoInstance := inherited NewInstance as TMySingletonDerivado;
    _MySingletonDerivadoInstance := inherited NewInstance;
  end;

  Result := _MySingletonDerivadoInstance;
end;

class procedure TMySingletonDerivado.PrepararParaLiberar;
begin
  _PreparadoParaLiberarDerivado := True;
  inherited;
end;

initialization
  TMySingletonDerivado._MySingletonDerivadoInstance := nil;
  TMySingletonDerivado._PreparadoParaLiberarDerivado := False;



finalization
  if (TMySingletonDerivado._MySingletonDerivadoInstance <> nil) then
  try
    TMySingletonDerivado.PrepararParaLiberar;
    TMySingletonDerivado._MySingletonDerivadoInstance.Free;
  except
    //tratamento de exceção, se precisar
  end;



end.

O programa de teste é o mesmo que fizemos no exemplo 3

Download do código: http://www.vitorrubio.com.br/downloads/Exemplo_Singleton_4.7z

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