Relacionamentos – Que tal um ORM Básico? Parte 18

Eis que estou de volta! E agora vai ser bem complicado arrumar uma desculpa pela demora… portanto, me perdoem. É o que me resta a fazer.

No recesso do Carnaval, após um tempo sem olhar o blog, aproveitei para dar uma atualizada em seus plugins. Ao acessar a área de administração, me deparei com vários pedidos relacionados à nossa série de ORM. Mais especificamente sobre a questão: Relacionamentos.

Até hoje eu particularmente não senti falta deste recurso, visto que a princípio meu maior desejo era acabar com o uso – interminável! – dos métodos e parâmetros das querys (ParamByName, FieldByName, AsInteger, AsString, AsDateTime…). Além disso, queria abstrair o máximo possível o processo de CRUD no meu sistema, evitando assim ficar dependente de componentes de conexão como o IBX, UIB, FireDac, etc.

Creio que para os objetivos citados, o nosso projeto já cumpre muito bem o seu papel, de forma simples e leve. Mas como vocês têm me pedido, vou iniciar o trato do relacionamento.

Será interessante acessar os fontes do projeto para ir acompanhando, visto que apenas colocarei trechos dos códigos e não a unit completa. Além disso, neste post me aterei, no que se refere a suíte de componentes, a unit que trata do FireDac, ou seja, Lca.Orm.FireDac. Cabendo a você repassar para a sua suíte o que for demonstrado aqui.

Fontes atualizados estão em: https://github.com/luizsistemas/ORM-Basico-Delphi

Relacionamento 1:N e Tabelas Exemplo

Não é o foco abordar neste post a normalização de tabelas e cardinalidade. O objetivo será única e exclusivamente definir que tipo de relacionamento iremos trabalhar.

Afim de dar um insight, um direcionamento a quem pretende aventurar-se por estas águas, eu vou mostrar uma alternativa de como implementar o processamento do relacionamento cuja a cardinalidade seja 1:N.

Para os nossos testes, utilizaremos o exemplo de um funcionário, que se encontra em uma cidade e está lotado em um departamento. O funcionário está no lado N (vários), visto que UM departamento pode ter 0, 1 ou VÁRIOS funcionários (vá entender o porquê de um departamento não ter ninguém, mas…). Da mesma forma, UMA cidade por ter 0, 1 ou VÁRIOS funcionários.

No Github do nosso projeto, na pasta teste/bd, contém o script de criação destas tabelas, ou seja, tabela FUNCIONARIO e DEPTO (a tabela Cidade já havia sido criada no início da série) e seus relacionamentos.

Refatorar é preciso

Teremos de fazer alguns ajustes para, aí sim, partir para a nova implementação.

As razões para isso se deve ao fato que antes, somente um comando era executado por vez por requisição. Por isso temos um objeto chamado FQuery em TDaoFireDac, que é global da classe, para execução de comandos SQL (inserts, updates e deletes).

Porém, este cenário deverá ser alterado, visto que poderão ocorrer várias chamadas a este objeto numa mesma requisição. Por exemplo, ao alterar funcionário, poderemos também inserir ou alterar um departamento. O mesmo vale para cidade. Sendo o FQuery global, inevitavelmente haverão conflitos, visto que um mesmo objeto estará recebendo várias instruções SQL concomitantemente numa mesma requisição.

Portanto, devemos mudar a forma inicial pensada para o FQuery. Este não mais poderá ser uma variável global. E fazendo uma análise bem rápida, percebemos também que nós temos métodos que constroem querys, ou seja, os métodos GetID, GetMax e GetRecordCount, cujos objetos deveriam ser destruídos dentro do escopo do método, e não é isso que acontece atualmente. Eles continuam em memória até a finalização da aplicação por conta do parâmetro, “Application”, passado na criação de cada objeto query.

Ajustes finos

Devemos primeiro, renomear a interface IDaoBase para IDaoBaseComandos, em Lca.Orm.Base. E a classe TQueryFireDac, para TParamsFireDac.

Além disso, dando uma passada pelas units que compõem o projeto, iremos retirar comentários desnecessários do código e corrigir o nome de algumas variáveis e métodos (CamelCase e padronização). Ajustes finos que melhoram o entendimento e leitura do código. Acompanhe pelo fontes para visualizar todas as pequenas e importantes alterações efetuadas.

Nova Interface e nova Classe: IQuery e TQueryFD

