Adiciona quebra em blocos para registro de `Class Relations`

Para evitar erro de compilação em aplicações com modelos muito grandes

src/IntegracaoDelphiSUML.pas

@@ -101,7 +101,11 @@ type
     function  GerarBodyRegisterMappings(piModelMappingsOptions: TModelMappingsOptions; piProgress: TFShowProgress; piStartAt: Integer; piEndAt: Integer): string;
     procedure GerarBodyRegisterMappings_CSharp(piModelMappingsOptions: TModelMappingsOptions; piProgress: TFShowProgress; piStartAt: Integer; piEndAt: Integer; piUnitRegisterMappings: PStringWriter);
     procedure GerarBodyRegisterMappings_Java(piModelMappingsOptions: TModelMappingsOptions; piProgress: TFShowProgress; piStartAt: Integer; piEndAt: Integer; piUnitRegisterMappings: PStringWriter);
-    function  GerarBodyRelationsAll(piProgress: TFShowProgress): string;
+
+
+    function  GerarBodyRelationsAll(piProgress: TFShowProgress): string; overload;
+    function  GerarBodyRelationsAll(piProgress: TFShowProgress; piStartAt: Integer; piEndAt: Integer): string; overload;
+
     procedure GerarBodyRelationsAll_CSharp(piProgress: TFShowProgress; piUnitRegisterMappings: PStringWriter);
     procedure GerarBodyRelationsAll_Java(piProgress: TFShowProgress; piUnitRegisterMappings: PStringWriter);
     procedure GerarUnitRelationsAll(piModelMappingsOptions: TModelMappingsOptions; psFileName: string; piProgress: TFShowProgress);
@@ -2293,6 +2297,7 @@ begin
   li := 1;
   // Obtm todos os ClassTickets da UNIT
   lEnum := MetaModel.ClassTickets.GetEnumerator;
+
   try
     // Visita todos os ClassTickets da UNIT
     if assigned(piProgress) then piProgress.ChangeMessage(format('Generating model mappings class tickets... (%d de %d classes)', [piStartAt + piEndAt - 1, MetaModel.ClassTickets.Count]), 0, MetaModel.ClassTickets.Count);
