2007-09-09 22:30:50 +00:00
|
|
|
{
|
|
|
|
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
|
2008-08-01 21:38:55 +00:00
|
|
|
Classes, SysUtils, Contnrs,
|
2008-06-06 14:59:24 +00:00
|
|
|
{$IFNDEF FPC}xmldom, wst_delphi_xml{$ELSE}DOM, wst_fpc_xml{$ENDIF},
|
2007-09-09 22:30:50 +00:00
|
|
|
cursor_intf, rtti_filters,
|
|
|
|
pastree, pascal_parser_intf, logger_intf,
|
2008-10-17 20:31:55 +00:00
|
|
|
xsd_parser, wst_types;
|
2007-09-09 22:30:50 +00:00
|
|
|
|
|
|
|
type
|
|
|
|
|
|
|
|
TNameSpaceValueType = ( nvtExpandValue, nvtShortSynonym );
|
2008-09-17 01:45:04 +00:00
|
|
|
TSearchSpace = ( ssCurrentModule, ssGlobal );
|
2007-09-09 22:30:50 +00:00
|
|
|
|
|
|
|
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;
|
2008-09-17 01:45:04 +00:00
|
|
|
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}
|
2009-11-26 10:39:50 +00:00
|
|
|
procedure SetAsEmbeddedType(AType : TPasType; const AValue : Boolean);
|
2009-09-02 12:24:19 +00:00
|
|
|
function IsEmbeddedType(AType : TPasType) : Boolean;
|
2008-08-18 18:19:00 +00:00
|
|
|
{$IFDEF WST_HANDLE_DOC}
|
|
|
|
procedure ParseDocumentation(AType : TPasType);
|
|
|
|
{$ENDIF WST_HANDLE_DOC}
|
2007-09-09 22:30:50 +00:00
|
|
|
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;
|
2009-11-26 10:39:50 +00:00
|
|
|
property Context : IParserContext read FContext;
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
TDerivationMode = ( dmNone, dmExtension, dmRestriction );
|
|
|
|
TSequenceType = ( stElement, stAll );
|
2008-09-10 01:46:45 +00:00
|
|
|
TParserTypeHint = ( pthDeriveFromSoapArray );
|
|
|
|
TParserTypeHints = set of TParserTypeHint;
|
2007-09-09 22:30:50 +00:00
|
|
|
|
2008-08-01 21:38:55 +00:00
|
|
|
{ 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;
|
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
{ TComplexTypeParser }
|
|
|
|
|
|
|
|
TComplexTypeParser = class(TAbstractTypeParser)
|
|
|
|
private
|
|
|
|
FAttCursor : IObjectCursor;
|
|
|
|
FChildCursor : IObjectCursor;
|
|
|
|
FContentNode : TDOMNode;
|
|
|
|
FContentType : string;
|
|
|
|
FBaseType : TPasType;
|
|
|
|
FDerivationMode : TDerivationMode;
|
|
|
|
FDerivationNode : TDOMNode;
|
|
|
|
FSequenceType : TSequenceType;
|
2008-09-10 01:46:45 +00:00
|
|
|
FHints : TParserTypeHints;
|
2008-08-01 21:38:55 +00:00
|
|
|
private
|
|
|
|
//helper routines
|
2008-10-23 19:21:59 +00:00
|
|
|
function ExtractElementCursor(
|
2011-09-14 02:31:02 +00:00
|
|
|
AParentNode : TDOMNode;
|
2008-10-23 19:21:59 +00:00
|
|
|
out AAttCursor : IObjectCursor;
|
|
|
|
out AAnyNode, AAnyAttNode : TDOMNode
|
|
|
|
):IObjectCursor;
|
2008-08-01 21:38:55 +00:00
|
|
|
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;
|
2008-09-11 02:12:27 +00:00
|
|
|
function IsHeaderBlock() : Boolean;
|
|
|
|
function IsSimpleContentHeaderBlock() : Boolean;
|
2007-09-09 22:30:50 +00:00
|
|
|
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
|
2009-07-09 14:10:58 +00:00
|
|
|
uses
|
|
|
|
dom_cursors, parserutils, StrUtils, xsd_consts, wst_consts;
|
2007-09-09 22:30:50 +00:00
|
|
|
|
|
|
|
{ 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
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdParserException.Create(SERR_UnableToFindNameTagInNode);
|
2007-09-09 22:30:50 +00:00
|
|
|
Result := (locCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
|
|
|
|
if IsStrEmpty(Result) then begin
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdParserException.Create(SERR_InvalidTypeName);
|
2007-09-09 22:30:50 +00:00
|
|
|
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;
|
2012-09-06 12:31:10 +00:00
|
|
|
raise EXsdParserException.CreateFmt('%s : Type Name = "%s", NodeName = "%s" .',[SERR_InvalidTypeDef_NoChild,ATypeName,AEltNode.NodeName]);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
typName := ATypeName;
|
|
|
|
if IsStrEmpty(typName) then begin
|
|
|
|
typName := ExtractTypeName();
|
|
|
|
end;
|
|
|
|
prsClss := FindParser(typNode);
|
|
|
|
if ( prsClss = nil ) then begin;
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdInvalidTypeDefinitionException.CreateFmt(SERR_TypeStyleNotSupported,[typName]);
|
2007-09-09 22:30:50 +00:00
|
|
|
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
|
2009-11-26 10:39:50 +00:00
|
|
|
if not Context.FindNameSpace(ANameSpace,locNS) then
|
2009-07-09 14:10:58 +00:00
|
|
|
raise EXsdParserAssertException.CreateFmt(SERR_CannotResolveNamespace,[ANameSpace]);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
Result := FSymbols.FindElementNS(ALocalName,locNS);
|
|
|
|
end;
|
|
|
|
|
2008-09-17 01:45:04 +00:00
|
|
|
function TAbstractTypeParser.GetModule : TPasModule;
|
2007-09-09 22:30:50 +00:00
|
|
|
begin
|
2009-11-26 10:39:50 +00:00
|
|
|
Result := Context.GetTargetModule();
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
|
2008-09-17 01:45:04 +00:00
|
|
|
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;
|
2007-09-09 22:30:50 +00:00
|
|
|
begin
|
2009-11-26 10:39:50 +00:00
|
|
|
if not wst_findCustomAttributeXsd(Context.GetXsShortNames(),AElement,s_WST_typeHint,Result) then
|
2008-09-17 01:45:04 +00:00
|
|
|
Result := '';
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
|
2009-11-26 10:39:50 +00:00
|
|
|
procedure TAbstractTypeParser.SetAsEmbeddedType(AType : TPasType; const AValue : Boolean);
|
|
|
|
var
|
|
|
|
s : string;
|
2009-09-02 12:24:19 +00:00
|
|
|
begin
|
2009-11-26 10:39:50 +00:00
|
|
|
if AValue then
|
|
|
|
s := '1'
|
|
|
|
else
|
|
|
|
s := '';
|
|
|
|
FSymbols.Properties.SetValue(AType,sEMBEDDED_TYPE,s);
|
2009-09-02 12:24:19 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
function TAbstractTypeParser.IsEmbeddedType(AType : TPasType) : Boolean;
|
|
|
|
begin
|
|
|
|
Result := ( FSymbols.Properties.GetValue(AType,sEMBEDDED_TYPE) = '1' );
|
|
|
|
end;
|
|
|
|
|
2008-08-18 18:19:00 +00:00
|
|
|
{$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),
|
2009-11-26 10:39:50 +00:00
|
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_annotation,Context.GetXsShortNames()),TDOMNodeRttiExposer)
|
2008-08-18 18:19:00 +00:00
|
|
|
);
|
|
|
|
if ( tmpCursor <> nil ) then begin
|
|
|
|
tmpCursor.Reset();
|
|
|
|
if tmpCursor.MoveNext() then begin
|
|
|
|
tmpCursor := CreateCursorOn(
|
|
|
|
CreateChildrenCursor(TDOMNodeRttiExposer(tmpCursor.GetCurrent()).InnerObject,cetRttiNode),
|
2009-11-26 10:39:50 +00:00
|
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_documentation,Context.GetXsShortNames()),TDOMNodeRttiExposer)
|
2008-08-18 18:19:00 +00:00
|
|
|
);
|
|
|
|
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}
|
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
{ TComplexTypeParser }
|
|
|
|
|
2008-10-23 19:21:59 +00:00
|
|
|
function TComplexTypeParser.ExtractElementCursor(
|
2011-09-14 02:31:02 +00:00
|
|
|
AParentNode : TDOMNode;
|
2008-10-23 19:21:59 +00:00
|
|
|
out AAttCursor : IObjectCursor;
|
|
|
|
out AAnyNode, AAnyAttNode : TDOMNode
|
|
|
|
) : IObjectCursor;
|
2008-08-01 21:38:55 +00:00
|
|
|
var
|
2008-10-23 19:21:59 +00:00
|
|
|
frstCrsr : IObjectCursor;
|
|
|
|
|
|
|
|
function ParseContent_ALL() : IObjectCursor;
|
|
|
|
var
|
|
|
|
locTmpCrs : IObjectCursor;
|
|
|
|
locTmpNode : TDOMNode;
|
|
|
|
begin
|
|
|
|
locTmpCrs := CreateCursorOn(
|
|
|
|
frstCrsr.Clone() as IObjectCursor,
|
2009-11-26 10:39:50 +00:00
|
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_all,Context.GetXsShortNames()),TDOMNodeRttiExposer)
|
2008-08-01 21:38:55 +00:00
|
|
|
);
|
2008-10-23 19:21:59 +00:00
|
|
|
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),
|
2009-11-26 10:39:50 +00:00
|
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_element,Context.GetXsShortNames()),TDOMNodeRttiExposer)
|
2008-10-23 19:21:59 +00:00
|
|
|
);
|
|
|
|
Result := locTmpCrs;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
function ParseContent_SEQUENCE(out ARes : IObjectCursor) : Boolean;
|
|
|
|
var
|
|
|
|
tmpCursor : IObjectCursor;
|
|
|
|
tmpNode : TDOMNode;
|
2011-09-14 02:31:02 +00:00
|
|
|
tmpFilter : IObjectFilter;
|
2008-10-23 19:21:59 +00:00
|
|
|
begin
|
|
|
|
ARes := nil;
|
2011-09-14 02:31:02 +00:00
|
|
|
tmpFilter := ParseFilter(CreateQualifiedNameFilterStr(s_sequence,Context.GetXsShortNames()),TDOMNodeRttiExposer);
|
|
|
|
tmpFilter := TAggregatedFilter.Create(
|
|
|
|
tmpFilter,
|
|
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_choice,Context.GetXsShortNames()),TDOMNodeRttiExposer),
|
|
|
|
fcOr
|
|
|
|
) as IObjectFilter;
|
2008-08-01 21:38:55 +00:00
|
|
|
tmpCursor := CreateCursorOn(
|
|
|
|
frstCrsr.Clone() as IObjectCursor,
|
2011-09-14 02:31:02 +00:00
|
|
|
tmpFilter
|
2008-08-01 21:38:55 +00:00
|
|
|
);
|
|
|
|
tmpCursor.Reset();
|
2008-10-23 19:21:59 +00:00
|
|
|
Result := tmpCursor.MoveNext();
|
|
|
|
if Result then begin
|
2008-08-01 21:38:55 +00:00
|
|
|
FSequenceType := stElement;
|
|
|
|
tmpNode := (tmpCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
|
|
if tmpNode.HasChildNodes() then begin
|
2011-09-14 02:31:02 +00:00
|
|
|
tmpFilter := ParseFilter(CreateQualifiedNameFilterStr(s_element,Context.GetXsShortNames()),TDOMNodeRttiExposer);
|
|
|
|
tmpFilter := TAggregatedFilter.Create(
|
|
|
|
tmpFilter,
|
|
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_choice,Context.GetXsShortNames()),TDOMNodeRttiExposer),
|
|
|
|
fcOr
|
|
|
|
) as IObjectFilter;
|
2008-08-01 21:38:55 +00:00
|
|
|
tmpCursor := CreateCursorOn(
|
|
|
|
CreateChildrenCursor(tmpNode,cetRttiNode),
|
2011-09-14 02:31:02 +00:00
|
|
|
tmpFilter
|
2008-08-01 21:38:55 +00:00
|
|
|
);
|
2008-10-23 19:21:59 +00:00
|
|
|
ARes := tmpCursor;
|
|
|
|
tmpCursor := CreateCursorOn(
|
|
|
|
CreateChildrenCursor(tmpNode,cetRttiNode),
|
2009-11-26 10:39:50 +00:00
|
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_any,Context.GetXsShortNames()),TDOMNodeRttiExposer)
|
2008-10-23 19:21:59 +00:00
|
|
|
);
|
|
|
|
tmpCursor.Reset();
|
|
|
|
if tmpCursor.MoveNext() then
|
|
|
|
AAnyNode := TDOMNodeRttiExposer(tmpCursor.GetCurrent()).InnerObject;
|
2008-08-01 21:38:55 +00:00
|
|
|
end;
|
|
|
|
end
|
2008-10-23 19:21:59 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
parentNode : TDOMNode;
|
|
|
|
crs : IObjectCursor;
|
|
|
|
begin
|
|
|
|
Result := nil;
|
|
|
|
AAttCursor := nil;
|
|
|
|
AAnyNode := nil;
|
|
|
|
AAnyAttNode := nil;
|
2011-09-14 02:31:02 +00:00
|
|
|
parentNode := AParentNode;
|
|
|
|
if (parentNode = nil) then begin
|
|
|
|
case FDerivationMode of
|
|
|
|
dmNone : parentNode := FContentNode;
|
|
|
|
dmRestriction,
|
|
|
|
dmExtension : parentNode := FDerivationNode;
|
|
|
|
end;
|
2008-10-23 19:21:59 +00:00
|
|
|
end;
|
|
|
|
if parentNode.HasChildNodes() then begin;
|
|
|
|
AAttCursor := CreateCursorOn(
|
|
|
|
CreateChildrenCursor(parentNode,cetRttiNode),
|
2009-11-26 10:39:50 +00:00
|
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_attribute,Context.GetXsShortNames()),TDOMNodeRttiExposer)
|
2008-10-23 19:21:59 +00:00
|
|
|
);
|
|
|
|
crs := CreateChildrenCursor(parentNode,cetRttiNode);
|
|
|
|
if ( crs <> nil ) then begin
|
|
|
|
crs := CreateCursorOn(
|
|
|
|
crs,
|
2009-11-26 10:39:50 +00:00
|
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_anyAttribute,Context.GetXsShortNames()),TDOMNodeRttiExposer)
|
2008-10-23 19:21:59 +00:00
|
|
|
);
|
|
|
|
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();
|
2008-08-01 21:38:55 +00:00
|
|
|
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);
|
2009-11-26 10:39:50 +00:00
|
|
|
if Context.FindNameSpace(ns_short, ns_long) then begin
|
2008-08-01 21:38:55 +00:00
|
|
|
locBuffer := e.NodeValue;
|
|
|
|
ExplodeQName(locBuffer,locBufferLocalName,locBufferNS);
|
|
|
|
if IsStrEmpty(locBufferNS) then
|
|
|
|
locBuffer := locBufferLocalName
|
2009-11-26 10:39:50 +00:00
|
|
|
else if Context.FindNameSpace(locBufferNS, locBufferNS_long) then
|
2008-08-01 21:38:55 +00:00
|
|
|
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
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdInvalidTypeDefinitionException.CreateFmt(SERR_InvalidTypeDef_AttributeNotFound,[FTypeName]);
|
2008-08-01 21:38:55 +00:00
|
|
|
end;
|
|
|
|
crs := CreateCursorOn(
|
|
|
|
CreateChildrenCursor(FDerivationNode,cetRttiNode),
|
2009-11-26 10:39:50 +00:00
|
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_attribute,Context.GetXsShortNames()),TDOMNodeRttiExposer)
|
2008-08-01 21:38:55 +00:00
|
|
|
);
|
|
|
|
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
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdInvalidTypeDefinitionException.CreateFmt(SERR_InvalidTypeDef_NamedAttributeNotFound,[s_arrayType,FTypeName]);
|
2008-08-01 21:38:55 +00:00
|
|
|
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
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdInvalidTypeDefinitionException.CreateFmt(SERR_InvalidArrayItemType,[FTypeName]);
|
2008-08-01 21:38:55 +00:00
|
|
|
Result := FSymbols.CreateArray(AInternalName,locSym as TPasType,s_item,s_item,asScoped);
|
|
|
|
if AHasInternalName then
|
|
|
|
FSymbols.RegisterExternalAlias(Result,ATypeName);
|
|
|
|
end;
|
|
|
|
|
2008-09-11 02:12:27 +00:00
|
|
|
function TComplexTypeParser.IsHeaderBlock() : Boolean;
|
|
|
|
var
|
|
|
|
strBuffer : string;
|
|
|
|
begin
|
2009-11-26 10:39:50 +00:00
|
|
|
Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),FTypeNode,s_WST_headerBlock,strBuffer) and AnsiSameText('true',Trim(strBuffer));
|
2008-09-11 02:12:27 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
function TComplexTypeParser.IsSimpleContentHeaderBlock() : Boolean;
|
|
|
|
var
|
|
|
|
strBuffer : string;
|
|
|
|
begin
|
2009-11-26 10:39:50 +00:00
|
|
|
Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),FTypeNode,s_WST_headerBlockSimpleContent,strBuffer) and AnsiSameText('true',Trim(strBuffer));
|
2008-09-11 02:12:27 +00:00
|
|
|
end;
|
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
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
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdParserException.Create(SERR_UnableToFindNameTagInNode);
|
2007-09-09 22:30:50 +00:00
|
|
|
FTypeName := (locCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
|
|
|
|
end;
|
|
|
|
if IsStrEmpty(FTypeName) then
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdParserException.Create(SERR_InvalidTypeName);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TComplexTypeParser.ExtractContentType();
|
|
|
|
var
|
|
|
|
locCrs : IObjectCursor;
|
|
|
|
begin
|
|
|
|
FContentType := '';
|
|
|
|
if Assigned(FChildCursor) then begin
|
|
|
|
locCrs := CreateCursorOn(
|
|
|
|
FChildCursor.Clone() as IObjectCursor,
|
2009-11-26 10:39:50 +00:00
|
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_complexContent,Context.GetXsShortNames()),TDOMNodeRttiExposer)
|
2007-09-09 22:30:50 +00:00
|
|
|
);
|
|
|
|
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,
|
2009-11-26 10:39:50 +00:00
|
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_simpleContent,Context.GetXsShortNames()),TDOMNodeRttiExposer)
|
2007-09-09 22:30:50 +00:00
|
|
|
);
|
|
|
|
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;
|
2008-09-10 01:46:45 +00:00
|
|
|
locBaseTypeLocalSpaceExpanded : string;
|
2007-09-09 22:30:50 +00:00
|
|
|
begin
|
2009-11-26 10:39:50 +00:00
|
|
|
locFilterStr := CreateQualifiedNameFilterStr(s_extension,Context.GetXsShortNames());
|
2007-09-09 22:30:50 +00:00
|
|
|
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
|
2009-11-26 10:39:50 +00:00
|
|
|
locFilterStr := CreateQualifiedNameFilterStr(s_restriction,Context.GetXsShortNames());
|
2007-09-09 22:30:50 +00:00
|
|
|
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
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdParserException.CreateFmt(SERR_InvalidTypeDef_BaseAttributeNotFound,[FTypeName]);
|
2007-09-09 22:30:50 +00:00
|
|
|
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
|
2007-12-29 00:58:19 +00:00
|
|
|
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;
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
end else begin
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdParserException.CreateFmt(SERR_ExpectedTypeDefinition,[locSymbol.Name]);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
end else begin
|
2008-09-10 01:46:45 +00:00
|
|
|
if ( FDerivationMode = dmRestriction ) and
|
|
|
|
( locBaseTypeLocalName = 'Array' ) and
|
2009-11-26 10:39:50 +00:00
|
|
|
( Context.FindNameSpace(locBaseTypeLocalSpace,locBaseTypeLocalSpaceExpanded) and
|
2008-09-10 01:46:45 +00:00
|
|
|
( 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;
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2011-09-14 02:31:02 +00:00
|
|
|
type
|
|
|
|
TOccurrenceRec = record
|
|
|
|
Valid : Boolean;
|
|
|
|
MinOccurs : Integer;
|
|
|
|
MaxOccurs : Integer;
|
|
|
|
Unboundded : Boolean;
|
|
|
|
end;
|
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
function TComplexTypeParser.ParseComplexContent(const ATypeName : string) : TPasType;
|
|
|
|
var
|
|
|
|
classDef : TPasClassType;
|
|
|
|
isArrayDef : Boolean;
|
2008-08-01 21:38:55 +00:00
|
|
|
arrayItems : TPropInfoReferenceList;
|
2008-06-06 14:59:24 +00:00
|
|
|
|
2008-08-01 21:38:55 +00:00
|
|
|
function IsCollectionArray(AElement : TDOMNode) : Boolean;
|
2008-06-06 14:59:24 +00:00
|
|
|
var
|
2008-08-01 21:38:55 +00:00
|
|
|
strBuffer : string;
|
2008-06-06 14:59:24 +00:00
|
|
|
begin
|
2009-11-26 10:39:50 +00:00
|
|
|
Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),AElement,s_WST_collection,strBuffer) and AnsiSameText('true',Trim(strBuffer));
|
2008-06-06 14:59:24 +00:00
|
|
|
end;
|
2008-09-17 01:45:04 +00:00
|
|
|
|
2011-09-14 02:31:02 +00:00
|
|
|
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);
|
2007-09-09 22:30:50 +00:00
|
|
|
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;
|
2008-09-17 01:45:04 +00:00
|
|
|
locTypeHint : string;
|
2010-09-08 14:02:52 +00:00
|
|
|
locTypeAddRef : Boolean;
|
2007-09-09 22:30:50 +00:00
|
|
|
begin
|
|
|
|
locType := nil;
|
|
|
|
locTypeName := '';
|
2008-09-17 01:45:04 +00:00
|
|
|
locTypeHint := '';
|
2007-09-09 22:30:50 +00:00
|
|
|
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;
|
2010-09-08 14:02:52 +00:00
|
|
|
locTypeAddRef := True;
|
2007-09-09 22:30:50 +00:00
|
|
|
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
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdParserException.Create(SERR_InvalidElementDef_MissingNameOrRef);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
locIsRefElement := True;
|
|
|
|
end;
|
|
|
|
locName := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
|
|
|
|
if locIsRefElement then begin
|
|
|
|
locName := ExtractNameFromQName(locName);
|
|
|
|
end;
|
|
|
|
if IsStrEmpty(locName) then
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdParserException.Create(SERR_InvalidElementDef_EmptyName);
|
2007-09-09 22:30:50 +00:00
|
|
|
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
|
2008-09-17 01:45:04 +00:00
|
|
|
locTypeName := ExtractNameFromQName(TDOMNodeRttiExposer(locPartCursor.GetCurrent()).NodeValue);
|
|
|
|
locTypeHint := ExtractTypeHint(AElement);
|
2007-09-09 22:30:50 +00:00
|
|
|
end else begin
|
|
|
|
locTypeName := Format('%s_%s_Type',[FTypeName,locName]);
|
2012-09-06 12:31:10 +00:00
|
|
|
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';
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
if IsStrEmpty(locTypeName) then
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdInvalidElementDefinitionException.Create(SERR_InvalidElementDef_EmptyType);
|
2008-09-17 01:45:04 +00:00
|
|
|
locType := FindElementWithHint(locTypeName,locTypeHint,ssGlobal);
|
2007-09-09 22:30:50 +00:00
|
|
|
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
|
2009-11-16 09:28:25 +00:00
|
|
|
locTypeInternalName := ExtractIdentifier(locTypeName);
|
2007-09-09 22:30:50 +00:00
|
|
|
if locIsRefElement or AnsiSameText(locTypeInternalName,locInternalEltName) then begin
|
|
|
|
locTypeInternalName := locTypeInternalName + '_Type';
|
|
|
|
end;
|
|
|
|
if IsReservedKeyWord(locTypeInternalName) then begin
|
|
|
|
locTypeInternalName := '_' + locTypeInternalName;
|
|
|
|
end;
|
2010-09-08 14:02:52 +00:00
|
|
|
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);
|
2007-09-09 22:30:50 +00:00
|
|
|
if not AnsiSameText(locTypeInternalName,locTypeName) then
|
|
|
|
FSymbols.RegisterExternalAlias(locType,locTypeName);
|
|
|
|
end;
|
|
|
|
|
2010-10-01 20:44:10 +00:00
|
|
|
locInternalEltName := ExtractIdentifier(locName);
|
|
|
|
locHasInternalName := (locInternalEltName <> locName);
|
|
|
|
if IsReservedKeyWord(locInternalEltName) then begin
|
|
|
|
locHasInternalName := True;
|
2007-09-09 22:30:50 +00:00
|
|
|
locInternalEltName := Format('_%s',[locInternalEltName]);
|
2010-10-01 20:44:10 +00:00
|
|
|
end;
|
2007-09-09 22:30:50 +00:00
|
|
|
|
|
|
|
locProp := TPasProperty(FSymbols.CreateElement(TPasProperty,locInternalEltName,classDef,visPublished,'',0));
|
|
|
|
classDef.Members.Add(locProp);
|
|
|
|
locProp.VarType := locType as TPasType;
|
2010-09-08 14:02:52 +00:00
|
|
|
if locTypeAddRef then
|
|
|
|
locType.AddRef();
|
2007-09-09 22:30:50 +00:00
|
|
|
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;}
|
|
|
|
|
2007-09-16 00:31:45 +00:00
|
|
|
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
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdInvalidDefinitionException.Create(SERR_InvalidAttributeDef_EmptyUse);
|
2007-09-16 00:31:45 +00:00
|
|
|
case AnsiIndexText(locStrBuffer,[s_required,s_optional,s_prohibited]) of
|
|
|
|
0 : locMinOccur := 1;
|
|
|
|
1 : locMinOccur := 0;
|
|
|
|
2 : locMinOccur := -1;
|
|
|
|
else
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdInvalidDefinitionException.CreateFmt(SERR_InvalidAttributeDef_InvalidUse,[locStrBuffer]);
|
2007-09-16 00:31:45 +00:00
|
|
|
end;
|
|
|
|
end else begin
|
|
|
|
locMinOccur := 0;
|
|
|
|
end;
|
|
|
|
end else begin
|
2011-09-14 02:31:02 +00:00
|
|
|
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;
|
2007-09-16 00:31:45 +00:00
|
|
|
end;
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
locProp.ReadAccessorName := 'F' + locProp.Name;
|
|
|
|
locProp.WriteAccessorName := 'F' + locProp.Name;
|
|
|
|
if ( locMinOccur = 0 ) then begin
|
2010-10-11 12:22:23 +00:00
|
|
|
locProp.StoredAccessorName := sWST_PROP_STORE_PREFIX + locProp.Name;
|
2007-09-16 00:31:45 +00:00
|
|
|
end else if ( locMinOccur = -1 ) then begin
|
|
|
|
locProp.StoredAccessorName := 'False';
|
2007-09-09 22:30:50 +00:00
|
|
|
end else begin
|
|
|
|
locProp.StoredAccessorName := 'True';
|
|
|
|
end;
|
|
|
|
|
2011-09-14 02:31:02 +00:00
|
|
|
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;
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
isArrayDef := locMaxOccurUnbounded or ( locMaxOccur > 1 );
|
|
|
|
if isArrayDef then begin
|
2008-08-01 21:38:55 +00:00
|
|
|
arrayItems.Add(locProp).FIsCollection := IsCollectionArray(AElement);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
if AnsiSameText(s_attribute,ExtractNameFromQName(AElement.NodeName)) then begin
|
|
|
|
FSymbols.SetPropertyAsAttribute(locProp,True);
|
|
|
|
end;
|
2008-06-06 14:59:24 +00:00
|
|
|
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);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
2008-08-01 21:38:55 +00:00
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
function IsRecordType() : Boolean;
|
|
|
|
var
|
|
|
|
strBuffer : string;
|
|
|
|
begin
|
2009-11-26 10:39:50 +00:00
|
|
|
Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),FTypeNode,s_WST_record,strBuffer) and AnsiSameText('true',Trim(strBuffer));
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
|
2011-09-14 02:31:02 +00:00
|
|
|
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;
|
2007-09-09 22:30:50 +00:00
|
|
|
begin
|
|
|
|
if Assigned(AEltCrs) then begin
|
|
|
|
AEltCrs.Reset();
|
|
|
|
while AEltCrs.MoveNext() do begin
|
2011-09-14 02:31:02 +00:00
|
|
|
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;
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
if Assigned(AEltAttCrs) then begin
|
|
|
|
AEltAttCrs.Reset();
|
|
|
|
while AEltAttCrs.MoveNext() do begin
|
2011-09-14 02:31:02 +00:00
|
|
|
ParseElement((AEltAttCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject,ABoundInfos);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
2008-09-29 12:37:11 +00:00
|
|
|
|
|
|
|
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;
|
|
|
|
|
2008-10-23 19:21:59 +00:00
|
|
|
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;
|
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
var
|
|
|
|
eltCrs, eltAttCrs : IObjectCursor;
|
|
|
|
internalName : string;
|
|
|
|
hasInternalName : Boolean;
|
|
|
|
arrayDef : TPasArrayType;
|
|
|
|
propTyp, tmpPropTyp : TPasProperty;
|
|
|
|
tmpClassDef : TPasClassType;
|
|
|
|
i : Integer;
|
|
|
|
recordType : TPasRecordType;
|
|
|
|
tmpRecVar : TPasVariable;
|
2007-09-16 00:31:45 +00:00
|
|
|
locStrBuffer : string;
|
2008-10-23 19:21:59 +00:00
|
|
|
locAnyNode, locAnyAttNode : TDOMNode;
|
2009-05-28 19:43:15 +00:00
|
|
|
locDefaultAncestorUsed : Boolean;
|
2011-09-14 02:31:02 +00:00
|
|
|
locBoundInfos : TOccurrenceRec;
|
|
|
|
locTempNode : TDOMNode;
|
2007-09-09 22:30:50 +00:00
|
|
|
begin
|
|
|
|
ExtractBaseType();
|
2011-09-14 02:31:02 +00:00
|
|
|
eltCrs := ExtractElementCursor(nil,eltAttCrs,locAnyNode,locAnyAttNode);
|
2007-09-16 00:31:45 +00:00
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
internalName := ExtractIdentifier(ATypeName);
|
|
|
|
hasInternalName := IsReservedKeyWord(internalName) or
|
|
|
|
( not IsValidIdent(internalName) ) or
|
2009-09-02 12:24:19 +00:00
|
|
|
( FSymbols.FindElementInModule(internalName,Self.Module,[elkName]) <> nil ) or
|
2007-09-09 22:30:50 +00:00
|
|
|
( not AnsiSameText(internalName,ATypeName) );
|
|
|
|
if hasInternalName then begin
|
2009-09-02 12:24:19 +00:00
|
|
|
internalName := Format('%s_Type',[internalName]);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
|
2008-09-10 01:46:45 +00:00
|
|
|
if ( pthDeriveFromSoapArray in FHints ) or
|
|
|
|
( ( FDerivationMode = dmRestriction ) and FSymbols.SameName(FBaseType,s_array) )
|
|
|
|
then begin
|
2008-08-01 21:38:55 +00:00
|
|
|
Result := ExtractSoapArray(ATypeName,internalName,hasInternalName);
|
2007-09-09 22:30:50 +00:00
|
|
|
end else begin
|
2008-08-01 21:38:55 +00:00
|
|
|
arrayItems := TPropInfoReferenceList.Create();
|
2007-09-09 22:30:50 +00:00
|
|
|
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;
|
2009-05-28 19:43:15 +00:00
|
|
|
locDefaultAncestorUsed := False;
|
2007-09-09 22:30:50 +00:00
|
|
|
if ( classDef.AncestorType = nil ) then begin
|
2009-05-28 19:43:15 +00:00
|
|
|
if IsHeaderBlock() then begin
|
2007-09-09 22:30:50 +00:00
|
|
|
classDef.AncestorType := FSymbols.FindElementInModule('THeaderBlock',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType
|
2009-05-28 19:43:15 +00:00
|
|
|
end else if IsSimpleContentHeaderBlock() then begin
|
2008-09-11 00:42:54 +00:00
|
|
|
classDef.AncestorType := FSymbols.FindElementInModule('TSimpleContentHeaderBlock',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType
|
2009-05-28 19:43:15 +00:00
|
|
|
end else begin
|
|
|
|
locDefaultAncestorUsed := True;
|
2007-09-09 22:30:50 +00:00
|
|
|
classDef.AncestorType := FSymbols.FindElementInModule('TBaseComplexRemotable',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType;
|
2009-05-28 19:43:15 +00:00
|
|
|
end;
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
classDef.AncestorType.AddRef();
|
|
|
|
if Assigned(eltCrs) or Assigned(eltAttCrs) then begin
|
|
|
|
isArrayDef := False;
|
2011-09-14 02:31:02 +00:00
|
|
|
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);
|
2008-08-01 21:38:55 +00:00
|
|
|
if ( arrayItems.GetCount() > 0 ) then begin
|
2009-05-28 19:43:15 +00:00
|
|
|
if ( arrayItems.GetCount() = 1 ) and locDefaultAncestorUsed and
|
|
|
|
( GetElementCount(classDef.Members,TPasProperty) = 1 )
|
|
|
|
then begin
|
2007-09-09 22:30:50 +00:00
|
|
|
Result := nil;
|
2008-08-01 21:38:55 +00:00
|
|
|
propTyp := arrayItems.GetItem(0).Prop;
|
2007-09-09 22:30:50 +00:00
|
|
|
arrayDef := FSymbols.CreateArray(internalName,propTyp.VarType,propTyp.Name,FSymbols.GetExternalName(propTyp),asScoped);
|
2007-09-16 00:31:45 +00:00
|
|
|
FSymbols.FreeProperties(classDef);
|
2007-09-09 22:30:50 +00:00
|
|
|
FreeAndNil(classDef);
|
|
|
|
Result := arrayDef;
|
|
|
|
if hasInternalName then
|
|
|
|
FSymbols.RegisterExternalAlias(arrayDef,ATypeName);
|
2008-08-01 21:38:55 +00:00
|
|
|
if arrayItems.GetItem(0).IsCollection then
|
|
|
|
FSymbols.SetCollectionFlag(arrayDef,True);
|
2007-09-09 22:30:50 +00:00
|
|
|
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));
|
2008-09-29 12:37:11 +00:00
|
|
|
CopyExtendedMetaData(propTyp,tmpPropTyp);
|
2007-09-09 22:30:50 +00:00
|
|
|
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));
|
2008-09-29 12:37:11 +00:00
|
|
|
CopyExtendedMetaData(propTyp,tmpPropTyp);
|
2007-09-09 22:30:50 +00:00
|
|
|
classDef.Members.Add(tmpPropTyp);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
2007-09-16 00:31:45 +00:00
|
|
|
FSymbols.FreeProperties(tmpClassDef);
|
2007-09-09 22:30:50 +00:00
|
|
|
FreeAndNil(tmpClassDef);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
2007-09-16 00:31:45 +00:00
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
//check for record
|
2007-09-10 22:19:20 +00:00
|
|
|
if ( FDerivationMode = dmNone ) and
|
|
|
|
Result.InheritsFrom(TPasClassType) and
|
|
|
|
IsRecordType()
|
|
|
|
then begin
|
2007-09-09 22:30:50 +00:00
|
|
|
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;
|
2007-09-16 00:31:45 +00:00
|
|
|
if AnsiSameText(propTyp.StoredAccessorName,'False') then
|
|
|
|
locStrBuffer := s_prohibited
|
2010-10-15 13:43:44 +00:00
|
|
|
else if AnsiSameText(Copy(propTyp.StoredAccessorName,1,Length(sWST_PROP_STORE_PREFIX)),sWST_PROP_STORE_PREFIX) then
|
2007-09-16 00:31:45 +00:00
|
|
|
locStrBuffer := s_optional
|
|
|
|
else
|
|
|
|
locStrBuffer := s_required;
|
|
|
|
FSymbols.Properties.SetValue(tmpRecVar,s_WST_storeType,locStrBuffer);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
end;
|
2007-09-16 00:31:45 +00:00
|
|
|
FSymbols.FreeProperties(tmpClassDef);
|
2007-09-09 22:30:50 +00:00
|
|
|
FreeAndNil(tmpClassDef);
|
|
|
|
end;
|
2008-10-23 19:21:59 +00:00
|
|
|
|
|
|
|
if ( locAnyNode <> nil ) or ( locAnyAttNode <> nil ) then
|
|
|
|
ProcessXsdAnyDeclarations(locAnyNode,locAnyAttNode,Result);
|
2007-09-09 22:30:50 +00:00
|
|
|
except
|
2007-09-16 00:31:45 +00:00
|
|
|
FSymbols.FreeProperties(Result);
|
2007-09-09 22:30:50 +00:00
|
|
|
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;
|
2009-11-26 10:39:50 +00:00
|
|
|
xsShortNameList := Context.GetXsShortNames();
|
2007-09-09 22:30:50 +00:00
|
|
|
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
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdInvalidDefinitionException.Create(SERR_InvalidAttributeDef_MissingName);
|
2007-09-09 22:30:50 +00:00
|
|
|
locName := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
|
|
|
|
if IsStrEmpty(locName) then
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdInvalidDefinitionException.Create(SERR_InvalidAttributeDef_EmptyName);
|
2007-09-09 22:30:50 +00:00
|
|
|
|
|
|
|
locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_type)]),TDOMNodeRttiExposer));
|
|
|
|
locPartCursor.Reset();
|
|
|
|
if not locPartCursor.MoveNext() then
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdInvalidDefinitionException.Create(SERR_InvalidAttributeDef_MissingType);
|
2007-09-09 22:30:50 +00:00
|
|
|
locTypeName := ExtractNameFromQName((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue);
|
|
|
|
if IsStrEmpty(locTypeName) then
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdInvalidDefinitionException.Create(SERR_InvalidAttributeDef_EmptyType);
|
2007-09-09 22:30:50 +00:00
|
|
|
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
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdInvalidDefinitionException.Create(SERR_InvalidAttributeDef_EmptyUse);
|
2007-09-09 22:30:50 +00:00
|
|
|
locStoreOptIdx := AnsiIndexText(locStoreOpt,[s_required,s_optional,s_prohibited]);
|
|
|
|
if ( locStoreOptIdx < 0 ) then
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdInvalidDefinitionException.CreateFmt(SERR_InvalidAttributeDef_InvalidUse,[locStoreOpt]);
|
2007-09-09 22:30:50 +00:00
|
|
|
end else begin
|
2007-09-16 00:31:45 +00:00
|
|
|
locStoreOptIdx := 1{optional by default!}; //0;
|
2007-09-09 22:30:50 +00:00
|
|
|
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';
|
2010-10-11 12:22:23 +00:00
|
|
|
1 : locAttObj.StoredAccessorName := sWST_PROP_STORE_PREFIX + locAttObj.Name;
|
2007-09-09 22:30:50 +00:00
|
|
|
2 : locAttObj.StoredAccessorName := 'False';
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
locAttCrs : IObjectCursor;
|
|
|
|
internalName : string;
|
|
|
|
hasInternalName : Boolean;
|
|
|
|
begin
|
|
|
|
ExtractBaseType();
|
|
|
|
if not ( FDerivationMode in [dmExtension, dmRestriction] ) then
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdInvalidTypeDefinitionException.Create(SERR_InvalidComplexSimpleTypeDef_NoRestOrExt);
|
2007-09-09 22:30:50 +00:00
|
|
|
|
|
|
|
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
|
2007-09-16 00:31:45 +00:00
|
|
|
FSymbols.FreeProperties(Result);
|
2007-09-09 22:30:50 +00:00
|
|
|
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);
|
2008-09-11 02:12:27 +00:00
|
|
|
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;
|
2007-09-09 22:30:50 +00:00
|
|
|
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
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdParserAssertException.CreateFmt(SERR_ExpectedButFound,[s_complexType,ExtractNameFromQName(FTypeNode.NodeName)]);
|
2009-11-10 10:52:11 +00:00
|
|
|
Result := nil;
|
2007-09-09 22:30:50 +00:00
|
|
|
CreateNodeCursors();
|
|
|
|
ExtractTypeName();
|
|
|
|
locContinue := True;
|
|
|
|
locSym := FSymbols.FindElement(FTypeName);
|
|
|
|
if Assigned(locSym) then begin
|
|
|
|
if not locSym.InheritsFrom(TPasType) then
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdParserException.CreateFmt(SERR_ExpectedTypeDefinition,[FTypeName]);
|
2009-09-02 12:24:19 +00:00
|
|
|
locContinue := locSym.InheritsFrom(TPasUnresolvedTypeRef) or
|
|
|
|
( IsEmbeddedType(TPasType(locSym)) <> FEmbededDef );
|
2007-09-09 22:30:50 +00:00
|
|
|
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;
|
2009-11-26 10:39:50 +00:00
|
|
|
if ( Result <> nil ) then begin
|
|
|
|
if ( IsEmbeddedType(Result) <> FEmbededDef ) then
|
|
|
|
SetAsEmbeddedType(Result,FEmbededDef);
|
|
|
|
end;
|
2008-08-18 18:19:00 +00:00
|
|
|
{$IFDEF WST_HANDLE_DOC}
|
|
|
|
if ( Result <> nil ) then
|
|
|
|
ParseDocumentation(Result);
|
|
|
|
{$ENDIF WST_HANDLE_DOC}
|
2007-09-09 22:30:50 +00:00
|
|
|
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
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdParserAssertException.Create(SERR_UnableToFindNameTagInNode);
|
2007-09-09 22:30:50 +00:00
|
|
|
FTypeName := (locCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
|
|
|
|
end;
|
|
|
|
if IsStrEmpty(FTypeName) then
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdParserAssertException.Create(SERR_InvalidTypeName);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
function TSimpleTypeParser.ExtractContentType() : Boolean;
|
|
|
|
var
|
|
|
|
locCrs, locAttCrs : IObjectCursor;
|
|
|
|
tmpNode : TDOMNode;
|
|
|
|
spaceShort : string;
|
|
|
|
begin
|
|
|
|
locCrs := CreateCursorOn(
|
|
|
|
FChildCursor.Clone() as IObjectCursor,
|
2009-11-26 10:39:50 +00:00
|
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_restriction,Context.GetXsShortNames()),TDOMNodeRttiExposer)
|
2007-09-09 22:30:50 +00:00
|
|
|
);
|
|
|
|
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);
|
2009-11-26 10:39:50 +00:00
|
|
|
if not Context.FindNameSpace(spaceShort,FBaseNameSpace) then
|
2009-07-09 14:10:58 +00:00
|
|
|
raise EXsdParserAssertException.CreateFmt(SERR_CannotResolveNamespace,[spaceShort]);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
locCrs := CreateChildrenCursor(FRestrictionNode,cetRttiNode) as IObjectCursor;
|
|
|
|
if Assigned(locCrs) then begin
|
|
|
|
locCrs := CreateCursorOn(
|
|
|
|
locCrs,
|
2009-11-26 10:39:50 +00:00
|
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_enumeration,Context.GetXsShortNames()),TDOMNodeRttiExposer)
|
2007-09-09 22:30:50 +00:00
|
|
|
);
|
|
|
|
locCrs.Reset();
|
|
|
|
if locCrs.MoveNext() then begin
|
|
|
|
FIsEnum := True;
|
|
|
|
end else begin
|
|
|
|
if IsStrEmpty(FBaseName) then
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdParserAssertException.CreateFmt(SERR_BaseTypeNotSpecfifiedForSimpleType,[FTypeName]);
|
2007-09-09 22:30:50 +00:00
|
|
|
FIsEnum := False
|
|
|
|
end;
|
|
|
|
end else begin
|
|
|
|
if IsStrEmpty(FBaseName) then
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdParserAssertException.CreateFmt(SERR_BaseTypeNotSpecfifiedForSimpleType,[FTypeName]);
|
2007-09-09 22:30:50 +00:00
|
|
|
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),
|
2009-11-26 10:39:50 +00:00
|
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_enumeration,Context.GetXsShortNames()),TDOMNodeRttiExposer)
|
2007-09-09 22:30:50 +00:00
|
|
|
);
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
locRes : TPasEnumType;
|
2012-09-06 12:31:10 +00:00
|
|
|
//locOrder : Integer;
|
2009-11-26 10:39:50 +00:00
|
|
|
prefixItems : Boolean;
|
2007-09-09 22:30:50 +00:00
|
|
|
|
|
|
|
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
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdInvalidDefinitionException.CreateFmt(SERR_InvalidEnumItemNode_NoValueAttribute,[FTypeName]);
|
2007-09-09 22:30:50 +00:00
|
|
|
locCrs.Reset();
|
|
|
|
if not locCrs.MoveNext() then
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdInvalidDefinitionException.CreateFmt(SERR_InvalidEnumItemNode_NoValueAttribute,[FTypeName]);
|
2007-09-09 22:30:50 +00:00
|
|
|
tmpNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
|
|
locItemName := tmpNode.NodeValue;
|
2008-06-26 15:06:00 +00:00
|
|
|
{ (26-06-2008) empty string "" can be valid enum item!
|
2007-09-09 22:30:50 +00:00
|
|
|
if IsStrEmpty(locItemName) then
|
|
|
|
raise EXsdInvalidDefinitionException.CreateFmt('Invalid "enum" item node : the value attribute is empty, type = "%s".',[FTypeName]);
|
2008-06-26 15:06:00 +00:00
|
|
|
}
|
2007-09-09 22:30:50 +00:00
|
|
|
locInternalItemName := ExtractIdentifier(locItemName);
|
2008-06-26 15:06:00 +00:00
|
|
|
if IsStrEmpty(locInternalItemName) then
|
|
|
|
locInternalItemName := 'EmptyItem';
|
2009-11-26 10:39:50 +00:00
|
|
|
locHasInternalName := prefixItems or
|
|
|
|
IsReservedKeyWord(locInternalItemName) or
|
2007-09-09 22:30:50 +00:00
|
|
|
( 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));
|
2012-09-06 12:31:10 +00:00
|
|
|
//locItem.Value := locOrder;
|
2007-09-09 22:30:50 +00:00
|
|
|
locRes.Values.Add(locItem);
|
|
|
|
if locHasInternalName then
|
|
|
|
FSymbols.RegisterExternalAlias(locItem,locItemName);
|
2012-09-06 12:31:10 +00:00
|
|
|
//Inc(locOrder);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
locEnumCrs : IObjectCursor;
|
|
|
|
intrName : string;
|
|
|
|
hasIntrnName : Boolean;
|
|
|
|
begin
|
2009-11-26 10:39:50 +00:00
|
|
|
prefixItems := ( poEnumAlwaysPrefix in Context.GetSimpleOptions() );
|
2007-09-09 22:30:50 +00:00
|
|
|
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();
|
2012-09-06 12:31:10 +00:00
|
|
|
//locOrder := 0;
|
2007-09-09 22:30:50 +00:00
|
|
|
while locEnumCrs.MoveNext() do begin
|
|
|
|
ParseEnumItem((locEnumCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject);
|
|
|
|
end;
|
|
|
|
except
|
2007-09-16 00:31:45 +00:00
|
|
|
FSymbols.FreeProperties(Result);
|
2007-09-09 22:30:50 +00:00
|
|
|
FreeAndNil(Result);
|
|
|
|
raise;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TSimpleTypeParser.ParseOtherContent(): TPasType;
|
2009-11-16 09:28:25 +00:00
|
|
|
var
|
|
|
|
intrName : string;
|
|
|
|
hasIntrnName : Boolean;
|
|
|
|
tmpElement : TPasElement;
|
2007-09-09 22:30:50 +00:00
|
|
|
begin // todo : implement TSimpleTypeParser.ParseOtherContent
|
|
|
|
if IsStrEmpty(FBaseName) then
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdInvalidTypeDefinitionException.CreateFmt(SERR_BaseTypeNotSpecfifiedForSimpleType,[FTypeName]);
|
2009-11-16 09:28:25 +00:00
|
|
|
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);
|
2007-09-09 22:30:50 +00:00
|
|
|
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
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdParserAssertException.CreateFmt(SERR_ExpectedButFound,[s_simpleType,ExtractNameFromQName(FTypeNode.NodeName)]);
|
2009-11-10 10:52:11 +00:00
|
|
|
Result := nil;
|
2007-09-09 22:30:50 +00:00
|
|
|
CreateNodeCursors();
|
|
|
|
ExtractTypeName();
|
|
|
|
locContinue := True;
|
|
|
|
locSym := FindElement(FTypeName);
|
|
|
|
if Assigned(locSym) then begin
|
|
|
|
if not locSym.InheritsFrom(TPasType) then
|
2010-10-16 18:22:28 +00:00
|
|
|
raise EXsdParserAssertException.CreateFmt(SERR_ExpectedTypeDefinition,[FTypeName]);
|
2007-09-09 22:30:50 +00:00
|
|
|
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;
|
2009-12-01 15:53:14 +00:00
|
|
|
if ( Result <> nil ) then begin
|
|
|
|
if ( IsEmbeddedType(Result) <> FEmbededDef ) then
|
|
|
|
SetAsEmbeddedType(Result,FEmbededDef);
|
|
|
|
end;
|
2008-08-18 18:19:00 +00:00
|
|
|
{$IFDEF WST_HANDLE_DOC}
|
|
|
|
if ( Result <> nil ) then
|
|
|
|
ParseDocumentation(Result);
|
|
|
|
{$ENDIF WST_HANDLE_DOC}
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2008-08-01 21:38:55 +00:00
|
|
|
{ TPropInfoReferenceList }
|
|
|
|
|
|
|
|
constructor TPropInfoReferenceList.Create();
|
|
|
|
begin
|
2008-09-11 17:53:43 +00:00
|
|
|
FList := TObjectList.Create(True);
|
2008-08-01 21:38:55 +00:00
|
|
|
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;
|
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
initialization
|
|
|
|
TAbstractTypeParser.RegisterParser(TSimpleTypeParser);
|
|
|
|
TAbstractTypeParser.RegisterParser(TComplexTypeParser);
|
|
|
|
|
|
|
|
finalization
|
|
|
|
FreeAndNil(FTypeParserList);
|
|
|
|
|
|
|
|
end.
|