Vamos criar em Lca.Orm.Base a interface IQuery:

  IQuery = interface
    ['{52E7E2A0-C3E7-41FC-86B1-50A50220C474}']
    function Sql: TStrings;
    function Dataset: TDataset;
    function RowsAffected: Integer;
    function RecordCount: Integer;
    procedure Executar;
    procedure Abrir;
  end;

Essa interface terá a responsabilidade de resolver o problema de múltiplas requisições SQL gerarem conflitos, além de evitar que os objetos criados nos métodos que constroem querys (GetId, GetMax, GetRecordCount, ConsultaSql, ConsultaAll, etc.) ficassem em memória até o fechamento da aplicação.

Partiremos para a implementação da classe concreta TQueryFD, Lca.Orm.Comp.FireDac:

...  
TQueryFD = class(TInterfacedObject, IQuery)
  private
    FQuery: TFDQuery;
    FSql: TStrings;
    function RecordCount: Integer;
    procedure Abrir;
  public
    constructor Create(Conexao: TFDConnection; Transacao: TFDTransaction);
    destructor Destroy; override;
    function Sql: TStrings;
    function Dataset: TDataset;
    function RowsAffected: Integer;
    procedure Executar;
  end;
...
implementation

...
{ TQueryFireDac }

constructor TQueryFD.Create(Conexao: TFDConnection; Transacao: TFDTransaction);
begin
  FQuery := TFDQuery.Create(nil);
  FQuery.Connection := Conexao;
  FQuery.Transaction := Transacao;
  FSql := FQuery.SQL;
end;

destructor TQueryFD.Destroy;
begin
  FQuery.Free;
  inherited;
end;

procedure TQueryFD.Executar;
begin
  FQuery.Prepare;
  FQuery.ExecSQL;
end;

procedure TQueryFD.Abrir;
begin
  FQuery.Open;
end;

function TQueryFD.Dataset: TDataset;
begin
  Result := FQuery;
end;

function TQueryFD.RowsAffected: Integer;
begin
  Result := FQuery.RowsAffected;
end;

function TQueryFD.RecordCount: Integer;
begin
  Result := FQuery.RecordCount;
end;

function TQueryFD.Sql: TStrings;
begin
  Result := FSql;
end;

Template Method

Devemos reorganizar TDaoFireDac. A ideia aqui é criar uma classe base chamada TDaoBase. Esta nova classe conterá tudo o que não é específico de uma suíte de componente de acesso a dados. Ou seja, será uma classe abstrata contendo alguns métodos implementados. Um design pattern que se encaixa nesta definição é o Template Method. TDaoBase será o nosso template, e as classes filhas ( TDaoFireDac e TDaoIbx, etc. ) passarão herdar dela.

Abra Lca.Orm.Base, e declare essa nova classe:

