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.
Luiz Carlos
Desenvolvedor de software desde 1995. Em 1998, abriu sua própria empresa, a Lukas Sistemas, desde então passou a atender diversas empresas, principalmente autopeças. Apaixonado por Delphi, porém não o impede de flertar com outras linguagens sempre que possível. Mora na cidade de Balsas/MA com sua esposa e dois filhos.
Olá Luiz, Gostaria de ver com você um tema que pouco amplo na minha opinião sobre o design patterns MVP (Model-View-Presenter) para sistemas em pascal Delphi.
Gosto muito do seu projeto de ORM para facilitar o uso do MCV mas gostaria de ir mais além com a utilização do MVP sendo aplicada na prática.
Quando puder comentar e talvez criar uma postagem sobre o assunto fica a minha sugestão!
Anderson,
Já tem um post na DevMedia bastante interessante sobre o tema: https://www.devmedia.com.br/o-padrao-mvp-model-view-presenter/3043
Eu particularmente, por preferência, utilizo majoritariamente em meus projetos o MVC.