1
0
mirror of synced 2024-11-23 22:13:49 +00:00

Fixed: improved support for simple type references

Fixed: resolve property name conflicts
This commit is contained in:
Mark van Renswoude 2012-05-22 13:16:16 +00:00
parent ea12a5124e
commit 8fa98da4fb
3 changed files with 149 additions and 69 deletions

View File

@ -41,10 +41,11 @@ type
function DelphiSafeName(const AName: String): String; function DelphiSafeName(const AName: String): String;
function TranslateItemName(AItem: TXMLDataBindingItem): String; override; function TranslateItemName(AItem: TXMLDataBindingItem): String; override;
procedure PostProcessItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingItem); override;
procedure ResolvePropertyNameConflicts(AItem: TXMLDataBindingInterface);
function DoGetFileName(const ASchemaName: String): String; function DoGetFileName(const ASchemaName: String): String;
function GetDataTypeMapping(ADataType: IXMLTypeDef; out ATypeMapping: TTypeMapping): Boolean; function GetDataTypeMapping(ADataType: IXMLTypeDef; out ATypeMapping: TTypeMapping): Boolean;
function GetDataTypeName(AProperty: TXMLDataBindingProperty; AInterfaceName: Boolean): String; function GetDataTypeName(AProperty: TXMLDataBindingProperty; AInterfaceName: Boolean): String;
function TranslateDataType(ADataType: IXMLTypeDef): String; function TranslateDataType(ADataType: IXMLTypeDef): String;
@ -374,6 +375,53 @@ begin
end; 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); procedure TDelphiXMLDataBindingGenerator.WriteUnitHeader(AStream: TStreamHelper; const ASourceFileName, AFileName: String);
begin begin
AStream.WriteNamedFmt(UnitHeader, AStream.WriteNamedFmt(UnitHeader,
@ -418,14 +466,10 @@ begin
hasItem := False; hasItem := False;
nameSpace := ''; 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 for schemaIndex := 0 to Pred(ASchemaList.Count) do
begin begin
schema := ASchemaList[schemaIndex]; schema := ASchemaList[schemaIndex];
if Length(schema.TargetNamespace) > 0 then
nameSpace := schema.TargetNamespace;
for itemIndex := 0 to Pred(schema.ItemCount) do for itemIndex := 0 to Pred(schema.ItemCount) do
begin begin
item := schema.Items[itemIndex]; item := schema.Items[itemIndex];
@ -445,6 +489,9 @@ begin
hasItem := True; hasItem := True;
end; end;
if Length(schema.TargetNamespace) > 0 then
nameSpace := schema.TargetNamespace;
with TNamedFormatStringList.Create do with TNamedFormatStringList.Create do
try try
case ASection of case ASection of

View File

@ -65,6 +65,7 @@ type
function ProcessElement(ASchema: TXMLDataBindingSchema; AAttribute: IXMLAttributeDef): TXMLDataBindingItem; overload; function ProcessElement(ASchema: TXMLDataBindingSchema; AAttribute: IXMLAttributeDef): TXMLDataBindingItem; overload;
procedure ProcessChildElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef; AInterface: TXMLDataBindingInterface); procedure ProcessChildElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef; AInterface: TXMLDataBindingInterface);
procedure ProcessAttribute(ASchema: TXMLDataBindingSchema; AAttribute: IXMLAttributeDef; 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; function IterateSchemaItems(ASchema: TXMLDataBindingSchema; AIterateProc: TXMLDataBindingIterateItemsProc; AData: Pointer): TXMLDataBindingItem;
@ -79,11 +80,11 @@ type
procedure ResolveSchema(ASchema: TXMLDataBindingSchema); procedure ResolveSchema(ASchema: TXMLDataBindingSchema);
procedure ResolveAlias(ASchema: TXMLDataBindingSchema); procedure ResolveAlias(ASchema: TXMLDataBindingSchema);
procedure ResolveItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingUnresolvedItem); procedure ResolveItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingUnresolvedItem);
procedure ResolveNameConflicts; procedure ResolveNameConflicts; virtual;
procedure PostProcessSchema(ASchema: TXMLDataBindingSchema); procedure PostProcessSchema(ASchema: TXMLDataBindingSchema);
procedure PostProcessItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingItem); procedure PostProcessItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingItem); virtual;
function TranslateItemName(AItem: TXMLDataBindingItem): String; virtual; function TranslateItemName(AItem: TXMLDataBindingItem): String; virtual;
procedure GenerateDataBinding; virtual; abstract; procedure GenerateDataBinding; virtual; abstract;
@ -682,9 +683,12 @@ begin
if not baseType.IsComplex then if not baseType.IsComplex then
begin begin
namespace := simpleType.SchemaDef.TargetNamespace; if not VarIsNull(simpleType.SchemaDef.TargetNamespace) then
if namespace = Schemas[0].TargetNamespace then begin
namespace := ''; namespace := simpleType.SchemaDef.TargetNamespace;
if namespace = Schemas[0].TargetNamespace then
namespace := '';
end;
simpleTypeAlias := TXMLDataBindingSimpleTypeAliasItem.Create(Self, baseType, simpleType.Name); simpleTypeAlias := TXMLDataBindingSimpleTypeAliasItem.Create(Self, baseType, simpleType.Name);
simpleTypeAlias.TargetNamespace := namespace; simpleTypeAlias.TargetNamespace := namespace;
@ -766,7 +770,6 @@ var
simpleAliasItem: TXMLDataBindingSimpleTypeAliasItem; simpleAliasItem: TXMLDataBindingSimpleTypeAliasItem;
elementIndex: Integer; elementIndex: Integer;
simpleTypeDef: IXMLSimpleTypeDef; simpleTypeDef: IXMLSimpleTypeDef;
typeDef: IXMLTypeDef;
begin begin
Result := nil; Result := nil;
@ -858,30 +861,11 @@ begin
for attributeIndex := 0 to Pred(AElement.AttributeDefs.Count) do for attributeIndex := 0 to Pred(AElement.AttributeDefs.Count) do
ProcessAttribute(ASchema, AElement.AttributeDefs[attributeIndex], interfaceObject); ProcessAttribute(ASchema, AElement.AttributeDefs[attributeIndex], interfaceObject);
end else {if AElement.IsGlobal then} end else //if AElement.IsGlobal then
begin begin
{ Non-anonymous non-complex type. Assume somewhere in there is a { Non-anonymous non-complex type. Assume somewhere in there is a
built-in type. built-in type. }
Result := ProcessSimpleTypeReference(ASchema, AElement, AElement.DataType);
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;
end; end;
end; end;
end; end;
@ -891,12 +875,11 @@ end;
function TXMLDataBindingGenerator.ProcessElement(ASchema: TXMLDataBindingSchema; AAttribute: IXMLAttributeDef): TXMLDataBindingItem; function TXMLDataBindingGenerator.ProcessElement(ASchema: TXMLDataBindingSchema; AAttribute: IXMLAttributeDef): TXMLDataBindingItem;
var var
enumerationObject: TXMLDataBindingEnumeration; enumerationObject: TXMLDataBindingEnumeration;
interfaceObject: TXMLDataBindingInterface; interfaceObject: TXMLDataBindingInterface;
complexAliasItem: TXMLDataBindingComplexTypeAliasItem; complexAliasItem: TXMLDataBindingComplexTypeAliasItem;
simpleAliasItem: TXMLDataBindingSimpleTypeAliasItem; simpleAliasItem: TXMLDataBindingSimpleTypeAliasItem;
simpleTypeDef: IXMLSimpleTypeDef; simpleTypeDef: IXMLSimpleTypeDef;
typeDef: IXMLTypeDef;
begin begin
Result := nil; Result := nil;
@ -976,30 +959,11 @@ begin
ASchema.AddItem(interfaceObject); ASchema.AddItem(interfaceObject);
Result := interfaceObject; Result := interfaceObject;
end else if AAttribute.IsGlobal then end else //if AAttribute.IsGlobal then
begin begin
{ Non-anonymous non-complex type. Assume somewhere in there is a { Non-anonymous non-complex type. Assume somewhere in there is a
built-in type. built-in type. }
Result := ProcessSimpleTypeReference(ASchema, AAttribute, AAttribute.DataType);
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;
end; end;
end; end;
end; end;
@ -1027,9 +991,12 @@ begin
AElement.Name, AElement.Name,
AElement.DataType); AElement.DataType);
namespace := AElement.SchemaDef.TargetNamespace; if not VarIsNull(AElement.SchemaDef.TargetNamespace) then
if namespace <> Schemas[0].TargetNamespace then begin
propertyItem.TargetNamespace := namespace; namespace := AElement.SchemaDef.TargetNamespace;
if namespace <> Schemas[0].TargetNamespace then
propertyItem.TargetNamespace := namespace;
end;
propertyItem.IsOptional := IsElementOptional(AElement) or propertyItem.IsOptional := IsElementOptional(AElement) or
IsChoice(AElement); IsChoice(AElement);
@ -1068,9 +1035,12 @@ begin
AAttribute.Name, AAttribute.Name,
AAttribute.DataType); AAttribute.DataType);
namespace := AAttribute.SchemaDef.TargetNamespace; if not VarIsNull(AAttribute.SchemaDef.TargetNamespace) then
if namespace <> ASchema.TargetNamespace then begin
propertyItem.TargetNamespace := namespace; namespace := AAttribute.SchemaDef.TargetNamespace;
if namespace <> ASchema.TargetNamespace then
propertyItem.TargetNamespace := namespace;
end;
propertyItem.IsOptional := (AAttribute.Use <> UseRequired); propertyItem.IsOptional := (AAttribute.Use <> UseRequired);
propertyItem.IsAttribute := True; propertyItem.IsAttribute := True;
@ -1079,6 +1049,66 @@ begin
end; 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; function TXMLDataBindingGenerator.IterateSchemaItems(ASchema: TXMLDataBindingSchema; AIterateProc: TXMLDataBindingIterateItemsProc; AData: Pointer): TXMLDataBindingItem;
var var
abort: Boolean; abort: Boolean;
@ -1310,7 +1340,8 @@ var
items: TObjectList; items: TObjectList;
begin begin
hashName := AItem.Name; { LowerCase because XML is case-sensitive, but Delphi isn't. }
hashName := LowerCase(AItem.Name);
if not itemNames.Exists(hashName) then if not itemNames.Exists(hashName) then
begin begin
@ -1777,6 +1808,8 @@ var
begin begin
inherited; inherited;
// #ToDo1 -oMvR: replacing a simpletypealias with nil doesn't quite work. not sure yet why.
for propertyIndex := Pred(PropertyCount) downto 0 do for propertyIndex := Pred(PropertyCount) downto 0 do
begin begin
propertyItem := Properties[propertyIndex]; propertyItem := Properties[propertyIndex];

View File

@ -24,7 +24,7 @@
<Borland.Personality>Delphi.Personality</Borland.Personality> <Borland.Personality>Delphi.Personality</Borland.Personality>
<Borland.ProjectType /> <Borland.ProjectType />
<BorlandProject> <BorlandProject>
<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters><Parameters Name="RunParams">"P:\updateserver\xsd\DealerCarTrimMsg_v0101.xsd"</Parameters></Parameters><VersionInfo><VersionInfo Name="IncludeVerInfo">False</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">0</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">1043</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName"></VersionInfoKeys><VersionInfoKeys Name="FileDescription"></VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">X2XMLDataBinding.dpr</Source></Source></Delphi.Personality></BorlandProject></BorlandProject> <BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters><Parameters Name="RunParams">"P:\updateserver\xsd\ads111.xsd"</Parameters></Parameters><VersionInfo><VersionInfo Name="IncludeVerInfo">False</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">0</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">1043</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName"></VersionInfoKeys><VersionInfoKeys Name="FileDescription"></VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">X2XMLDataBinding.dpr</Source></Source></Delphi.Personality></BorlandProject></BorlandProject>
</ProjectExtensions> </ProjectExtensions>
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" /> <Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
<ItemGroup> <ItemGroup>