...
IDaoBaseComandos = interface  //antigo IDaoBase
    ['{6E2AFB66-465B-4924-9221-88E283E81EA7}']
    function GerarClasse(ATabela, ANomeUnit: string; ANomeClasse: string = ''): string;
    function GetID(ATabela:TTabela; ACampo: string): Integer; overload;
    function GetID(Generator: string): Integer; overload;
    function Inserir(ATabela: TTabela): Integer; overload;
    function Inserir(ATabela: TTabela; ACampos: array of string;
... 
 TDaoBase = class(TInterfacedObject)
  private
  protected
    FSql: IBaseSql;
    FDataSet: TDataSet;
    FParams: IQueryParams;
    procedure SetDataSet(const Value: TDataSet);
    procedure BuscarRelacionamento(ATabela: TTabela; APropRtti: TRttiProperty;
      Relacionamento: TCustomAttribute; AQuery: TDataSet); virtual; abstract;
    procedure AtualizarRelacionamento(ATabela: TTabela; APropRtti: TRttiProperty;
      Relacionamento: TCustomAttribute; AQuery: TDataSet); virtual; abstract;
    procedure SetarDadosFromDataSet(ADataset: TDataset; PropRtti: TRttiProperty; Objeto: TValue; Campo: string);
  public
    constructor Create;
    property DataSet: TDataSet read FDataSet write SetDataSet;
  end;

Note que TDaoBase descende de TInterfacedObject. O motivo você entenderá quando da declaração da classe filha TDaoFiredac. Essa classe possui dois métodos abstratos, AtualizarRelacionamento e BuscarRelacionamento. Sendo abstrados, não são implementados diretamente nela, mas sim nas classes filhas. Segue implementação dos demais métodos de TDaoBase:

...

{ TDaoBase }

constructor TDaoBase.Create;
begin
  FSql := TPadraoSql.Create;
end;

procedure TDaoBase.SetarDadosFromDataSet(ADataset: TDataset; PropRtti: TRttiProperty; Objeto: TValue; Campo: string);
var
  DataType: TFieldType;
begin
  DataType := ADataSet.FieldByName(Campo).DataType;
  case DataType of
    ftInteger:
      begin
        PropRtti.SetValue(Objeto.AsObject,
          TValue.FromVariant(ADataSet.FieldByName(Campo).AsInteger));
      end;
    ftString, ftWideString, ftWideMemo:
      begin
        PropRtti.SetValue(Objeto.AsObject,
          TValue.FromVariant(ADataSet.FieldByName(Campo).AsString));
      end;
    ftBCD, ftFMTBcd, ftFloat:
      begin
        PropRtti.SetValue(Objeto.AsObject,
          TValue.FromVariant(ADataSet.FieldByName(Campo).AsFloat));
      end;
    ftCurrency:
      begin
        PropRtti.SetValue(Objeto.AsObject,
          TValue.FromVariant(ADataSet.FieldByName(Campo).AsCurrency));
      end;
    ftDate, ftDateTime:
      begin
        PropRtti.SetValue(Objeto.AsObject,
          TValue.FromVariant(ADataSet.FieldByName(Campo).AsDateTime));
      end;
  else
    raise Exception.Create('Tipo de campo não conhecido: ' + PropRtti.PropertyType.ToString);
  end;
end;

procedure TDaoBase.SetDataSet(const Value: TDataSet);
begin
  FDataSet := Value;
end;

Em resumo movemos os objetos FSql e FDataSet da classe filha para a nova classe. Temos o método chamado SetarDadosFromDataSet, e como o próprio nome já diz, grava os dados vindos de um dataset e não de properties. Perceba que neste método os Datatypes são diferentes, pois vêm do TDataSet. Eis o motivo de precisarmos deste método.

Se observar atentamente, o mesmo poderia ter sido feito com a IQuery e TQueryFD. Porém, no atual estágio, nenhum dado poderia ser movido para a classe template. Então, no momento, não vejo vantagem de tal abordagem. Quem sabe futuramente.

Na declaração de TDaoFireDac, devemos fazer uma alteração, pois esta passará a implementar tanto TDaoBase quando IDaoBaseComandos. Agora você já sabe o motivo de TDaoBase herdar de TInterfacedObject. Segue código:

unit Lca.Orm.Comp.FireDac;

interface
...

 TDaoFireDac = class(TDaoBase, IDaoBaseComandos)
  private
    FConexao: TFDConnection;
    FTransacao: TFDTransaction;
  protected

...

Finalmente, implementando o relacionamento

Ajustes feitos, vamos ao que realmente é objeto de interesse deste post.

O primeiro passo será criar um atributo que guarde os dados do relacionamento: chave estrangeira (FK), tabela relacionada, chave primária (Pk) da tabela relacionada e o tipo de dado.

Vá em Lca.Orm.Atributos, e insira o atributo chamado AttFk:

unit Lca.Orm.Atributos;

interface

uses
  Lca.Orm.Base, Rtti, System.Classes, Data.DB;
...
AttFk = class(TCustomAttribute)
  private
    FCampoFk,
    FTabela,
    FPk: string;
    FTipo: TTypeKind;
  public
    constructor Create(CampoFk, Tabela, Pk: string; Tipo: TTypeKind = tkInteger);
    property CampoFk: string read FCampoFk;
    property Tabela: string read FTabela;
    property Pk: string read FPk;
  end;
...

Na implementação do constructor, apenas setamos os parâmetros recebidos nos fields correspondentes:

...
constructor AttFk.Create(CampoFk, Tabela, Pk: string; Tipo: TTypeKind);
begin
  FCampoFk := CampoFk;
  FTabela := Tabela;
  FPk := Pk;
  FTipo := Tipo;
end;
...

Sem segredo até aqui. Apesar de simples, isso nos dará tudo o que é preciso para atingirmos nosso objetivo.

O próximo passo será ir nos métodos Inserir, Salvar, Buscar e ConsultaGen, e inserir o código responsável por processar o relacionamento. Iniciemos pelo método Inserir:

function TDaoFireDac.Inserir(ATabela: TTabela; ACampos: array of string; AFlag: TFlagCampos): Integer;
var
  PropRtti: TRttiProperty;
  RttiType: TRttiType;
  AtribFk: AttFk;
  NomeTabela: string;
  Comando: IQuery;
begin
  try
    TAtributos.Get.ValidaTabela(ATabela, ACampos, AFlag);
    RttiType := TRttiContext.Create.GetType(ATabela.ClassType);
    NomeTabela := TAtributos.Get.PegaNomeTab(ATabela);
    Comando := TQueryFD.Create(FConexao, FTransacao);
    Comando.Sql.Text := FSql.GerarSqlInsert(NomeTabela, RttiType, ACampos, AFlag);
    for PropRtti in RttiType.GetProperties do
    begin
      if (Length(ACampos) > 0) then
      begin
        if not (TAtributos.Get.LocalizaCampo(PropRtti.Name, TAtributos.Get.PegaPks(ATabela))) then
        begin
          if ((AFlag = fcIgnore) and (TAtributos.Get.LocalizaCampo(PropRtti.Name, ACampos))) or
             ((AFlag = fcAdd) and (not TAtributos.Get.LocalizaCampo(PropRtti.Name, ACampos))) then
            Continue;
        end;
      end;
      AtribFk := TAtributos.Get.GetAtribFk(PropRtti);
      if Assigned(AtribFk) then
        AtualizarRelacionamento(ATabela, PropRtti, AtribFk, Comando.Dataset)
      else
        TAtributos.Get.ConfiguraParametro(PropRtti, PropRtti.Name, ATabela, Comando.Dataset, FParams);
    end;
    Comando.Executar;
    Result := Comando.RowsAffected;
  except
    raise;
  end;
end;

No código:

• Criamos um objeto do tipo do atributo AttFk se no loop atual existe um atributo do tipo de relacionamento (26);
• Se sim, executamos o método AtualizarRelacionamento (28). Este método foi definido na classe base como abstrato e ainda não foi implementado em TDaoFireDac;
• Se não, processamos normalmente a property, como era feito antes (30);

Como mencionado acima, o método AtualizarRelacionamento ainda não consta em TDaoFireDac. Portanto, vamos resolver esta pendência. Vá na seção protected da classe e insira:

...
TDaoFireDac = class(TDaoBase, IDaoBaseComandos)
  private
    FConexao: TFDConnection;
    FTransacao: TFDTransaction;
  protected
    procedure AtualizarRelacionamento(ATabela: TTabela; APropRtti: TRttiProperty;
      Relacionamento: TCustomAttribute; AQuery: TDataSet); override;
...

Na implementação de AtualizarRelacionamento, temos:

...
procedure TDaoFireDac.AtualizarRelacionamento(ATabela: TTabela; APropRtti: TRttiProperty;
  Relacionamento: TCustomAttribute; AQuery: TDataSet);
var
  Objeto: TTabela;
  RttiType: TRttiType;
  Prop: TRttiProperty;
begin
  if (APropRtti.GetValue(ATabela).AsObject is TTabela) then
  begin
    Objeto := (APropRtti.GetValue(ATabela).AsObject as TTabela);
    RttiType := TRttiContext.Create.GetType(Objeto.ClassType);
    for Prop in RttiType.GetProperties do
    begin
      if CompareText(Prop.Name, AttFK(Relacionamento).Pk) = 0 then
      begin
        TAtributos.Get.ConfiguraParametro(Prop, AttFK(Relacionamento).CampoFk, Objeto, AQuery, FParams);
        Break;
      end;
    end;
    if GetRecordCount(Objeto, [AttFk(Relacionamento).Pk]) = 0 then
      Inserir(Objeto)
    else
      Salvar(Objeto);
  end;
end;

Segue explicação:

• Verificamos se a propriedade é do tipo TTabela (9). Essa propriedade contém os dados da tabela relacionada;
• Se sim, setamos o conteúdo da propriedade na variável Objeto (11);
• Fazemos então um loop em suas propriedades em busca de sua chave primária (15);
• Se é chave primária, seta o valor da propriedade no Objeto (17);
• Finalizado o loop, de posse do valor (ou valores) da chave primária, definimos se insere ou se salva os dados na tabela relacionada (21).

Para o método Salvar, segue conforme foi feito no Inserir:

function TDaoFireDac.Salvar(ATabela: TTabela; ACampos: array of string; AFlag: TFlagCampos): Integer;
var
  PropRtti: TRttiProperty;
  RttiType: TRttiType;
  Comando: IQuery;
  AtribFk: AttFk;
begin
  try
    TAtributos.Get.ValidaTabela(ATabela, ACampos, AFlag);
    RttiType := TRttiContext.Create.GetType(ATabela.ClassType);
    Comando := TQueryFD.Create(FConexao, FTransacao);
    Comando.Sql.Text := FSql.GerarSqlUpdate(ATabela, RttiType, ACampos, AFlag);
    for PropRtti in RttiType.GetProperties do
    begin
      if (Length(ACampos) > 0) and not (TAtributos.Get.LocalizaCampo(PropRtti.Name, TAtributos.Get.PegaPks(ATabela))) then
      begin
        if ((AFlag = fcAdd) and (not TAtributos.Get.LocalizaCampo(PropRtti.Name, ACampos))) or ((AFlag = fcIgnore) and (TAtributos.Get.LocalizaCampo(PropRtti.Name, ACampos))) then
          Continue;
      end;
      AtribFk := TAtributos.Get.GetAtribFk(PropRtti);
      if Assigned(AtribFk) then
        AtualizarRelacionamento(ATabela, PropRtti, AtribFk, Comando.Dataset)
      else
        TAtributos.Get.ConfiguraParametro(PropRtti, PropRtti.Name, ATabela, Comando.Dataset, FParams);
    end;
    Comando.Executar;
    Result := Comando.RowsAffected;
  except
    raise;
  end;
end;

Nada de novo. Vamos para o método Buscar:

function TDaoFireDac.Buscar(ATabela: TTabela): Integer;
var
  Campo: string;
  PropRtti: TRttiProperty;
  RttiType: TRttiType;
  AtribFk: AttFk;
  Query: IQuery;
begin
  RttiType := TRttiContext.Create.GetType(ATabela.ClassType);
  Query := TQueryFD.Create(FConexao, nil);
  Query.Sql.Text := FSql.GerarSqlSelect(ATabela);
  for Campo in TAtributos.Get.PegaPks(ATabela) do
  begin
    for PropRtti in RttiType.GetProperties do
    begin
      if CompareText(PropRtti.Name, Campo) = 0 then
      begin
        TAtributos.Get.ConfiguraParametro(PropRtti, Campo, ATabela, Query.Dataset, FParams);
        Break;
      end;
    end;
  end;
  Query.Abrir;
  Result := Query.RecordCount;
  ATabela.Limpar;
  if Result > 0 then
  begin
    for PropRtti in RttiType.GetProperties do
    begin
      AtribFk := TAtributos.Get.GetAtribFk(PropRtti);
      if Assigned(AtribFk) then
        BuscarRelacionamento(ATabela, PropRtti, AtribFk, TFDQuery(Query.Dataset))
      else
        TAtributos.Get.SetarDadosTabela(PropRtti, PropRtti.Name, ATabela, Query.Dataset, FParams);
    end;
  end;
end;

A diferença é que neste método chamamos BuscarRelacionamento e não AtualizarRelacionamento. É preciso implementar este novo método em TDaoFireDac:

...
TDaoFireDac = class(TDaoBase, IDaoBaseComandos)
  private
    FConexao: TFDConnection;
    FTransacao: TFDTransaction;
  protected
    procedure AtualizarRelacionamento(ATabela: TTabela; APropRtti: TRttiProperty;
      Relacionamento: TCustomAttribute; AQuery: TDataSet); override;

    procedure BuscarRelacionamento(ATabela: TTabela; APropRtti: TRttiProperty;
      Relacionamento: TCustomAttribute; AQuery: TDataSet); override;
...

Implementação do método BuscarRelacionamento:

procedure TDaoFireDac.BuscarRelacionamento(ATabela: TTabela; APropRtti: TRttiProperty;
  Relacionamento: TCustomAttribute; AQuery: TDataSet);
var
  Contexto: TRttiContext;
  Objeto: TTabela;
  RttiType: TRttiType;
  Prop: TRttiProperty;
  KeyLocalized: Boolean;
begin
  KeyLocalized := False;
  if (APropRtti.GetValue(ATabela).AsObject is TTabela) then
  begin
    Contexto := TRttiContext.Create;
    try
      Objeto := (APropRtti.GetValue(ATabela).AsObject as TTabela);
      RttiType := Contexto.GetType(Objeto.ClassType);
      for Prop in RttiType.GetProperties do
      begin
        if CompareText(Prop.Name, AttFk(Relacionamento).Pk) = 0 then
        begin
          TAtributos.Get.SetarDadosTabela(Prop, AttFk(Relacionamento).CampoFk, Objeto, AQuery, FParams);
          KeyLocalized := True;
          Break;
        end;
      end;
      if KeyLocalized then
        Buscar(Objeto);
    finally
      Contexto.Free;
    end;
  end;
end;

Bem simples, não é mesmo? Assim como no AtualizarRelacionamento, setamos a chave primário no Objeto (21). Se foi localizado a chave primária, buscamos o Objeto (27).

Por fim, o método ConsultaGen. E este eu lhes digo que tem uma pegadinha. Vamos a ele:

function TDaoFireDac.ConsultaGen<T>(ATabela: TTabela; ACamposWhere: array of string): TObjectList<T>;
var
  Contexto: TRttiContext;
  Campo: string;
  TipoRtti: TRttiType;
  PropRtti: TRttiProperty;
  Query: IQuery;
  Objeto: TValue;
  AtribFk: AttFk;
begin
  Contexto := TRttiContext.Create;
  try
    Result := TObjectList<T>.Create;
    TipoRtti := Contexto.GetType(ATabela.ClassType);
    Query := TQueryFD.Create(FConexao, nil);
    Query.SQL.Text := FSql.GerarSqlSelect(ATabela, ACamposWhere);
    for Campo in ACamposWhere do
    begin
      if not TAtributos.Get.PropExiste(Campo, PropRtti, TipoRtti) then
        raise Exception.Create('Campo ' + Campo + ' não existe no objeto!');
      for PropRtti in TipoRtti.GetProperties do
      begin
        if CompareText(PropRtti.Name, Campo) = 0 then
        begin
          TAtributos.Get.ConfiguraParametro(PropRtti, Campo, ATabela, Query.Dataset, FParams);
          Break;
        end;
      end;
    end;
    Query.Abrir;
    while not Query.Dataset.Eof do
    begin
      Objeto := TObjectFactory<T>.Get.CriarInstancia;
      TipoRtti := Contexto.GetType(ATabela.ClassType);
      for PropRtti in TipoRtti.GetProperties do
      begin
        AtribFk := TAtributos.Get.GetAtribFk(PropRtti);
        if Assigned(AtribFk) then
          BuscarRelacionamento(Objeto.AsType<T>, PropRtti, AtribFk, Query.Dataset)
        else
          SetarDadosFromDataset(Query.Dataset, PropRtti, Objeto.AsType<T>, PropRtti.Name);
      end;
      Result.Add(Objeto.AsType<T>);
      Query.Dataset.Next;
    end;
  finally
    Contexto.Free;
  end;
end;

Note que em vez de:

Objeto := (APropRtti.GetValue(ATabela).AsObject as TTabela);

Temos:

Objeto := TObjectFactory<T>.Get.CriarInstancia;

Ou seja, tivemos de utilizar uma fábrica de objeto (que ainda será criada, diga-se de passagem) em detrimento da primeira opção. O motivo é simples, pois veja que no primeiro, instanciamos o objeto como sendo do tipo TTabela. Tudo certo se não fosse por um pequeno detalhe: o Objeto terá todo o comportamento previsto em uma classe TTabela, inclusive seu construtor. E é aí que inviabiliza esta forma de utilização. Pois, vejamos a entidade Funcionario, não mencionada até o momento, mas em tempo o faço abaixo:

unit Funcionario;

interface

uses
  Lca.Orm.Atributos, Lca.Orm.Base, Cidade, Depto;

type
  [AttTabela('FUNCIONARIO')]
  TFuncionario = class(TTabela)
  private
    FBairro: string;
    FSalario: Currency;
    FId: Integer;
    FDepto: TDepto;
    FNome: string;
    FCidade: TCidade;
    FEndereco: string;
    FCpf: string;
  public
    constructor Create;
    destructor Destroy; override;
    [AttPK]
    property Id: Integer read FId write FId;
    property Nome: string read FNome write FNome;
    property Cpf: string read FCpf write FCpf;
    property Endereco: string read FEndereco write FEndereco;
    property Bairro: string read FBairro write FBairro;
    [AttNotNull('Cidade')]
    [AttFk('IDCIDADE', 'CIDADE', 'ID')]
    property Cidade: TCidade read FCidade write FCidade;
    [AttNotNull('Departamento')]
    [AttFk('IDDEPTO', 'DEPTO', 'ID')]
    property Depto: TDepto read FDepto write FDepto;
    property Salario: Currency read FSalario write FSalario;
  end;

implementation

{ TFuncionario }

constructor TFuncionario.Create;
begin
  FCidade := TCidade.Create;
  FDepto := TDepto.Create;
end;

destructor TFuncionario.Destroy;
begin
  FCidade.Free;
  FDepto.Free;
  inherited;
end;

Para esta classe não utilizamos o construtor padrão de um TObject, e sim um modificado para a instanciação dos objetos das tabelas relacionadas.

Entende como isso muda tudo? Se utilizarmos o construtor de TTabela, não estaremos instanciando os objetos relacionados a TFuncionario, e ao tentar acessar os atributos Cidade e Departamento desta classe obteremos um Access Violation na fuça!

Portanto, é necessário criar a fábrica de objetos. Para isso, abra Lca.Orm.Base e declare a interface e classe:

...
  IObjectFactory<T:TTabela> = interface
    ['{50ACF26D-52D9-490A-B22D-F672B344AB94}']
    function CriarInstancia: T;
  end;

  TObjectFactory<T:TTabela> = class (TInterfacedObject, IObjectFactory<T>)
  public
    class function Get: IObjectFactory<T>;
    function CriarInstancia: T;
  end;
...

Segue implementação dos métodos:

...
{ TObjectFactory<T> }

function TObjectFactory<T>.CriarInstancia: T;
var
  AValue: TValue;
  Contexto: TRttiContext;
  TipoRtti: TRttiType;
  MetodoCriar: TRttiMethod;
  TipoInstancia: TRttiInstanceType;
begin
  Contexto := TRttiContext.Create;
  try
    TipoRtti := Contexto.GetType(TypeInfo(T));
    MetodoCriar := TipoRtti.GetMethod('Create');
    if Assigned(MetodoCriar) and TipoRtti.IsInstance then
    begin
      TipoInstancia := TipoRtti.AsInstance;
      AValue := MetodoCriar.Invoke(TipoInstancia.MetaclassType, []);
      Result := AValue.AsType<T>;
    end;
  finally
    Contexto.Free;
  end;
end;

class function TObjectFactory<T>.Get: IObjectFactory<T>;
begin
  Result := TObjectFactory<T>.Create;
end;
...

O método CriarInstancia basicamente localiza o método Create do tipo T (genérico) e o invoca (executa). O resultado é retornado na Linha 20. Assim, garantimos que o constructor chamado será o do tipo passado (T) e não o constructor padrão de TTabela. Como, ao consultar, estaremos fazendo algo do tipo:

Lista := Dao.ConsultaGen<TFuncionario>(Funcionario, ...

Ou seja, passamos o tipo TFuncionario, o construtor chamado será de TFuncionario e não de TTabela. Espero que eu tenha sido claro. 😒

De código para o relacionamento, pelo menos para início dos testes, é isso.

Testes

Junto com os fontes, vai um novo form (ufrmTesteRelacionamento) para os testes:

Com relação ao código do botão de busca genérica, cabe um pequeno adendo:

var
  Lista: TObjectList<TFuncionario>;
  I: Integer;
begin
  Memo.Lines.Clear;
  Memo.Lines.Add('Teste do método ConsultaGen, obtendo como retorno objeto(s) do tipo especificado.');
  Memo.Lines.Add('');
  Funcionario.Limpar;
  Funcionario.Id := StrToIntDef(edCodFunc.Text, 0);
  Lista := Dao.ConsultaGen<TFuncionario>(Funcionario, ['Id']);
  try
    for I := 0 to Lista.Count - 1 do
    begin
      Funcionario.CopyProps(Lista.Items[I]);
      Memo.Lines.Add('Registro no DataSet: ' + IntToStr(Funcionario.Id));
      Memo.Lines.Add('');
      AtualizaForm;
    end;
  finally
    Lista.Free;
  end;
end;

Note que na linha 14, foi adicionado um novo método para agilizar a cópia dos dados de um objeto para outro. O método CopyProps varre a propriedade de objeto passado no parâmetro e repassa os valores para objeto que chamou o método. Segue o código (unit Lca.Orm.Base, classe TTabela):

...
  TTabela = class
  public
    procedure Limpar;
    procedure CopyProps(From: TTabela);
  end;
...

implementation

...
procedure TTabela.CopyProps(From: TTabela);
var
  Contexto: TRttiContext;
  TipoRtti, TipoFrom: TRttiType;
  PropRtti, PropFrom: TRttiProperty;
begin
  Contexto := TRttiContext.Create;
  try
    TipoRtti := Contexto.GetType(Self.ClassType);
    TipoFrom := Contexto.GetType(From.ClassType);
    for PropRtti in TipoRtti.GetProperties do
    begin
      for PropFrom in TipoFrom.GetProperties do
        if SameText(PropFrom.Name, PropRtti.Name) then
        begin
          if PropRtti.PropertyType.TypeKind = tkClass then
          begin
            (PropRtti.GetValue(Self).AsObject as TTabela).CopyProps((PropFrom.GetValue(From).AsObject as TTabela));
          end
          else
            PropRtti.SetValue(Self, PropFrom.GetValue(From));
          Break;
        end;
    end;
  finally
    Contexto.Free;
  end;
end;

Nada de novo, temos apenas um loop que varre as propriedades e repassa para o objeto que chamou o método. Porém, na linha 27, verificamos se o tipo de dado é tkClass, ou seja, verificamos se é uma classe relacionada a uma tabela, se sim, recursivamente, chamamos o método CopyProps, e assim atualizamos a tabela relacionada também.

No código do botão de inserir:

var
  Registros: Integer;
begin
  Memo.Clear;
  Memo.Lines.Add('Teste do método Inserir.');
  Memo.Lines.Add('');
  FormToObjetos;
  Dao.StartTransaction;
  try
    Funcionario.Id := Dao.GetID(Funcionario, 'Id');
    Registros := Dao.Inserir(Funcionario);
    Dao.Commit;
    AtualizaForm;
    Memo.Lines.Add(Format('Registro inserido: %d', [Registros]));
  except
    on E: Exception do
    begin
      Dao.RollBack;
      ShowMessage('Ocorreu um problema ao executar operação: ' + e.Message);
    end;
  end;
end;

Nele, chamamos o método FormToObjetos, que simplesmente irá pegar os valores inseridos nos edits do form e repassar para objeto Funcionario. O grande destaque é que, na linha 11, apenas chamando o método inserir para um objeto, que no caso é o Funcionario, já irá atualizar também as tabelas Depto e Cidade. Segue código de FormToObjetos:

procedure TfrmTesteRelacionamento.FormToObjetos;
var
  Fmt: TFormatSettings;
begin
  Funcionario.Id := StrToIntDef(edCodFunc.Text, 0);
  Funcionario.Nome := edNomeFunc.Text;
  Funcionario.Cpf := edCpf.Text;
  Funcionario.Endereco := edEndereco.Text;
  Funcionario.Bairro := edBairro.Text;
  Funcionario.Cidade.Id := StrToIntDef(edCodCidade.Text, 0);
  Funcionario.Cidade.Nome := edNomeCidade.Text;
  Funcionario.Cidade.Uf := edUF.Text;
  Funcionario.Cidade.Ibge := StrToIntDef(edIbge.Text, 0);
  Funcionario.Depto.Id := StrToIntDef(edCodDep.Text, 0);
  Funcionario.Depto.Nome := edNomeDep.Text;
  Fmt := TFormatSettings.Create;
  Fmt.DecimalSeparator := ',';
  Funcionario.Salario := StrToFloat(StringReplace(edSalario.Text, '.', '', [rfReplaceAll]), Fmt);
end;

Estes são os destaques que eu achei importante pontuar na hora dos testes.

Considerações finais

Este post já está bem extenso, então irei parar por aqui. No Github ( https://github.com/luizsistemas/ORM-Basico-Delphi ), você encontra os fontes atualizados.

Com relação ao relacionamento, já conseguimos consultar um objeto e este já vem com os objetos relacionados a ele. Da mesma forma, ao inserir e salvar. Para melhor desempenho, dica de uma possível alteração, seria a de implementar o design pattern Lazy Loading, e somente carregar os dados das tabelas relacionadas quando este for acessado. Ou então, na alteração de dados, ter uma flag para informar se deseja ou não atualizar determinada tabela. São, digamos, ajustes bem vindos. Mas por ora, fico por aqui.

Abraços.