From 595ae4ea7d71c598ef84c45f6d4b6e902d14faf9 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Thu, 15 Jul 2010 10:57:03 +0000 Subject: [PATCH] Added: XSDValidate methods to ensure: - required elements are created (with limitations; no data content validation or default value checking is performed) - the order of Sequences is maintained --- Shared/XMLDataBindingUtils.pas | 142 ++++++++++++ Units/DelphiXMLDataBindingGenerator.pas | 186 +++++++++++----- Units/DelphiXMLDataBindingResources.pas | 55 +++-- Units/XMLDataBindingGenerator.pas | 285 ++++++++++++++++++------ X2XMLDataBinding.dproj | 2 +- 5 files changed, 526 insertions(+), 144 deletions(-) diff --git a/Shared/XMLDataBindingUtils.pas b/Shared/XMLDataBindingUtils.pas index 6b4ff01..657878c 100644 --- a/Shared/XMLDataBindingUtils.pas +++ b/Shared/XMLDataBindingUtils.pas @@ -22,6 +22,12 @@ type TXMLTimeFragments = set of TXMLTimeFragment; + IXSDValidate = interface + ['{3BFDC851-7459-403B-87B3-A52E9E85BC8C}'] + procedure XSDValidate; + end; + + const AllTimeFragments = [Low(TXMLTimeFragment)..High(TXMLTimeFragment)]; @@ -41,6 +47,11 @@ const function GetNodeIsNil(ANode: IXMLNode): Boolean; procedure SetNodeIsNil(ANode: IXMLNode; ASetNil: Boolean); + + procedure XSDValidate(AParent: IXMLNode; ARecurse: Boolean = True; AValidateParent: Boolean = True); + procedure CreateRequiredElements(AParent: IXMLNode; ANodes: array of string); + procedure CreateRequiredAttributes(AParent: IXMLNode; ANodes: array of string); + procedure SortChildNodes(AParent: IXMLNode; ASortOrder: array of string); const @@ -78,9 +89,20 @@ const implementation uses DateUtils, + Math, + Types, Windows; +type + PSortNodeInfo = ^TSortNodeInfo; + TSortNodeInfo = record + Node: IXMLNode; + SortIndex: Integer; + OriginalIndex: Integer; + end; + + function DateTimeToXML(ADate: TDateTime; AFormat: TXMLDateTimeFormat; ATimeFragments: TXMLTimeFragments): string; var formatSettings: TFormatSettings; @@ -417,5 +439,125 @@ begin ANode.AttributeNodes.Delete(XMLIsNilAttribute, XMLSchemaInstanceURI); end; + +function DoSortNodes(Item1, Item2: Pointer): Integer; +var + nodeInfo1: PSortNodeInfo; + nodeInfo2: PSortNodeInfo; + +begin + nodeInfo1 := Item1; + nodeInfo2 := Item2; + + if (nodeInfo1^.SortIndex > -1) and (nodeInfo2^.SortIndex = -1) then + Result := GreaterThanValue + + else if (nodeInfo1^.SortIndex = -1) and (nodeInfo2^.SortIndex > -1) then + Result := LessThanValue + + else if (nodeInfo1^.SortIndex = -1) and (nodeInfo2^.SortIndex = -1) then + Result := CompareValue(nodeInfo1^.OriginalIndex, nodeInfo2^.OriginalIndex) + + else + Result := CompareValue(nodeInfo1^.SortIndex, nodeInfo2^.SortIndex); +end; + + +procedure XSDValidate(AParent: IXMLNode; ARecurse, AValidateParent: Boolean); +var + validate: IXSDValidate; + childIndex: Integer; + +begin + if AValidateParent and Supports(AParent, IXSDValidate, validate) then + validate.XSDValidate; + + if ARecurse then + begin + for childIndex := 0 to Pred(AParent.ChildNodes.Count) do + XSDValidate(AParent.ChildNodes[childIndex], ARecurse, True); + end; +end; + + +procedure CreateRequiredElements(AParent: IXMLNode; ANodes: array of string); +var + nodeIndex: Integer; + node: IXMLNode; + +begin + for nodeIndex := Low(ANodes) to High(ANodes) do + begin + if not Assigned(AParent.ChildNodes.FindNode(ANodes[nodeIndex])) then + begin + node := AParent.OwnerDocument.CreateElement(ANodes[nodeIndex], AParent.NamespaceURI); + AParent.ChildNodes.Add(node); + end; + end; +end; + + +procedure CreateRequiredAttributes(AParent: IXMLNode; ANodes: array of string); +var + nodeIndex: Integer; + +begin + for nodeIndex := Low(ANodes) to High(ANodes) do + begin + if not Assigned(AParent.AttributeNodes.FindNode(ANodes[nodeIndex])) then + AParent.Attributes[ANodes[nodeIndex]] := ''; + end; +end; + + +procedure SortChildNodes(AParent: IXMLNode; ASortOrder: array of string); +var + sortList: TList; + nodeInfo: PSortNodeInfo; + childIndex: Integer; + sortIndex: Integer; + node: IXMLNode; + +begin + sortList := TList.Create; + try + { Build a list of the child nodes, with their original index and the + index in the ASortOrder array. } + for childIndex := 0 to Pred(AParent.ChildNodes.Count) do + begin + New(nodeInfo); + nodeInfo^.Node := AParent.ChildNodes[childIndex]; + nodeInfo^.OriginalIndex := childIndex; + + for sortIndex := Low(ASortOrder) to High(ASortOrder) do + begin + if ASortOrder[sortIndex] = nodeInfo^.Node.NodeName then + begin + nodeInfo^.SortIndex := sortIndex; + Break; + end; + end; + + sortList.Add(nodeInfo); + end; + + sortList.Sort(DoSortNodes); + + { Rebuild the ChildNodes list } + for childIndex := 0 to Pred(sortList.Count) do + begin + node := PSortNodeInfo(sortList[childIndex])^.Node; + + AParent.ChildNodes.Remove(node); + AParent.ChildNodes.Insert(childIndex, node); + end; + finally + for sortIndex := 0 to Pred(sortList.Count) do + Dispose(PSortNodeInfo(sortList[sortIndex])); + + FreeAndNil(sortList); + end; +end; + end. diff --git a/Units/DelphiXMLDataBindingGenerator.pas b/Units/DelphiXMLDataBindingGenerator.pas index 969e232..a81cb45 100644 --- a/Units/DelphiXMLDataBindingGenerator.pas +++ b/Units/DelphiXMLDataBindingGenerator.pas @@ -67,6 +67,8 @@ type procedure WriteSchemaEnumeration(AStream: TStreamHelper; AItem: TXMLDataBindingEnumeration; ASection: TDelphiXMLSection); procedure WriteSchemaEnumerationArray(AStream: TStreamHelper; AItem: TXMLDataBindingEnumeration); + procedure WriteValidate(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection); + function GetDelphiNodeType(AProperty: TXMLDataBindingProperty): TDelphiNodeType; function DataTypeConversion(const ADestination, ASource: String; ADataType: IXMLTypeDef; AAccessor: TDelphiAccessor; ANodeType: TDelphiNodeType; const ALinesBefore: String = ''): String; function XMLToNativeDataType(const ADestination, ASource: String; ADataType: IXMLTypeDef; ANodeType: TDelphiNodeType; const ALinesBefore: String = ''): String; @@ -366,7 +368,7 @@ begin case AItem.ItemType of itEnumerationMember: - Result := TXMLDataBindingEnumerationMember(AItem).Enumeration.TranslatedName + '_' + Result; + Result := DelphiSafeName(TXMLDataBindingEnumerationMember(AItem).Enumeration.TranslatedName) + '_' + Result; end; end; @@ -566,66 +568,11 @@ end; procedure TDelphiXMLDataBindingGenerator.WriteImplementationUses(AStream: TStreamHelper; ASchemaList: TXMLSchemaList); -var - needsUtils: Boolean; - schemaIndex: Integer; - schema: TXMLDataBindingSchema; - itemIndex: Integer; - interfaceItem: TXMLDataBindingInterface; - propertyIndex: Integer; - propertyItem: TXMLDataBindingSimpleProperty; - typeMapping: TTypeMapping; - begin - needsUtils := False; - - { Determine if any helper functions are used } - for schemaIndex := Pred(ASchemaList.Count) downto 0 do - begin - schema := ASchemaList[schemaIndex]; - - for itemIndex := Pred(schema.ItemCount) downto 0 do - begin - if schema.Items[itemIndex].ItemType = itInterface then - begin - interfaceItem := TXMLDataBindingInterface(schema.Items[itemIndex]); - - for propertyIndex := Pred(interfaceItem.PropertyCount) downto 0 do - begin - if interfaceItem.Properties[propertyIndex].PropertyType = ptSimple then - begin - propertyItem := TXMLDataBindingSimpleProperty(interfaceItem.Properties[propertyIndex]); - - if propertyItem.IsNillable then - begin - needsUtils := True; - Break; - end; - - if GetDataTypeMapping(propertyItem.DataType, typeMapping) then - begin - if TypeConversionReqUtils[typeMapping.Conversion] then - begin - needsUtils := True; - Break; - end; - end; - end; - end; - end; - end; - end; - - + { In ye olde days this is where we checked if XMLDataBindingUtils was required. With the + introduction of the IXSDValidate, this is practically always the case. } AStream.WriteLn('uses'); - - if needsUtils then - begin - AStream.WriteLn(' SysUtils,'); - AStream.WriteLn(' XMLDataBindingUtils;'); - end else - AStream.WriteLn(' SysUtils;'); - + AStream.WriteLn(' SysUtils;'); AStream.WriteLn; end; @@ -726,6 +673,10 @@ begin parent := ItemClass; + if AItem.CanValidate then + parent := parent + ', ' + XSDValidateInterface; + + AStream.WriteLnNamedFmt(InterfaceItemClass, ['Name', AItem.TranslatedName, 'ParentName', parent]); @@ -914,6 +865,7 @@ begin if ASection = dxsClass then AStream.WriteLn(' protected'); + WriteValidate(AStream, AItem, ASection); hasMembers := WriteSchemaInterfaceCollectionProperties(AStream, AItem, ASection); for member := Low(TDelphiXMLMember) to High(TDelphiXMLMember) do @@ -1408,6 +1360,122 @@ begin end; +procedure TDelphiXMLDataBindingGenerator.WriteValidate(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection); +var + propertyIndex: Integer; + propertyItem: TXMLDataBindingProperty; + elementSortOrder: string; + elementSortCount: Integer; + elementRequired: string; + elementRequiredCount: Integer; + attributeRequired: string; + attributeRequiredCount: Integer; + +begin + if AItem.DocumentElement then + begin + case ASection of + dxsInterface, + dxsClass: + AStream.WriteLn(XSDValidateDocumentMethodInterface); + + dxsImplementation: + AStream.WriteLnNamedFmt(XSDValidateDocumentMethodImplementation, + ['Name', AItem.TranslatedName]); + end; + end; + + if AItem.CanValidate then + begin + case ASection of + dxsInterface, + dxsClass: + begin + AStream.WriteLn(XSDValidateMethodInterface); + AStream.WriteLn(''); + end; + + dxsImplementation: + begin + AStream.WriteLnNamedFmt(XSDValidateMethodImplementationBegin, + ['Name', AItem.TranslatedName]); + + elementSortOrder := ''; + elementSortCount := 0; + + elementRequired := ''; + elementRequiredCount := 0; + + attributeRequired := ''; + attributeRequiredCount := 0; + + + for propertyIndex := 0 to Pred(AItem.PropertyCount) do + begin + propertyItem := AItem.Properties[propertyIndex]; + + if propertyItem.IsAttribute then + begin + if not propertyItem.IsOptional then + begin + attributeRequired := attributeRequired + ', ' + QuotedStr(propertyItem.Name); + Inc(attributeRequiredCount); + end; + end else if not propertyItem.IsNodeValue then + begin + elementSortOrder := elementSortOrder + ', ' + QuotedStr(propertyItem.Name); + Inc(elementSortCount); + + if (not propertyItem.IsOptional) and (not propertyItem.IsRepeating) then + begin + case propertyItem.PropertyType of + ptSimple: + begin + elementRequired := elementRequired + ', ' + QuotedStr(propertyItem.Name); + Inc(elementRequiredCount); + end; + + ptItem: + { For Item properties, we call our getter property. This ensures the child element exists, + but also that it is created using our binding implementation. Otherwise there will be no + IXSDValidate interface to call on the newly created node. } + AStream.WriteLnNamedFmt(XSDValidateMethodImplementationComplex, + ['Name', propertyItem.TranslatedName]); + end; + end; + end; + end; + + + if elementRequiredCount > 0 then + begin + Delete(elementRequired, 1, 2); + AStream.WriteLnNamedFmt(XSDValidateMethodImplementationRequired, + ['RequiredElements', elementRequired]); + end; + + + if attributeRequiredCount > 0 then + begin + Delete(attributeRequired, 1, 2); + AStream.WriteLnNamedFmt(XSDValidateMethodImplementationAttrib, + ['RequiredAttributes', attributeRequired]); + end; + + if elementSortCount > 1 then + begin + Delete(elementSortOrder, 1, 2); + AStream.WriteLnNamedFmt(XSDValidateMethodImplementationSort, + ['SortOrder', elementSortOrder]); + end; + + AStream.WriteLn(XSDValidateMethodImplementationEnd); + end; + end; + end; +end; + + function TDelphiXMLDataBindingGenerator.GetDelphiNodeType(AProperty: TXMLDataBindingProperty): TDelphiNodeType; begin if AProperty.IsAttribute then diff --git a/Units/DelphiXMLDataBindingResources.pas b/Units/DelphiXMLDataBindingResources.pas index 1e654f7..9b75ffe 100644 --- a/Units/DelphiXMLDataBindingResources.pas +++ b/Units/DelphiXMLDataBindingResources.pas @@ -25,7 +25,8 @@ const '%:s' + ' Classes,' + CrLf + ' XMLDoc,' + CrLf + - ' XMLIntf;' + CrLf + + ' XMLIntf,' + CrLf + + ' XMLDataBindingUtils;' + CrLf + '' + CrLf + 'type' + CrLf; @@ -70,6 +71,30 @@ const '' + CrLf; + + XSDValidateInterface = 'IXSDValidate'; + + XSDValidateDocumentMethodInterface = ' procedure XSDValidateDocument;'; + + XSDValidateDocumentMethodImplementation = 'procedure TXML%:s.XSDValidateDocument;' + CrLf + + 'begin' + CrLf + + ' XMLDataBindingUtils.XSDValidate(Self);' + CrLf + + 'end;' + CrLf; + + + XSDValidateMethodInterface = ' procedure XSDValidate;'; + + XSDValidateMethodImplementationBegin = 'procedure TXML%:s.XSDValidate;' + CrLf + + 'begin'; + + XSDValidateMethodImplementationRequired = ' CreateRequiredElements(Self, [%:s]);'; + XSDValidateMethodImplementationComplex = ' Get%:s;'; + XSDValidateMethodImplementationAttrib = ' CreateRequiredAttributes(Self, [%:s]);'; + XSDValidateMethodImplementationSort = ' SortChildNodes(Self, [%:s]);'; + + XSDValidateMethodImplementationEnd = 'end;' + CrLf; + + PropertyIntfMethodGetOptional = ' function GetHas%:s: Boolean;'; PropertyIntfMethodGetNil = ' function Get%:sIsNil: Boolean;'; PropertyIntfMethodGetText = ' function Get%:sText: WideString;'; @@ -248,14 +273,14 @@ const ( { dntElement } ' %:s := ChildNodes[''%:s''].NodeValue;', { dntAttribute } ' %:s := AttributeNodes[''%:s''].NodeValue;', - { dntNodeValue } ' %:s := NodeValue;', + { dntNodeValue } ' %:s := GetNodeValue;', { dntCustom } ' %:s := %:s;' ), { daSet } ( { dntElement } ' ChildNodes[''%:s''].NodeValue := %:s;', { dntAttribute } ' SetAttribute(''%:s'', %:s);', - { dntNodeValue } ' NodeValue := %:s;', + { dntNodeValue } ' SetNodeValue(%:s);', { dntCustom } ' %:s := %:s;' ) ); @@ -291,12 +316,12 @@ const ( { tcNone } '', { tcBoolean } '', - { tcFloat } ' %:s := XMLToFloat(NodeValue);', - { tcDateTime } ' %:s := XMLToDateTime(NodeValue, xdtDateTime);', - { tcDate } ' %:s := XMLToDateTime(NodeValue, xdtDate);', - { tcTime } ' %:s := XMLToDateTime(NodeValue, xdtTime);', - { tcString } ' %:s := NodeValue;', - { tcBase64 } ' %:s := Base64Decode(Trim(NodeValue));' + { tcFloat } ' %:s := XMLToFloat(GetNodeValue);', + { tcDateTime } ' %:s := XMLToDateTime(GetNodeValue, xdtDateTime);', + { tcDate } ' %:s := XMLToDateTime(GetNodeValue, xdtDate);', + { tcTime } ' %:s := XMLToDateTime(GetNodeValue, xdtTime);', + { tcString } ' %:s := GetNodeValue;', + { tcBase64 } ' %:s := Base64Decode(Trim(GetNodeValue));' ), { dntCustom} ( @@ -337,13 +362,13 @@ const { dntNodeValue } ( { tcNone } '', - { tcBoolean } ' NodeValue := BoolToXML(%:s);', - { tcFloat } ' NodeValue := FloatToXML(%:s);', - { tcDateTime } ' NodeValue := DateTimeToXML(%:s, xdtDateTime);', - { tcDate } ' NodeValue := DateTimeToXML(%:s, xdtDate);', - { tcTime } ' NodeValue := DateTimeToXML(%:s, xdtTime);', + { tcBoolean } ' SetNodeValue(BoolToXML(%:s));', + { tcFloat } ' SetNodeValue(FloatToXML(%:s));', + { tcDateTime } ' SetNodeValue(DateTimeToXML(%:s, xdtDateTime));', + { tcDate } ' SetNodeValue(DateTimeToXML(%:s, xdtDate));', + { tcTime } ' SetNodeValue(DateTimeToXML(%:s, xdtTime));', { tcString } '', - { tcBase64 } ' NodeValue := Base64Encode(%:s);' + { tcBase64 } ' SetNodeValue(Base64Encode(%:s));' ), { dntCustom} ( diff --git a/Units/XMLDataBindingGenerator.pas b/Units/XMLDataBindingGenerator.pas index a6626ac..262851d 100644 --- a/Units/XMLDataBindingGenerator.pas +++ b/Units/XMLDataBindingGenerator.pas @@ -72,7 +72,7 @@ type function FindInterface(ASchema: TXMLDataBindingSchema; const AName: String; AType: TXMLDataBindingInterfaceType): TXMLDataBindingInterface; procedure FindEnumerationProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean); - function FindEnumeration(ASchema: TXMLDataBindingSchema; const AName: String): TXMLDataBindingEnumeration; + function FindEnumeration(ASchema: TXMLDataBindingSchema; const AName: String; AAttribute: Boolean): TXMLDataBindingEnumeration; procedure ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem); @@ -81,6 +81,7 @@ type procedure ResolveItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingUnresolvedItem); procedure ResolveNameConflicts; + procedure PostProcessSchema(ASchema: TXMLDataBindingSchema); procedure PostProcessItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingItem); function TranslateItemName(AItem: TXMLDataBindingItem): String; virtual; @@ -194,12 +195,14 @@ type TXMLDataBindingInterface = class(TXMLDataBindingItem) private FInterfaceType: TXMLDataBindingInterfaceType; + FIsSequence: Boolean; FProperties: TObjectList; FBaseName: String; FBaseItem: TXMLDataBindingInterface; function GetProperties(Index: Integer): TXMLDataBindingProperty; function GetPropertyCount: Integer; + function GetCanValidate: Boolean; protected function GetItemType: TXMLDataBindingItemType; override; @@ -213,7 +216,9 @@ type property BaseName: String read FBaseName write FBaseName; property BaseItem: TXMLDataBindingInterface read FBaseItem write FBaseItem; + property CanValidate: Boolean read GetCanValidate; property InterfaceType: TXMLDataBindingInterfaceType read FInterfaceType; + property IsSequence: Boolean read FIsSequence; property PropertyCount: Integer read GetPropertyCount; property Properties[Index: Integer]: TXMLDataBindingProperty read GetProperties; @@ -234,18 +239,20 @@ type TXMLDataBindingEnumeration = class(TXMLDataBindingItem) private - FMembers: TObjectList; + FMembers: TObjectList; + FIsAttribute: Boolean; function GetMemberCount: Integer; function GetMembers(Index: Integer): TXMLDataBindingEnumerationMember; protected function GetItemType: TXMLDataBindingItemType; override; public - constructor Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; AEnumerations: IXMLEnumerationCollection; const AName: String); + constructor Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; AEnumerations: IXMLEnumerationCollection; const AName: String; AIsAttribute: Boolean); destructor Destroy; override; property MemberCount: Integer read GetMemberCount; property Members[Index: Integer]: TXMLDataBindingEnumerationMember read GetMembers; + property IsAttribute: Boolean read FIsAttribute; end; @@ -307,12 +314,14 @@ type TXMLDataBindingUnresolvedItem = class(TXMLDataBindingItem) private FInterfaceType: TXMLDataBindingInterfaceType; + FIsAttribute: Boolean; protected function GetItemType: TXMLDataBindingItemType; override; public - constructor Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String; AInterfaceType: TXMLDataBindingInterfaceType); + constructor Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String; AInterfaceType: TXMLDataBindingInterfaceType; AIsAttribute: Boolean); property InterfaceType: TXMLDataBindingInterfaceType read FInterfaceType; + property IsAttribute: Boolean read FIsAttribute; end; @@ -581,9 +590,10 @@ end; procedure TXMLDataBindingGenerator.GenerateElementObjects(ASchema: TXMLDataBindingSchema; ARootDocument: Boolean); var - schemaDef: IXMLSchemaDef; - elementIndex: Integer; - item: TXMLDataBindingItem; + schemaDef: IXMLSchemaDef; + elementIndex: Integer; + item: TXMLDataBindingItem; + attributeIndex: Integer; begin schemaDef := ASchema.SchemaDef; @@ -595,6 +605,9 @@ begin if Assigned(item) and ARootDocument then item.DocumentElement := True; end; + + for attributeIndex := 0 to Pred(schemaDef.AttributeDefs.Count) do + ProcessElement(ASchema, schemaDef.AttributeDefs[attributeIndex]); end; @@ -646,7 +659,7 @@ begin if simpleType.Enumerations.Count > 0 then begin - enumerationObject := TXMLDataBindingEnumeration.Create(Self, simpleType, simpleType.Enumerations, simpleType.Name); + enumerationObject := TXMLDataBindingEnumeration.Create(Self, simpleType, simpleType.Enumerations, simpleType.Name, False); ASchema.AddItem(enumerationObject); end; end; @@ -724,6 +737,7 @@ var simpleAliasItem: TXMLDataBindingSimpleTypeAliasItem; elementIndex: Integer; simpleTypeDef: IXMLSimpleTypeDef; + typeDef: IXMLTypeDef; begin Result := nil; @@ -736,7 +750,7 @@ begin if not Assigned(Result) then begin - Result := TXMLDataBindingUnresolvedItem.Create(Self, AElement, AElement.Ref.Name, ifElement); + Result := TXMLDataBindingUnresolvedItem.Create(Self, AElement, AElement.Ref.Name, ifElement, False); ASchema.AddItem(Result); end; end else @@ -750,7 +764,7 @@ begin if not Assigned(Result) then begin - Result := TXMLDataBindingUnresolvedItem.Create(Self, AElement, AElement.DataTypeName, ifComplexType); + Result := TXMLDataBindingUnresolvedItem.Create(Self, AElement, AElement.DataTypeName, ifComplexType, True); ASchema.AddItem(Result); end; @@ -767,11 +781,11 @@ begin if simpleTypeDef.Enumerations.Count > 0 then begin { References enumeration. } - Result := FindEnumeration(ASchema, AElement.DataTypeName); + Result := FindEnumeration(ASchema, AElement.DataTypeName, False); if not Assigned(Result) then begin - Result := TXMLDataBindingUnresolvedItem.Create(Self, AElement, AElement.DataTypeName, ifEnumeration); + Result := TXMLDataBindingUnresolvedItem.Create(Self, AElement, AElement.DataTypeName, ifEnumeration, False); ASchema.AddItem(Result); end; end else if simpleTypeDef.IsBuiltInType and AElement.IsGlobal then @@ -791,7 +805,7 @@ begin if AElement.DataType.Enumerations.Count > 0 then begin { Enumeration } - enumerationObject := TXMLDataBindingEnumeration.Create(Self, AElement, AElement.DataType.Enumerations, AElement.Name); + enumerationObject := TXMLDataBindingEnumeration.Create(Self, AElement, AElement.DataType.Enumerations, AElement.Name, False); ASchema.AddItem(enumerationObject); Result := enumerationObject; end else if AElement.DataType.IsComplex then @@ -812,6 +826,29 @@ begin for attributeIndex := 0 to Pred(AElement.AttributeDefs.Count) do ProcessAttribute(ASchema, AElement.AttributeDefs[attributeIndex], interfaceObject); + 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); + simpleAliasItem.DataType := typeDef; + ASchema.AddItem(simpleAliasItem); + + Result := simpleAliasItem; + Break; + end; + + typeDef := typeDef.BaseType; + end; end; end; end; @@ -820,11 +857,12 @@ end; function TXMLDataBindingGenerator.ProcessElement(ASchema: TXMLDataBindingSchema; AAttribute: IXMLAttributeDef): TXMLDataBindingItem; var - enumerationObject: TXMLDataBindingEnumeration; - interfaceObject: TXMLDataBindingInterface; - complexAliasItem: TXMLDataBindingComplexTypeAliasItem; - simpleAliasItem: TXMLDataBindingSimpleTypeAliasItem; - simpleTypeDef: IXMLSimpleTypeDef; + enumerationObject: TXMLDataBindingEnumeration; + interfaceObject: TXMLDataBindingInterface; + complexAliasItem: TXMLDataBindingComplexTypeAliasItem; + simpleAliasItem: TXMLDataBindingSimpleTypeAliasItem; + simpleTypeDef: IXMLSimpleTypeDef; + typeDef: IXMLTypeDef; begin Result := nil; @@ -836,7 +874,7 @@ begin if not Assigned(Result) then begin - Result := TXMLDataBindingUnresolvedItem.Create(Self, AAttribute, AAttribute.Ref.Name, ifElement); + Result := TXMLDataBindingUnresolvedItem.Create(Self, AAttribute, AAttribute.Ref.Name, ifElement, True); ASchema.AddItem(Result); end; end else @@ -850,7 +888,7 @@ begin if not Assigned(Result) then begin - Result := TXMLDataBindingUnresolvedItem.Create(Self, AAttribute, AAttribute.DataTypeName, ifComplexType); + Result := TXMLDataBindingUnresolvedItem.Create(Self, AAttribute, AAttribute.DataTypeName, ifComplexType, True); ASchema.AddItem(Result); end; @@ -867,11 +905,11 @@ begin if simpleTypeDef.Enumerations.Count > 0 then begin { References enumeration. } - Result := FindEnumeration(ASchema, AAttribute.DataTypeName); + Result := FindEnumeration(ASchema, AAttribute.DataTypeName, True); if not Assigned(Result) then begin - Result := TXMLDataBindingUnresolvedItem.Create(Self, AAttribute, AAttribute.DataTypeName, ifEnumeration); + Result := TXMLDataBindingUnresolvedItem.Create(Self, AAttribute, AAttribute.DataTypeName, ifEnumeration, True); ASchema.AddItem(Result); end; end else if simpleTypeDef.IsBuiltInType and AAttribute.IsGlobal then @@ -891,7 +929,7 @@ begin if AAttribute.DataType.Enumerations.Count > 0 then begin { Enumeration } - enumerationObject := TXMLDataBindingEnumeration.Create(Self, AAttribute, AAttribute.DataType.Enumerations, AAttribute.Name); + enumerationObject := TXMLDataBindingEnumeration.Create(Self, AAttribute, AAttribute.DataType.Enumerations, AAttribute.Name, True); ASchema.AddItem(enumerationObject); Result := enumerationObject; end else if AAttribute.DataType.IsComplex then @@ -903,6 +941,29 @@ begin ASchema.AddItem(interfaceObject); Result := interfaceObject; + 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); + simpleAliasItem.DataType := typeDef; + ASchema.AddItem(simpleAliasItem); + + Result := simpleAliasItem; + Break; + end; + + typeDef := typeDef.BaseType; + end; end; end; end; @@ -1015,6 +1076,12 @@ type Name: String; end; + PFindEnumerationInfo = ^TFindEnumerationInfo; + TFindEnumerationInfo = record + Attribute: Boolean; + Name: String; + end; + procedure TXMLDataBindingGenerator.FindInterfaceProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean); var @@ -1051,15 +1118,25 @@ end; procedure TXMLDataBindingGenerator.FindEnumerationProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean); +var + findInfo: PFindEnumerationInfo; + begin - AAbort := (AItem.ItemType = itEnumeration) and - (AItem.Name = PChar(AData)); + findInfo := PFindEnumerationInfo(AData); + AAbort := (AItem.ItemType = itEnumeration) and + (AItem.Name = findInfo^.Name) and + (TXMLDataBindingEnumeration(AItem).IsAttribute = findInfo^.Attribute); end; -function TXMLDataBindingGenerator.FindEnumeration(ASchema: TXMLDataBindingSchema; const AName: String): TXMLDataBindingEnumeration; +function TXMLDataBindingGenerator.FindEnumeration(ASchema: TXMLDataBindingSchema; const AName: String; AAttribute: Boolean): TXMLDataBindingEnumeration; +var + findInfo: TFindEnumerationInfo; + begin - Result := TXMLDataBindingEnumeration(IterateSchemaItems(ASchema, FindEnumerationProc, PChar(AName))); + findInfo.Attribute := AAttribute; + findInfo.Name := AName; + Result := TXMLDataBindingEnumeration(IterateSchemaItems(ASchema, FindEnumerationProc, @findInfo)); end; @@ -1158,14 +1235,14 @@ begin Exit; if AItem.InterfaceType = ifEnumeration then - referenceItem := FindEnumeration(ASchema, AItem.Name) + referenceItem := FindEnumeration(ASchema, AItem.Name, AItem.IsAttribute) else begin referenceItem := FindInterface(ASchema, AItem.Name, AItem.InterfaceType); if (not Assigned(referenceItem)) and (AItem.InterfaceType = ifElement) then - referenceItem := FindEnumeration(ASchema, AItem.Name); + referenceItem := FindEnumeration(ASchema, AItem.Name, AItem.IsAttribute); end; if Assigned(referenceItem) then @@ -1285,6 +1362,13 @@ begin Inc(depth); end; + { test } + if not resolved then + begin + newName := newName + IntToStr(Succ(itemIndex)); + resolved := True; + end; + if resolved then begin items.Delete(itemIndex); @@ -1325,8 +1409,41 @@ var begin { Translate name } - AItem.TranslatedName := TranslateItemName(AItem); - + AItem.TranslatedName := TranslateItemName(AItem); + + { Process members } + case AItem.ItemType of + itInterface: + begin + interfaceItem := TXMLDataBindingInterface(AItem); + + if (not Assigned(interfaceItem.BaseItem)) and + (Length(interfaceItem.BaseName) > 0) then + begin + { Assume this is a reference to a simple type } + if Supports(interfaceItem.SchemaItem, IXMLTypedSchemaItem, typedSchemaItem) then + begin + propertyItem := TXMLDataBindingSimpleProperty.Create(Self, interfaceItem.SchemaItem, 'Value', + typedSchemaItem.DataType.BaseType); + propertyItem.IsNodeValue := True; + + interfaceItem.AddProperty(propertyItem); + end; + end; + + + for propertyIndex := 0 to Pred(interfaceItem.PropertyCount) do + PostProcessItem(ASchema, interfaceItem.Properties[propertyIndex]); + end; + itEnumeration: + begin + enumerationItem := TXMLDataBindingEnumeration(AItem); + + for memberIndex := 0 to Pred(enumerationItem.MemberCount) do + PostProcessItem(ASchema, enumerationItem.Members[memberIndex]); + end; + end; + { Extract collections } if AItem.ItemType = itInterface then @@ -1381,40 +1498,6 @@ begin FreeAndNil(repeatingItems); end; end; - - - { Process members } - case AItem.ItemType of - itInterface: - begin - interfaceItem := TXMLDataBindingInterface(AItem); - - if (not Assigned(interfaceItem.BaseItem)) and - (Length(interfaceItem.BaseName) > 0) then - begin - { Assume this is a reference to a simple type } - if Supports(interfaceItem.SchemaItem, IXMLTypedSchemaItem, typedSchemaItem) then - begin - propertyItem := TXMLDataBindingSimpleProperty.Create(Self, interfaceItem.SchemaItem, 'NodeValue', - typedSchemaItem.DataType.BaseType); - propertyItem.IsNodeValue := True; - - interfaceItem.AddProperty(propertyItem); - end; - end; - - - for propertyIndex := 0 to Pred(interfaceItem.PropertyCount) do - PostProcessItem(ASchema, interfaceItem.Properties[propertyIndex]); - end; - itEnumeration: - begin - enumerationItem := TXMLDataBindingEnumeration(AItem); - - for memberIndex := 0 to Pred(enumerationItem.MemberCount) do - PostProcessItem(ASchema, enumerationItem.Members[memberIndex]); - end; - end; end; @@ -1599,11 +1682,31 @@ end; { TXMLDataBindingInterface } constructor TXMLDataBindingInterface.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String); +var + elementDef: IXMLElementDef; + compositor: IXMLElementCompositor; + begin inherited Create(AOwner, ASchemaItem, AName); FProperties := TObjectList.Create(True); FInterfaceType := GetInterfaceType(SchemaItem); + FIsSequence := False; + + if Supports(ASchemaItem, IXMLElementDef, elementDef) then + begin + { To access the compositor, we need to go through a ChildElement's ParentNode. + + Tried but did not work: + ASchemaItem as IXMLElementCompositor + ASchemaItem.ChildNodes[0] as IXMLElementCompositor + } + if elementDef.ChildElements.Count > 0 then + begin + if Supports(elementDef.ChildElements[0].ParentNode, IXMLElementCompositor, compositor) then + FIsSequence := (compositor.CompositorType = ctSequence); + end; + end; end; @@ -1660,6 +1763,48 @@ begin end; +function TXMLDataBindingInterface.GetCanValidate: Boolean; +var + propertyIndex: Integer; + elementCount: Integer; + requiredCount: Integer; + propertyItem: TXMLDataBindingProperty; + +begin + Result := False; + + elementCount := 0; + requiredCount := 0; + + for propertyIndex := 0 to Pred(PropertyCount) do + begin + propertyItem := Properties[propertyIndex]; + + if propertyItem.IsAttribute then + begin + if not propertyItem.IsOptional then + Inc(requiredCount); + end else + begin + Inc(elementCount); + if not propertyItem.IsOptional then + Inc(requiredCount); + end; + end; + + + { If there's a required element or attribute, + we can validate their presence. } + if requiredCount > 0 then + Result := True + + { If our children are a sequence and there's at least two elements, + we can validate their order. } + else if IsSequence and (elementCount > 1) then + Result := True; +end; + + function TXMLDataBindingInterface.GetItemType: TXMLDataBindingItemType; begin Result := itInterface; @@ -1694,14 +1839,15 @@ end; { TXMLDataBindingEnumeration } -constructor TXMLDataBindingEnumeration.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; AEnumerations: IXMLEnumerationCollection; const AName: String); +constructor TXMLDataBindingEnumeration.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; AEnumerations: IXMLEnumerationCollection; const AName: String; AIsAttribute: Boolean); var memberIndex: Integer; begin inherited Create(AOwner, ASchemaItem, AName); - FMembers := TObjectList.Create; + FMembers := TObjectList.Create; + FIsAttribute := AIsAttribute; for memberIndex := 0 to Pred(AEnumerations.Count) do FMembers.Add(TXMLDataBindingEnumerationMember.Create(Owner, Self, AEnumerations.Items[memberIndex].Value)); @@ -1804,11 +1950,12 @@ end; { TXMLDataBindingUnresolvedItem } -constructor TXMLDataBindingUnresolvedItem.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String; AInterfaceType: TXMLDataBindingInterfaceType); +constructor TXMLDataBindingUnresolvedItem.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String; AInterfaceType: TXMLDataBindingInterfaceType; AIsAttribute: Boolean); begin inherited Create(AOwner, ASchemaItem, AName); - FInterfaceType := AInterfaceType; + FInterfaceType := AInterfaceType; + FIsAttribute := AIsAttribute; end; diff --git a/X2XMLDataBinding.dproj b/X2XMLDataBinding.dproj index 17ad493..98cf5d2 100644 --- a/X2XMLDataBinding.dproj +++ b/X2XMLDataBinding.dproj @@ -24,7 +24,7 @@ Delphi.Personality -FalseTrueFalse"P:\test\XMLDataBinding\Tests\Data\04. Type with attributes.xsd"FalseFalse1000FalseFalseFalseFalseFalse104312521.0.0.01.0.0.0X2XMLDataBinding.dpr +FalseTrueFalse"P:\test\XMLDataBinding\Tests\Data\01. Basic simple and complex types.xsd"FalseFalse1000FalseFalseFalseFalseFalse104312521.0.0.01.0.0.0X2XMLDataBinding.dpr