Files
lazarus-ccr/wst/trunk/ws_helper/ws_parser_imp.pas

1885 lines
71 KiB
ObjectPascal
Raw Normal View History

{
This file is part of the Web Service Toolkit
Copyright (c) 2007 by Inoussa OUEDRAOGO
This file is provide under modified LGPL licence
( the files COPYING.modifiedLGPL and COPYING.LGPL).
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
{$INCLUDE wst_global.inc}
unit ws_parser_imp;
interface
uses
Classes, SysUtils, Contnrs,
{$IFNDEF FPC}xmldom, wst_delphi_xml{$ELSE}DOM, wst_fpc_xml{$ENDIF},
cursor_intf, rtti_filters,
pastree, pascal_parser_intf, logger_intf,
xsd_parser, wst_types;
type
TNameSpaceValueType = ( nvtExpandValue, nvtShortSynonym );
TSearchSpace = ( ssCurrentModule, ssGlobal );
TAbstractTypeParserClass = class of TAbstractTypeParser;
{ TAbstractTypeParser }
TAbstractTypeParser = class
private
FContext : IParserContext;
FTypeNode : TDOMNode;
FSymbols : TwstPasTreeContainer;
FTypeName : string;
FEmbededDef : Boolean;
private
function GetModule: TPasModule;{$IFDEF USE_INLINE}inline;{$ENDIF}
protected
function FindElementNS(
const ANameSpace,
ALocalName : string;
const ASpaceType : TNameSpaceValueType
) : TPasElement;
function FindElement(
const ALocalName : string;
const ANameKinds : TElementNameKinds = [elkDeclaredName,elkName]
) : TPasElement;{$IFDEF USE_INLINE}inline;{$ENDIF}
function FindElementWithHint(const AName, AHint : string; const ASpace : TSearchSpace) : TPasElement;
function ExtractTypeHint(AElement : TDOMNode) : string;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure SetAsEmbeddedType(AType : TPasType; const AValue : Boolean);
function IsEmbeddedType(AType : TPasType) : Boolean;
{$IFDEF WST_HANDLE_DOC}
procedure ParseDocumentation(AType : TPasType);
{$ENDIF WST_HANDLE_DOC}
public
constructor Create(
AOwner : IParserContext;
ATypeNode : TDOMNode;
const ATypeName : string;
const AEmbededDef : Boolean
);
class function ExtractEmbeddedTypeFromElement(
AOwner : IParserContext;
AEltNode : TDOMNode;
ASymbols : TwstPasTreeContainer;
const ATypeName : string
) : TPasType;
class function GetParserSupportedStyle():string;virtual;abstract;
class procedure RegisterParser(AParserClass : TAbstractTypeParserClass);
class function GetRegisteredParserCount() : Integer;
class function GetRegisteredParser(const AIndex : Integer):TAbstractTypeParserClass;
function Parse():TPasType;virtual;abstract;
property Module : TPasModule read GetModule;
property Context : IParserContext read FContext;
end;
TDerivationMode = ( dmNone, dmExtension, dmRestriction );
TSequenceType = ( stElement, stAll );
TParserTypeHint = ( pthDeriveFromSoapArray );
TParserTypeHints = set of TParserTypeHint;
{ TPropInfoReference }
TPropInfoReference = class
private
FIsCollection : Boolean;
FProp : TPasProperty;
public
property Prop : TPasProperty read FProp;
property IsCollection : Boolean read FIsCollection;
end;
{ TPropInfoReferenceList }
TPropInfoReferenceList = class
private
FList : TObjectList;
public
constructor Create();
destructor Destroy();override;
function Add(AProp : TPasProperty) : TPropInfoReference;
function GetItem(const AIndex : PtrInt) : TPropInfoReference;{$IFDEF USE_INLINE}inline;{$ENDIF}
function IndexOf(const AProp : TPasProperty) : PtrInt;
function GetCount() : PtrInt;{$IFDEF USE_INLINE}inline;{$ENDIF}
end;
{ TComplexTypeParser }
TComplexTypeParser = class(TAbstractTypeParser)
private
FAttCursor : IObjectCursor;
FChildCursor : IObjectCursor;
FContentNode : TDOMNode;
FContentType : string;
FBaseType : TPasType;
FDerivationMode : TDerivationMode;
FDerivationNode : TDOMNode;
FSequenceType : TSequenceType;
FHints : TParserTypeHints;
private
//helper routines
function ExtractElementCursor(
AParentNode : TDOMNode;
out AAttCursor : IObjectCursor;
out AAnyNode, AAnyAttNode : TDOMNode
):IObjectCursor;
procedure ExtractExtendedMetadata(const AItem : TPasElement; const ANode : TDOMNode);
procedure GenerateArrayTypes(
const AClassName : string;
AArrayPropList : TPropInfoReferenceList
);
function ExtractSoapArray(
const ATypeName : string;
const AInternalName : string;
const AHasInternalName : Boolean
) : TPasArrayType;
function IsHeaderBlock() : Boolean;
function IsSimpleContentHeaderBlock() : Boolean;
private
procedure CreateNodeCursors();
procedure ExtractTypeName();
procedure ExtractContentType();
procedure ExtractBaseType();
function ParseSimpleContent(const ATypeName : string):TPasType;
function ParseEmptyContent(const ATypeName : string):TPasType;
function ParseComplexContent(const ATypeName : string):TPasType;virtual;
public
class function GetParserSupportedStyle():string;override;
function Parse():TPasType;override;
end;
{ TSimpleTypeParser }
TSimpleTypeParser = class(TAbstractTypeParser)
private
FAttCursor : IObjectCursor;
FChildCursor : IObjectCursor;
FBaseName : string;
FBaseNameSpace : string;
FRestrictionNode : TDOMNode;
FIsEnum : Boolean;
private
procedure CreateNodeCursors();
procedure ExtractTypeName();
function ExtractContentType() : Boolean;
function ParseEnumContent():TPasType;
function ParseOtherContent():TPasType;
public
class function GetParserSupportedStyle():string;override;
function Parse():TPasType;override;
end;
implementation
uses
dom_cursors, parserutils, StrUtils, xsd_consts, wst_consts;
{ TAbstractTypeParser }
constructor TAbstractTypeParser.Create(
AOwner : IParserContext;
ATypeNode : TDOMNode;
const ATypeName : string;
const AEmbededDef : Boolean
);
var
symtbl : TwstPasTreeContainer;
begin
Assert(Assigned(AOwner));
Assert(Assigned(ATypeNode));
symtbl := AOwner.GetSymbolTable();
Assert(Assigned(symtbl));
FContext := AOwner;
FTypeNode := ATypeNode;
FSymbols := symtbl;
FTypeName := ATypeName;
FEmbededDef := AEmbededDef;
end;
class function TAbstractTypeParser.ExtractEmbeddedTypeFromElement(
AOwner : IParserContext;
AEltNode : TDOMNode;
ASymbols : TwstPasTreeContainer;
const ATypeName : string
): TPasType;
function ExtractTypeName() : string;
var
locCrs : IObjectCursor;
begin
locCrs := CreateCursorOn(
CreateAttributesCursor(AEltNode,cetRttiNode),
ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer)
);
locCrs.Reset();
if not locCrs.MoveNext() then
raise EXsdParserException.Create(SERR_UnableToFindNameTagInNode);
Result := (locCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
if IsStrEmpty(Result) then begin
raise EXsdParserException.Create(SERR_InvalidTypeName);
end;
end;
function FindParser(out AFoundTypeNode : TDOMNode):TAbstractTypeParserClass;
var
k : Integer;
locPrsClss : TAbstractTypeParserClass;
locFilter : string;
locCrs : IObjectCursor;
begin
Result := nil;
AFoundTypeNode := nil;
for k := 0 to Pred(GetRegisteredParserCount()) do begin
locPrsClss := GetRegisteredParser(k);
locFilter := locPrsClss.GetParserSupportedStyle();
if not IsStrEmpty(locFilter) then begin
locFilter := CreateQualifiedNameFilterStr(locFilter,AOwner.GetXsShortNames());
locCrs := CreateCursorOn(CreateChildrenCursor(AEltNode,cetRttiNode),ParseFilter(locFilter,TDOMNodeRttiExposer));
locCrs.Reset();
if locCrs.MoveNext() then begin
AFoundTypeNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
Result := locPrsClss;
Break;
end;
end;
end;
end;
var
typName : string;
prsClss : TAbstractTypeParserClass;
prs : TAbstractTypeParser;
typNode : TDOMNode;
begin
if not AEltNode.HasChildNodes() then begin;
raise EXsdParserException.CreateFmt('%s : Type Name = "%s", NodeName = "%s" .',[SERR_InvalidTypeDef_NoChild,ATypeName,AEltNode.NodeName]);
end;
typName := ATypeName;
if IsStrEmpty(typName) then begin
typName := ExtractTypeName();
end;
prsClss := FindParser(typNode);
if ( prsClss = nil ) then begin;
raise EXsdInvalidTypeDefinitionException.CreateFmt(SERR_TypeStyleNotSupported,[typName]);
end;
prs := prsClss.Create(AOwner,typNode,typName,True);
try
Result := prs.Parse();
finally
FreeAndNil(prs);
end;
end;
var
FTypeParserList : TClassList = nil;
class procedure TAbstractTypeParser.RegisterParser(AParserClass: TAbstractTypeParserClass);
begin
if ( FTypeParserList = nil ) then begin
FTypeParserList := TClassList.Create();
end;
if ( FTypeParserList.IndexOf(AParserClass) < 0 ) then begin
FTypeParserList.Add(AParserClass);
end;
end;
class function TAbstractTypeParser.GetRegisteredParserCount(): Integer;
begin
if Assigned(FTypeParserList) then begin
Result := FTypeParserList.Count;
end else begin
Result := 0;
end;
end;
class function TAbstractTypeParser.GetRegisteredParser(const AIndex: Integer): TAbstractTypeParserClass;
begin
Result := TAbstractTypeParserClass(FTypeParserList[AIndex]);
end;
function TAbstractTypeParser.FindElementNS(
const ANameSpace,
ALocalName : string;
const ASpaceType : TNameSpaceValueType
) : TPasElement;
var
locNS : string;
begin
if ( ASpaceType = nvtExpandValue ) then begin
locNS := ANameSpace
end else begin
if not Context.FindNameSpace(ANameSpace,locNS) then
raise EXsdParserAssertException.CreateFmt(SERR_CannotResolveNamespace,[ANameSpace]);
end;
Result := FSymbols.FindElementNS(ALocalName,locNS);
end;
function TAbstractTypeParser.GetModule : TPasModule;
begin
Result := Context.GetTargetModule();
end;
function TAbstractTypeParser.FindElement(
const ALocalName: string;
const ANameKinds : TElementNameKinds
) : TPasElement;
begin
Result := FSymbols.FindElementInModule(ALocalName,Module,ANameKinds);
end;
function TAbstractTypeParser.FindElementWithHint(
const AName,
AHint : string;
const ASpace : TSearchSpace
) : TPasElement;
begin
Result := nil;
if ( ASpace = ssCurrentModule ) then begin
if ( Length(AHint) > 0 ) then
Result := FindElement(AHint,[elkName]);
if ( Result = nil ) then
Result := FindElement(AName);
end else if ( ASpace = ssGlobal ) then begin
if ( Length(AHint) > 0 ) then
Result := FSymbols.FindElement(AHint,[elkName]);
if ( Result = nil ) then
Result := FSymbols.FindElement(AName);
end;
end;
function TAbstractTypeParser.ExtractTypeHint(AElement: TDOMNode): string;
begin
if not wst_findCustomAttributeXsd(Context.GetXsShortNames(),AElement,s_WST_typeHint,Result) then
Result := '';
end;
procedure TAbstractTypeParser.SetAsEmbeddedType(AType : TPasType; const AValue : Boolean);
var
s : string;
begin
if AValue then
s := '1'
else
s := '';
FSymbols.Properties.SetValue(AType,sEMBEDDED_TYPE,s);
end;
function TAbstractTypeParser.IsEmbeddedType(AType : TPasType) : Boolean;
begin
Result := ( FSymbols.Properties.GetValue(AType,sEMBEDDED_TYPE) = '1' );
end;
{$IFDEF WST_HANDLE_DOC}
procedure TAbstractTypeParser.ParseDocumentation(AType : TPasType);
var
tmpCursor : IObjectCursor;
props : TStrings;
docString : string;
i : PtrInt;
tempNode : TDOMNode;
begin
if FTypeNode.HasChildNodes() then begin
tmpCursor := CreateCursorOn(
CreateChildrenCursor(FTypeNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_annotation,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
if ( tmpCursor <> nil ) then begin
tmpCursor.Reset();
if tmpCursor.MoveNext() then begin
tmpCursor := CreateCursorOn(
CreateChildrenCursor(TDOMNodeRttiExposer(tmpCursor.GetCurrent()).InnerObject,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_documentation,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
if ( tmpCursor <> nil ) then begin
tmpCursor.Reset();
if tmpCursor.MoveNext() then begin
tempNode := TDOMNodeRttiExposer(tmpCursor.GetCurrent()).InnerObject.FirstChild;
if ( tempNode <> nil ) then
docString := tempNode.NodeValue
else
docString := '';
props := FSymbols.Properties.FindList(AType);
if IsStrEmpty(docString) then begin
if ( props <> nil ) then begin
i := props.IndexOfName(s_documentation);
if ( i >= 0 ) then
props.Values[s_documentation] := '';
end
end else begin
if ( props = nil ) then
props := FSymbols.Properties.GetList(AType);
props.Values[s_documentation] := EncodeLineBreak(docString);
end;
end;
end;
end;
end;
end;
end;
{$ENDIF WST_HANDLE_DOC}
{ TComplexTypeParser }
function TComplexTypeParser.ExtractElementCursor(
AParentNode : TDOMNode;
out AAttCursor : IObjectCursor;
out AAnyNode, AAnyAttNode : TDOMNode
) : IObjectCursor;
var
frstCrsr : IObjectCursor;
function ParseContent_ALL() : IObjectCursor;
var
locTmpCrs : IObjectCursor;
locTmpNode : TDOMNode;
begin
locTmpCrs := CreateCursorOn(
frstCrsr.Clone() as IObjectCursor,
ParseFilter(CreateQualifiedNameFilterStr(s_all,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
locTmpCrs.Reset();
if locTmpCrs.MoveNext() then begin
FSequenceType := stElement;
locTmpNode := (locTmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
if locTmpNode.HasChildNodes() then begin
locTmpCrs := CreateCursorOn(
CreateChildrenCursor(locTmpNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_element,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
Result := locTmpCrs;
end;
end;
end;
function ParseContent_SEQUENCE(out ARes : IObjectCursor) : Boolean;
var
tmpCursor : IObjectCursor;
tmpNode : TDOMNode;
tmpFilter : IObjectFilter;
begin
ARes := nil;
tmpFilter := ParseFilter(CreateQualifiedNameFilterStr(s_sequence,Context.GetXsShortNames()),TDOMNodeRttiExposer);
tmpFilter := TAggregatedFilter.Create(
tmpFilter,
ParseFilter(CreateQualifiedNameFilterStr(s_choice,Context.GetXsShortNames()),TDOMNodeRttiExposer),
fcOr
) as IObjectFilter;
tmpCursor := CreateCursorOn(
frstCrsr.Clone() as IObjectCursor,
tmpFilter
);
tmpCursor.Reset();
Result := tmpCursor.MoveNext();
if Result then begin
FSequenceType := stElement;
tmpNode := (tmpCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
if tmpNode.HasChildNodes() then begin
tmpFilter := ParseFilter(CreateQualifiedNameFilterStr(s_element,Context.GetXsShortNames()),TDOMNodeRttiExposer);
tmpFilter := TAggregatedFilter.Create(
tmpFilter,
ParseFilter(CreateQualifiedNameFilterStr(s_choice,Context.GetXsShortNames()),TDOMNodeRttiExposer),
fcOr
) as IObjectFilter;
tmpCursor := CreateCursorOn(
CreateChildrenCursor(tmpNode,cetRttiNode),
tmpFilter
);
ARes := tmpCursor;
tmpCursor := CreateCursorOn(
CreateChildrenCursor(tmpNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_any,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
tmpCursor.Reset();
if tmpCursor.MoveNext() then
AAnyNode := TDOMNodeRttiExposer(tmpCursor.GetCurrent()).InnerObject;
end;
end
end;
var
parentNode : TDOMNode;
crs : IObjectCursor;
begin
Result := nil;
AAttCursor := nil;
AAnyNode := nil;
AAnyAttNode := nil;
parentNode := AParentNode;
if (parentNode = nil) then begin
case FDerivationMode of
dmNone : parentNode := FContentNode;
dmRestriction,
dmExtension : parentNode := FDerivationNode;
end;
end;
if parentNode.HasChildNodes() then begin;
AAttCursor := CreateCursorOn(
CreateChildrenCursor(parentNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_attribute,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
crs := CreateChildrenCursor(parentNode,cetRttiNode);
if ( crs <> nil ) then begin
crs := CreateCursorOn(
crs,
ParseFilter(CreateQualifiedNameFilterStr(s_anyAttribute,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
if ( crs <> nil ) then begin
crs.Reset();
if crs.MoveNext() then
AAnyAttNode := TDOMNodeRttiExposer(crs.GetCurrent()).InnerObject;
end;
end;
frstCrsr := CreateChildrenCursor(parentNode,cetRttiNode);
if not ParseContent_SEQUENCE(Result) then
Result := ParseContent_ALL();
end;
end;
procedure TComplexTypeParser.ExtractExtendedMetadata(
const AItem : TPasElement;
const ANode : TDOMNode
);
var
ls : TDOMNamedNodeMap;
e : TDOMNode;
k, q : PtrInt;
ns_short, ns_long, localName, locBuffer, locBufferNS, locBufferNS_long, locBufferLocalName : string;
begin
if ( ANode.Attributes <> nil ) and ( GetNodeListCount(ANode.Attributes) > 0 ) then begin
ls := ANode.Attributes;
q := GetNodeListCount(ANode.Attributes);
for k := 0 to ( q - 1 ) do begin
e := ls.Item[k];
if ( Pos(':', e.NodeName) > 1 ) then begin
ExplodeQName(e.NodeName,localName,ns_short);
if Context.FindNameSpace(ns_short, ns_long) then begin
locBuffer := e.NodeValue;
ExplodeQName(locBuffer,locBufferLocalName,locBufferNS);
if IsStrEmpty(locBufferNS) then
locBuffer := locBufferLocalName
else if Context.FindNameSpace(locBufferNS, locBufferNS_long) then
locBuffer := Format('%s#%s',[locBufferNS_long,locBufferLocalName]);
FSymbols.Properties.SetValue(AItem,Format('%s#%s',[ns_long,localName]),locBuffer);
end;
end;
end;
end;
end;
procedure TComplexTypeParser.GenerateArrayTypes(
const AClassName : string;
AArrayPropList : TPropInfoReferenceList
);
var
propRef : TPropInfoReference;
locPropTyp : TPasProperty;
k : Integer;
locString : string;
locSym : TPasElement;
begin
for k := 0 to Pred(AArrayPropList.GetCount()) do begin
propRef := AArrayPropList.GetItem(k);
locPropTyp := propRef.Prop;
locString := Format('%s_%sArray',[AClassName,locPropTyp.Name]);
locSym := FSymbols.FindElement(locString);
if ( locSym = nil ) then begin
locSym := FSymbols.CreateArray(
locString,
locPropTyp.VarType,
locPropTyp.Name,
FSymbols.GetExternalName(locPropTyp),
asEmbeded
);
Self.Module.InterfaceSection.Declarations.Add(locSym);
Self.Module.InterfaceSection.Types.Add(locSym);
if propRef.IsCollection then
FSymbols.SetCollectionFlag(TPasArrayType(locSym),True);
end;
end;
end;
function TComplexTypeParser.ExtractSoapArray(
const ATypeName : string;
const AInternalName : string;
const AHasInternalName : Boolean
) : TPasArrayType;
var
ls : TStringList;
crs, locCrs : IObjectCursor;
s : string;
i : Integer;
locSym : TPasElement;
ok : Boolean;
nd : TDOMNode;
begin
if not FDerivationNode.HasChildNodes then begin
raise EXsdInvalidTypeDefinitionException.CreateFmt(SERR_InvalidTypeDef_AttributeNotFound,[FTypeName]);
end;
crs := CreateCursorOn(
CreateChildrenCursor(FDerivationNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_attribute,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
ls := TStringList.Create();
try
ok := False;
crs.Reset();
while crs.MoveNext() do begin
nd := (crs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
if Assigned(nd.Attributes) and ( nd.Attributes.Length > 0 ) then begin
ls.Clear();
ExtractNameSpaceShortNamesNested(nd,ls,s_wsdl);
locCrs := CreateAttributesCursor(nd,cetRttiNode);
locCrs := CreateCursorOn(
locCrs,
ParseFilter(CreateQualifiedNameFilterStr(s_arrayType,ls),TDOMNodeRttiExposer)
);
if Assigned(locCrs) then begin
locCrs.Reset();
if locCrs.MoveNext() then begin
ok := True;
Break;
end;
end;
end;
end;
finally
FreeAndNil(ls);
end;
if not ok then begin
raise EXsdInvalidTypeDefinitionException.CreateFmt(SERR_InvalidTypeDef_NamedAttributeNotFound,[s_arrayType,FTypeName]);
end;
s := ExtractNameFromQName((locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject.NodeValue);
i := Pos('[',s);
if ( i < 1 ) then begin
i := MaxInt;
end;
s := Copy(s,1,Pred(i));
locSym := FSymbols.FindElement(s);
if not Assigned(locSym) then begin
locSym := TPasUnresolvedTypeRef(FSymbols.CreateElement(TPasUnresolvedTypeRef,s,Self.Module.InterfaceSection,visDefault,'',0));
Self.Module.InterfaceSection.Declarations.Add(locSym);
Self.Module.InterfaceSection.Types.Add(locSym);
end;
if not locSym.InheritsFrom(TPasType) then
raise EXsdInvalidTypeDefinitionException.CreateFmt(SERR_InvalidArrayItemType,[FTypeName]);
Result := FSymbols.CreateArray(AInternalName,locSym as TPasType,s_item,s_item,asScoped);
if AHasInternalName then
FSymbols.RegisterExternalAlias(Result,ATypeName);
end;
function TComplexTypeParser.IsHeaderBlock() : Boolean;
var
strBuffer : string;
begin
Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),FTypeNode,s_WST_headerBlock,strBuffer) and AnsiSameText('true',Trim(strBuffer));
end;
function TComplexTypeParser.IsSimpleContentHeaderBlock() : Boolean;
var
strBuffer : string;
begin
Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),FTypeNode,s_WST_headerBlockSimpleContent,strBuffer) and AnsiSameText('true',Trim(strBuffer));
end;
procedure TComplexTypeParser.CreateNodeCursors();
begin
FAttCursor := CreateAttributesCursor(FTypeNode,cetRttiNode);
FChildCursor := CreateChildrenCursor(FTypeNode,cetRttiNode);
end;
procedure TComplexTypeParser.ExtractTypeName();
var
locCrs : IObjectCursor;
begin
if not FEmbededDef then begin
locCrs := CreateCursorOn(
FAttCursor.Clone() as IObjectCursor,
ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer)
);
locCrs.Reset();
if not locCrs.MoveNext() then
raise EXsdParserException.Create(SERR_UnableToFindNameTagInNode);
FTypeName := (locCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
end;
if IsStrEmpty(FTypeName) then
raise EXsdParserException.Create(SERR_InvalidTypeName);
end;
procedure TComplexTypeParser.ExtractContentType();
var
locCrs : IObjectCursor;
begin
FContentType := '';
if Assigned(FChildCursor) then begin
locCrs := CreateCursorOn(
FChildCursor.Clone() as IObjectCursor,
ParseFilter(CreateQualifiedNameFilterStr(s_complexContent,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
if Assigned(locCrs) then begin
locCrs.Reset();
if locCrs.MoveNext() then begin
FContentNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
FContentType := FContentNode.NodeName;
end else begin
locCrs := CreateCursorOn(
FChildCursor.Clone() as IObjectCursor,
ParseFilter(CreateQualifiedNameFilterStr(s_simpleContent,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
locCrs.Reset();
if locCrs.MoveNext() then begin
FContentNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
FContentType := FContentNode.NodeName;
end else begin
FContentNode := FTypeNode;
FContentType := s_complexContent;
end;
end;
FContentType := ExtractNameFromQName(FContentType);
end;
end;
end;
procedure TComplexTypeParser.ExtractBaseType();
var
locContentChildCrs, locCrs : IObjectCursor;
locSymbol : TPasElement;
locBaseTypeLocalSpace, locBaseTypeLocalName, locBaseTypeInternalName, locFilterStr : string;
locBaseTypeLocalSpaceExpanded : string;
begin
locFilterStr := CreateQualifiedNameFilterStr(s_extension,Context.GetXsShortNames());
locContentChildCrs := CreateChildrenCursor(FContentNode,cetRttiNode);
locCrs := CreateCursorOn(
locContentChildCrs.Clone() as IObjectCursor,
ParseFilter(locFilterStr,TDOMNodeRttiExposer)
);
locCrs.Reset();
if locCrs.MoveNext() then begin
FDerivationMode := dmExtension;
FDerivationNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
end else begin
locFilterStr := CreateQualifiedNameFilterStr(s_restriction,Context.GetXsShortNames());
locCrs := CreateCursorOn(
locContentChildCrs.Clone() as IObjectCursor,
ParseFilter(locFilterStr,TDOMNodeRttiExposer)
);
locCrs.Reset();
if locCrs.MoveNext() then begin
FDerivationMode := dmRestriction;
FDerivationNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
end else begin
FDerivationMode := dmNone;
FDerivationNode := nil;
end;
end;
if ( FDerivationMode > dmNone ) then begin
locCrs := CreateCursorOn(
CreateAttributesCursor(FDerivationNode,cetRttiNode),
ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_base)]),TDOMNodeRttiExposer)
);
locCrs.Reset();
if not locCrs.MoveNext() then
raise EXsdParserException.CreateFmt(SERR_InvalidTypeDef_BaseAttributeNotFound,[FTypeName]);
ExplodeQName((locCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue,locBaseTypeLocalName,locBaseTypeLocalSpace);
locSymbol := FindElementNS(locBaseTypeLocalSpace,locBaseTypeLocalName,nvtShortSynonym);
if Assigned(locSymbol) then begin
if locSymbol.InheritsFrom(TPasType) then begin
FBaseType := locSymbol as TPasType;
while Assigned(FBaseType) and FBaseType.InheritsFrom(TPasAliasType) do begin
FBaseType := (FBaseType as TPasAliasType).DestType;
end;
if FBaseType.InheritsFrom(TPasNativeSimpleType) then begin
Assert(Assigned(TPasNativeSimpleType(FBaseType).ExtendableType));
FBaseType := TPasNativeSimpleType(FBaseType).ExtendableType;
end else if FBaseType.InheritsFrom(TPasNativeClassType) then begin
if Assigned(TPasNativeClassType(FBaseType).ExtendableType) then
FBaseType := TPasNativeClassType(FBaseType).ExtendableType;
end;
end else begin
raise EXsdParserException.CreateFmt(SERR_ExpectedTypeDefinition,[locSymbol.Name]);
end;
end else begin
if ( FDerivationMode = dmRestriction ) and
( locBaseTypeLocalName = 'Array' ) and
( Context.FindNameSpace(locBaseTypeLocalSpace,locBaseTypeLocalSpaceExpanded) and
( locBaseTypeLocalSpaceExpanded = s_soapEncodingNameSpace )
)
then begin
FHints := FHints + [pthDeriveFromSoapArray];
end else begin
locBaseTypeInternalName := ExtractIdentifier(locBaseTypeLocalName);
if IsReservedKeyWord(locBaseTypeInternalName) then
locBaseTypeInternalName := '_' + locBaseTypeInternalName ;
FBaseType := TPasUnresolvedTypeRef(FSymbols.CreateElement(TPasUnresolvedTypeRef,locBaseTypeInternalName,Self.Module.InterfaceSection,visDefault,'',0));
Self.Module.InterfaceSection.Declarations.Add(FBaseType);
Self.Module.InterfaceSection.Types.Add(FBaseType);
if not AnsiSameText(locBaseTypeInternalName,locBaseTypeLocalName) then
FSymbols.RegisterExternalAlias(FBaseType,locBaseTypeLocalName);
end;
end;
end;
end;
type
TOccurrenceRec = record
Valid : Boolean;
MinOccurs : Integer;
MaxOccurs : Integer;
Unboundded : Boolean;
end;
function TComplexTypeParser.ParseComplexContent(const ATypeName : string) : TPasType;
var
classDef : TPasClassType;
isArrayDef : Boolean;
arrayItems : TPropInfoReferenceList;
function IsCollectionArray(AElement : TDOMNode) : Boolean;
var
strBuffer : string;
begin
Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),AElement,s_WST_collection,strBuffer) and AnsiSameText('true',Trim(strBuffer));
end;
procedure ExtractOccurences(
AItemName : string;
AAttCursor : IObjectCursor;
var AMinOccurs,
AMaxOccurs : Integer;
var AMaxUnboundded : Boolean
);
var
locAttCursor, locPartCursor : IObjectCursor;
locMin, locMax : Integer;
locMaxOccurUnbounded : Boolean;
locStrBuffer : string;
begin
if (AAttCursor = nil) then begin
AMinOccurs := 1;
AMaxOccurs := 1;
AMaxUnboundded := False;
exit;
end;
locMin := 1;
locPartCursor := CreateCursorOn(AAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_minOccurs)]),TDOMNodeRttiExposer));
locPartCursor.Reset();
if locPartCursor.MoveNext() then begin
if not TryStrToInt((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue,locMin) then
raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[FTypeName,AItemName]);
if ( locMin < 0 ) then
raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[FTypeName,AItemName]);
end;
locMax := 1;
locMaxOccurUnbounded := False;
locPartCursor := CreateCursorOn(AAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_maxOccurs)]),TDOMNodeRttiExposer));
locPartCursor.Reset();
if locPartCursor.MoveNext() then begin
locStrBuffer := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
if AnsiSameText(locStrBuffer,s_unbounded) then begin
locMaxOccurUnbounded := True;
end else begin
if not TryStrToInt(locStrBuffer,locMax) then
raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[FTypeName,AItemName]);
if ( locMin < 0 ) then
raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[FTypeName,AItemName]);
end;
end;
AMinOccurs := locMin;
AMaxOccurs := locMax;
AMaxUnboundded := locMaxOccurUnbounded;
end;
procedure ParseElement(AElement : TDOMNode; const ABoundInfos : TOccurrenceRec);
var
locAttCursor, locPartCursor : IObjectCursor;
locName, locTypeName, locTypeInternalName : string;
locType : TPasElement;
locInternalEltName : string;
locProp : TPasProperty;
locHasInternalName : Boolean;
locMinOccur, locMaxOccur : Integer;
locMaxOccurUnbounded : Boolean;
locStrBuffer : string;
locIsRefElement : Boolean;
locTypeHint : string;
locTypeAddRef : Boolean;
begin
locType := nil;
locTypeName := '';
locTypeHint := '';
locAttCursor := CreateAttributesCursor(AElement,cetRttiNode);
locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer));
locPartCursor.Reset();
locIsRefElement := False;
locTypeAddRef := True;
if not locPartCursor.MoveNext() then begin
locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_ref)]),TDOMNodeRttiExposer));
locPartCursor.Reset();
if not locPartCursor.MoveNext() then begin
raise EXsdParserException.Create(SERR_InvalidElementDef_MissingNameOrRef);
end;
locIsRefElement := True;
end;
locName := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
if locIsRefElement then begin
locName := ExtractNameFromQName(locName);
end;
if IsStrEmpty(locName) then
raise EXsdParserException.Create(SERR_InvalidElementDef_EmptyName);
if locIsRefElement then begin
locTypeName := locName;
end else begin
locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_type)]),TDOMNodeRttiExposer));
locPartCursor.Reset();
if locPartCursor.MoveNext() then begin
locTypeName := ExtractNameFromQName(TDOMNodeRttiExposer(locPartCursor.GetCurrent()).NodeValue);
locTypeHint := ExtractTypeHint(AElement);
end else begin
locTypeName := Format('%s_%s_Type',[FTypeName,locName]);
if AElement.HasChildNodes() then begin
locType := TAbstractTypeParser.ExtractEmbeddedTypeFromElement(Context,AElement,FSymbols,locTypeName);
if ( locType = nil ) then begin
raise EXsdInvalidElementDefinitionException.CreateFmt(SERR_InvalidElementDef_Type,[FTypeName,locName]);
end;
Self.Module.InterfaceSection.Declarations.Add(locType);
Self.Module.InterfaceSection.Types.Add(locType);
if locType.InheritsFrom(TPasClassType) then begin
Self.Module.InterfaceSection.Classes.Add(locType);
end;
end else begin
locTypeName := 'anyType';
end;
end;
end;
if IsStrEmpty(locTypeName) then
raise EXsdInvalidElementDefinitionException.Create(SERR_InvalidElementDef_EmptyType);
locType := FindElementWithHint(locTypeName,locTypeHint,ssGlobal);
if Assigned(locType) then begin
if locIsRefElement then begin
locTypeInternalName := locTypeName;
locTypeInternalName := locTypeInternalName + '_Type';
locType.Name := locTypeInternalName;
FSymbols.RegisterExternalAlias(locType,locTypeName);
end;
end else begin
locTypeInternalName := ExtractIdentifier(locTypeName);
if locIsRefElement or AnsiSameText(locTypeInternalName,locInternalEltName) then begin
locTypeInternalName := locTypeInternalName + '_Type';
end;
if IsReservedKeyWord(locTypeInternalName) then begin
locTypeInternalName := '_' + locTypeInternalName;
end;
locType := TPasUnresolvedTypeRef(FSymbols.CreateElement(TPasUnresolvedTypeRef,locTypeInternalName,nil{Self.Module.InterfaceSection},visDefault,'',0));
locTypeAddRef := False;
//Self.Module.InterfaceSection.Declarations.Add(locType);
//Self.Module.InterfaceSection.Types.Add(locType);
if not AnsiSameText(locTypeInternalName,locTypeName) then
FSymbols.RegisterExternalAlias(locType,locTypeName);
end;
locInternalEltName := ExtractIdentifier(locName);
locHasInternalName := (locInternalEltName <> locName);
if IsReservedKeyWord(locInternalEltName) then begin
locHasInternalName := True;
locInternalEltName := Format('_%s',[locInternalEltName]);
end;
locProp := TPasProperty(FSymbols.CreateElement(TPasProperty,locInternalEltName,classDef,visPublished,'',0));
classDef.Members.Add(locProp);
locProp.VarType := locType as TPasType;
if locTypeAddRef then
locType.AddRef();
if locHasInternalName then
FSymbols.RegisterExternalAlias(locProp,locName);
{if AnsiSameText(locType.Name,locProp.Name) then begin
FSymbols.RegisterExternalAlias(locType,FSymbols.GetExternalName(locType));
TPasEmentCrack(locType).SetName(locType.Name + '_Type');
end;}
if AnsiSameText(s_attribute,ExtractNameFromQName(AElement.NodeName)) then begin
locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_use)]),TDOMNodeRttiExposer));
locPartCursor.Reset();
if locPartCursor.MoveNext() then begin
locStrBuffer := ExtractNameFromQName((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue);
if IsStrEmpty(locStrBuffer) then
raise EXsdInvalidDefinitionException.Create(SERR_InvalidAttributeDef_EmptyUse);
case AnsiIndexText(locStrBuffer,[s_required,s_optional,s_prohibited]) of
0 : locMinOccur := 1;
1 : locMinOccur := 0;
2 : locMinOccur := -1;
else
raise EXsdInvalidDefinitionException.CreateFmt(SERR_InvalidAttributeDef_InvalidUse,[locStrBuffer]);
end;
end else begin
locMinOccur := 0;
end;
end else begin
if ABoundInfos.Valid then begin
locMinOccur := ABoundInfos.MinOccurs;
end else begin
locMinOccur := 1;
locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_minOccurs)]),TDOMNodeRttiExposer));
locPartCursor.Reset();
if locPartCursor.MoveNext() then begin
if not TryStrToInt((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue,locMinOccur) then
raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[FTypeName,locName]);
if ( locMinOccur < 0 ) then
raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[FTypeName,locName]);
end;
end;
end;
locProp.ReadAccessorName := 'F' + locProp.Name;
locProp.WriteAccessorName := 'F' + locProp.Name;
if ( locMinOccur = 0 ) then begin
locProp.StoredAccessorName := sWST_PROP_STORE_PREFIX + locProp.Name;
end else if ( locMinOccur = -1 ) then begin
locProp.StoredAccessorName := 'False';
end else begin
locProp.StoredAccessorName := 'True';
end;
if ABoundInfos.Valid then begin
locMaxOccur := ABoundInfos.MaxOccurs;
locMaxOccurUnbounded := ABoundInfos.Unboundded;
end else begin
locMaxOccur := 1;
locMaxOccurUnbounded := False;
locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_maxOccurs)]),TDOMNodeRttiExposer));
locPartCursor.Reset();
if locPartCursor.MoveNext() then begin
locStrBuffer := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
if AnsiSameText(locStrBuffer,s_unbounded) then begin
locMaxOccurUnbounded := True;
end else begin
if not TryStrToInt(locStrBuffer,locMaxOccur) then
raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[FTypeName,locName]);
if ( locMinOccur < 0 ) then
raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[FTypeName,locName]);
end;
end;
end;
isArrayDef := locMaxOccurUnbounded or ( locMaxOccur > 1 );
if isArrayDef then begin
arrayItems.Add(locProp).FIsCollection := IsCollectionArray(AElement);
end;
if AnsiSameText(s_attribute,ExtractNameFromQName(AElement.NodeName)) then begin
FSymbols.SetPropertyAsAttribute(locProp,True);
end;
locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_default)]),TDOMNodeRttiExposer));
locPartCursor.Reset();
if locPartCursor.MoveNext() then
locProp.DefaultValue := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
ExtractExtendedMetadata(locProp,AElement);
end;
function IsRecordType() : Boolean;
var
strBuffer : string;
begin
Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),FTypeNode,s_WST_record,strBuffer) and AnsiSameText('true',Trim(strBuffer));
end;
procedure ParseElementsAndAttributes(
AEltCrs,
AEltAttCrs : IObjectCursor;
ABoundInfos : TOccurrenceRec
);
function ExtractElement(ANode : TDOMNode) : IObjectCursor;
var
tmpFilter : IObjectFilter;
begin
tmpFilter := ParseFilter(CreateQualifiedNameFilterStr(s_element,Context.GetXsShortNames()),TDOMNodeRttiExposer);
tmpFilter := TAggregatedFilter.Create(
tmpFilter,
ParseFilter(CreateQualifiedNameFilterStr(s_choice,Context.GetXsShortNames()),TDOMNodeRttiExposer),
fcOr
) as IObjectFilter;
Result := CreateCursorOn(
CreateChildrenCursor(ANode,cetRttiNode),
tmpFilter
);
end;
var
locNode, locAnyNode, locAnyAttNode : TDOMNode;
locNS, locLN : string;
locEltCrs, locEltAttCrs : IObjectCursor;
locBoundInfos : TOccurrenceRec;
begin
if Assigned(AEltCrs) then begin
AEltCrs.Reset();
while AEltCrs.MoveNext() do begin
locNode := (AEltCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
ExplodeQName(locNode.NodeName,locLN,locNS);
if (locLN = s_choice) then begin
locEltCrs := ExtractElement(locNode);
if (locEltCrs <> nil) then begin
ExtractOccurences(s_choice,locEltAttCrs,locBoundInfos.MinOccurs,locBoundInfos.MaxOccurs,locBoundInfos.Unboundded);
locBoundInfos.MinOccurs := 0;
locBoundInfos.Valid := True;
ParseElementsAndAttributes(locEltCrs,locEltAttCrs,locBoundInfos);
end;
end else begin
ParseElement(locNode,ABoundInfos);
end;
end;
end;
if Assigned(AEltAttCrs) then begin
AEltAttCrs.Reset();
while AEltAttCrs.MoveNext() do begin
ParseElement((AEltAttCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject,ABoundInfos);
end;
end;
end;
procedure CopyExtendedMetaData(ASource,ADesc : TPasElement);
var
ls : TStrings;
begin
ls := FSymbols.Properties.FindList(ASource);
if ( ls <> nil ) then
FSymbols.Properties.GetList(ADesc).Assign(ls);
end;
procedure ProcessXsdAnyDeclarations(AAnyNode, AAnyAttNode : TDOMNode; AType : TPasType);
var
anyElt : TDOMElement;
ls : TStringList;
anyDec : string;
begin
if ( AAnyNode <> nil ) then begin
anyElt := AAnyNode as TDOMElement;
ls := TStringList.Create();
try
if anyElt.hasAttribute(s_processContents) then
ls.Values[s_processContents] := anyElt.GetAttribute(s_processContents);
if anyElt.hasAttribute(s_minOccurs) then
ls.Values[s_minOccurs] := anyElt.GetAttribute(s_minOccurs);
if anyElt.hasAttribute(s_maxOccurs) then
ls.Values[s_maxOccurs] := anyElt.GetAttribute(s_maxOccurs);
if ( ls.Count > 0 ) then begin
ls.Delimiter := ';';
anyDec := ls.DelimitedText;
end;
finally
ls.Free();
end;
FSymbols.Properties.SetValue(AType,Format('%s#%s',[s_xs,s_any]),anyDec);
end;
if ( AAnyAttNode <> nil ) then begin
anyDec := '';
anyElt := AAnyAttNode as TDOMElement;
if anyElt.hasAttribute(s_processContents) then
anyDec := anyElt.GetAttribute(s_processContents);
FSymbols.Properties.SetValue(AType,Format('%s#%s',[s_xs,s_anyAttribute]),Format('%s=%s',[s_processContents,anyDec]));
end;
end;
var
eltCrs, eltAttCrs : IObjectCursor;
internalName : string;
hasInternalName : Boolean;
arrayDef : TPasArrayType;
propTyp, tmpPropTyp : TPasProperty;
tmpClassDef : TPasClassType;
i : Integer;
recordType : TPasRecordType;
tmpRecVar : TPasVariable;
locStrBuffer : string;
locAnyNode, locAnyAttNode : TDOMNode;
locDefaultAncestorUsed : Boolean;
locBoundInfos : TOccurrenceRec;
locTempNode : TDOMNode;
begin
ExtractBaseType();
eltCrs := ExtractElementCursor(nil,eltAttCrs,locAnyNode,locAnyAttNode);
internalName := ExtractIdentifier(ATypeName);
hasInternalName := IsReservedKeyWord(internalName) or
( not IsValidIdent(internalName) ) or
( FSymbols.FindElementInModule(internalName,Self.Module,[elkName]) <> nil ) or
( not AnsiSameText(internalName,ATypeName) );
if hasInternalName then begin
internalName := Format('%s_Type',[internalName]);
end;
if ( pthDeriveFromSoapArray in FHints ) or
( ( FDerivationMode = dmRestriction ) and FSymbols.SameName(FBaseType,s_array) )
then begin
Result := ExtractSoapArray(ATypeName,internalName,hasInternalName);
end else begin
arrayItems := TPropInfoReferenceList.Create();
try
classDef := TPasClassType(FSymbols.CreateElement(TPasClassType,internalName,Self.Module.InterfaceSection,visDefault,'',0));
try
classDef.ObjKind := okClass;
Result := classDef;
if hasInternalName then
FSymbols.RegisterExternalAlias(classDef,ATypeName);
if ( FDerivationMode in [dmExtension, dmRestriction] ) then begin
classDef.AncestorType := FBaseType;
end;
locDefaultAncestorUsed := False;
if ( classDef.AncestorType = nil ) then begin
if IsHeaderBlock() then begin
classDef.AncestorType := FSymbols.FindElementInModule('THeaderBlock',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType
end else if IsSimpleContentHeaderBlock() then begin
classDef.AncestorType := FSymbols.FindElementInModule('TSimpleContentHeaderBlock',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType
end else begin
locDefaultAncestorUsed := True;
classDef.AncestorType := FSymbols.FindElementInModule('TBaseComplexRemotable',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType;
end;
end;
classDef.AncestorType.AddRef();
if Assigned(eltCrs) or Assigned(eltAttCrs) then begin
isArrayDef := False;
FillChar(locBoundInfos,SizeOf(locBoundInfos),#0);
if (eltCrs <> nil) then begin
eltCrs.Reset();
if eltCrs.MoveNext() then begin
locTempNode := (eltCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
locTempNode := locTempNode.ParentNode;
if (ExtractNameFromQName(locTempNode.NodeName) = s_choice) then begin
ExtractOccurences(
s_choice,
CreateAttributesCursor(locTempNode,cetRttiNode),
locBoundInfos.MinOccurs,locBoundInfos.MaxOccurs,locBoundInfos.Unboundded
);
locBoundInfos.MinOccurs := 0;
locBoundInfos.Valid := True;
end;
end;
end;
ParseElementsAndAttributes(eltCrs,eltAttCrs,locBoundInfos);
if ( arrayItems.GetCount() > 0 ) then begin
if ( arrayItems.GetCount() = 1 ) and locDefaultAncestorUsed and
( GetElementCount(classDef.Members,TPasProperty) = 1 )
then begin
Result := nil;
propTyp := arrayItems.GetItem(0).Prop;
arrayDef := FSymbols.CreateArray(internalName,propTyp.VarType,propTyp.Name,FSymbols.GetExternalName(propTyp),asScoped);
FSymbols.FreeProperties(classDef);
FreeAndNil(classDef);
Result := arrayDef;
if hasInternalName then
FSymbols.RegisterExternalAlias(arrayDef,ATypeName);
if arrayItems.GetItem(0).IsCollection then
FSymbols.SetCollectionFlag(arrayDef,True);
end else begin
GenerateArrayTypes(internalName,arrayItems);
tmpClassDef := classDef;
classDef := TPasClassType(FSymbols.CreateElement(TPasClassType,tmpClassDef.Name,Self.Module.InterfaceSection,visPublic,'',0));
classDef.ObjKind := okClass;
Result := classDef;
classDef.AncestorType := tmpClassDef.AncestorType;
classDef.AncestorType.AddRef();
if hasInternalName then
FSymbols.RegisterExternalAlias(classDef,ATypeName);
for i := 0 to Pred(tmpClassDef.Members.Count) do begin
if TPasElement(tmpClassDef.Members[i]).InheritsFrom(TPasProperty) then begin
propTyp := TPasProperty(tmpClassDef.Members[i]);
if ( arrayItems.IndexOf(propTyp) = -1 ) then begin
tmpPropTyp := TPasProperty(FSymbols.CreateElement(TPasProperty,propTyp.Name,classDef,visPublished,'',0));
if FSymbols.IsAttributeProperty(propTyp) then begin
FSymbols.SetPropertyAsAttribute(tmpPropTyp,True);
end;
tmpPropTyp.VarType := propTyp.VarType;
tmpPropTyp.VarType.AddRef();
tmpPropTyp.StoredAccessorName := propTyp.StoredAccessorName;
FSymbols.RegisterExternalAlias(tmpPropTyp,FSymbols.GetExternalName(propTyp));
CopyExtendedMetaData(propTyp,tmpPropTyp);
classDef.Members.Add(tmpPropTyp);
end else begin
tmpPropTyp := TPasProperty(FSymbols.CreateElement(TPasProperty,propTyp.Name,classDef,visPublished,'',0));
tmpPropTyp.StoredAccessorName := propTyp.StoredAccessorName;
tmpPropTyp.VarType := FSymbols.FindElement(Format('%s_%sArray',[internalName,propTyp.Name])) as TPasType;
tmpPropTyp.VarType.AddRef();
FSymbols.RegisterExternalAlias(tmpPropTyp,FSymbols.GetExternalName(propTyp));
CopyExtendedMetaData(propTyp,tmpPropTyp);
classDef.Members.Add(tmpPropTyp);
end;
end;
end;
FSymbols.FreeProperties(tmpClassDef);
FreeAndNil(tmpClassDef);
end;
end;
end;
//check for record
if ( FDerivationMode = dmNone ) and
Result.InheritsFrom(TPasClassType) and
IsRecordType()
then begin
tmpClassDef := classDef;
classDef := nil;
recordType := TPasRecordType(FSymbols.CreateElement(TPasRecordType,tmpClassDef.Name,Self.Module.InterfaceSection,visPublic,'',0));
Result := recordType;
if hasInternalName then
FSymbols.RegisterExternalAlias(recordType,ATypeName);
for i := 0 to Pred(tmpClassDef.Members.Count) do begin
if TPasElement(tmpClassDef.Members[i]).InheritsFrom(TPasProperty) then begin
propTyp := TPasProperty(tmpClassDef.Members[i]);
tmpRecVar := TPasVariable(FSymbols.CreateElement(TPasVariable,propTyp.Name,recordType,visPublic,'',0));
tmpRecVar.VarType := propTyp.VarType;
tmpRecVar.VarType.AddRef();
FSymbols.RegisterExternalAlias(tmpRecVar,FSymbols.GetExternalName(propTyp));
recordType.Members.Add(tmpRecVar);
if FSymbols.IsAttributeProperty(propTyp) then begin
FSymbols.SetPropertyAsAttribute(tmpRecVar,True);
end;
if AnsiSameText(propTyp.StoredAccessorName,'False') then
locStrBuffer := s_prohibited
else if AnsiSameText(Copy(propTyp.StoredAccessorName,1,Length(sWST_PROP_STORE_PREFIX)),sWST_PROP_STORE_PREFIX) then
locStrBuffer := s_optional
else
locStrBuffer := s_required;
FSymbols.Properties.SetValue(tmpRecVar,s_WST_storeType,locStrBuffer);
end;
end;
FSymbols.FreeProperties(tmpClassDef);
FreeAndNil(tmpClassDef);
end;
if ( locAnyNode <> nil ) or ( locAnyAttNode <> nil ) then
ProcessXsdAnyDeclarations(locAnyNode,locAnyAttNode,Result);
except
FSymbols.FreeProperties(Result);
FreeAndNil(Result);
raise;
end;
finally
FreeAndNil(arrayItems);
end;
end;
end;
function TComplexTypeParser.ParseSimpleContent(const ATypeName : string) : TPasType;
function ExtractAttributeCursor():IObjectCursor;
var
frstCrsr, tmpCursor : IObjectCursor;
parentNode, tmpNode : TDOMNode;
locFilterStr : string;
xsShortNameList : TStrings;
begin
Result := nil;
parentNode := FContentNode;
if parentNode.HasChildNodes() then begin;
xsShortNameList := Context.GetXsShortNames();
frstCrsr := CreateChildrenCursor(parentNode,cetRttiNode);
locFilterStr := CreateQualifiedNameFilterStr(s_extension,xsShortNameList) + ' or ' +
CreateQualifiedNameFilterStr(s_restriction,xsShortNameList) ;
tmpCursor := CreateCursorOn(frstCrsr.Clone() as IObjectCursor,ParseFilter(locFilterStr,TDOMNodeRttiExposer));
if Assigned(tmpCursor) then begin
tmpCursor.Reset();
if tmpCursor.MoveNext() then begin
tmpNode := (tmpCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
if tmpNode.HasChildNodes() then begin
locFilterStr := CreateQualifiedNameFilterStr(s_attribute,xsShortNameList);
tmpCursor := CreateCursorOn(CreateChildrenCursor(tmpNode,cetRttiNode),ParseFilter(locFilterStr,TDOMNodeRttiExposer));
if Assigned(tmpCursor) then begin
Result := tmpCursor;
Result.Reset();
end;
end;
end;
end;
end else begin
Result := nil;
end;
end;
var
locClassDef : TPasClassType;
procedure ParseAttribute(AElement : TDOMNode);
var
locAttCursor, locPartCursor : IObjectCursor;
locName, locTypeName, locStoreOpt : string;
locType : TPasElement;
locStoreOptIdx : Integer;
locAttObj : TPasProperty;
locInternalEltName : string;
locHasInternalName : boolean;
begin
locAttCursor := CreateAttributesCursor(AElement,cetRttiNode);
locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer));
locPartCursor.Reset();
if not locPartCursor.MoveNext() then
raise EXsdInvalidDefinitionException.Create(SERR_InvalidAttributeDef_MissingName);
locName := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
if IsStrEmpty(locName) then
raise EXsdInvalidDefinitionException.Create(SERR_InvalidAttributeDef_EmptyName);
locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_type)]),TDOMNodeRttiExposer));
locPartCursor.Reset();
if not locPartCursor.MoveNext() then
raise EXsdInvalidDefinitionException.Create(SERR_InvalidAttributeDef_MissingType);
locTypeName := ExtractNameFromQName((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue);
if IsStrEmpty(locTypeName) then
raise EXsdInvalidDefinitionException.Create(SERR_InvalidAttributeDef_EmptyType);
locType := FSymbols.FindElement(locTypeName) as TPasType;
if not Assigned(locType) then begin
locType := TPasUnresolvedTypeRef(FSymbols.CreateElement(TPasUnresolvedTypeRef,locTypeName,Self.Module.InterfaceSection,visPublic,'',0));
Self.Module.InterfaceSection.Declarations.Add(locType);
Self.Module.InterfaceSection.Types.Add(locType);
end;
locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_use)]),TDOMNodeRttiExposer));
locPartCursor.Reset();
if locPartCursor.MoveNext() then begin
locStoreOpt := ExtractNameFromQName((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue);
if IsStrEmpty(locStoreOpt) then
raise EXsdInvalidDefinitionException.Create(SERR_InvalidAttributeDef_EmptyUse);
locStoreOptIdx := AnsiIndexText(locStoreOpt,[s_required,s_optional,s_prohibited]);
if ( locStoreOptIdx < 0 ) then
raise EXsdInvalidDefinitionException.CreateFmt(SERR_InvalidAttributeDef_InvalidUse,[locStoreOpt]);
end else begin
locStoreOptIdx := 1{optional by default!}; //0;
end;
locInternalEltName := locName;
locHasInternalName := IsReservedKeyWord(locInternalEltName);
if locHasInternalName then
locInternalEltName := Format('_%s',[locInternalEltName]);
locAttObj := TPasProperty(FSymbols.CreateElement(TPasProperty,locInternalEltName,locClassDef,visPublished,'',0));
locClassDef.Members.Add(locAttObj);
locAttObj.VarType := locType as TPasType;
locAttObj.VarType.AddRef();
if locHasInternalName then
FSymbols.RegisterExternalAlias(locAttObj,locName);
FSymbols.SetPropertyAsAttribute(locAttObj,True);
case locStoreOptIdx of
0 : locAttObj.StoredAccessorName := 'True';
1 : locAttObj.StoredAccessorName := sWST_PROP_STORE_PREFIX + locAttObj.Name;
2 : locAttObj.StoredAccessorName := 'False';
end;
end;
var
locAttCrs : IObjectCursor;
internalName : string;
hasInternalName : Boolean;
begin
ExtractBaseType();
if not ( FDerivationMode in [dmExtension, dmRestriction] ) then
raise EXsdInvalidTypeDefinitionException.Create(SERR_InvalidComplexSimpleTypeDef_NoRestOrExt);
internalName := ATypeName;
hasInternalName := IsReservedKeyWord(internalName) or
( not IsValidIdent(internalName) );{ or
( FSymbols.IndexOf(internalName) <> -1 );}
if hasInternalName then
internalName := Format('_%s',[internalName]);
locAttCrs := ExtractAttributeCursor();
locClassDef := TPasClassType(FSymbols.CreateElement(TPasClassType,Trim(internalName),Self.Module.InterfaceSection,visDefault,'',0));
try
locClassDef.ObjKind := okClass;
Result := locClassDef;
if hasInternalName then
FSymbols.RegisterExternalAlias(locClassDef,ATypeName);
if ( FDerivationMode in [dmExtension, dmRestriction] ) then begin
locClassDef.AncestorType := FBaseType;
end;
if ( locClassDef.AncestorType = nil ) then begin
locClassDef.AncestorType := FSymbols.FindElementInModule('TBaseComplexRemotable',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType;
end;
locClassDef.AncestorType.AddRef();
if ( locAttCrs <> nil ) then begin
locAttCrs.Reset();
while locAttCrs.MoveNext() do begin
ParseAttribute((locAttCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject);
end;
end;
except
FSymbols.FreeProperties(Result);
FreeAndNil(Result);
raise;
end;
end;
function TComplexTypeParser.ParseEmptyContent(const ATypeName: string): TPasType;
var
internalName : string;
hasInternalName : Boolean;
begin
internalName := ATypeName;
hasInternalName := IsReservedKeyWord(internalName) or
( not IsValidIdent(internalName) );{ or
( FSymbols.IndexOf(internalName) <> -1 );}
if hasInternalName then
internalName := Format('_%s',[internalName]);
Result := TPasClassType(FSymbols.CreateElement(TPasClassType,internalName,Self.Module.InterfaceSection,visDefault,'',0));
TPasClassType(Result).ObjKind := okClass;
if hasInternalName then
FSymbols.RegisterExternalAlias(Result,ATypeName);
if IsHeaderBlock() then
TPasClassType(Result).AncestorType := FSymbols.FindElementInModule('THeaderBlock',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType
else if IsSimpleContentHeaderBlock() then
TPasClassType(Result).AncestorType := FSymbols.FindElementInModule('TSimpleContentHeaderBlock',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType
else
TPasClassType(Result).AncestorType := FSymbols.FindElementInModule('TBaseComplexRemotable',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType;
TPasClassType(Result).AncestorType.AddRef();
end;
class function TComplexTypeParser.GetParserSupportedStyle(): string;
begin
Result := s_complexType;
end;
function TComplexTypeParser.Parse() : TPasType;
var
locSym : TPasElement;
locContinue : Boolean;
begin
if not AnsiSameText(ExtractNameFromQName(FTypeNode.NodeName),s_complexType) then
raise EXsdParserAssertException.CreateFmt(SERR_ExpectedButFound,[s_complexType,ExtractNameFromQName(FTypeNode.NodeName)]);
Result := nil;
CreateNodeCursors();
ExtractTypeName();
locContinue := True;
locSym := FSymbols.FindElement(FTypeName);
if Assigned(locSym) then begin
if not locSym.InheritsFrom(TPasType) then
raise EXsdParserException.CreateFmt(SERR_ExpectedTypeDefinition,[FTypeName]);
locContinue := locSym.InheritsFrom(TPasUnresolvedTypeRef) or
( IsEmbeddedType(TPasType(locSym)) <> FEmbededDef );
if not locContinue then;
Result := locSym as TPasType;
end;
if locContinue then begin
ExtractContentType();
if IsStrEmpty(FContentType) then begin
Result := ParseEmptyContent(FTypeName);
end else begin
if AnsiSameText(FContentType,s_complexContent) then
Result := ParseComplexContent(FTypeName)
else
Result := ParseSimpleContent(FTypeName);
end;
if ( Result <> nil ) then begin
if ( IsEmbeddedType(Result) <> FEmbededDef ) then
SetAsEmbeddedType(Result,FEmbededDef);
end;
{$IFDEF WST_HANDLE_DOC}
if ( Result <> nil ) then
ParseDocumentation(Result);
{$ENDIF WST_HANDLE_DOC}
end;
end;
{ TSimpleTypeParser }
procedure TSimpleTypeParser.CreateNodeCursors();
begin
FAttCursor := CreateAttributesCursor(FTypeNode,cetRttiNode);
FChildCursor := CreateChildrenCursor(FTypeNode,cetRttiNode);
end;
procedure TSimpleTypeParser.ExtractTypeName();
var
locCrs : IObjectCursor;
begin
if not FEmbededDef then begin
locCrs := CreateCursorOn(
FAttCursor.Clone() as IObjectCursor,
ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer)
);
locCrs.Reset();
if not locCrs.MoveNext() then
raise EXsdParserAssertException.Create(SERR_UnableToFindNameTagInNode);
FTypeName := (locCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
end;
if IsStrEmpty(FTypeName) then
raise EXsdParserAssertException.Create(SERR_InvalidTypeName);
end;
function TSimpleTypeParser.ExtractContentType() : Boolean;
var
locCrs, locAttCrs : IObjectCursor;
tmpNode : TDOMNode;
spaceShort : string;
begin
locCrs := CreateCursorOn(
FChildCursor.Clone() as IObjectCursor,
ParseFilter(CreateQualifiedNameFilterStr(s_restriction,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
locCrs.Reset();
if locCrs.MoveNext() then begin
FRestrictionNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
tmpNode := nil;
locAttCrs := CreateAttributesCursor(FRestrictionNode,cetRttiNode);
if Assigned(locAttCrs) then begin
locAttCrs := CreateCursorOn(locAttCrs,ParseFilter(Format('%s=%s',[s_NODE_NAME,QuotedStr(s_base)]),TDOMNodeRttiExposer));
locAttCrs.Reset();
if locAttCrs.MoveNext() then begin
tmpNode := (locAttCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
end;
end;
FBaseName := '';
FBaseNameSpace := '';
if Assigned(tmpNode) then begin
ExplodeQName(tmpNode.NodeValue,FBaseName,spaceShort);
if not Context.FindNameSpace(spaceShort,FBaseNameSpace) then
raise EXsdParserAssertException.CreateFmt(SERR_CannotResolveNamespace,[spaceShort]);
end;
locCrs := CreateChildrenCursor(FRestrictionNode,cetRttiNode) as IObjectCursor;
if Assigned(locCrs) then begin
locCrs := CreateCursorOn(
locCrs,
ParseFilter(CreateQualifiedNameFilterStr(s_enumeration,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
locCrs.Reset();
if locCrs.MoveNext() then begin
FIsEnum := True;
end else begin
if IsStrEmpty(FBaseName) then
raise EXsdParserAssertException.CreateFmt(SERR_BaseTypeNotSpecfifiedForSimpleType,[FTypeName]);
FIsEnum := False
end;
end else begin
if IsStrEmpty(FBaseName) then
raise EXsdParserAssertException.CreateFmt(SERR_BaseTypeNotSpecfifiedForSimpleType,[FTypeName]);
FIsEnum := False
end;
Result := True;
end else begin
//raise EWslParserException.CreateFmt('The parser only support "Restriction" mode simple type derivation, parsing : "%s".',[FTypeName]);
Result := False;
end;
end;
function TSimpleTypeParser.ParseEnumContent(): TPasType;
function ExtractEnumCursor():IObjectCursor ;
begin
Result := CreateCursorOn(
CreateChildrenCursor(FRestrictionNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_enumeration,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
end;
var
locRes : TPasEnumType;
//locOrder : Integer;
prefixItems : Boolean;
procedure ParseEnumItem(AItemNode : TDOMNode);
var
tmpNode : TDOMNode;
locItemName, locInternalItemName : string;
locCrs : IObjectCursor;
locItem : TPasEnumValue;
locHasInternalName : Boolean;
locBuffer : string;
begin
locCrs := CreateCursorOn(CreateAttributesCursor(AItemNode,cetRttiNode),ParseFilter(Format('%s=%s',[s_NODE_NAME,QuotedStr(s_value)]),TDOMNodeRttiExposer)) as IObjectCursor;
if not Assigned(locCrs) then
raise EXsdInvalidDefinitionException.CreateFmt(SERR_InvalidEnumItemNode_NoValueAttribute,[FTypeName]);
locCrs.Reset();
if not locCrs.MoveNext() then
raise EXsdInvalidDefinitionException.CreateFmt(SERR_InvalidEnumItemNode_NoValueAttribute,[FTypeName]);
tmpNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
locItemName := tmpNode.NodeValue;
{ (26-06-2008) empty string "" can be valid enum item!
if IsStrEmpty(locItemName) then
raise EXsdInvalidDefinitionException.CreateFmt('Invalid "enum" item node : the value attribute is empty, type = "%s".',[FTypeName]);
}
locInternalItemName := ExtractIdentifier(locItemName);
if IsStrEmpty(locInternalItemName) then
locInternalItemName := 'EmptyItem';
locHasInternalName := prefixItems or
IsReservedKeyWord(locInternalItemName) or
( not IsValidIdent(locInternalItemName) ) or
( FSymbols.FindElementInModule(locInternalItemName,Self.Module) <> nil ) or
FSymbols.IsEnumItemNameUsed(locInternalItemName,Self.Module) or
( not AnsiSameText(locInternalItemName,locItemName) );
if locHasInternalName then begin
locBuffer := ExtractIdentifier(FSymbols.GetExternalName(locRes));
if ( not IsStrEmpty(locBuffer) ) and ( locBuffer[Length(locBuffer)] <> '_' ) then begin
locInternalItemName := Format('%s_%s',[locBuffer,locInternalItemName]);
end else begin
locInternalItemName := Format('%s%s',[locBuffer,locInternalItemName]);
end;
end;
locItem := TPasEnumValue(FSymbols.CreateElement(TPasEnumValue,locInternalItemName,locRes,visDefault,'',0));
//locItem.Value := locOrder;
locRes.Values.Add(locItem);
if locHasInternalName then
FSymbols.RegisterExternalAlias(locItem,locItemName);
//Inc(locOrder);
end;
var
locEnumCrs : IObjectCursor;
intrName : string;
hasIntrnName : Boolean;
begin
prefixItems := ( poEnumAlwaysPrefix in Context.GetSimpleOptions() );
locEnumCrs := ExtractEnumCursor();
intrName := FTypeName;
hasIntrnName := IsReservedKeyWord(FTypeName) or
( ( FindElement(intrName) <> nil ) and ( not FindElement(intrName).InheritsFrom(TPasUnresolvedTypeRef) ) );
if hasIntrnName then
intrName := '_' + intrName;
locRes := TPasEnumType(FSymbols.CreateElement(TPasEnumType,Trim(intrName),Self.Module.InterfaceSection,visDefault,'',0));
try
Result := locRes;
if hasIntrnName then
FSymbols.RegisterExternalAlias(locRes,FTypeName);
locEnumCrs.Reset();
//locOrder := 0;
while locEnumCrs.MoveNext() do begin
ParseEnumItem((locEnumCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject);
end;
except
FSymbols.FreeProperties(Result);
FreeAndNil(Result);
raise;
end;
end;
function TSimpleTypeParser.ParseOtherContent(): TPasType;
var
intrName : string;
hasIntrnName : Boolean;
tmpElement : TPasElement;
begin // todo : implement TSimpleTypeParser.ParseOtherContent
if IsStrEmpty(FBaseName) then
raise EXsdInvalidTypeDefinitionException.CreateFmt(SERR_BaseTypeNotSpecfifiedForSimpleType,[FTypeName]);
intrName := ExtractIdentifier(FTypeName);
hasIntrnName := ( intrName <> FTypeName ) or
IsReservedKeyWord(intrName);
if not hasIntrnName then begin
tmpElement := FindElement(intrName);
if ( tmpElement <> nil ) and ( not tmpElement.InheritsFrom(TPasUnresolvedTypeRef) ) then
hasIntrnName := True;
end;
if hasIntrnName then
intrName := '_' + intrName;
Result := TPasTypeAliasType(FSymbols.CreateElement(TPasTypeAliasType,intrName,Self.Module.InterfaceSection,visDefault,'',0));
if ( intrName <> FTypeName ) then
FSymbols.RegisterExternalAlias(Result,FTypeName);
TPasTypeAliasType(Result).DestType := FindElementNS(FBaseNameSpace,FBaseName,nvtExpandValue) as TPasType;
TPasTypeAliasType(Result).DestType.AddRef();
end;
class function TSimpleTypeParser.GetParserSupportedStyle(): string;
begin
Result := s_simpleType;
end;
function TSimpleTypeParser.Parse(): TPasType;
var
locSym : TPasElement;
locContinue : Boolean;
begin
if not AnsiSameText(ExtractNameFromQName(FTypeNode.NodeName),s_simpleType) then
raise EXsdParserAssertException.CreateFmt(SERR_ExpectedButFound,[s_simpleType,ExtractNameFromQName(FTypeNode.NodeName)]);
Result := nil;
CreateNodeCursors();
ExtractTypeName();
locContinue := True;
locSym := FindElement(FTypeName);
if Assigned(locSym) then begin
if not locSym.InheritsFrom(TPasType) then
raise EXsdParserAssertException.CreateFmt(SERR_ExpectedTypeDefinition,[FTypeName]);
locContinue := locSym.InheritsFrom(TPasUnresolvedTypeRef);
if not locContinue then begin
Result := locSym as TPasType;
end;
end;
if locContinue then begin
if ExtractContentType() then begin
if FIsEnum then begin
Result := ParseEnumContent()
end else begin
Result := ParseOtherContent();
end;
end else begin
FBaseName := 'string';
FBaseNameSpace := s_xs;
Result := ParseOtherContent();
end;
if ( Result <> nil ) then begin
if ( IsEmbeddedType(Result) <> FEmbededDef ) then
SetAsEmbeddedType(Result,FEmbededDef);
end;
{$IFDEF WST_HANDLE_DOC}
if ( Result <> nil ) then
ParseDocumentation(Result);
{$ENDIF WST_HANDLE_DOC}
end;
end;
{ TPropInfoReferenceList }
constructor TPropInfoReferenceList.Create();
begin
FList := TObjectList.Create(True);
end;
destructor TPropInfoReferenceList.Destroy();
begin
FList.Free();
inherited Destroy();
end;
function TPropInfoReferenceList.Add(AProp : TPasProperty) : TPropInfoReference;
var
i : PtrInt;
begin
i := IndexOf(AProp);
if ( i = -1 ) then begin
Result := TPropInfoReference.Create();
Result.FProp := AProp;
FList.Add(Result);
end else begin
Result := TPropInfoReference(FList[i]);
end;
end;
function TPropInfoReferenceList.GetItem(const AIndex : PtrInt) : TPropInfoReference;
begin
Result := TPropInfoReference(FList[AIndex]);
end;
function TPropInfoReferenceList.IndexOf(const AProp : TPasProperty) : PtrInt;
var
i : PtrInt;
begin
Result := -1;
for i := 0 to Pred(FList.Count) do begin
if ( TPropInfoReference(FList[i]).Prop = AProp ) then begin
Result := i;
Break;
end;
end;
end;
function TPropInfoReferenceList.GetCount() : PtrInt;
begin
Result := FList.Count;
end;
initialization
TAbstractTypeParser.RegisterParser(TSimpleTypeParser);
TAbstractTypeParser.RegisterParser(TComplexTypeParser);
finalization
FreeAndNil(FTypeParserList);
end.