From 8fa98da4fb52823fa56b078348086a3e33093524 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Tue, 22 May 2012 13:16:16 +0000 Subject: [PATCH] Fixed: improved support for simple type references Fixed: resolve property name conflicts --- Units/DelphiXMLDataBindingGenerator.pas | 57 ++++++++- Units/XMLDataBindingGenerator.pas | 159 ++++++++++++++---------- X2XMLDataBinding.dproj | 2 +- 3 files changed, 149 insertions(+), 69 deletions(-) diff --git a/Units/DelphiXMLDataBindingGenerator.pas b/Units/DelphiXMLDataBindingGenerator.pas index 1f2e694..fd32af3 100644 --- a/Units/DelphiXMLDataBindingGenerator.pas +++ b/Units/DelphiXMLDataBindingGenerator.pas @@ -41,10 +41,11 @@ type function DelphiSafeName(const AName: String): String; function TranslateItemName(AItem: TXMLDataBindingItem): String; override; + procedure PostProcessItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingItem); override; + procedure ResolvePropertyNameConflicts(AItem: TXMLDataBindingInterface); function DoGetFileName(const ASchemaName: String): String; - function GetDataTypeMapping(ADataType: IXMLTypeDef; out ATypeMapping: TTypeMapping): Boolean; function GetDataTypeName(AProperty: TXMLDataBindingProperty; AInterfaceName: Boolean): String; function TranslateDataType(ADataType: IXMLTypeDef): String; @@ -374,6 +375,53 @@ begin end; +procedure TDelphiXMLDataBindingGenerator.PostProcessItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingItem); +begin + inherited PostProcessItem(ASchema, AItem); + + if AItem.ItemType = itInterface then + begin + { Resolve conflicts in case only for properties } + ResolvePropertyNameConflicts(TXMLDataBindingInterface(AItem)); + end; +end; + + +procedure TDelphiXMLDataBindingGenerator.ResolvePropertyNameConflicts(AItem: TXMLDataBindingInterface); +var + propertyNames: TStringList; + propertyItem: TXMLDataBindingProperty; + propertyIndex: Integer; + baseName: String; + counter: Integer; + +begin + propertyNames := TStringList.Create; + try + propertyNames.CaseSensitive := False; + + for propertyIndex := 0 to Pred(AItem.PropertyCount) do + begin + propertyItem := AItem.Properties[propertyIndex]; + + baseName := propertyItem.TranslatedName; + counter := 1; + + while propertyNames.IndexOf(propertyItem.TranslatedName) > -1 do + begin + { Unfortunately, the context is exactly the same, this is the best we can do } + Inc(counter); + propertyItem.TranslatedName := baseName + IntToStr(counter); + end; + + propertyNames.Add(propertyItem.TranslatedName); + end; + finally + FreeAndNil(propertyNames); + end; +end; + + procedure TDelphiXMLDataBindingGenerator.WriteUnitHeader(AStream: TStreamHelper; const ASourceFileName, AFileName: String); begin AStream.WriteNamedFmt(UnitHeader, @@ -418,13 +466,9 @@ begin hasItem := False; nameSpace := ''; - // #ToDo1 -oMvR: 6-4-2012: bij de Hyundai XSD's wordt hiermee TargetNamespace incorrect de laatste schema namespace for schemaIndex := 0 to Pred(ASchemaList.Count) do begin schema := ASchemaList[schemaIndex]; - - if Length(schema.TargetNamespace) > 0 then - nameSpace := schema.TargetNamespace; for itemIndex := 0 to Pred(schema.ItemCount) do begin @@ -445,6 +489,9 @@ begin hasItem := True; end; + if Length(schema.TargetNamespace) > 0 then + nameSpace := schema.TargetNamespace; + with TNamedFormatStringList.Create do try case ASection of diff --git a/Units/XMLDataBindingGenerator.pas b/Units/XMLDataBindingGenerator.pas index a91a496..5dfbec0 100644 --- a/Units/XMLDataBindingGenerator.pas +++ b/Units/XMLDataBindingGenerator.pas @@ -65,6 +65,7 @@ type function ProcessElement(ASchema: TXMLDataBindingSchema; AAttribute: IXMLAttributeDef): TXMLDataBindingItem; overload; procedure ProcessChildElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef; AInterface: TXMLDataBindingInterface); procedure ProcessAttribute(ASchema: TXMLDataBindingSchema; AAttribute: IXMLAttributeDef; AInterface: TXMLDataBindingInterface); + function ProcessSimpleTypeReference(ASchema: TXMLDataBindingSchema; AItem: IXMLSchemaItem; ADataType: IXMLTypeDef): TXMLDataBindingItem; function IterateSchemaItems(ASchema: TXMLDataBindingSchema; AIterateProc: TXMLDataBindingIterateItemsProc; AData: Pointer): TXMLDataBindingItem; @@ -79,11 +80,11 @@ type procedure ResolveSchema(ASchema: TXMLDataBindingSchema); procedure ResolveAlias(ASchema: TXMLDataBindingSchema); procedure ResolveItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingUnresolvedItem); - procedure ResolveNameConflicts; + procedure ResolveNameConflicts; virtual; procedure PostProcessSchema(ASchema: TXMLDataBindingSchema); - procedure PostProcessItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingItem); + procedure PostProcessItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingItem); virtual; function TranslateItemName(AItem: TXMLDataBindingItem): String; virtual; procedure GenerateDataBinding; virtual; abstract; @@ -682,9 +683,12 @@ begin if not baseType.IsComplex then begin - namespace := simpleType.SchemaDef.TargetNamespace; - if namespace = Schemas[0].TargetNamespace then - namespace := ''; + if not VarIsNull(simpleType.SchemaDef.TargetNamespace) then + begin + namespace := simpleType.SchemaDef.TargetNamespace; + if namespace = Schemas[0].TargetNamespace then + namespace := ''; + end; simpleTypeAlias := TXMLDataBindingSimpleTypeAliasItem.Create(Self, baseType, simpleType.Name); simpleTypeAlias.TargetNamespace := namespace; @@ -766,7 +770,6 @@ var simpleAliasItem: TXMLDataBindingSimpleTypeAliasItem; elementIndex: Integer; simpleTypeDef: IXMLSimpleTypeDef; - typeDef: IXMLTypeDef; begin Result := nil; @@ -858,30 +861,11 @@ begin for attributeIndex := 0 to Pred(AElement.AttributeDefs.Count) do ProcessAttribute(ASchema, AElement.AttributeDefs[attributeIndex], interfaceObject); - end else {if AElement.IsGlobal then} + end else //if AElement.IsGlobal then begin { Non-anonymous non-complex type. Assume somewhere in there is a - built-in type. - - This code probably isn't correct, but it works for the files I got. } - typeDef := AElement.DataType; - - while Assigned(typeDef) do - begin - if Supports(typeDef, IXMLSimpleTypeDef, simpleTypeDef) and (simpleTypeDef.IsBuiltInType) then - begin - { The element is global, but only references a simple type. } - simpleAliasItem := TXMLDataBindingSimpleTypeAliasItem.Create(Self, AElement, AElement.Name); - // #ToDo1 -oMvR: 17-4-2012: TargetNamespace! - simpleAliasItem.DataType := typeDef; - ASchema.AddItem(simpleAliasItem); - - Result := simpleAliasItem; - Break; - end; - - typeDef := typeDef.BaseType; - end; + built-in type. } + Result := ProcessSimpleTypeReference(ASchema, AElement, AElement.DataType); end; end; end; @@ -891,12 +875,11 @@ end; function TXMLDataBindingGenerator.ProcessElement(ASchema: TXMLDataBindingSchema; AAttribute: IXMLAttributeDef): TXMLDataBindingItem; var - enumerationObject: TXMLDataBindingEnumeration; - interfaceObject: TXMLDataBindingInterface; - complexAliasItem: TXMLDataBindingComplexTypeAliasItem; - simpleAliasItem: TXMLDataBindingSimpleTypeAliasItem; - simpleTypeDef: IXMLSimpleTypeDef; - typeDef: IXMLTypeDef; + enumerationObject: TXMLDataBindingEnumeration; + interfaceObject: TXMLDataBindingInterface; + complexAliasItem: TXMLDataBindingComplexTypeAliasItem; + simpleAliasItem: TXMLDataBindingSimpleTypeAliasItem; + simpleTypeDef: IXMLSimpleTypeDef; begin Result := nil; @@ -976,30 +959,11 @@ begin ASchema.AddItem(interfaceObject); Result := interfaceObject; - end else if AAttribute.IsGlobal then + end else //if AAttribute.IsGlobal then begin { Non-anonymous non-complex type. Assume somewhere in there is a - built-in type. - - This code probably isn't correct, but it works for the files I got. } - typeDef := AAttribute.DataType; - - while Assigned(typeDef) do - begin - if Supports(typeDef, IXMLSimpleTypeDef, simpleTypeDef) and (simpleTypeDef.IsBuiltInType) then - begin - { The element is global, but only references a simple type. } - simpleAliasItem := TXMLDataBindingSimpleTypeAliasItem.Create(Self, AAttribute, AAttribute.Name); - // #ToDo1 -oMvR: 17-4-2012: TargetNamespace! - simpleAliasItem.DataType := typeDef; - ASchema.AddItem(simpleAliasItem); - - Result := simpleAliasItem; - Break; - end; - - typeDef := typeDef.BaseType; - end; + built-in type. } + Result := ProcessSimpleTypeReference(ASchema, AAttribute, AAttribute.DataType); end; end; end; @@ -1027,9 +991,12 @@ begin AElement.Name, AElement.DataType); - namespace := AElement.SchemaDef.TargetNamespace; - if namespace <> Schemas[0].TargetNamespace then - propertyItem.TargetNamespace := namespace; + if not VarIsNull(AElement.SchemaDef.TargetNamespace) then + begin + namespace := AElement.SchemaDef.TargetNamespace; + if namespace <> Schemas[0].TargetNamespace then + propertyItem.TargetNamespace := namespace; + end; propertyItem.IsOptional := IsElementOptional(AElement) or IsChoice(AElement); @@ -1068,9 +1035,12 @@ begin AAttribute.Name, AAttribute.DataType); - namespace := AAttribute.SchemaDef.TargetNamespace; - if namespace <> ASchema.TargetNamespace then - propertyItem.TargetNamespace := namespace; + if not VarIsNull(AAttribute.SchemaDef.TargetNamespace) then + begin + namespace := AAttribute.SchemaDef.TargetNamespace; + if namespace <> ASchema.TargetNamespace then + propertyItem.TargetNamespace := namespace; + end; propertyItem.IsOptional := (AAttribute.Use <> UseRequired); propertyItem.IsAttribute := True; @@ -1079,6 +1049,66 @@ begin end; +function TXMLDataBindingGenerator.ProcessSimpleTypeReference(ASchema: TXMLDataBindingSchema; AItem: IXMLSchemaItem; ADataType: IXMLTypeDef): TXMLDataBindingItem; +var + typeDef: IXMLTypeDef; + simpleTypeDef: IXMLSimpleTypeDef; + simpleAliasItem: TXMLDataBindingSimpleTypeAliasItem; + +begin + Result := nil; + + { This code is a fine bit of trial-and-error. It works for the files + I've seen so far, but has been modified enough times to say for sure + there'll be another unsupported way of referencing simple types. } + typeDef := ADataType; + + while Assigned(typeDef) do + begin + if Supports(typeDef, IXMLSimpleTypeDef, simpleTypeDef) then + begin + if simpleTypeDef.IsBuiltInType then + begin + { The element is global, but only references a simple type. } + simpleAliasItem := TXMLDataBindingSimpleTypeAliasItem.Create(Self, AItem, AItem.Name); + simpleAliasItem.DataType := typeDef; + ASchema.AddItem(simpleAliasItem); + + Result := simpleAliasItem; + Break; + end else + begin + case simpleTypeDef.DerivationMethod of + sdmRestriction: + typeDef := typeDef.BaseType; + + sdmUnion: + begin + simpleAliasItem := TXMLDataBindingSimpleTypeAliasItem.Create(Self, AItem, AItem.Name); + simpleAliasItem.DataType := typeDef; + + // #ToDo1 -oMvR: set type "union" + + ASchema.AddItem(simpleAliasItem); + end + else + typeDef := nil; + end; + + + end; + end; + end; + +// if not VarIsNull(typeDef.SchemaDef.TargetNamespace) then +// begin +// namespace := typeDef.SchemaDef.TargetNamespace; +// if namespace <> ASchema.TargetNamespace then +// propertyItem.TargetNamespace := namespace; +// end; +end; + + function TXMLDataBindingGenerator.IterateSchemaItems(ASchema: TXMLDataBindingSchema; AIterateProc: TXMLDataBindingIterateItemsProc; AData: Pointer): TXMLDataBindingItem; var abort: Boolean; @@ -1310,7 +1340,8 @@ var items: TObjectList; begin - hashName := AItem.Name; + { LowerCase because XML is case-sensitive, but Delphi isn't. } + hashName := LowerCase(AItem.Name); if not itemNames.Exists(hashName) then begin @@ -1777,6 +1808,8 @@ var begin inherited; + // #ToDo1 -oMvR: replacing a simpletypealias with nil doesn't quite work. not sure yet why. + for propertyIndex := Pred(PropertyCount) downto 0 do begin propertyItem := Properties[propertyIndex]; diff --git a/X2XMLDataBinding.dproj b/X2XMLDataBinding.dproj index a4dc717..2f78b13 100644 --- a/X2XMLDataBinding.dproj +++ b/X2XMLDataBinding.dproj @@ -24,7 +24,7 @@ Delphi.Personality -FalseTrueFalse"P:\updateserver\xsd\DealerCarTrimMsg_v0101.xsd"FalseFalse1000FalseFalseFalseFalseFalse104312521.0.0.01.0.0.0X2XMLDataBinding.dpr +FalseTrueFalse"P:\updateserver\xsd\ads111.xsd"FalseFalse1000FalseFalseFalseFalseFalse104312521.0.0.01.0.0.0X2XMLDataBinding.dpr