@@ -2831,6 +2836,7 @@ procedure TUtil.GerarUnitRegisterModelMappings(piModelMappingsOptions: TModelMap
 const
   MAX_UC = 100;
   MAX_CLASS = 200;
+  MAX_RELATIONS = 200;
 var
     lInstantCodeModule: TInstantCodeModule;
     lInstantCodeProc: TInstantCodeProc;
@@ -2840,6 +2846,7 @@ var
     lI,
     lTotalGroups: Integer;
     lRegisterUseCasesCall,
+    lRegisterRelationsCall,
     lRegisterClassCall: string;
 //    lInstantCodeWriter: TInstantCodeWriter;
 //    s: string;
@@ -2884,16 +2891,28 @@ begin
       
     end;
 
-    //PROCEDURE RegisterClassRelationTickets //////////////////////////////////////////
-    lInstantCodeProc := lInstantCodeModule.ImplementationSection.AddProc;
-    lInstantCodeProc.Name := 'RegisterClassRelationTickets';
-    lInstantCodeProc.Parameters.AddParameter('piMetaModel', 'acMetaModel', []);
-    lInstantCodeBody := lInstantCodeProc.Body;
-    //class
-    lInstantCodeVar := lInstantCodeBody.Vars.Add;
-    lInstantCodeVar.Name := 'lRelationTicket';
-    lInstantCodeVar.TypeName := 'acRelationTicket';
-    lInstantCodeBody.Text := GerarBodyRelationsAll(piProgress);
+
+    lTotalGroups := (MetaModel.RelationTickets.Count div MAX_RELATIONS);
+    if (MetaModel.RelationTickets.Count mod MAX_RELATIONS) <> 0 then Inc(lTotalGroups);
+
+    for lI := 0 to lTotalGroups - 1 do
+    begin
+      //PROCEDURE RegisterClassRelationTickets //////////////////////////////////////////
+      lInstantCodeProc := lInstantCodeModule.ImplementationSection.AddProc;
+      lInstantCodeProc.Name := 'RegisterClassRelationTickets' + IntToStr(lI + 1);
+      lInstantCodeProc.Parameters.AddParameter('piMetaModel', 'acMetaModel', []);
+      lInstantCodeBody := lInstantCodeProc.Body;
+      //class
+      lInstantCodeVar := lInstantCodeBody.Vars.Add;
+      lInstantCodeVar.Name := 'lRelationTicket';
+      lInstantCodeVar.TypeName := 'acRelationTicket';
+      lInstantCodeBody.Text := GerarBodyRelationsAll(piProgress, lI*(MAX_RELATIONS) + 1, (lI + 1)*MAX_RELATIONS);
+
+      if (lRegisterRelationsCall <> '') then lRegisterRelationsCall := concat(lRegisterRelationsCall, #13#10);
+      lRegisterRelationsCall := concat(lRegisterRelationsCall, 'RegisterClassRelationTickets',  IntToStr(lI + 1), '(piMetaModel)', '{', IntToStr(lI*(MAX_CLASS) + 1) , ' - ', IntToStr( (lI + 1)*MAX_CLASS ), '};' );
+
+    end;
+
 
     lTotalGroups := (MetaModel.UseCaseTickets.Count div MAX_UC);
     if (MetaModel.UseCaseTickets.Count mod MAX_UC) <> 0 then Inc(lTotalGroups);
@@ -2945,7 +2964,7 @@ begin
     lInstantCodeBody := lInstantCodeProc.Body;
 
     lInstantCodeBody.Text := concat(' ', lRegisterClassCall, #13#10,
-                                    ' ', 'RegisterClassRelationTickets(piMetaModel);',#13#10,
+                                    ' ', lRegisterRelationsCall,#13#10,
                                     ' ', lRegisterUseCasesCall);
 
     // Gerao de arquivo
@@ -3133,7 +3152,7 @@ begin
     // Gerao de arquivo
     if assigned(piProgress) then piProgress.ChangeMessage('Saving file "'+ piModelMappingsOptions.FileName +'"...');
     lArquivoRegisterModelMappings.SaveToFile(piModelMappingsOptions.FileName);
-    
+
   finally
     lArquivoRegisterModelMappings.Free;
   end;
@@ -3256,6 +3275,128 @@ begin
     result := sRelationsAll;
 end;
 
+function TUtil.GerarBodyRelationsAll(piProgress: TFShowProgress; piStartAt: Integer; piEndAt: Integer): string;
+var lEnumRelation: acEnumerator;
+    lRelationTicket: acRelationTicket;
+    lClassTicketOrigem, lClassTicketDestino: acClassTicket;
+    sRelationsAll, lsNomeTabelaAssociativa, lsNomeFKA, lsNomeFKB: String;
+    sMetodo, lsOrAggregation, lsDsAggregation: string;
+    lRelationSQLPersistenceMapTicket: acRelationSQLPersistenceMapTicket;
+    bIndireta: boolean;
+    lMultiplicityOrMax, lMultiplicityDsMax, lMultiplicityOrMin, lMultiplicityDsMin: integer;
+    li: integer;
+begin
+  li := 1;
+
+  if assigned(piProgress) then piProgress.ChangeMessage(Format('Generating model mappings relation tickets... (%d of %d relations)', [piStartAt + piEndAt - 1, MetaModel.ClassTickets.Count]));
+  lEnumRelation := MetaModel.RelationTickets.GetEnumerator;
+  try
+    while (not lEnumRelation.EOL) and (li <= piEndAt) do
+    begin
+         if assigned(piProgress) then piProgress.Inc;
+         if (li >= piStartAt) then
+         begin
+           lRelationTicket := acRelationTicket(lEnumRelation.Current);
+           // Obtm classes origem e destino. No est sendo considerada associaao ternria.
+           lClassTicketOrigem := lRelationTicket.OriginTicket;
+           lClassTicketDestino := lRelationTicket.DestinationTicket;
+
+           lMultiplicityOrMax := lRelationTicket.OriginMaxMultiplicity;
+           lMultiplicityDsMax := lRelationTicket.DestinationMaxMultiplicity;
+
+           lMultiplicityOrMin := lRelationTicket.OriginMinMultiplicity;
+           lMultiplicityDsMin := lRelationTicket.DestinationMinMultiplicity;
+
+            case lRelationTicket.OriginAggregation of
+              pvNone: lsOrAggregation := 'pvNone';
+              pvAggregate: lsOrAggregation := 'pvAggregate';
+              pvComposite: lsOrAggregation := 'pvComposite';
+            end;
+
+            case lRelationTicket.DestinationAggregation of
+              pvNone: lsDsAggregation := 'pvNone';
+              pvAggregate: lsDsAggregation := 'pvAggregate';
+              pvComposite: lsDsAggregation := 'pvComposite';
+            end;
+
+           sRelationsAll := sRelationsAll + 'lRelationTicket := piMetaModel.NewRelationRegisterTicket(';
+           sRelationsAll := sRelationsAll + '''' + lClassTicketOrigem.PersistentObjectClassName + '''' + ', ' + '''' + lRelationTicket.OriginPropertyName + '''' + ', ' + inttostr(lMultiplicityOrMin) + ', ' + inttostr(lMultiplicityOrMax) + ', ' + lsOrAggregation;
+           sRelationsAll := sRelationsAll + ', ' + '''' + lRelationTicket.Name + '''' + ', ';
+           sRelationsAll := sRelationsAll + '''' + lClassTicketDestino.PersistentObjectClassName + '''' + ', ' + '''' + lRelationTicket.DestinationPropertyName + '''' + ', ' + inttostr(lMultiplicityDsMin) + ', ' + inttostr(lMultiplicityDsMax) + ', ' + lsDsAggregation;
+           sRelationsAll := sRelationsAll + ', ' + BoolToStr(lRelationTicket.Bidirectional, true);
+           sRelationsAll := sRelationsAll + ', ' + BoolToStr(lRelationTicket.IsAuditable, true);
+           sRelationsAll := sRelationsAll + ');' + #13#10;
+           if lRelationTicket.DisplayName <> lRelationTicket.Name then
+             sRelationsAll := sRelationsAll + 'lRelationTicket.DisplayName := ' + QuotedStr(lRelationTicket.DisplayName) + ';' + #13#10;
+           if lRelationTicket.OriginDisplayName <> '' then
+             sRelationsAll := sRelationsAll + 'lRelationTicket.OriginDisplayName := ' + QuotedStr(lRelationTicket.OriginDisplayName) + ';' + #13#10;
+           if lRelationTicket.DestinationDisplayName <> '' then
+             sRelationsAll := sRelationsAll + 'lRelationTicket.DestinationDisplayName := ' + QuotedStr(lRelationTicket.DestinationDisplayName) + ';' + #13#10;
+
+
+           // ATRIBUTOS ESTENDIDOS
+           // Obtm classe responsvel por mapeamento OO-DB para Relacionamento
+           lRelationSQLPersistenceMapTicket := (MetaModel.DefaultMetaModelPersistenceMap as acMetaModelPersistenceMapSQL).GetRelationsSQLPersistenceMapTicket(lRelationTicket);
+
+           if (lRelationSQLPersistenceMapTicket is acIndirectDBRelationMapTicket) then
+           begin
+               bIndireta := true;
+               lsNomeTabelaAssociativa := ', ''' + (lRelationSQLPersistenceMapTicket as acIndirectDBRelationMapTicket).TableName + '''';
+               lsNomeFKA := ', ''' + (lRelationSQLPersistenceMapTicket as acIndirectDBRelationMapTicket).FKOrigemName + '''';
+               lsNomeFKB := ', ''' + (lRelationSQLPersistenceMapTicket as acIndirectDBRelationMapTicket).FKDestinoName + '''';
+
+           end
+           else
+           begin
+               bIndireta := false;
+               lsNomeFKA := ', ''' + (lRelationSQLPersistenceMapTicket as acDirectDBRelationMapTicket).FKColumnName + '''';
+           end;
+
+           // Lgica responsvel por selecionar o mtodo de relacionamento de acordo com a cardinalidade
+           if lMultiplicityOrMax <= 1 then
+           begin
+             if lMultiplicityDsMax <= 1 then
+             begin
+                 if bIndireta then
+                   sMetodo := 'NewIndirectOneToOneDbRelationMapRegisterTicket'
+                 else
+                   sMetodo := 'NewOneToOneDbRelationMapRegisterTicket';
+             end
+             else
+             begin
+               if bIndireta then
+                 sMetodo := 'NewIndirectOneToManyDbRelationMapRegisterTicket'
+               else
+                 sMetodo := 'NewOneToManyDbRelationMapRegisterTicket';
+             end;
+           end
+           else //lsMultiplicityOr = N
+           begin
+             if lMultiplicityDsMax <= 1 then
+             begin
+               if bIndireta then
+                 sMetodo := 'NewIndirectOneToManyDbRelationMapRegisterTicket'
+               else
+                 sMetodo := 'NewOneToManyDbRelationMapRegisterTicket';
+             end
+             else
+               sMetodo := 'NewManyToManyDbRelationMapRegisterTicket';
+           end;
+
+           sRelationsAll := sRelationsAll + 'if lRelationTicket <> nil then (piMetaModel.DefaultMetaModelPersistenceMap as acMetaModelPersistenceMapSql).';
+           sRelationsAll := sRelationsAll + sMetodo + '(lRelationTicket' + lsNomeFKA + lsNomeFKB + lsNomeTabelaAssociativa + ');' + #13#10 + #13#10;
+           lsNomeFKA := '';
+           lsNomeFKB := '';
+           lsNomeTabelaAssociativa := '';
+         end;
+         Inc(li);
+         lEnumRelation.MoveNext;
+    end;
+  finally
+    lEnumRelation.Free;
+  end;
+    result := sRelationsAll;
+end;
 
 procedure TUtil.GerarBodyRelationsAll_CSharp(piProgress: TFShowProgress; piUnitRegisterMappings: PStringWriter);
 var lEnumRelation: acEnumerator;
@@ -6878,7 +7019,7 @@ destructor TUtil.Destroy;
 begin
   MetaModel.DefaultMetaModelPersistenceMap.Free;
   MetaModel.Free;
-  fStarUMLApp := nil; 
+  fStarUMLApp := nil;
   inherited;
 end;