unit Biblioteca;

interface

uses
  SysUtils, Rtti, mORMot, Atributos;

procedure MapeamentoDTOmORMot(aModel: TSQLModel);
function TrataNomeTabela(pNome: String): String;


implementation

(*
  Procedimento desenvolvido pelo colega Leandro Corrêa Martins
  http://t2ti.com/ead2/mod/forum/discuss.php?d=2360
*)
procedure MapeamentoDTOmORMot;
var
  Contexto: TRttiContext;
  Tipo: TRttiType;
  Propriedade: TRttiProperty;
  Atributo: TCustomAttribute;
  Tabela: TSQLRecordClass;

  RttiInstanceType: TRttiInstanceType;
  ObjetoLocal: TSQLRecord;
  ObjetoLocalRtti: TValue;
  NomeUnitObjeto: String;
  NomeClasseObjeto: String;
begin
  writeln;
  try
    Contexto := TRttiContext.Create;

    for Tabela in aModel.Tables do
    begin
      // Utiliza o nome da Classe para formar o nome da Unit, pois a pesquisa no contexto (RTTI) Contexto.FindType utiliza o nome qualificado
      // Ex: PessoaContatoDTO.TPessoa_Contato - Como o nome da Unit na pesquisa é case sensitive, o nome da classe não pode ser em letras
      // maiúsculas. TPESSOA_CONTATO não será mapeado. Deve ser no mesmo formato da Unit: TPessoa_Contato. Todas as classes com o nome em
      // letras maiúsculas foram ajustadas.

      NomeUnitObjeto   := TrataNomeTabela(Tabela.SQLTableName) + 'DTO';
      NomeUnitObjeto   := StringReplace(NomeUnitObjeto, '_', '', [rfReplaceAll]);
      NomeClasseObjeto := StringReplace(NomeUnitObjeto, '_', '', [rfReplaceAll]) + '.' + Tabela.ClassName; // Monta o nome qualificado unit.classe: PessoaContatoDTO.TPessoa_Contato
      RttiInstanceType := (Contexto.FindType(NomeClasseObjeto) as TRttiInstanceType);

      if not Assigned(RttiInstanceType) then // Indica as classes que não foram mapeadas
        begin
          writeln('***** Error: Unit ' + NomeUnitObjeto + ' not found!'#10);
          continue;
        end;

      ObjetoLocalRtti := RttiInstanceType.GetMethod('Create').Invoke(RttiInstanceType.MetaclassType,[]);
      ObjetoLocal := TSQLRecord(ObjetoLocalRtti.AsObject);

      Tipo := Contexto.GetType(ObjetoLocal.ClassType);

      for Propriedade in Tipo.GetProperties do
        for Atributo in Propriedade.GetAttributes do
          if (Atributo is TColumn) and ((Atributo as TColumn).ClassName = 'TColumn') then // Ignora o Atributo TColumnDisplay em Public
            if UpperCase(Propriedade.Name) <> UpperCase((Atributo as TColumn).Name) then
              aModel.Props[Tabela].ExternalDB.MapField(Propriedade.Name, (Atributo as TColumn).Name); // Realiza o mapeamento no mORMot

      FreeAndNil(ObjetoLocal);
    end;
  finally
    Contexto.Free;
  end;
end;

function TrataNomeTabela(pNome: String): String;
var
  NomeTabela: String;
  I: Integer;
begin
  NomeTabela := pNome;
  NomeTabela := UpperCase(Copy(NomeTabela, 1, 1)) + LowerCase(Copy(NomeTabela, 2, length(NomeTabela) - 1));

  for I := 1 to length(NomeTabela) do
  begin
    if Copy(NomeTabela, I, 1) = '_' then
    begin
      Delete(NomeTabela, I, 1);
      NomeTabela := Copy(NomeTabela, 1, I - 1) + UpperCase(Copy(NomeTabela, I, 1)) + LowerCase(Copy(NomeTabela, I + 1, length(NomeTabela) - 1));
    end;
  end;

  Result := NomeTabela;
end;

end.
