1271 lines
36 KiB
ObjectPascal
1271 lines
36 KiB
ObjectPascal
unit XMLDataBindingGenerator;
|
|
|
|
// #ToDo1 (MvR) 7-3-2008: check if List items can be collapsed if an item is
|
|
// already a list parent
|
|
// #ToDo3 (MvR) 7-3-2008: enum collections?
|
|
interface
|
|
uses
|
|
Classes,
|
|
Contnrs,
|
|
XMLSchema;
|
|
|
|
type
|
|
TXMLDataBindingSchema = class;
|
|
TXMLDataBindingItem = class;
|
|
TXMLDataBindingInterface = class;
|
|
TXMLDataBindingCollection = class;
|
|
TXMLDataBindingEnumerationMember = class;
|
|
TXMLDataBindingEnumeration = class;
|
|
TXMLDataBindingProperty = class;
|
|
|
|
|
|
TXMLDataBindingOutputType = (otSingle, otMultiple);
|
|
TXMLDataBindingItemType = (itInterface, itCollection, itEnumeration,
|
|
itEnumerationMember, itProperty, itForward);
|
|
TXMLDataBindingInterfaceType = (ifElement, ifComplexType);
|
|
TXMLDataBindingPropertyType = (ptSimple, ptItem);
|
|
|
|
|
|
TXMLDataBindingIterateItemsProc = procedure(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean) of object;
|
|
|
|
|
|
TXMLDataBindingGenerator = class(TObject)
|
|
private
|
|
FIncludePaths: TStrings;
|
|
FOutputPath: String;
|
|
FOutputType: TXMLDataBindingOutputType;
|
|
FSourceFileName: String;
|
|
|
|
FSchemas: TObjectList;
|
|
|
|
function GetSchemaCount(): Integer;
|
|
function GetSchemas(Index: Integer): TXMLDataBindingSchema;
|
|
protected
|
|
function LoadSchema(const AStream: TStream; const ASchemaName: String): TXMLDataBindingSchema;
|
|
function GetSchemaData(const ALocation: String): TStream;
|
|
function FindSchema(const ALocation: String): TXMLDataBindingSchema;
|
|
|
|
procedure GenerateSchemaObjects(ASchema: TXMLDataBindingSchema; ARootDocument: Boolean);
|
|
procedure GenerateElementObjects(ASchema: TXMLDataBindingSchema; ARootDocument: Boolean);
|
|
procedure GenerateComplexTypeObjects(ASchema: TXMLDataBindingSchema);
|
|
|
|
function ProcessElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef): TXMLDataBindingItem;
|
|
procedure ProcessChildElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef; AInterface: TXMLDataBindingInterface);
|
|
|
|
function IterateSchemaItems(ASchema: TXMLDataBindingSchema; AIterateProc: TXMLDataBindingIterateItemsProc; AData: Pointer): TXMLDataBindingItem;
|
|
|
|
procedure FindInterfaceProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean);
|
|
function FindInterface(ASchema: TXMLDataBindingSchema; const AName: String; AType: TXMLDataBindingInterfaceType): TXMLDataBindingInterface;
|
|
|
|
procedure FindCollectionProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean);
|
|
function FindCollection(ASchema: TXMLDataBindingSchema; const AName: String): TXMLDataBindingCollection;
|
|
|
|
procedure FindEnumerationProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean);
|
|
function FindEnumeration(ASchema: TXMLDataBindingSchema; const AName: String): TXMLDataBindingEnumeration;
|
|
|
|
procedure ResolveSchema(ASchema: TXMLDataBindingSchema);
|
|
procedure ResolveNameConflicts();
|
|
|
|
procedure TranslateSchema(ASchema: TXMLDataBindingSchema);
|
|
procedure TranslateItem(AItem: TXMLDataBindingItem);
|
|
function TranslateItemName(AItem: TXMLDataBindingItem): String; virtual;
|
|
|
|
procedure GenerateDataBinding(); virtual; abstract;
|
|
|
|
property SourceFileName: String read FSourceFileName write FSourceFileName;
|
|
property SchemaCount: Integer read GetSchemaCount;
|
|
property Schemas[Index: Integer]: TXMLDataBindingSchema read GetSchemas;
|
|
public
|
|
constructor Create();
|
|
destructor Destroy(); override;
|
|
|
|
procedure Execute(const AStream: TStream; const ASchemaName: String); overload;
|
|
procedure Execute(const AFileName: String); overload;
|
|
|
|
property IncludePaths: TStrings read FIncludePaths;
|
|
property OutputType: TXMLDataBindingOutputType read FOutputType write FOutputType;
|
|
property OutputPath: String read FOutputPath write FOutputPath;
|
|
end;
|
|
|
|
|
|
TXMLDataBindingSchema = class(TObject)
|
|
private
|
|
FIncludes: TObjectList;
|
|
FItems: TObjectList;
|
|
FItemsGenerated: Boolean;
|
|
FSchemaDef: IXMLSchemaDef;
|
|
FSchemaName: String;
|
|
|
|
function GetItemCount(): Integer;
|
|
function GetItems(Index: Integer): TXMLDataBindingItem;
|
|
function GetIncludeCount(): Integer;
|
|
function GetIncludes(Index: Integer): TXMLDataBindingSchema;
|
|
protected
|
|
procedure AddInclude(ASchema: TXMLDataBindingSchema);
|
|
procedure AddItem(AItem: TXMLDataBindingItem);
|
|
|
|
property ItemsGenerated: Boolean read FItemsGenerated write FItemsGenerated;
|
|
public
|
|
constructor Create();
|
|
destructor Destroy(); override;
|
|
|
|
property IncludeCount: Integer read GetIncludeCount;
|
|
property Includes[Index: Integer]: TXMLDataBindingSchema read GetIncludes;
|
|
|
|
property SchemaDef: IXMLSchemaDef read FSchemaDef write FSchemaDef;
|
|
property SchemaName: String read FSchemaName write FSchemaName;
|
|
|
|
property ItemCount: Integer read GetItemCount;
|
|
property Items[Index: Integer]: TXMLDataBindingItem read GetItems;
|
|
end;
|
|
|
|
|
|
TXMLDataBindingItem = class(TObject)
|
|
private
|
|
FDocumentElement: Boolean;
|
|
FName: String;
|
|
FSchemaItem: IXMLSchemaItem;
|
|
FTranslatedName: String;
|
|
|
|
function GetDocumentation(): String;
|
|
function GetHasDocumentation(): Boolean;
|
|
protected
|
|
function GetItemType(): TXMLDataBindingItemType; virtual; abstract;
|
|
procedure SetName(const Value: String);
|
|
procedure SetTranslatedName(const Value: string);
|
|
|
|
property SchemaItem: IXMLSchemaItem read FSchemaItem;
|
|
public
|
|
constructor Create(ASchemaItem: IXMLSchemaItem; const AName: String);
|
|
|
|
property DocumentElement: Boolean read FDocumentElement write FDocumentElement;
|
|
property Documentation: String read GetDocumentation;
|
|
property HasDocumentation: Boolean read GetHasDocumentation;
|
|
property ItemType: TXMLDataBindingItemType read GetItemType;
|
|
property Name: String read FName;
|
|
property TranslatedName: String read FTranslatedName;
|
|
end;
|
|
|
|
|
|
TXMLDataBindingInterface = class(TXMLDataBindingItem)
|
|
private
|
|
FInterfaceType: TXMLDataBindingInterfaceType;
|
|
FProperties: TObjectList;
|
|
FBaseName: String;
|
|
FBaseItem: TXMLDataBindingInterface;
|
|
|
|
function GetProperties(Index: Integer): TXMLDataBindingProperty;
|
|
function GetPropertyCount: Integer;
|
|
protected
|
|
function GetItemType(): TXMLDataBindingItemType; override;
|
|
|
|
procedure AddProperty(AProperty: TXMLDataBindingProperty);
|
|
public
|
|
constructor Create(ASchemaItem: IXMLSchemaItem; const AName: String);
|
|
destructor Destroy; override;
|
|
|
|
property BaseName: String read FBaseName write FBaseName;
|
|
property BaseItem: TXMLDataBindingInterface read FBaseItem write FBaseItem;
|
|
|
|
property InterfaceType: TXMLDataBindingInterfaceType read FInterfaceType;
|
|
|
|
property PropertyCount: Integer read GetPropertyCount;
|
|
property Properties[Index: Integer]: TXMLDataBindingProperty read GetProperties;
|
|
end;
|
|
|
|
|
|
TXMLDataBindingCollection = class(TXMLDataBindingItem)
|
|
private
|
|
FCollectionItem: TXMLDataBindingInterface;
|
|
protected
|
|
function GetItemType(): TXMLDataBindingItemType; override;
|
|
public
|
|
constructor Create(ASchemaItem: IXMLSchemaItem; ACollectionItem: TXMLDataBindingInterface; const AName: String);
|
|
|
|
property CollectionItem: TXMLDataBindingInterface read FCollectionItem;
|
|
end;
|
|
|
|
|
|
TXMLDataBindingEnumerationMember = class(TXMLDataBindingItem)
|
|
private
|
|
FEnumeration: TXMLDataBindingEnumeration;
|
|
protected
|
|
function GetItemType(): TXMLDataBindingItemType; override;
|
|
public
|
|
constructor Create(AEnumeration: TXMLDataBindingEnumeration; const AName: String);
|
|
|
|
property Enumeration: TXMLDataBindingEnumeration read FEnumeration;
|
|
end;
|
|
|
|
|
|
TXMLDataBindingEnumeration = class(TXMLDataBindingItem)
|
|
private
|
|
FDataType: IXMLTypeDef;
|
|
FMembers: TObjectList;
|
|
|
|
function GetMemberCount(): Integer;
|
|
function GetMembers(Index: Integer): TXMLDataBindingEnumerationMember;
|
|
protected
|
|
function GetItemType(): TXMLDataBindingItemType; override;
|
|
public
|
|
constructor Create(ASchemaItem: IXMLSchemaItem; ADataType: IXMLTypeDef; const AName: String);
|
|
destructor Destroy(); override;
|
|
|
|
property DataType: IXMLTypeDef read FDataType;
|
|
property MemberCount: Integer read GetMemberCount;
|
|
property Members[Index: Integer]: TXMLDataBindingEnumerationMember read GetMembers;
|
|
end;
|
|
|
|
|
|
TXMLDataBindingProperty = class(TXMLDataBindingItem)
|
|
private
|
|
FIsOptional: Boolean;
|
|
protected
|
|
function GetIsReadOnly(): Boolean; virtual; abstract;
|
|
|
|
function GetItemType(): TXMLDataBindingItemType; override;
|
|
function GetPropertyType(): TXMLDataBindingPropertyType; virtual; abstract;
|
|
public
|
|
property IsOptional: Boolean read FIsOptional write FIsOptional;
|
|
property IsReadOnly: Boolean read GetIsReadOnly;
|
|
property PropertyType: TXMLDataBindingPropertyType read GetPropertyType;
|
|
end;
|
|
|
|
|
|
TXMLDataBindingSimpleProperty = class(TXMLDataBindingProperty)
|
|
private
|
|
FDataType: IXMLTypeDef;
|
|
protected
|
|
function GetIsReadOnly(): Boolean; override;
|
|
function GetPropertyType(): TXMLDataBindingPropertyType; override;
|
|
public
|
|
constructor Create(ASchemaItem: IXMLSchemaItem; const AName: String; ADataType: IXMLTypeDef);
|
|
|
|
property DataType: IXMLTypeDef read FDataType;
|
|
end;
|
|
|
|
|
|
TXMLDataBindingItemProperty = class(TXMLDataBindingProperty)
|
|
private
|
|
FItem: TXMLDataBindingItem;
|
|
|
|
function GetItem(): TXMLDataBindingItem;
|
|
protected
|
|
function GetIsReadOnly(): Boolean; override;
|
|
function GetPropertyType(): TXMLDataBindingPropertyType; override;
|
|
public
|
|
constructor Create(ASchemaItem: IXMLSchemaItem; const AName: String; AItem: TXMLDataBindingItem);
|
|
|
|
property Item: TXMLDataBindingItem read GetItem;
|
|
end;
|
|
|
|
|
|
TXMLDataBindingForwardItem = class(TXMLDataBindingItem)
|
|
private
|
|
FItem: TXMLDataBindingItem;
|
|
FInterfaceType: TXMLDataBindingInterfaceType;
|
|
protected
|
|
function GetItemType(): TXMLDataBindingItemType; override;
|
|
public
|
|
constructor Create(ASchemaItem: IXMLSchemaItem; const AName: String; AInterfaceType: TXMLDataBindingInterfaceType);
|
|
|
|
property InterfaceType: TXMLDataBindingInterfaceType read FInterfaceType;
|
|
property Item: TXMLDataBindingItem read FItem write FItem;
|
|
end;
|
|
|
|
|
|
implementation
|
|
uses
|
|
SysUtils,
|
|
Windows,
|
|
XMLDoc,
|
|
XMLIntf,
|
|
|
|
X2UtHashes;
|
|
|
|
|
|
const
|
|
MaxOccursUnbounded = 'unbounded';
|
|
|
|
|
|
|
|
function GetInterfaceType(ASchemaItem: IXMLSchemaItem): TXMLDataBindingInterfaceType;
|
|
begin
|
|
if Supports(ASchemaItem, IXMLComplexTypeDef) then
|
|
Result := ifComplexType
|
|
else
|
|
Result := ifElement;
|
|
end;
|
|
|
|
|
|
{ TXMLDataBindingGenerator }
|
|
constructor TXMLDataBindingGenerator.Create();
|
|
begin
|
|
inherited;
|
|
|
|
FIncludePaths := TStringList.Create();
|
|
FSchemas := TObjectList.Create(True);
|
|
|
|
with TStringList(FIncludePaths) do
|
|
begin
|
|
CaseSensitive := False;
|
|
Duplicates := dupIgnore;
|
|
end;
|
|
end;
|
|
|
|
|
|
destructor TXMLDataBindingGenerator.Destroy();
|
|
begin
|
|
FreeAndNil(FSchemas);
|
|
FreeAndNil(FIncludePaths);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
|
|
procedure TXMLDataBindingGenerator.Execute(const AStream: TStream; const ASchemaName: String);
|
|
var
|
|
schemaIndex: Integer;
|
|
|
|
begin
|
|
FSchemas.Clear();
|
|
LoadSchema(AStream, ASchemaName);
|
|
|
|
if SchemaCount > 0 then
|
|
begin
|
|
{ Map schema elements to objects }
|
|
for schemaIndex := 0 to Pred(SchemaCount) do
|
|
GenerateSchemaObjects(Schemas[schemaIndex], (schemaIndex = 0));
|
|
|
|
|
|
{ Process unresolved references }
|
|
for schemaIndex := 0 to Pred(SchemaCount) do
|
|
ResolveSchema(Schemas[schemaIndex]);
|
|
|
|
ResolveNameConflicts();
|
|
|
|
|
|
{ Perform output-specific translations }
|
|
for schemaIndex := 0 to Pred(SchemaCount) do
|
|
TranslateSchema(Schemas[schemaIndex]);
|
|
|
|
|
|
{ Output }
|
|
GenerateDataBinding();
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TXMLDataBindingGenerator.Execute(const AFileName: String);
|
|
var
|
|
currentDir: String;
|
|
fileStream: TFileStream;
|
|
|
|
begin
|
|
currentDir := GetCurrentDir();
|
|
try
|
|
ChDir(ExtractFilePath(AFileName));
|
|
|
|
fileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
|
|
try
|
|
FSourceFileName := AFileName;
|
|
IncludePaths.Add(ExtractFilePath(AFileName));
|
|
|
|
Execute(fileStream, ChangeFileExt(ExtractFileName(AFileName), ''));
|
|
finally
|
|
FreeAndNil(fileStream);
|
|
end;
|
|
finally
|
|
ChDir(currentDir);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
function TXMLDataBindingGenerator.LoadSchema(const AStream: TStream; const ASchemaName: String): TXMLDataBindingSchema;
|
|
|
|
procedure HandleDocRefs(const ADocRefs: IXMLSchemaDocRefs; ASchema: TXMLDataBindingSchema);
|
|
var
|
|
location: String;
|
|
schemaName: String;
|
|
refSchema: TXMLDataBindingSchema;
|
|
refIndex: Integer;
|
|
refStream: TStream;
|
|
|
|
begin
|
|
for refIndex := 0 to Pred(ADocRefs.Count) do
|
|
begin
|
|
location := ADocRefs[refIndex].SchemaLocation;
|
|
schemaName := ChangeFileExt(ExtractFileName(location), '');
|
|
refSchema := FindSchema(schemaName);
|
|
|
|
if not Assigned(refSchema) then
|
|
begin
|
|
refStream := GetSchemaData(location);
|
|
|
|
if Assigned(refStream) then
|
|
try
|
|
refSchema := LoadSchema(refStream, schemaName);
|
|
finally
|
|
FreeAndNil(refStream);
|
|
end;
|
|
end;
|
|
|
|
if Assigned(refSchema) then
|
|
ASchema.AddInclude(refSchema);
|
|
end;
|
|
end;
|
|
|
|
|
|
var
|
|
schemaDoc: IXMLSchemaDoc;
|
|
schemaDef: IXMLSchemaDef;
|
|
|
|
begin
|
|
schemaDoc := TXMLSchemaDoc.Create(nil);
|
|
schemaDoc.LoadFromStream(AStream);
|
|
schemaDef := schemaDoc.SchemaDef;
|
|
|
|
Result := TXMLDataBindingSchema.Create();
|
|
Result.SchemaDef := schemaDef;
|
|
Result.SchemaName := ASchemaName;
|
|
FSchemas.Add(Result);
|
|
|
|
{ Handle imports / includes }
|
|
HandleDocRefs(schemaDef.SchemaImports, Result);
|
|
HandleDocRefs(schemaDef.SchemaIncludes, Result);
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingGenerator.GetSchemaData(const ALocation: String): TStream;
|
|
var
|
|
includeIndex: Integer;
|
|
includePath: String;
|
|
|
|
begin
|
|
Result := nil;
|
|
|
|
// #ToDo3 (MvR) 31-1-2007: support more locations than just a filename ?
|
|
|
|
for includeIndex := 0 to Pred(IncludePaths.Count) do
|
|
begin
|
|
includePath := IncludeTrailingPathDelimiter(IncludePaths[includeIndex]);
|
|
|
|
if FileExists(includePath + ALocation) then
|
|
begin
|
|
Result := TFileStream.Create(includePath + ALocation, fmOpenRead or fmShareDenyNone);
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingGenerator.FindSchema(const ALocation: String): TXMLDataBindingSchema;
|
|
var
|
|
schemaIndex: Integer;
|
|
|
|
begin
|
|
Result := nil;
|
|
|
|
for schemaIndex := 0 to Pred(SchemaCount) do
|
|
if Schemas[schemaIndex].SchemaName = ALocation then
|
|
begin
|
|
Result := Schemas[schemaIndex];
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TXMLDataBindingGenerator.GenerateSchemaObjects(ASchema: TXMLDataBindingSchema; ARootDocument: Boolean);
|
|
var
|
|
includeIndex: Integer;
|
|
|
|
begin
|
|
if ASchema.ItemsGenerated then
|
|
exit;
|
|
|
|
ASchema.ItemsGenerated := True;
|
|
|
|
{ First generate the objects for all includes and imports, so we can get
|
|
proper references. }
|
|
for includeIndex := 0 to Pred(ASchema.IncludeCount) do
|
|
GenerateSchemaObjects(ASchema.Includes[includeIndex], False);
|
|
|
|
|
|
GenerateElementObjects(ASchema, ARootDocument);
|
|
GenerateComplexTypeObjects(ASchema);
|
|
end;
|
|
|
|
|
|
procedure TXMLDataBindingGenerator.GenerateElementObjects(ASchema: TXMLDataBindingSchema; ARootDocument: Boolean);
|
|
var
|
|
schemaDef: IXMLSchemaDef;
|
|
elementIndex: Integer;
|
|
item: TXMLDataBindingItem;
|
|
|
|
begin
|
|
schemaDef := ASchema.SchemaDef;
|
|
|
|
for elementIndex := 0 to Pred(schemaDef.ElementDefs.Count) do
|
|
begin
|
|
item := ProcessElement(ASchema, schemaDef.ElementDefs[elementIndex]);
|
|
|
|
if Assigned(item) and ARootDocument then
|
|
item.DocumentElement := True;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TXMLDataBindingGenerator.GenerateComplexTypeObjects(ASchema: TXMLDataBindingSchema);
|
|
var
|
|
schemaDef: IXMLSchemaDef;
|
|
complexTypeIndex: Integer;
|
|
complexType: IXMLComplexTypeDef;
|
|
interfaceItem: TXMLDataBindingInterface;
|
|
elementIndex: Integer;
|
|
|
|
begin
|
|
schemaDef := ASchema.SchemaDef;
|
|
|
|
for complexTypeIndex := 0 to Pred(schemaDef.ComplexTypes.Count) do
|
|
begin
|
|
complexType := schemaDef.ComplexTypes[complexTypeIndex];
|
|
interfaceItem := TXMLDataBindingInterface.Create(complexType, complexType.Name);
|
|
ASchema.AddItem(interfaceItem);
|
|
|
|
for elementIndex := 0 to Pred(complexType.ElementDefs.Count) do
|
|
ProcessChildElement(ASchema, complexType.ElementDefs[elementIndex], interfaceItem);
|
|
end;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingGenerator.ProcessElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef): TXMLDataBindingItem;
|
|
var
|
|
elementIndex: Integer;
|
|
enumerationObject: TXMLDataBindingEnumeration;
|
|
interfaceObject: TXMLDataBindingInterface;
|
|
|
|
begin
|
|
Result := nil;
|
|
interfaceObject := nil;
|
|
|
|
if Assigned(AElement.Ref) then
|
|
begin
|
|
{ Find reference. If not found, mark as "resolve later". }
|
|
Result := FindInterface(ASchema, AElement.Ref.Name, ifElement);
|
|
|
|
if not Assigned(Result) then
|
|
begin
|
|
Result := TXMLDataBindingForwardItem.Create(AElement, AElement.Ref.Name, ifElement);
|
|
ASchema.AddItem(Result);
|
|
end;
|
|
end else
|
|
begin
|
|
if (not AElement.DataType.IsAnonymous) and
|
|
(AElement.DataType.IsComplex) then
|
|
begin
|
|
{ Find data type. If not found, mark as "resolve later". }
|
|
Result := FindInterface(ASchema, AElement.DataTypeName, ifComplexType);
|
|
|
|
if not Assigned(Result) then
|
|
begin
|
|
Result := TXMLDataBindingForwardItem.Create(AElement, AElement.DataTypeName, ifComplexType);
|
|
ASchema.AddItem(Result);
|
|
end;
|
|
end;
|
|
|
|
if not Assigned(Result) then
|
|
begin
|
|
if AElement.DataType.Enumerations.Count > 0 then
|
|
begin
|
|
{ Enumeration }
|
|
enumerationObject := TXMLDataBindingEnumeration.Create(AElement, AElement.DataType, AElement.Name);
|
|
ASchema.AddItem(enumerationObject);
|
|
Result := enumerationObject;
|
|
end else if AElement.DataType.IsComplex then
|
|
begin
|
|
{ Interface }
|
|
interfaceObject := TXMLDataBindingInterface.Create(AElement, AElement.Name);
|
|
if Assigned(AElement.DataType.BaseType) then
|
|
interfaceObject.BaseName := AElement.DataType.BaseTypeName;
|
|
|
|
ASchema.AddItem(interfaceObject);
|
|
|
|
Result := interfaceObject;
|
|
end;
|
|
|
|
|
|
for elementIndex := 0 to Pred(AElement.ChildElements.Count) do
|
|
ProcessChildElement(ASchema, AElement.ChildElements[elementIndex], interfaceObject);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TXMLDataBindingGenerator.ProcessChildElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef; AInterface: TXMLDataBindingInterface);
|
|
var
|
|
collectionObject: TXMLDataBindingCollection;
|
|
propertyType: TXMLDataBindingItem;
|
|
propertyItem: TXMLDataBindingProperty;
|
|
|
|
begin
|
|
collectionObject := nil;
|
|
|
|
|
|
if Assigned(AInterface) then
|
|
begin
|
|
if (AElement.MaxOccurs = MaxOccursUnbounded) or
|
|
(AElement.MaxOccurs > 1) then
|
|
begin
|
|
{ Collection }
|
|
collectionObject := FindCollection(ASchema, AElement.Name);
|
|
|
|
if not Assigned(collectionObject) then
|
|
begin
|
|
collectionObject := TXMLDataBindingCollection.Create(AELement, AInterface, AElement.Name);
|
|
ASchema.AddItem(collectionObject);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
propertyType := ProcessElement(ASchema, AElement);
|
|
if Assigned(collectionObject) then
|
|
propertyType := collectionObject;
|
|
|
|
|
|
if Assigned(AInterface) then
|
|
begin
|
|
if Assigned(propertyType) then
|
|
propertyItem := TXMLDataBindingItemProperty.Create(AElement,
|
|
AElement.Name,
|
|
propertyType)
|
|
else
|
|
propertyItem := TXMLDataBindingSimpleProperty.Create(AElement,
|
|
AElement.Name,
|
|
AElement.DataType);
|
|
|
|
propertyItem.IsOptional := (AElement.MinOccurs = 0);
|
|
AInterface.AddProperty(propertyItem);
|
|
end;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingGenerator.IterateSchemaItems(ASchema: TXMLDataBindingSchema; AIterateProc: TXMLDataBindingIterateItemsProc; AData: Pointer): TXMLDataBindingItem;
|
|
var
|
|
abort: Boolean;
|
|
itemIndex: Integer;
|
|
schemaItem: TXMLDataBindingItem;
|
|
includeIndex: Integer;
|
|
|
|
begin
|
|
Result := nil;
|
|
abort := False;
|
|
|
|
for itemIndex := 0 to Pred(ASchema.ItemCount) do
|
|
begin
|
|
schemaItem := ASchema.Items[itemIndex];
|
|
|
|
AIterateProc(schemaItem, AData, abort);
|
|
if abort then
|
|
begin
|
|
Result := schemaItem;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
if not Assigned(Result) then
|
|
begin
|
|
for includeIndex := 0 to Pred(ASchema.IncludeCount) do
|
|
begin
|
|
Result := IterateSchemaItems(ASchema.Includes[includeIndex], AIterateProc, AData);
|
|
if Assigned(Result) then
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
type
|
|
PFindInterfaceInfo = ^TFindInterfaceInfo;
|
|
TFindInterfaceInfo = record
|
|
InterfaceType: TXMLDataBindingInterfaceType;
|
|
Name: String;
|
|
end;
|
|
|
|
|
|
procedure TXMLDataBindingGenerator.FindInterfaceProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean);
|
|
var
|
|
findInfo: PFindInterfaceInfo;
|
|
|
|
begin
|
|
findInfo := PFindInterfaceInfo(AData);
|
|
AAbort := (AItem.ItemType = itInterface) and
|
|
(TXMLDataBindingInterface(AItem).InterfaceType = findInfo^.InterfaceType) and
|
|
(AItem.Name = findInfo^.Name);
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingGenerator.FindInterface(ASchema: TXMLDataBindingSchema; const AName: String; AType: TXMLDataBindingInterfaceType): TXMLDataBindingInterface;
|
|
var
|
|
findInfo: TFindInterfaceInfo;
|
|
|
|
begin
|
|
findInfo.InterfaceType := AType;
|
|
findInfo.Name := AName;
|
|
Result := TXMLDataBindingInterface(IterateSchemaItems(ASchema, FindInterfaceProc, @findInfo));
|
|
end;
|
|
|
|
|
|
procedure TXMLDataBindingGenerator.FindEnumerationProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean);
|
|
begin
|
|
AAbort := (AItem.ItemType = itEnumeration) and
|
|
(AItem.Name = PChar(AData));
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingGenerator.FindEnumeration(ASchema: TXMLDataBindingSchema; const AName: String): TXMLDataBindingEnumeration;
|
|
begin
|
|
Result := TXMLDataBindingEnumeration(IterateSchemaItems(ASchema, FindEnumerationProc, PChar(AName)));
|
|
end;
|
|
|
|
|
|
procedure TXMLDataBindingGenerator.FindCollectionProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean);
|
|
begin
|
|
AAbort := (AItem.ItemType = itCollection) and
|
|
(AItem.Name = PChar(AData));
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingGenerator.FindCollection(ASchema: TXMLDataBindingSchema; const AName: String): TXMLDataBindingCollection;
|
|
begin
|
|
Result := TXMLDataBindingCollection(IterateSchemaItems(ASchema, FindCollectionProc, PChar(AName)));
|
|
end;
|
|
|
|
|
|
|
|
procedure TXMLDataBindingGenerator.ResolveSchema(ASchema: TXMLDataBindingSchema);
|
|
var
|
|
itemIndex: Integer;
|
|
item: TXMLDataBindingItem;
|
|
forwardItem: TXMLDataBindingForwardItem;
|
|
referenceItem: TXMLDataBindingItem;
|
|
interfaceItem: TXMLDataBindingInterface;
|
|
|
|
begin
|
|
for itemIndex := 0 to Pred(ASchema.ItemCount) do
|
|
begin
|
|
item := ASchema.Items[itemIndex];
|
|
|
|
case item.ItemType of
|
|
itInterface:
|
|
begin
|
|
{ Resolve base interface }
|
|
interfaceItem := TXMLDataBindingInterface(item);
|
|
|
|
if Length(interfaceItem.BaseName) > 0 then
|
|
interfaceItem.BaseItem := FindInterface(ASchema, interfaceItem.BaseName, ifComplexType);
|
|
end;
|
|
|
|
itForward:
|
|
begin
|
|
{ Resolve forwarded item }
|
|
forwardItem := TXMLDataBindingForwardItem(item);
|
|
referenceItem := FindInterface(ASchema, item.Name, forwardItem.InterfaceType);
|
|
|
|
if (not Assigned(referenceItem)) and
|
|
(forwardItem.InterfaceType = ifElement) then
|
|
referenceItem := FindEnumeration(ASchema, item.Name);
|
|
|
|
if Assigned(referenceItem) then
|
|
TXMLDataBindingForwardItem(item).Item := referenceItem;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TXMLDataBindingGenerator.ResolveNameConflicts();
|
|
var
|
|
itemNames: TX2SOHash;
|
|
|
|
|
|
procedure AddItem(AItem: TXMLDataBindingItem);
|
|
var
|
|
hashName: String;
|
|
items: TObjectList;
|
|
|
|
begin
|
|
{ Collections use the same Name as their items, differentiate
|
|
between them while determining conflicts. }
|
|
hashName := AItem.Name;
|
|
if AItem.ItemType = itCollection then
|
|
hashName := hashName + #1;
|
|
|
|
if not itemNames.Exists(hashName) then
|
|
begin
|
|
items := TObjectList.Create(False);
|
|
itemNames[hashName] := items;
|
|
end else
|
|
items := TObjectList(itemNames[hashName]);
|
|
|
|
items.Add(AItem);
|
|
end;
|
|
|
|
|
|
function ResolveItemNameConflict(AItem: TXMLDataBindingItem; ADepth: Integer; out ANewName: String): Boolean;
|
|
var
|
|
currentDepth: Integer;
|
|
parentNode: IXMLNode;
|
|
schemaItem: IXMLSchemaItem;
|
|
|
|
begin
|
|
Result := False;
|
|
currentDepth := 0;
|
|
parentNode := AItem.SchemaItem;
|
|
ANewName := AItem.Name;
|
|
|
|
while Assigned(parentNode) do
|
|
begin
|
|
parentNode := parentNode.ParentNode;
|
|
|
|
if Assigned(parentNode) and
|
|
Supports(parentNode, IXMLSchemaItem, schemaItem) and
|
|
(Length(schemaItem.Name) > 0) then
|
|
begin
|
|
ANewName := schemaItem.Name + ANewName;
|
|
|
|
Inc(currentDepth);
|
|
if currentDepth = ADepth then
|
|
begin
|
|
Result := True;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
var
|
|
schemaIndex: Integer;
|
|
schema: TXMLDataBindingSchema;
|
|
itemIndex: Integer;
|
|
items: TObjectList;
|
|
item: TXMLDataBindingItem;
|
|
depth: Integer;
|
|
newName: String;
|
|
resolved: Boolean;
|
|
|
|
begin
|
|
itemNames := TX2SOHash.Create(True);
|
|
try
|
|
{ Gather names }
|
|
for schemaIndex := 0 to Pred(SchemaCount) do
|
|
begin
|
|
schema := Schemas[schemaIndex];
|
|
|
|
for itemIndex := 0 to Pred(schema.ItemCount) do
|
|
begin
|
|
item := schema.Items[itemIndex];
|
|
|
|
if item.ItemType in [itInterface, itCollection, itEnumeration] then
|
|
AddItem(item);
|
|
end;
|
|
end;
|
|
|
|
|
|
{ Find conflicts }
|
|
itemNames.First();
|
|
|
|
while itemNames.Next() do
|
|
begin
|
|
items := TObjectList(itemNames.CurrentValue);
|
|
|
|
if items.Count > 1 then
|
|
begin
|
|
{ Attempt to rename items }
|
|
for itemIndex := Pred(items.Count) downto 0 do
|
|
begin
|
|
item := TXMLDataBindingItem(items[itemIndex]);
|
|
newName := item.Name;
|
|
resolved := False;
|
|
depth := 1;
|
|
|
|
while ResolveItemNameConflict(item, depth, newName) do
|
|
begin
|
|
if not itemNames.Exists(newName) then
|
|
begin
|
|
resolved := True;
|
|
break;
|
|
end else
|
|
Inc(depth);
|
|
end;
|
|
|
|
if resolved then
|
|
begin
|
|
items.Delete(itemIndex);
|
|
|
|
item.SetName(newName);
|
|
AddItem(item);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
FreeAndNil(itemNames);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TXMLDataBindingGenerator.TranslateSchema(ASchema: TXMLDataBindingSchema);
|
|
var
|
|
itemIndex: Integer;
|
|
|
|
begin
|
|
for itemIndex := 0 to Pred(ASchema.ItemCount) do
|
|
TranslateItem(ASchema.Items[itemIndex]);
|
|
end;
|
|
|
|
|
|
procedure TXMLDataBindingGenerator.TranslateItem(AItem: TXMLDataBindingItem);
|
|
var
|
|
interfaceItem: TXMLDataBindingInterface;
|
|
propertyIndex: Integer;
|
|
enumerationItem: TXMLDataBindingEnumeration;
|
|
memberIndex: Integer;
|
|
|
|
begin
|
|
AItem.SetTranslatedName(TranslateItemName(AItem));
|
|
|
|
case AItem.ItemType of
|
|
itInterface:
|
|
begin
|
|
interfaceItem := TXMLDataBindingInterface(AItem);
|
|
|
|
for propertyIndex := 0 to Pred(interfaceItem.PropertyCount) do
|
|
TranslateItem(interfaceItem.Properties[propertyIndex]);
|
|
end;
|
|
itEnumeration:
|
|
begin
|
|
enumerationItem := TXMLDataBindingEnumeration(AItem);
|
|
|
|
for memberIndex := 0 to Pred(enumerationItem.MemberCount) do
|
|
TranslateItem(enumerationItem.Members[memberIndex]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingGenerator.TranslateItemName(AItem: TXMLDataBindingItem): String;
|
|
begin
|
|
Result := AItem.Name;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingGenerator.GetSchemaCount(): Integer;
|
|
begin
|
|
Result := FSchemas.Count;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingGenerator.GetSchemas(Index: Integer): TXMLDataBindingSchema;
|
|
begin
|
|
Result := TXMLDataBindingSchema(FSchemas[Index]);
|
|
end;
|
|
|
|
|
|
{ TXMLDataBindingSchema }
|
|
constructor TXMLDataBindingSchema.Create();
|
|
begin
|
|
inherited;
|
|
|
|
FIncludes := TObjectList.Create(False);
|
|
FItems := TObjectList.Create(True);
|
|
end;
|
|
|
|
|
|
destructor TXMLDataBindingSchema.Destroy();
|
|
begin
|
|
FreeAndNil(FItems);
|
|
FreeAndNil(FIncludes);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
|
|
procedure TXMLDataBindingSchema.AddInclude(ASchema: TXMLDataBindingSchema);
|
|
begin
|
|
if FIncludes.IndexOf(ASchema) = -1 then
|
|
FIncludes.Add(ASchema);
|
|
end;
|
|
|
|
|
|
procedure TXMLDataBindingSchema.AddItem(AItem: TXMLDataBindingItem);
|
|
begin
|
|
if FItems.IndexOf(AItem) = -1 then
|
|
FItems.Add(AItem);
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingSchema.GetIncludeCount(): Integer;
|
|
begin
|
|
Result := FIncludes.Count;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingSchema.GetIncludes(Index: Integer): TXMLDataBindingSchema;
|
|
begin
|
|
Result := TXMLDataBindingSchema(FIncludes[Index]);
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingSchema.GetItemCount(): Integer;
|
|
begin
|
|
Result := FItems.Count;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingSchema.GetItems(Index: Integer): TXMLDataBindingItem;
|
|
begin
|
|
Result := TXMLDataBindingItem(FItems[Index]);
|
|
end;
|
|
|
|
|
|
{ TXMLDataBindingItem }
|
|
constructor TXMLDataBindingItem.Create(ASchemaItem: IXMLSchemaItem; const AName: String);
|
|
begin
|
|
inherited Create();
|
|
|
|
FName := AName;
|
|
FSchemaItem := ASchemaItem;
|
|
FTranslatedName := AName;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingItem.GetDocumentation(): String;
|
|
var
|
|
documentationIndex: Integer;
|
|
|
|
begin
|
|
Result := '';
|
|
if HasDocumentation then
|
|
begin
|
|
for documentationIndex := 0 to Pred(SchemaItem.Documentation.Count) do
|
|
Result := Result + SchemaItem.Documentation[documentationIndex].Text + #13#10;
|
|
|
|
Result := Trim(Result);
|
|
end;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingItem.GetHasDocumentation: Boolean;
|
|
begin
|
|
Result := Assigned(SchemaItem) and
|
|
(SchemaItem.Documentation.Count > 0);
|
|
end;
|
|
|
|
procedure TXMLDataBindingItem.SetName(const Value: String);
|
|
begin
|
|
FName := Value;
|
|
end;
|
|
|
|
|
|
procedure TXMLDataBindingItem.SetTranslatedName(const Value: string);
|
|
begin
|
|
FTranslatedName := Value;
|
|
end;
|
|
|
|
|
|
{ TXMLDataBindingInterface }
|
|
constructor TXMLDataBindingInterface.Create(ASchemaItem: IXMLSchemaItem; const AName: String);
|
|
begin
|
|
inherited Create(ASchemaItem, AName);
|
|
|
|
FProperties := TObjectList.Create(True);
|
|
FInterfaceType := GetInterfaceType(SchemaItem);
|
|
end;
|
|
|
|
|
|
destructor TXMLDataBindingInterface.Destroy;
|
|
begin
|
|
FreeAndNil(FProperties);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
|
|
procedure TXMLDataBindingInterface.AddProperty(AProperty: TXMLDataBindingProperty);
|
|
begin
|
|
FProperties.Add(AProperty);
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingInterface.GetItemType(): TXMLDataBindingItemType;
|
|
begin
|
|
Result := itInterface;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingInterface.GetPropertyCount(): Integer;
|
|
begin
|
|
Result := FProperties.Count;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingInterface.GetProperties(Index: Integer): TXMLDataBindingProperty;
|
|
begin
|
|
Result := TXMLDataBindingProperty(FProperties[Index]);
|
|
end;
|
|
|
|
|
|
{ TXMLDataBindingCollection }
|
|
constructor TXMLDataBindingCollection.Create(ASchemaItem: IXMLSchemaItem; ACollectionItem: TXMLDataBindingInterface; const AName: String);
|
|
begin
|
|
inherited Create(ASchemaItem, AName);
|
|
|
|
FCollectionItem := ACollectionItem;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingCollection.GetItemType(): TXMLDataBindingItemType;
|
|
begin
|
|
Result := itCollection;
|
|
end;
|
|
|
|
|
|
{ TXMLDataBindingEnumerationMember }
|
|
constructor TXMLDataBindingEnumerationMember.Create(AEnumeration: TXMLDataBindingEnumeration; const AName: String);
|
|
begin
|
|
inherited Create(nil, AName);
|
|
|
|
FEnumeration := AEnumeration;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingEnumerationMember.GetItemType(): TXMLDataBindingItemType;
|
|
begin
|
|
Result := itEnumerationMember;
|
|
end;
|
|
|
|
|
|
{ TXMLDataBindingEnumeration }
|
|
constructor TXMLDataBindingEnumeration.Create(ASchemaItem: IXMLSchemaItem; ADataType: IXMLTypeDef; const AName: String);
|
|
var
|
|
memberIndex: Integer;
|
|
|
|
begin
|
|
inherited Create(ASchemaItem, AName);
|
|
|
|
FDataType := ADataType;
|
|
FMembers := TObjectList.Create();
|
|
|
|
for memberIndex := 0 to Pred(ADataType.Enumerations.Count) do
|
|
FMembers.Add(TXMLDataBindingEnumerationMember.Create(Self, ADataType.Enumerations.Items[memberIndex].Value));
|
|
end;
|
|
|
|
|
|
destructor TXMLDataBindingEnumeration.Destroy();
|
|
begin
|
|
FreeAndNil(FMembers);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingEnumeration.GetItemType(): TXMLDataBindingItemType;
|
|
begin
|
|
Result := itEnumeration;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingEnumeration.GetMemberCount(): Integer;
|
|
begin
|
|
Result := FMembers.Count;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingEnumeration.GetMembers(Index: Integer): TXMLDataBindingEnumerationMember;
|
|
begin
|
|
Result := TXMLDataBindingEnumerationMember(FMembers[Index]);
|
|
end;
|
|
|
|
|
|
{ TXMLDataBindingProperty }
|
|
function TXMLDataBindingProperty.GetItemType(): TXMLDataBindingItemType;
|
|
begin
|
|
Result := itProperty;
|
|
end;
|
|
|
|
|
|
{ TXMLDataBindingSimpleProperty }
|
|
constructor TXMLDataBindingSimpleProperty.Create(ASchemaItem: IXMLSchemaItem; const AName: String; ADataType: IXMLTypeDef);
|
|
begin
|
|
inherited Create(ASchemaItem, AName);
|
|
|
|
FDataType := ADataType;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingSimpleProperty.GetIsReadOnly(): Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingSimpleProperty.GetPropertyType(): TXMLDataBindingPropertyType;
|
|
begin
|
|
Result := ptSimple;
|
|
end;
|
|
|
|
|
|
{ TXMLDataBindingItemProperty }
|
|
constructor TXMLDataBindingItemProperty.Create(ASchemaItem: IXMLSchemaItem; const AName: String; AItem: TXMLDataBindingItem);
|
|
begin
|
|
inherited Create(ASchemaItem, AName);
|
|
|
|
FItem := AItem;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingItemProperty.GetIsReadOnly(): Boolean;
|
|
begin
|
|
Result := Assigned(Item) and (Item.ItemType <> itEnumeration);
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingItemProperty.GetPropertyType(): TXMLDataBindingPropertyType;
|
|
begin
|
|
Result := ptItem;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingItemProperty.GetItem(): TXMLDataBindingItem;
|
|
begin
|
|
Result := FItem;
|
|
|
|
while Assigned(Result) and (Result.ItemType = itForward) do
|
|
Result := TXMLDataBindingForwardItem(Result).Item;
|
|
end;
|
|
|
|
|
|
{ TXMLDataBindingForwardItem }
|
|
constructor TXMLDataBindingForwardItem.Create(ASchemaItem: IXMLSchemaItem; const AName: String; AInterfaceType: TXMLDataBindingInterfaceType);
|
|
begin
|
|
inherited Create(ASchemaItem, AName);
|
|
|
|
FInterfaceType := AInterfaceType;
|
|
end;
|
|
|
|
|
|
function TXMLDataBindingForwardItem.GetItemType(): TXMLDataBindingItemType;
|
|
begin
|
|
Result := itForward;
|
|
end;
|
|
|
|
end.
|
|
|
|
|
|
|
|
|