You've already forked lazarus-ccr
1c633e091d
- xsd_parser.pas XML schema parser - wsdl_parser.pas WSDL parser ( uses xsd_parser to parse type definitions ) ws_helper now supports XML Schema ( .XSD files ) parsing. test cases for XSD and WSDL parsers git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@264 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2638 lines
101 KiB
ObjectPascal
2638 lines
101 KiB
ObjectPascal
{
|
|
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 wsdl2pas_imp;
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils,
|
|
{$IFNDEF FPC}xmldom, wst_delphi_xml{$ELSE}DOM{$ENDIF},
|
|
cursor_intf, rtti_filters,
|
|
pastree, pascal_parser_intf, logger_intf;
|
|
|
|
type
|
|
|
|
EWslParserException = class(Exception)
|
|
end;
|
|
|
|
EWslTypeNotFoundException = class(EWslParserException)
|
|
end;
|
|
|
|
TOnParserMessage = procedure (const AMsgType : TMessageType; const AMsg : string) of object;
|
|
|
|
TWsdlParser = class;
|
|
|
|
TAbstractTypeParserClass = class of TAbstractTypeParser;
|
|
|
|
{ TAbstractTypeParser }
|
|
|
|
TAbstractTypeParser = class
|
|
private
|
|
FOwner : TWsdlParser;
|
|
FTypeNode : TDOMNode;
|
|
FSymbols : TwstPasTreeContainer;
|
|
FTypeName : string;
|
|
FEmbededDef : Boolean;
|
|
public
|
|
constructor Create(
|
|
AOwner : TWsdlParser;
|
|
ATypeNode : TDOMNode;
|
|
ASymbols : TwstPasTreeContainer;
|
|
const ATypeName : string;
|
|
const AEmbededDef : Boolean
|
|
);
|
|
class function ExtractEmbeddedTypeFromElement(
|
|
AOwner : TWsdlParser;
|
|
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;
|
|
end;
|
|
|
|
TDerivationMode = ( dmNone, dmExtension, dmRestriction );
|
|
TSequenceType = ( stElement, stAll );
|
|
|
|
{ TComplexTypeParser }
|
|
|
|
TComplexTypeParser = class(TAbstractTypeParser)
|
|
private
|
|
FAttCursor : IObjectCursor;
|
|
FChildCursor : IObjectCursor;
|
|
FContentNode : TDOMNode;
|
|
FContentType : string;
|
|
FBaseType : TPasType;
|
|
FDerivationMode : TDerivationMode;
|
|
FDerivationNode : TDOMNode;
|
|
FSequenceType : TSequenceType;
|
|
private
|
|
procedure CreateNodeCursors();
|
|
procedure ExtractTypeName();
|
|
procedure ExtractContentType();
|
|
procedure ExtractBaseType();
|
|
function ParseComplexContent(const ATypeName : string):TPasType;
|
|
function ParseSimpleContent(const ATypeName : string):TPasType;
|
|
function ParseEmptyContent(const ATypeName : string):TPasType;
|
|
public
|
|
class function GetParserSupportedStyle():string;override;
|
|
function Parse():TPasType;override;
|
|
end;
|
|
|
|
{ TSimpleTypeParser }
|
|
|
|
TSimpleTypeParser = class(TAbstractTypeParser)
|
|
private
|
|
FAttCursor : IObjectCursor;
|
|
FChildCursor : IObjectCursor;
|
|
FBaseName : 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;
|
|
|
|
TParserMode = ( pmUsedTypes, pmAllTypes );
|
|
|
|
{ TWsdlParser }
|
|
|
|
TWsdlParser = class
|
|
private
|
|
FDoc : TXMLDocument;
|
|
FSymbols : TwstPasTreeContainer;
|
|
FModule : TPasModule;
|
|
private
|
|
FWsdlShortNames : TStringList;
|
|
FSoapShortNames : TStringList;
|
|
FXSShortNames : TStringList;
|
|
FChildCursor : IObjectCursor;
|
|
FServiceCursor : IObjectCursor;
|
|
FBindingCursor : IObjectCursor;
|
|
FPortTypeCursor : IObjectCursor;
|
|
FMessageCursor : IObjectCursor;
|
|
FTypesCursor : IObjectCursor;
|
|
FSchemaCursor : IObjectCursor;
|
|
FOnMessage: TOnParserMessage;
|
|
private
|
|
procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string);
|
|
private
|
|
function CreateWsdlNameFilter(const AName : WideString):IObjectFilter;
|
|
function FindNamedNode(AList : IObjectCursor; const AName : WideString; const AOrder : Integer = 0):TDOMNode;
|
|
procedure Prepare(const AModuleName : string);
|
|
procedure ParseService(ANode : TDOMNode);
|
|
procedure ParsePort(ANode : TDOMNode);
|
|
function ParsePortType(
|
|
ANode, ABindingNode : TDOMNode;
|
|
const ABindingStyle : string
|
|
) : TPasClassType;
|
|
function ParseOperation(
|
|
AOwner : TPasClassType;
|
|
ANode : TDOMNode;
|
|
const ASoapBindingStyle : string
|
|
) : TPasProcedure;
|
|
function ParseType(const AName, ATypeOrElement : string) : TPasType;
|
|
procedure ParseTypes();
|
|
public
|
|
constructor Create(ADoc : TXMLDocument; ASymbols : TwstPasTreeContainer);
|
|
destructor Destroy();override;
|
|
procedure Parse(const AMode : TParserMode; const AModuleName : string);
|
|
property SymbolTable : TwstPasTreeContainer read FSymbols;
|
|
|
|
property OnMessage : TOnParserMessage read FOnMessage write FOnMessage;
|
|
end;
|
|
|
|
|
|
implementation
|
|
uses dom_cursors, parserutils, StrUtils, Contnrs;
|
|
|
|
const
|
|
s_address : WideString = 'address';
|
|
s_all : WideString = 'all';
|
|
//s_any : WideString = 'any';
|
|
s_array : WideString = 'array';
|
|
s_arrayType : WideString = 'arrayType';
|
|
s_attribute : WideString = 'attribute';
|
|
s_base : WideString = 'base';
|
|
s_binding : WideString = 'binding';
|
|
s_body : WideString = 'body';
|
|
s_complexContent : WideString = 'complexContent';
|
|
s_complexType : WideString = 'complexType';
|
|
s_customAttributes : WideString = 'customAttributes';
|
|
s_document : WideString = 'document';
|
|
s_element : WideString = 'element';
|
|
s_enumeration : WideString = 'enumeration';
|
|
s_extension : WideString = 'extension';
|
|
s_guid : WideString = 'GUID';
|
|
s_headerBlock : WideString = 'headerBlock';
|
|
s_input : WideString = 'input';
|
|
s_item : WideString = 'item';
|
|
s_location : WideString = 'location';
|
|
s_message : WideString = 'message';
|
|
s_maxOccurs : WideString = 'maxOccurs';
|
|
s_minOccurs : WideString = 'minOccurs';
|
|
s_name : WideString = 'name';
|
|
s_operation : WideString = 'operation';
|
|
s_optional : WideString = 'optional';
|
|
s_output : WideString = 'output';
|
|
s_part : WideString = 'part';
|
|
s_port : WideString = 'port';
|
|
s_portType : WideString = 'portType';
|
|
s_prohibited : WideString = 'prohibited';
|
|
s_record : WideString = 'record';
|
|
s_ref : WideString = 'ref';
|
|
s_required : WideString = 'required';
|
|
s_restriction : WideString = 'restriction';
|
|
//s_return : WideString = 'return';
|
|
s_rpc : WideString = 'rpc';
|
|
s_schema : WideString = 'schema';
|
|
s_xs : WideString = 'http://www.w3.org/2001/XMLSchema';
|
|
s_sequence : WideString = 'sequence';
|
|
s_service : WideString = 'service';
|
|
s_simpleContent : WideString = 'simpleContent';
|
|
s_simpleType : WideString = 'simpleType';
|
|
s_soap : WideString = 'http://schemas.xmlsoap.org/wsdl/soap/';
|
|
s_soapAction : WideString = 'soapAction';
|
|
s_soapInputEncoding : WideString = 'Input_EncodingStyle';
|
|
s_soapOutputEncoding : WideString = 'OutputEncodingStyle';
|
|
s_soapStyle : WideString = 'style';
|
|
s_style : WideString = 'style';
|
|
s_targetNamespace : WideString = 'targetNamespace';
|
|
s_type : WideString = 'type';
|
|
s_types : WideString = 'types';
|
|
s_unbounded : WideString = 'unbounded';
|
|
s_use : WideString = 'use';
|
|
s_value : WideString = 'value';
|
|
s_wsdl : WideString = 'http://schemas.xmlsoap.org/wsdl/';
|
|
s_xmlns : WideString = 'xmlns';
|
|
|
|
//----------------------------------------------------------
|
|
s_TRANSPORT = 'TRANSPORT';
|
|
s_FORMAT = 'FORMAT';
|
|
|
|
|
|
function ExtractNameFromQName(const AQName : string):string ;
|
|
var
|
|
i : Integer;
|
|
begin
|
|
Result := Trim(AQName);
|
|
i := Pos(':',Result);
|
|
if ( i > 0 ) then
|
|
Result := Copy(Result,( i + 1 ), MaxInt);
|
|
end;
|
|
|
|
function CreateQualifiedNameFilterStr(
|
|
const AName : WideString;
|
|
APrefixList : TStrings
|
|
) : string;
|
|
var
|
|
k : Integer;
|
|
locStr : string;
|
|
locWStr : WideString;
|
|
begin
|
|
Result := '';
|
|
if ( APrefixList.Count > 0 ) then begin
|
|
for k := 0 to Pred(APrefixList.Count) do begin
|
|
if IsStrEmpty(APrefixList[k]) then begin
|
|
locWStr := ''
|
|
end else begin
|
|
locWStr := APrefixList[k] + ':';
|
|
end;
|
|
locWStr := locWStr + AName;
|
|
locStr := s_NODE_NAME;
|
|
Result := Result + ' or ' + locStr + ' = ' + QuotedStr(locWStr);
|
|
end;
|
|
if ( Length(Result) > 0 ) then begin
|
|
Delete(Result,1,Length(' or'));
|
|
end;
|
|
end else begin
|
|
Result := Format('%s = %s',[s_NODE_NAME,QuotedStr(AName)]);
|
|
end;
|
|
end;
|
|
|
|
function wst_findCustomAttribute(
|
|
AWsdlShortNames : TStrings;
|
|
ANode : TDOMNode;
|
|
const AAttribute : string;
|
|
out AValue : string
|
|
) : Boolean;
|
|
var
|
|
nd : TDOMNode;
|
|
tmpCrs : IObjectCursor;
|
|
begin
|
|
Result := False;
|
|
tmpCrs := CreateCursorOn(
|
|
CreateChildrenCursor(ANode,cetRttiNode),
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_document,AWsdlShortNames),TDOMNodeRttiExposer)
|
|
);
|
|
tmpCrs.Reset();
|
|
if tmpCrs.MoveNext() then begin
|
|
nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
if nd.HasChildNodes() then begin
|
|
tmpCrs := CreateCursorOn(
|
|
CreateChildrenCursor(nd,cetRttiNode),
|
|
ParseFilter(Format('%s=%s',[s_NODE_NAME,QuotedStr(s_customAttributes)]),TDOMNodeRttiExposer)
|
|
);
|
|
tmpCrs.Reset();
|
|
if tmpCrs.MoveNext() then begin
|
|
nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
if ( nd.Attributes <> nil ) then begin
|
|
nd := nd.Attributes.GetNamedItem(AAttribute);
|
|
if Assigned(nd) then begin
|
|
Result := True;
|
|
AValue := nd.NodeValue;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TWsdlParser }
|
|
|
|
procedure TWsdlParser.DoOnMessage(const AMsgType : TMessageType; const AMsg : string);
|
|
begin
|
|
if Assigned(FOnMessage) then begin
|
|
FOnMessage(AMsgType,AMsg);
|
|
end else if IsConsole then begin
|
|
GetLogger().Log(AMsgType, AMsg);
|
|
end;
|
|
end;
|
|
|
|
function TWsdlParser.CreateWsdlNameFilter(const AName: WideString): IObjectFilter;
|
|
begin
|
|
Result := ParseFilter(CreateQualifiedNameFilterStr(AName,FWsdlShortNames),TDOMNodeRttiExposer);
|
|
end;
|
|
|
|
function TWsdlParser.FindNamedNode(
|
|
AList : IObjectCursor;
|
|
const AName : WideString;
|
|
const AOrder : Integer
|
|
): TDOMNode;
|
|
var
|
|
attCrs, crs : IObjectCursor;
|
|
curObj : TDOMNodeRttiExposer;
|
|
fltr : IObjectFilter;
|
|
locOrder : Integer;
|
|
begin
|
|
Result := nil;
|
|
if Assigned(AList) then begin
|
|
fltr := ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer);
|
|
AList.Reset();
|
|
locOrder := AOrder;
|
|
while AList.MoveNext() do begin
|
|
curObj := AList.GetCurrent() as TDOMNodeRttiExposer;
|
|
attCrs := CreateAttributesCursor(curObj.InnerObject,cetRttiNode);
|
|
if Assigned(attCrs) then begin
|
|
crs := CreateCursorOn(attCrs,fltr);
|
|
crs.Reset();
|
|
if crs.MoveNext() and AnsiSameText(AName,TDOMNodeRttiExposer(crs.GetCurrent()).NodeValue) then begin
|
|
Dec(locOrder);
|
|
if ( locOrder <= 0 ) then begin
|
|
Result := curObj.InnerObject;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
type
|
|
TNotFoundAction = ( nfaNone, nfaRaiseException );
|
|
procedure ExtractNameSpaceShortNames(
|
|
AAttribCursor : IObjectCursor;
|
|
AResList : TStrings;
|
|
const ANameSpace : WideString;
|
|
const ANotFoundAction : TNotFoundAction;
|
|
const AClearBefore : Boolean
|
|
);
|
|
var
|
|
crs : IObjectCursor;
|
|
locObj : TDOMNodeRttiExposer;
|
|
wStr : WideString;
|
|
i : Integer;
|
|
begin
|
|
if AClearBefore then begin
|
|
AResList.Clear();
|
|
end;
|
|
AAttribCursor.Reset();
|
|
crs := CreateCursorOn(AAttribCursor,ParseFilter(Format('%s=%s',[s_NODE_VALUE,QuotedStr(ANameSpace)]),TDOMNodeRttiExposer));
|
|
crs.Reset();
|
|
if crs.MoveNext() then begin
|
|
repeat
|
|
locObj := crs.GetCurrent() as TDOMNodeRttiExposer;
|
|
wStr := Trim(locObj.NodeName);
|
|
i := AnsiPos(s_xmlns + ':',wStr);
|
|
if ( i > 0 ) then begin
|
|
i := AnsiPos(':',wStr);
|
|
AResList.Add(Copy(wStr,( i + 1 ), MaxInt));
|
|
end else begin
|
|
if ( AResList.IndexOf('') = -1 ) then
|
|
AResList.Add('');
|
|
end;
|
|
until not crs.MoveNext();
|
|
end else begin
|
|
if ( ANotFoundAction = nfaRaiseException ) then begin
|
|
raise EWslParserException.CreateFmt('Namespace not found : "%s"',[ANameSpace]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure ExtractNameSpaceShortNamesNested(
|
|
ANode : TDOMNode;
|
|
AResList : TStrings;
|
|
const ANameSpace : WideString
|
|
);
|
|
var
|
|
nd : TDOMNode;
|
|
begin
|
|
AResList.Clear();
|
|
nd := ANode;
|
|
while Assigned(nd) do begin
|
|
if Assigned(nd.Attributes) and ( nd.Attributes.Length > 0 ) then begin
|
|
ExtractNameSpaceShortNames(CreateAttributesCursor(nd,cetRttiNode),AResList,ANameSpace,nfaNone,False);
|
|
end;
|
|
nd := nd.ParentNode;
|
|
end;
|
|
end;
|
|
|
|
procedure TWsdlParser.Prepare(const AModuleName : string);
|
|
var
|
|
locAttCursor : IObjectCursor;
|
|
locObj : TDOMNodeRttiExposer;
|
|
begin
|
|
CreateWstInterfaceSymbolTable(SymbolTable);
|
|
FModule := TPasModule(SymbolTable.CreateElement(TPasModule,AModuleName,SymbolTable.Package,visDefault,'',0));
|
|
SymbolTable.Package.Modules.Add(FModule);
|
|
FModule.InterfaceSection := TPasSection(SymbolTable.CreateElement(TPasSection,'',FModule,visDefault,'',0));
|
|
|
|
FPortTypeCursor := nil;
|
|
FWsdlShortNames.Clear();
|
|
locAttCursor := CreateAttributesCursor(FDoc.DocumentElement,cetRttiNode);
|
|
|
|
FChildCursor := CreateChildrenCursor(FDoc.DocumentElement,cetRttiNode);
|
|
|
|
ExtractNameSpaceShortNames(locAttCursor,FWsdlShortNames,s_wsdl,nfaRaiseException,True);
|
|
ExtractNameSpaceShortNames(locAttCursor,FSoapShortNames,s_soap,nfaRaiseException,False);
|
|
ExtractNameSpaceShortNames(locAttCursor,FXSShortNames,s_xs,nfaNone,True);
|
|
|
|
FServiceCursor := CreateCursorOn(
|
|
FChildCursor.Clone() as IObjectCursor,
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_service,FWsdlShortNames),TDOMNodeRttiExposer)
|
|
);
|
|
FServiceCursor.Reset();
|
|
|
|
FBindingCursor := CreateCursorOn(
|
|
FChildCursor.Clone() as IObjectCursor,
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_binding,FWsdlShortNames),TDOMNodeRttiExposer)
|
|
);
|
|
FBindingCursor.Reset();
|
|
|
|
FPortTypeCursor := CreateCursorOn(
|
|
FChildCursor.Clone() as IObjectCursor,
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_portType,FWsdlShortNames),TDOMNodeRttiExposer)
|
|
);
|
|
FPortTypeCursor.Reset();
|
|
|
|
FSchemaCursor := nil;
|
|
FTypesCursor := CreateCursorOn(
|
|
FChildCursor.Clone() as IObjectCursor,
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_types,FWsdlShortNames),TDOMNodeRttiExposer)
|
|
);
|
|
FTypesCursor.Reset();
|
|
if FTypesCursor.MoveNext() then begin
|
|
locObj := FTypesCursor.GetCurrent() as TDOMNodeRttiExposer;
|
|
if locObj.InnerObject.HasChildNodes() then begin
|
|
FSchemaCursor := CreateChildrenCursor(locObj.InnerObject,cetRttiNode);
|
|
FSchemaCursor.Reset();
|
|
FSchemaCursor := CreateCursorOn(
|
|
FSchemaCursor,//.Clone() as IObjectCursor,
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_schema,FXSShortNames),TDOMNodeRttiExposer)
|
|
);
|
|
FSchemaCursor.Reset();
|
|
end;
|
|
end;
|
|
|
|
FMessageCursor := CreateCursorOn(
|
|
FChildCursor.Clone() as IObjectCursor,
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_message,FWsdlShortNames),TDOMNodeRttiExposer)
|
|
);
|
|
FMessageCursor.Reset();
|
|
end;
|
|
|
|
procedure TWsdlParser.ParseService(ANode: TDOMNode);
|
|
var
|
|
locCursor, locPortCursor : IObjectCursor;
|
|
locObj : TDOMNodeRttiExposer;
|
|
begin
|
|
locCursor := CreateChildrenCursor(ANode,cetRttiNode);
|
|
if Assigned(locCursor) then begin
|
|
locPortCursor := CreateCursorOn(
|
|
locCursor,
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_port,FWsdlShortNames),TDOMNodeRttiExposer)
|
|
);
|
|
locPortCursor.Reset();
|
|
while locPortCursor.MoveNext() do begin
|
|
locObj := locPortCursor.GetCurrent() as TDOMNodeRttiExposer;
|
|
ParsePort(locObj.InnerObject);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function StrToBindingStyle(const AStr : string):TBindingStyle;
|
|
begin
|
|
if IsStrEmpty(AStr) then begin
|
|
Result := bsDocument;
|
|
end else if AnsiSameText(AStr,s_document) then begin
|
|
Result := bsDocument;
|
|
end else if AnsiSameText(AStr,s_rpc) then begin
|
|
Result := bsRPC;
|
|
end else begin
|
|
Result := bsUnknown;
|
|
end;
|
|
end;
|
|
|
|
procedure TWsdlParser.ParsePort(ANode: TDOMNode);
|
|
|
|
function FindBindingNode(const AName : WideString):TDOMNode;
|
|
var
|
|
crs : IObjectCursor;
|
|
begin
|
|
Result := FindNamedNode(FBindingCursor,AName);
|
|
if Assigned(Result) then begin
|
|
crs := CreateChildrenCursor(Result,cetRttiNode);
|
|
if Assigned(crs) then begin
|
|
crs := CreateCursorOn(crs,ParseFilter(CreateQualifiedNameFilterStr(s_binding,FSoapShortNames),TDOMNodeRttiExposer));
|
|
crs.Reset();
|
|
if not crs.MoveNext() then begin
|
|
Result := nil;
|
|
end;
|
|
end else begin
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ExtractBindingQName(out AName : WideString):Boolean ;
|
|
var
|
|
attCrs, crs : IObjectCursor;
|
|
begin
|
|
Result := False;
|
|
attCrs := CreateAttributesCursor(ANode,cetRttiNode);
|
|
if Assigned(attCrs) then begin
|
|
crs := CreateCursorOn(attCrs,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_binding)]),TDOMNodeRttiExposer));
|
|
crs.Reset();
|
|
if crs.MoveNext() then begin
|
|
AName := TDOMNodeRttiExposer(crs.GetCurrent()).NodeValue;
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ExtractTypeQName(ABndgNode : TDOMNode; out AName : WideString):Boolean ;
|
|
var
|
|
attCrs, crs : IObjectCursor;
|
|
begin
|
|
Result := False;
|
|
attCrs := CreateAttributesCursor(ABndgNode,cetRttiNode);
|
|
if Assigned(attCrs) then begin
|
|
crs := CreateCursorOn(attCrs,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_type)]),TDOMNodeRttiExposer));
|
|
crs.Reset();
|
|
if crs.MoveNext() then begin
|
|
AName := TDOMNodeRttiExposer(crs.GetCurrent()).NodeValue;
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function FindTypeNode(const AName : WideString):TDOMNode;
|
|
begin
|
|
Result := FindNamedNode(FPortTypeCursor,AName);
|
|
end;
|
|
|
|
function ExtractAddress() : string;
|
|
var
|
|
tmpCrs : IObjectCursor;
|
|
nd : TDOMNode;
|
|
begin
|
|
Result := '';
|
|
if ANode.HasChildNodes() then begin
|
|
tmpCrs := CreateCursorOn(
|
|
CreateChildrenCursor(ANode,cetRttiNode),
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_address,FSoapShortNames),TDOMNodeRttiExposer)
|
|
);
|
|
tmpCrs.Reset();
|
|
if tmpCrs.MoveNext() then begin
|
|
nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
tmpCrs := CreateCursorOn(
|
|
CreateAttributesCursor(nd,cetRttiNode),
|
|
ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_location)]),TDOMNodeRttiExposer)
|
|
);
|
|
if Assigned(tmpCrs) and tmpCrs.MoveNext() then begin
|
|
Result := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ExtractSoapBindingStyle(ABindingNode : TDOMNode;out AName : WideString):Boolean ;
|
|
var
|
|
childrenCrs, crs, attCrs : IObjectCursor;
|
|
s : string;
|
|
begin
|
|
AName := '';
|
|
Result := False;
|
|
childrenCrs := CreateChildrenCursor(ABindingNode,cetRttiNode);
|
|
if Assigned(childrenCrs) then begin
|
|
s := CreateQualifiedNameFilterStr(s_binding,FSoapShortNames);
|
|
crs := CreateCursorOn(childrenCrs,ParseFilter(s,TDOMNodeRttiExposer));
|
|
crs.Reset();
|
|
if crs.MoveNext() then begin
|
|
attCrs := CreateAttributesCursor(TDOMNodeRttiExposer(crs.GetCurrent()).InnerObject,cetRttiNode);
|
|
if Assigned(attCrs) then begin
|
|
s := s_NODE_NAME + ' = ' + QuotedStr(s_style);
|
|
crs := CreateCursorOn(attCrs,ParseFilter(s,TDOMNodeRttiExposer));
|
|
crs.Reset();
|
|
if crs.MoveNext() then begin
|
|
AName := TDOMNodeRttiExposer(crs.GetCurrent()).NodeValue;
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
bindingName, typeName : WideString;
|
|
i : Integer;
|
|
bindingNode, typeNode : TDOMNode;
|
|
intfDef : TPasClassType;
|
|
bdng : TwstBinding;
|
|
locSoapBindingStyle : string;
|
|
locWStrBuffer : WideString;
|
|
begin
|
|
if ExtractBindingQName(bindingName) then begin
|
|
i := Pos(':',bindingName);
|
|
bindingName := Copy(bindingName,( i + 1 ), MaxInt);
|
|
bindingNode := FindBindingNode(bindingName);
|
|
if Assigned(bindingNode) then begin
|
|
if ExtractTypeQName(bindingNode,typeName) then begin
|
|
i := Pos(':',typeName);
|
|
typeName := Copy(typeName,( i + 1 ), MaxInt);
|
|
typeNode := FindTypeNode(typeName);
|
|
if Assigned(typeNode) then begin
|
|
ExtractSoapBindingStyle(bindingNode,locWStrBuffer);
|
|
locSoapBindingStyle := locWStrBuffer;
|
|
intfDef := ParsePortType(typeNode,bindingNode,locSoapBindingStyle);
|
|
bdng := SymbolTable.AddBinding(bindingName,intfDef);
|
|
bdng.Address := ExtractAddress();
|
|
bdng.BindingStyle := StrToBindingStyle(locSoapBindingStyle);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TWsdlParser.ParsePortType(
|
|
ANode, ABindingNode : TDOMNode;
|
|
const ABindingStyle : string
|
|
) : TPasClassType;
|
|
var
|
|
s : string;
|
|
ws : widestring;
|
|
|
|
function ExtractBindingOperationCursor() : IObjectCursor ;
|
|
begin
|
|
Result := nil;
|
|
if ABindingNode.HasChildNodes() then begin
|
|
Result := CreateCursorOn(
|
|
CreateChildrenCursor(ABindingNode,cetRttiNode),
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_operation,FWsdlShortNames),TDOMNodeRttiExposer)
|
|
);
|
|
end;
|
|
end;
|
|
|
|
procedure ParseOperation_EncodingStyle(ABndngOpCurs : IObjectCursor; AOp : TPasProcedure);
|
|
var
|
|
nd, ndSoap : TDOMNode;
|
|
tmpCrs, tmpSoapCrs, tmpXcrs : IObjectCursor;
|
|
in_out_count : Integer;
|
|
strBuffer : string;
|
|
begin
|
|
nd := FindNamedNode(ABndngOpCurs,SymbolTable.GetExternalName(AOp));
|
|
if Assigned(nd) and nd.HasChildNodes() then begin
|
|
tmpCrs := CreateCursorOn(
|
|
CreateChildrenCursor(nd,cetRttiNode),
|
|
ParseFilter(
|
|
CreateQualifiedNameFilterStr(s_input,FWsdlShortNames) + ' or ' +
|
|
CreateQualifiedNameFilterStr(s_output,FWsdlShortNames)
|
|
,
|
|
TDOMNodeRttiExposer
|
|
)
|
|
);
|
|
tmpCrs.Reset();
|
|
in_out_count := 0;
|
|
while tmpCrs.MoveNext() and ( in_out_count < 2 ) do begin
|
|
Inc(in_out_count);
|
|
nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
if nd.HasChildNodes() then begin
|
|
tmpSoapCrs := CreateCursorOn(
|
|
CreateChildrenCursor(nd,cetRttiNode),
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_body,FSoapShortNames),TDOMNodeRttiExposer)
|
|
);
|
|
tmpSoapCrs.Reset();
|
|
if tmpSoapCrs.MoveNext() then begin
|
|
ndSoap := (tmpSoapCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
if Assigned(ndSoap.Attributes) and ( ndSoap.Attributes.Length > 0 ) then begin
|
|
tmpXcrs := CreateCursorOn(
|
|
CreateAttributesCursor(ndSoap,cetRttiNode),
|
|
ParseFilter(
|
|
Format('%s = %s',[s_NODE_NAME,QuotedStr(s_use)]),
|
|
TDOMNodeRttiExposer
|
|
)
|
|
);
|
|
tmpXcrs.Reset();
|
|
if tmpXcrs.MoveNext() then begin
|
|
if AnsiSameText(s_input,ExtractNameFromQName(nd.NodeName)) then begin
|
|
strBuffer := s_soapInputEncoding;
|
|
end else begin
|
|
strBuffer := s_soapOutputEncoding;
|
|
end;
|
|
SymbolTable.Properties.SetValue(AOp,s_FORMAT + '_' + strBuffer,(tmpXcrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject.NodeValue);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure ParseOperationAttributes(ABndngOpCurs : IObjectCursor; AOp : TPasProcedure);
|
|
var
|
|
nd : TDOMNode;
|
|
tmpCrs : IObjectCursor;
|
|
//s : string;
|
|
//ws : widestring;
|
|
begin
|
|
ws := '';
|
|
s := SymbolTable.GetExternalName(AOp);
|
|
ws := s;
|
|
nd := FindNamedNode(ABndngOpCurs,ws);
|
|
if Assigned(nd) and nd.HasChildNodes() then begin
|
|
tmpCrs := CreateCursorOn(
|
|
CreateChildrenCursor(nd,cetRttiNode),
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_operation,FSoapShortNames),TDOMNodeRttiExposer)
|
|
);
|
|
tmpCrs.Reset();
|
|
if tmpCrs.MoveNext() then begin
|
|
nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
if Assigned(nd.Attributes) and ( nd.Attributes.Length > 0 ) then begin
|
|
tmpCrs := CreateCursorOn(
|
|
CreateAttributesCursor(nd,cetRttiNode),
|
|
ParseFilter(
|
|
Format( '%s = %s or %s = %s',
|
|
[ s_NODE_NAME,QuotedStr(s_soapAction),
|
|
s_NODE_NAME,QuotedStr(s_style)
|
|
]
|
|
),
|
|
TDOMNodeRttiExposer
|
|
)
|
|
);
|
|
tmpCrs.Reset();
|
|
if tmpCrs.MoveNext() then begin
|
|
nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
if AnsiSameText(nd.NodeName,s_style) then begin
|
|
SymbolTable.Properties.SetValue(AOp,s_soapStyle,nd.NodeValue);
|
|
end else if AnsiSameText(nd.NodeName,s_soapAction) then begin
|
|
SymbolTable.Properties.SetValue(AOp,s_TRANSPORT + '_' + s_soapAction,nd.NodeValue);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
ParseOperation_EncodingStyle(ABndngOpCurs,AOp);
|
|
end;
|
|
end;
|
|
|
|
function ParseIntfGuid() : string;
|
|
var
|
|
nd : TDOMNode;
|
|
tmpCrs : IObjectCursor;
|
|
begin
|
|
Result := '';
|
|
tmpCrs := CreateCursorOn(
|
|
CreateChildrenCursor(ANode,cetRttiNode),
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_document,FWsdlShortNames),TDOMNodeRttiExposer)
|
|
);
|
|
tmpCrs.Reset();
|
|
if tmpCrs.MoveNext() then begin
|
|
nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
if nd.HasChildNodes() then begin
|
|
tmpCrs := CreateCursorOn(
|
|
CreateChildrenCursor(nd,cetRttiNode),
|
|
ParseFilter(Format('%s=%s',[s_NODE_NAME,QuotedStr(s_guid)]),TDOMNodeRttiExposer)
|
|
);
|
|
tmpCrs.Reset();
|
|
if tmpCrs.MoveNext() then begin
|
|
nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
if ( nd.Attributes <> nil ) then begin
|
|
nd := nd.Attributes.GetNamedItem(s_value);
|
|
if Assigned(nd) then
|
|
Result := Trim(nd.NodeValue);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
locIntf : TPasClassType;
|
|
locAttCursor : IObjectCursor;
|
|
locCursor, locOpCursor, locBindingOperationCursor : IObjectCursor;
|
|
locObj : TDOMNodeRttiExposer;
|
|
locMthd : TPasProcedure;
|
|
inft_guid : TGuid;
|
|
ansiStrBuffer : ansistring;
|
|
elt : TPasElement;
|
|
begin
|
|
locIntf := nil;
|
|
locAttCursor := CreateAttributesCursor(ANode,cetRttiNode);
|
|
locCursor := CreateCursorOn(locAttCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer));
|
|
locCursor.Reset();
|
|
if not locCursor.MoveNext() then
|
|
raise EWslParserException.CreateFmt('PortType Attribute not found : "%s"',[s_name]);
|
|
locObj := locCursor.GetCurrent() as TDOMNodeRttiExposer;
|
|
ansiStrBuffer := locObj.NodeValue;
|
|
elt := SymbolTable.FindElementInModule(ansiStrBuffer,SymbolTable.CurrentModule);
|
|
if ( elt = nil ) then begin
|
|
locIntf := TPasClassType(SymbolTable.CreateElement(TPasClassType,ansiStrBuffer,SymbolTable.CurrentModule.InterfaceSection,visDefault,'',0));
|
|
FModule.InterfaceSection.Declarations.Add(locIntf);
|
|
FModule.InterfaceSection.Types.Add(locIntf);
|
|
FModule.InterfaceSection.Classes.Add(locIntf);
|
|
locIntf.ObjKind := okInterface;
|
|
Result := locIntf;
|
|
locIntf.InterfaceGUID := ParseIntfGuid();
|
|
if IsStrEmpty(locIntf.InterfaceGUID) and ( CreateGUID(inft_guid) = 0 ) then
|
|
locIntf.InterfaceGUID := GUIDToString(inft_guid);
|
|
locCursor := CreateChildrenCursor(ANode,cetRttiNode);
|
|
if Assigned(locCursor) then begin
|
|
locOpCursor := CreateCursorOn(locCursor,ParseFilter(CreateQualifiedNameFilterStr(s_operation,FWsdlShortNames),TDOMNodeRttiExposer));
|
|
locOpCursor.Reset();
|
|
locBindingOperationCursor := ExtractBindingOperationCursor();
|
|
while locOpCursor.MoveNext() do begin
|
|
locObj := locOpCursor.GetCurrent() as TDOMNodeRttiExposer;
|
|
locMthd := ParseOperation(locIntf,locObj.InnerObject,ABindingStyle);
|
|
if Assigned(locMthd) then begin
|
|
ParseOperationAttributes(locBindingOperationCursor,locMthd);
|
|
end;
|
|
end;
|
|
end;
|
|
end else begin
|
|
if elt.InheritsFrom(TPasClassType) and ( TPasClassType(elt).ObjKind = okInterface ) then begin
|
|
Result := TPasClassType(elt);
|
|
end else begin
|
|
raise EWslParserException.CreateFmt('Invalid element definition : "%s".',[elt.Name]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TWsdlParser.ParseOperation(
|
|
AOwner : TPasClassType;
|
|
ANode : TDOMNode;
|
|
const ASoapBindingStyle : string
|
|
) : TPasProcedure;
|
|
|
|
function ExtractOperationName(out AName : string):Boolean;
|
|
var
|
|
attCrs, crs : IObjectCursor;
|
|
begin
|
|
Result := False;
|
|
AName := '';
|
|
attCrs := CreateAttributesCursor(ANode,cetRttiNode);
|
|
if Assigned(attCrs) then begin
|
|
crs := CreateCursorOn(attCrs,ParseFilter(s_NODE_NAME + '=' + QuotedStr(s_name) ,TDOMNodeRttiExposer));
|
|
crs.Reset();
|
|
if crs.MoveNext() then begin
|
|
AName := TDOMNodeRttiExposer(crs.GetCurrent()).NodeValue;
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ExtractMsgName(const AMsgType : string; out AName : string) : Boolean;
|
|
var
|
|
chldCrs, crs : IObjectCursor;
|
|
begin
|
|
chldCrs := CreateChildrenCursor(ANode,cetRttiNode);
|
|
if ( chldCrs <> nil ) then begin
|
|
//crs := CreateCursorOn(chldCrs,ParseFilter(s_NODE_NAME + '=' + QuotedStr(AMsgType) ,TDOMNodeRttiExposer));
|
|
crs := CreateCursorOn(chldCrs,CreateWsdlNameFilter(AMsgType));
|
|
crs.Reset();
|
|
if crs.MoveNext() then begin
|
|
chldCrs := CreateAttributesCursor(TDOMNodeRttiExposer(crs.GetCurrent()).InnerObject,cetRttiNode);
|
|
if ( chldCrs <> nil ) then begin
|
|
crs := CreateCursorOn(chldCrs,ParseFilter(s_NODE_NAME + '=' + QuotedStr(s_message) ,TDOMNodeRttiExposer));
|
|
crs.Reset();
|
|
if crs.MoveNext() then begin
|
|
AName := TDOMNodeRttiExposer(crs.GetCurrent()).NodeValue;
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
Result := False;
|
|
end;
|
|
|
|
function FindMessageNode(const AName : string) : TDOMNode;
|
|
begin
|
|
Result := FindNamedNode(FMessageCursor.Clone() as IObjectCursor,ExtractNameFromQName(AName));
|
|
end;
|
|
|
|
function CreatePartCursor(AMsgNode : TDOMNode):IObjectCursor ;
|
|
begin
|
|
Result := CreateChildrenCursor(AMsgNode,cetRttiNode);
|
|
if Assigned(Result) then
|
|
Result := CreateCursorOn(Result,CreateWsdlNameFilter(s_part));
|
|
end;
|
|
|
|
function GetDataType(const AName, ATypeOrElement : string):TPasType;
|
|
begin
|
|
Result := nil;
|
|
try
|
|
Result := ParseType(AName,ATypeOrElement);
|
|
except
|
|
on e : Exception do begin
|
|
DoOnMessage(mtError, e.Message + ' ' + AName + ' ' + ATypeOrElement);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure ExtractMethod(
|
|
const AMthdName : string;
|
|
out AMthd : TPasProcedure
|
|
);
|
|
var
|
|
tmpMthd : TPasProcedure;
|
|
tmpMthdType : TPasProcedureType;
|
|
|
|
procedure ParseInputMessage();
|
|
var
|
|
inMsg, strBuffer : string;
|
|
inMsgNode, tmpNode : TDOMNode;
|
|
crs, tmpCrs : IObjectCursor;
|
|
prmName, prmTypeName, prmTypeType, prmTypeInternalName : string;
|
|
prmInternameName : string;
|
|
prmHasInternameName : Boolean;
|
|
prmDef : TPasArgument;
|
|
prmTypeDef : TPasType;
|
|
begin
|
|
tmpMthdType := TPasProcedureType(SymbolTable.CreateElement(TPasProcedureType,'',tmpMthd,visDefault,'',0));
|
|
tmpMthd.ProcType := tmpMthdType;
|
|
if ExtractMsgName(s_input,inMsg) then begin
|
|
inMsgNode := FindMessageNode(inMsg);
|
|
if ( inMsgNode <> nil ) then begin
|
|
crs := CreatePartCursor(inMsgNode);
|
|
if ( crs <> nil ) then begin
|
|
crs.Reset();
|
|
while crs.MoveNext() do begin
|
|
tmpNode := (crs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
if ( tmpNode.Attributes = nil ) or ( tmpNode.Attributes.Length < 1 ) then begin
|
|
raise EWslParserException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
|
|
end;
|
|
strBuffer := s_NODE_NAME + '=' + QuotedStr(s_name);
|
|
tmpCrs := CreateCursorOn(
|
|
CreateAttributesCursor(tmpNode,cetRttiNode),
|
|
ParseFilter(strBuffer,TDOMNodeRttiExposer)
|
|
);
|
|
tmpCrs.Reset();
|
|
if not tmpCrs.MoveNext() then begin
|
|
raise EWslParserException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
|
|
end;
|
|
prmName := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
|
|
strBuffer := s_NODE_NAME + '=' + QuotedStr(s_element) + ' or ' + s_NODE_NAME + ' = ' + QuotedStr(s_type);
|
|
tmpCrs := CreateCursorOn(
|
|
CreateAttributesCursor(tmpNode,cetRttiNode),
|
|
ParseFilter(strBuffer,TDOMNodeRttiExposer)
|
|
);
|
|
tmpCrs.Reset();
|
|
if not tmpCrs.MoveNext() then begin
|
|
raise EWslParserException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
|
|
end;
|
|
prmTypeName := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
|
|
prmTypeType := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeName;
|
|
if IsStrEmpty(prmName) or IsStrEmpty(prmTypeName) or IsStrEmpty(prmTypeType) then begin
|
|
raise EWslParserException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
|
|
end;
|
|
if SameText(s_document,ASoapBindingStyle) and
|
|
AnsiSameText(prmTypeType,s_element)
|
|
then begin
|
|
prmName := ExtractNameFromQName(prmTypeName);
|
|
end;
|
|
prmInternameName := Trim(prmName);
|
|
if AnsiSameText(prmInternameName,tmpMthd.Name) then begin
|
|
prmInternameName := prmInternameName + 'Param';
|
|
end;
|
|
prmHasInternameName := IsReservedKeyWord(prmInternameName) or
|
|
( not IsValidIdent(prmInternameName) ) or
|
|
( GetParameterIndex(tmpMthdType,prmInternameName) >= 0 );
|
|
if prmHasInternameName then begin
|
|
prmInternameName := '_' + prmInternameName;
|
|
end;
|
|
prmHasInternameName := not AnsiSameText(prmInternameName,prmName);
|
|
prmTypeDef := GetDataType(prmTypeName,prmTypeType);
|
|
prmDef := TPasArgument(SymbolTable.CreateElement(TPasArgument,prmInternameName,tmpMthdType,visDefault,'',0));
|
|
tmpMthdType.Args.Add(prmDef);
|
|
prmDef.ArgType := prmTypeDef;
|
|
prmTypeDef.AddRef();
|
|
prmDef.Access := argConst;
|
|
if prmHasInternameName or ( not AnsiSameText(prmName,prmInternameName) ) then begin
|
|
SymbolTable.RegisterExternalAlias(prmDef,prmName);
|
|
end;
|
|
if AnsiSameText(tmpMthd.Name,prmTypeDef.Name) then begin
|
|
prmTypeInternalName := prmTypeDef.Name + '_Type';
|
|
while Assigned(FSymbols.FindElement(prmTypeInternalName)) do begin
|
|
prmTypeInternalName := '_' + prmTypeInternalName;
|
|
end;
|
|
SymbolTable.RegisterExternalAlias(prmTypeDef,SymbolTable.GetExternalName(prmTypeDef));
|
|
prmTypeDef.Name := prmTypeInternalName;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure ParseOutputMessage();
|
|
var
|
|
outMsg, strBuffer : string;
|
|
outMsgNode, tmpNode : TDOMNode;
|
|
crs, tmpCrs : IObjectCursor;
|
|
prmName, prmTypeName, prmTypeType : string;
|
|
prmDef : TPasArgument;
|
|
prmInternameName : string;
|
|
prmHasInternameName : Boolean;
|
|
locProcType : TPasProcedureType;
|
|
locFunc : TPasFunction;
|
|
locFuncType : TPasFunctionType;
|
|
j : Integer;
|
|
arg_a, arg_b : TPasArgument;
|
|
begin
|
|
if ExtractMsgName(s_output,outMsg) then begin
|
|
outMsgNode := FindMessageNode(outMsg);
|
|
if ( outMsgNode <> nil ) then begin
|
|
crs := CreatePartCursor(outMsgNode);
|
|
if ( crs <> nil ) then begin
|
|
prmDef := nil;
|
|
crs.Reset();
|
|
while crs.MoveNext() do begin
|
|
tmpNode := (crs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
if ( tmpNode.Attributes = nil ) or ( tmpNode.Attributes.Length < 1 ) then
|
|
raise EWslParserException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
|
|
strBuffer := s_NODE_NAME + '=' + QuotedStr(s_name);
|
|
tmpCrs := CreateCursorOn(CreateAttributesCursor(tmpNode,cetRttiNode),ParseFilter(strBuffer,TDOMNodeRttiExposer));
|
|
tmpCrs.Reset();
|
|
if not tmpCrs.MoveNext() then
|
|
raise EWslParserException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
|
|
prmName := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
|
|
strBuffer := s_NODE_NAME + '=' + QuotedStr(s_element) + ' or ' + s_NODE_NAME + ' = ' + QuotedStr(s_type);
|
|
tmpCrs := CreateCursorOn(
|
|
CreateAttributesCursor(tmpNode,cetRttiNode),
|
|
ParseFilter(strBuffer,TDOMNodeRttiExposer)
|
|
);
|
|
tmpCrs.Reset();
|
|
if not tmpCrs.MoveNext() then
|
|
raise EWslParserException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
|
|
prmTypeName := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
|
|
prmTypeType := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeName;
|
|
if IsStrEmpty(prmName) or IsStrEmpty(prmTypeName) or IsStrEmpty(prmTypeType) then
|
|
raise EWslParserException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
|
|
if SameText(s_document,ASoapBindingStyle) and
|
|
AnsiSameText(prmTypeType,s_element)
|
|
then begin
|
|
prmName := ExtractNameFromQName(prmTypeName);
|
|
end;
|
|
prmInternameName := Trim(prmName);
|
|
if AnsiSameText(prmInternameName,tmpMthd.Name) then begin
|
|
prmInternameName := prmInternameName + 'Param';
|
|
end;
|
|
prmHasInternameName := IsReservedKeyWord(prmInternameName) or
|
|
( not IsValidIdent(prmInternameName) ) or
|
|
( GetParameterIndex(tmpMthdType,prmInternameName) >= 0 );
|
|
if prmHasInternameName then
|
|
prmInternameName := '_' + prmInternameName;
|
|
prmHasInternameName := not AnsiSameText(prmInternameName,prmName);
|
|
prmDef := FindParameter(tmpMthdType,prmInternameName);
|
|
if ( prmDef = nil ) then begin
|
|
prmDef := TPasArgument(SymbolTable.CreateElement(TPasArgument,prmInternameName,tmpMthdType,visDefault,'',0));
|
|
tmpMthdType.Args.Add(prmDef);
|
|
prmDef.ArgType := GetDataType(prmTypeName,prmTypeType);
|
|
prmDef.ArgType.AddRef();
|
|
prmDef.Access := argOut;
|
|
if prmHasInternameName then begin
|
|
SymbolTable.RegisterExternalAlias(prmDef,prmName);
|
|
end;
|
|
end else begin
|
|
if SymbolTable.SameName(prmDef.ArgType,prmTypeName) then begin
|
|
prmDef.Access := argVar;
|
|
end else begin
|
|
prmInternameName := '_' + prmInternameName;
|
|
prmDef := TPasArgument(SymbolTable.CreateElement(TPasArgument,prmInternameName,tmpMthdType,visDefault,'',0));
|
|
prmDef.ArgType := GetDataType(prmTypeName,prmTypeType);
|
|
prmDef.ArgType.AddRef();
|
|
prmDef.Access := argOut;
|
|
tmpMthdType.Args.Add(prmDef);
|
|
SymbolTable.RegisterExternalAlias(prmDef,prmName);
|
|
end;
|
|
end;
|
|
end;
|
|
if ( SameText(ASoapBindingStyle,s_rpc) and
|
|
( prmDef <> nil ) and ( prmDef.Access = argOut ) and
|
|
( prmDef = TPasArgument(tmpMthdType.Args[Pred(tmpMthdType.Args.Count)]) )
|
|
) or
|
|
( SameText(ASoapBindingStyle,s_document) and
|
|
( prmDef <> nil ) and
|
|
( prmDef.Access = argOut ) and
|
|
( prmDef = TPasArgument(tmpMthdType.Args[Pred(tmpMthdType.Args.Count)]) )
|
|
)
|
|
then begin
|
|
locProcType := tmpMthd.ProcType;
|
|
locFunc := TPasFunction(SymbolTable.CreateElement(TPasFunction,tmpMthd.Name,AOwner,visDefault,'',0));
|
|
locFuncType := SymbolTable.CreateFunctionType('','Result',locFunc,False,'',0);
|
|
locFunc.ProcType := locFuncType;
|
|
for j := 0 to ( locProcType.Args.Count - 2 ) do begin
|
|
arg_a := TPasArgument(locProcType.Args[j]);
|
|
arg_b := TPasArgument(SymbolTable.CreateElement(TPasArgument,arg_a.Name,locFuncType,visDefault,'',0));
|
|
locFuncType.Args.Add(arg_b);
|
|
arg_b.Access := arg_a.Access;
|
|
arg_b.ArgType := arg_a.ArgType;
|
|
arg_b.ArgType.AddRef();
|
|
SymbolTable.RegisterExternalAlias(arg_b,SymbolTable.GetExternalName(arg_a));
|
|
end;
|
|
j := locProcType.Args.Count - 1;
|
|
arg_a := TPasArgument(locProcType.Args[j]);
|
|
locFuncType.ResultEl.ResultType := arg_a.ArgType;
|
|
SymbolTable.RegisterExternalAlias(locFuncType.ResultEl,SymbolTable.GetExternalName(arg_a));
|
|
locFuncType.ResultEl.ResultType.AddRef();
|
|
tmpMthd.Release();
|
|
tmpMthd := locFunc;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
AMthd := nil;
|
|
tmpMthd := TPasProcedure(SymbolTable.CreateElement(TPasProcedure,AMthdName,AOwner,visDefault,'',0));
|
|
try
|
|
ParseInputMessage();
|
|
ParseOutputMessage();
|
|
except
|
|
FreeAndNil(tmpMthd);
|
|
AMthd := nil;
|
|
raise;
|
|
end;
|
|
AMthd := tmpMthd;
|
|
end;
|
|
|
|
var
|
|
locMthd : TPasProcedure;
|
|
mthdName : string;
|
|
begin
|
|
Result := nil;
|
|
locMthd := nil;
|
|
if not ExtractOperationName(mthdName) then
|
|
raise EWslParserException.CreateFmt('Operation Attribute not found : "%s"',[s_name]);
|
|
if SameText(s_document,ASoapBindingStyle) then begin
|
|
ExtractMethod(mthdName,locMthd);
|
|
if ( locMthd <> nil ) then begin
|
|
AOwner.Members.Add(locMthd);
|
|
end;
|
|
end else if SameText(s_rpc,ASoapBindingStyle) then begin
|
|
ExtractMethod(mthdName,locMthd);
|
|
if ( locMthd <> nil ) then begin
|
|
AOwner.Members.Add(locMthd);
|
|
end;
|
|
end;
|
|
Result := locMthd;
|
|
end;
|
|
|
|
function TWsdlParser.ParseType(const AName, ATypeOrElement: string): TPasType;
|
|
var
|
|
crsSchemaChild : IObjectCursor;
|
|
typNd : TDOMNode;
|
|
typName : string;
|
|
embededType : Boolean;
|
|
|
|
procedure Init();
|
|
var
|
|
nd : TDOMNodeRttiExposer;
|
|
schmCrsr : IObjectCursor;
|
|
begin
|
|
if not Assigned(FSchemaCursor) then
|
|
raise EWslParserException.Create('Schema cursor not assigned.');
|
|
schmCrsr := FSchemaCursor.Clone() as IObjectCursor;
|
|
FSchemaCursor.Reset();
|
|
if not FSchemaCursor.MoveNext() then
|
|
raise EWslParserException.Create('Schema cursor is empty.');
|
|
nd := FSchemaCursor.GetCurrent() as TDOMNodeRttiExposer;
|
|
crsSchemaChild := CreateChildrenCursor(nd.InnerObject,cetRttiNode);
|
|
end;
|
|
|
|
function FindTypeNode(out ASimpleTypeAlias : TPasType) : Boolean;
|
|
var
|
|
nd, oldTypeNode : TDOMNode;
|
|
crs : IObjectCursor;
|
|
locStrFilter : string;
|
|
begin
|
|
ASimpleTypeAlias := nil;
|
|
Result := True;
|
|
typNd := FindNamedNode(crsSchemaChild,ExtractNameFromQName(AName));
|
|
if not Assigned(typNd) then
|
|
raise EWslTypeNotFoundException.CreateFmt('Type definition not found 1 : "%s"',[AName]);
|
|
if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_element) then begin
|
|
crs := CreateCursorOn(CreateAttributesCursor(typNd,cetRttiNode),ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_type)]),TDOMNodeRttiExposer));
|
|
crs.Reset();
|
|
if crs.MoveNext() then begin
|
|
nd := (crs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
ASimpleTypeAlias := FSymbols.FindElement(ExtractNameFromQName(nd.NodeValue)) as TPasType;
|
|
if Assigned(ASimpleTypeAlias) then begin
|
|
Result := False;
|
|
end else begin
|
|
oldTypeNode := typNd;
|
|
typNd := FindNamedNode(crsSchemaChild,ExtractNameFromQName(nd.NodeValue));
|
|
if not Assigned(typNd) then
|
|
raise EWslTypeNotFoundException.CreateFmt('Type definition not found 2 : "%s"',[AName]);
|
|
embededType := False;
|
|
if ( typNd = oldTypeNode ) then begin
|
|
typNd := FindNamedNode(crsSchemaChild,ExtractNameFromQName(nd.NodeValue),2);
|
|
if not Assigned(typNd) then
|
|
raise EWslTypeNotFoundException.CreateFmt('Type definition not found 2.1 : "%s"',[AName]);
|
|
end;
|
|
end;
|
|
end else begin
|
|
//locStrFilter := Format('%s = %s or %s = %s ',[s_NODE_NAME,QuotedStr(s_complexType),s_NODE_NAME,QuotedStr(s_simpleType)]);
|
|
locStrFilter := CreateQualifiedNameFilterStr(s_complexType,FXSShortNames) + ' or ' +
|
|
CreateQualifiedNameFilterStr(s_simpleType,FXSShortNames);
|
|
crs := CreateCursorOn(CreateChildrenCursor(typNd,cetRttiNode),ParseFilter(locStrFilter,TDOMNodeRttiExposer));
|
|
crs.Reset();
|
|
if not crs.MoveNext() then begin
|
|
raise EWslTypeNotFoundException.CreateFmt('Type definition not found 3 : "%s"',[AName]);
|
|
end;
|
|
typNd := (crs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
typName := ExtractNameFromQName(AName);
|
|
embededType := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ParseComplexType():TPasType;
|
|
var
|
|
locParser : TComplexTypeParser;
|
|
begin
|
|
locParser := TComplexTypeParser.Create(Self,typNd,FSymbols,typName,embededType);
|
|
try
|
|
Result := locParser.Parse();
|
|
finally
|
|
FreeAndNil(locParser);
|
|
end;
|
|
end;
|
|
|
|
function ParseSimpleType():TPasType;
|
|
var
|
|
locParser : TSimpleTypeParser;
|
|
begin
|
|
locParser := TSimpleTypeParser.Create(Self,typNd,FSymbols,typName,embededType);
|
|
try
|
|
Result := locParser.Parse();
|
|
finally
|
|
FreeAndNil(locParser);
|
|
end;
|
|
end;
|
|
|
|
function CreateTypeAlias(const ABase : TPasType): TPasType;
|
|
var
|
|
hasInternameName : Boolean;
|
|
internameName : string;
|
|
begin
|
|
internameName := ExtractNameFromQName(AName);
|
|
hasInternameName := IsReservedKeyWord(internameName) or
|
|
( not IsValidIdent(internameName) );
|
|
if hasInternameName then begin
|
|
internameName := '_' + internameName;
|
|
end;
|
|
Result := TPasType(SymbolTable.CreateElement(TPasAliasType,internameName,SymbolTable.CurrentModule.InterfaceSection,visDefault,'',0));
|
|
TPasAliasType(Result).DestType := ABase;
|
|
ABase.AddRef();
|
|
end;
|
|
|
|
function CreateUnresolveType(): TPasType;
|
|
var
|
|
hasInternameName : Boolean;
|
|
internameName : string;
|
|
begin
|
|
internameName := ExtractNameFromQName(AName);
|
|
hasInternameName := IsReservedKeyWord(internameName) or
|
|
( not IsValidIdent(internameName) );
|
|
if hasInternameName then begin
|
|
internameName := '_' + internameName;
|
|
end;
|
|
Result := TPasUnresolvedTypeRef(SymbolTable.CreateElement(TPasUnresolvedTypeRef,internameName,SymbolTable.CurrentModule.InterfaceSection,visDefault,'',0));
|
|
if not AnsiSameText(internameName,AName) then
|
|
SymbolTable.RegisterExternalAlias(Result,AName);
|
|
end;
|
|
|
|
var
|
|
frwType, aliasType : TPasType;
|
|
sct : TPasSection;
|
|
begin
|
|
DoOnMessage(mtInfo, Format('Parsing "%s" ...',[AName]));
|
|
try
|
|
embededType := False;
|
|
aliasType := nil;
|
|
Result := nil;
|
|
Result := FSymbols.FindElement(ExtractNameFromQName(AName)) as TPasType;
|
|
if ( Result = nil ) or Result.InheritsFrom(TPasUnresolvedTypeRef) then begin
|
|
sct := FSymbols.CurrentModule.InterfaceSection;
|
|
frwType := Result;
|
|
Result := nil;
|
|
Init();
|
|
if FindTypeNode(aliasType) then begin
|
|
if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_complexType) then begin
|
|
Result := ParseComplexType();
|
|
end else if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_simpleType) then begin
|
|
Result := ParseSimpleType();
|
|
end;
|
|
if Assigned(Result) then begin
|
|
if Assigned(frwType) and AnsiSameText(SymbolTable.GetExternalName(Result),SymbolTable.GetExternalName(frwType)) then begin
|
|
Result.Name := frwType.Name;
|
|
SymbolTable.RegisterExternalAlias(Result,SymbolTable.GetExternalName(frwType));
|
|
end;
|
|
end else begin
|
|
raise EWslTypeNotFoundException.CreateFmt('Type node found but unable to parse it : "%s"',[AName]);
|
|
end;
|
|
end else begin
|
|
Result := CreateTypeAlias(aliasType);
|
|
end;
|
|
if ( frwType <> nil ) then begin
|
|
sct.Declarations.Extract(frwType);
|
|
sct.Types.Extract(frwType);
|
|
frwType.Release();
|
|
end;
|
|
sct.Declarations.Add(Result);
|
|
sct.Types.Add(Result);
|
|
if Result.InheritsFrom(TPasClassType) then begin
|
|
sct.Classes.Add(Result);
|
|
end;
|
|
end;
|
|
except
|
|
on e : EWslTypeNotFoundException do begin
|
|
Result := CreateUnresolveType();
|
|
sct.Declarations.Add(Result);
|
|
sct.Types.Add(Result);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TWsdlParser.ParseTypes();
|
|
var
|
|
nd : TDOMNodeRttiExposer;
|
|
schmCrsr, crsSchemaChild, typTmpCrs : IObjectCursor;
|
|
typFilterStr : string;
|
|
typNode : TDOMNode;
|
|
begin
|
|
if Assigned(FSchemaCursor) then begin
|
|
schmCrsr := FSchemaCursor.Clone() as IObjectCursor;
|
|
schmCrsr.Reset();
|
|
while schmCrsr.MoveNext() do begin
|
|
nd := schmCrsr.GetCurrent() as TDOMNodeRttiExposer;
|
|
crsSchemaChild := CreateChildrenCursor(nd.InnerObject,cetRttiNode);
|
|
if Assigned(crsSchemaChild) then begin
|
|
typFilterStr := Format(
|
|
'%s or %s or %s',
|
|
[ CreateQualifiedNameFilterStr(s_complexType,FXSShortNames),
|
|
CreateQualifiedNameFilterStr(s_simpleType,FXSShortNames),
|
|
CreateQualifiedNameFilterStr(s_element,FXSShortNames)
|
|
]
|
|
);
|
|
crsSchemaChild := CreateCursorOn(crsSchemaChild,ParseFilter(typFilterStr,TDOMNodeRttiExposer));
|
|
crsSchemaChild.Reset();
|
|
while crsSchemaChild.MoveNext() do begin
|
|
typNode := (crsSchemaChild.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
typTmpCrs := CreateAttributesCursor(typNode,cetRttiNode);
|
|
if Assigned(typTmpCrs) then begin
|
|
typTmpCrs.Reset();
|
|
typTmpCrs := CreateCursorOn(typTmpCrs,ParseFilter(Format('%s=%s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer));
|
|
typTmpCrs.Reset();
|
|
if typTmpCrs.MoveNext() then begin
|
|
ParseType(
|
|
(typTmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue,
|
|
ExtractNameFromQName(typNode.NodeName)
|
|
);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
constructor TWsdlParser.Create(ADoc: TXMLDocument; ASymbols : TwstPasTreeContainer);
|
|
begin
|
|
Assert(Assigned(ADoc));
|
|
Assert(Assigned(ASymbols));
|
|
FDoc := ADoc;
|
|
FWsdlShortNames := TStringList.Create();
|
|
FSoapShortNames := TStringList.Create();
|
|
FXSShortNames := TStringList.Create();
|
|
FSymbols := ASymbols;
|
|
end;
|
|
|
|
destructor TWsdlParser.Destroy();
|
|
begin
|
|
FreeAndNil(FXSShortNames);
|
|
FreeAndNil(FSoapShortNames);
|
|
FreeAndNil(FWsdlShortNames);
|
|
inherited Destroy();
|
|
end;
|
|
|
|
procedure TWsdlParser.Parse(const AMode : TParserMode; const AModuleName : string);
|
|
|
|
procedure ParseForwardDeclarations();
|
|
var
|
|
i, c : Integer;
|
|
sym, symNew : TPasElement;
|
|
typeCursor : IObjectCursor;
|
|
tmpNode : TDOMNode;
|
|
s : string;
|
|
typeList : TList;
|
|
begin
|
|
if Assigned(FSchemaCursor) then begin
|
|
FSchemaCursor.Reset();
|
|
if FSchemaCursor.MoveNext() then begin
|
|
tmpNode := (FSchemaCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
if tmpNode.HasChildNodes() then begin
|
|
typeCursor := CreateChildrenCursor(tmpNode,cetRttiNode);
|
|
s := CreateQualifiedNameFilterStr(s_complexType,FXSShortNames) + ' or ' +
|
|
CreateQualifiedNameFilterStr(s_simpleType,FXSShortNames) + ' or ' +
|
|
CreateQualifiedNameFilterStr(s_element,FXSShortNames);
|
|
typeCursor := CreateCursorOn(typeCursor,ParseFilter(s,TDOMNodeRttiExposer));
|
|
typeCursor.Reset();
|
|
if typeCursor.MoveNext() then begin
|
|
typeList := FSymbols.CurrentModule.InterfaceSection.Declarations;
|
|
c := typeList.Count;
|
|
i := 0;
|
|
while ( i < c ) do begin
|
|
sym := TPasElement(typeList[i]);
|
|
if sym.InheritsFrom(TPasUnresolvedTypeRef) then begin
|
|
typeCursor.Reset();
|
|
tmpNode := FindNamedNode(typeCursor,FSymbols.GetExternalName(sym));
|
|
if Assigned(tmpNode) then begin
|
|
symNew := ParseType(FSymbols.GetExternalName(sym),ExtractNameFromQName(tmpNode.NodeName));
|
|
if ( sym <> symNew ) then begin
|
|
FModule.InterfaceSection.Declarations.Extract(sym);
|
|
FModule.InterfaceSection.Types.Extract(sym);
|
|
symNew.Name := sym.Name;
|
|
DoOnMessage(mtInfo,Format('forward type paring %s; %d %d',[symNew.Name,c, typeList.Count]));
|
|
//sym.Release();
|
|
end;
|
|
i := 0; //Dec(i);
|
|
c := typeList.Count;
|
|
end else begin
|
|
DoOnMessage(mtInfo, 'unable to find the node of this type : ' + sym.Name);
|
|
end;
|
|
end;
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure ExtractNameSpace();
|
|
var
|
|
tmpCrs : IObjectCursor;
|
|
nd : TDOMNode;
|
|
s : string;
|
|
begin
|
|
nd := FDoc.DocumentElement;
|
|
if Assigned(nd.Attributes) and ( nd.Attributes.Length > 0 ) then begin
|
|
tmpCrs := CreateCursorOn(
|
|
CreateAttributesCursor(nd,cetRttiNode),
|
|
ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_targetNamespace)]),TDOMNodeRttiExposer)
|
|
);
|
|
tmpCrs.Reset();
|
|
if tmpCrs.MoveNext() then begin
|
|
s := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
|
|
if not IsStrEmpty(s) then begin
|
|
FSymbols.RegisterExternalAlias(FSymbols.CurrentModule,s);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
locSrvcCrs : IObjectCursor;
|
|
locObj : TDOMNodeRttiExposer;
|
|
begin
|
|
Prepare(AModuleName);
|
|
|
|
locSrvcCrs := FServiceCursor.Clone() as IObjectCursor;
|
|
locSrvcCrs.Reset();
|
|
while locSrvcCrs.MoveNext() do begin
|
|
locObj := locSrvcCrs.GetCurrent() as TDOMNodeRttiExposer;
|
|
ParseService(locObj.InnerObject);
|
|
end;
|
|
|
|
if ( AMode = pmAllTypes ) then begin
|
|
ParseTypes();
|
|
end;
|
|
|
|
ParseForwardDeclarations();
|
|
ExtractNameSpace();
|
|
SymbolTable.SetCurrentModule(FModule);
|
|
end;
|
|
|
|
{ TAbstractTypeParser }
|
|
|
|
constructor TAbstractTypeParser.Create(
|
|
AOwner : TWsdlParser;
|
|
ATypeNode : TDOMNode;
|
|
ASymbols : TwstPasTreeContainer;
|
|
const ATypeName : string;
|
|
const AEmbededDef : Boolean
|
|
);
|
|
begin
|
|
Assert(Assigned(AOwner));
|
|
Assert(Assigned(ATypeNode));
|
|
Assert(Assigned(ASymbols));
|
|
FOwner := AOwner;
|
|
FTypeNode := ATypeNode;
|
|
FSymbols := ASymbols;
|
|
FTypeName := ATypeName;
|
|
FEmbededDef := AEmbededDef;
|
|
end;
|
|
|
|
class function TAbstractTypeParser.ExtractEmbeddedTypeFromElement(
|
|
AOwner : TWsdlParser;
|
|
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 EWslParserException.Create('Unable to find the <name> tag in the type/element node attributes.');
|
|
Result := (locCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
|
|
if IsStrEmpty(Result) then begin
|
|
raise EWslParserException.Create('Invalid type/element name( the name is empty ).');
|
|
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.FXSShortNames);
|
|
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 EWslParserException.Create('Invalid type definition, this element must have children.');
|
|
end;
|
|
Result := nil;
|
|
typName := ATypeName;
|
|
if IsStrEmpty(typName) then begin
|
|
typName := ExtractTypeName();
|
|
end;
|
|
prsClss := FindParser(typNode);
|
|
if ( prsClss = nil ) then begin;
|
|
raise EWslParserException.CreateFmt('This type style is not supported : "%s".',[typName]);
|
|
end;
|
|
prs := prsClss.Create(AOwner,typNode,ASymbols,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;
|
|
|
|
|
|
{ TComplexTypeParser }
|
|
|
|
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 EWslParserException.Create('Unable to find the <name> tag in the type node attributes.');
|
|
FTypeName := (locCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
|
|
end;
|
|
if IsStrEmpty(FTypeName) then
|
|
raise EWslParserException.Create('Invalid type name( the name is empty ).');
|
|
end;
|
|
|
|
procedure TComplexTypeParser.ExtractContentType();
|
|
var
|
|
locCrs : IObjectCursor;
|
|
begin
|
|
FContentType := '';
|
|
if Assigned(FChildCursor) then begin
|
|
locCrs := CreateCursorOn(
|
|
FChildCursor.Clone() as IObjectCursor,
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_complexContent,FOwner.FXSShortNames),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,FOwner.FXSShortNames),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;
|
|
locBaseTypeName, locBaseTypeInternalName, locFilterStr : string;
|
|
begin
|
|
locFilterStr := CreateQualifiedNameFilterStr(s_extension,FOwner.FXSShortNames);
|
|
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,FOwner.FXSShortNames);
|
|
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 EWslParserException.CreateFmt('Invalid extention/restriction of type "%s" : "base" attribute not found.',[FTypeName]);
|
|
locBaseTypeName := ExtractNameFromQName((locCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue);
|
|
locSymbol := FSymbols.FindElement(locBaseTypeName);
|
|
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).BoxedType));
|
|
FBaseType := TPasNativeSimpleType(FBaseType).BoxedType;
|
|
end;
|
|
end else begin
|
|
raise EWslParserException.CreateFmt('"%s" was expected to be a type definition.',[locSymbol.Name]);
|
|
end;
|
|
end else begin
|
|
locBaseTypeInternalName := ExtractIdentifier(locBaseTypeName);
|
|
if IsReservedKeyWord(locBaseTypeInternalName) then
|
|
locBaseTypeInternalName := '_' + locBaseTypeInternalName ;
|
|
FBaseType := TPasUnresolvedTypeRef(FSymbols.CreateElement(TPasUnresolvedTypeRef,locBaseTypeInternalName,FSymbols.CurrentModule.InterfaceSection,visDefault,'',0));
|
|
FSymbols.CurrentModule.InterfaceSection.Declarations.Add(FBaseType);
|
|
FSymbols.CurrentModule.InterfaceSection.Types.Add(FBaseType);
|
|
if not AnsiSameText(locBaseTypeInternalName,locBaseTypeName) then
|
|
FSymbols.RegisterExternalAlias(FBaseType,locBaseTypeName);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TComplexTypeParser.ParseComplexContent(const ATypeName : string) : TPasType;
|
|
|
|
function ExtractElementCursor(out AAttCursor : IObjectCursor):IObjectCursor;
|
|
var
|
|
frstCrsr, tmpCursor : IObjectCursor;
|
|
parentNode, tmpNode : TDOMNode;
|
|
begin
|
|
Result := nil;
|
|
AAttCursor := nil;
|
|
case FDerivationMode of
|
|
dmNone : parentNode := FContentNode;
|
|
dmRestriction,
|
|
dmExtension : parentNode := FDerivationNode;
|
|
end;
|
|
if parentNode.HasChildNodes() then begin;
|
|
AAttCursor := CreateCursorOn(
|
|
CreateChildrenCursor(parentNode,cetRttiNode),
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_attribute,FOwner.FXSShortNames),TDOMNodeRttiExposer)
|
|
);
|
|
frstCrsr := CreateChildrenCursor(parentNode,cetRttiNode);
|
|
tmpCursor := CreateCursorOn(
|
|
frstCrsr.Clone() as IObjectCursor,
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_sequence,FOwner.FXSShortNames),TDOMNodeRttiExposer)
|
|
);
|
|
tmpCursor.Reset();
|
|
if tmpCursor.MoveNext() then begin
|
|
FSequenceType := stElement;
|
|
tmpNode := (tmpCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
if tmpNode.HasChildNodes() then begin
|
|
tmpCursor := CreateCursorOn(
|
|
CreateChildrenCursor(tmpNode,cetRttiNode),
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_element,FOwner.FXSShortNames),TDOMNodeRttiExposer)
|
|
);
|
|
Result := tmpCursor;
|
|
end;
|
|
end else begin
|
|
tmpCursor := CreateCursorOn(
|
|
frstCrsr.Clone() as IObjectCursor,
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_all,FOwner.FXSShortNames),TDOMNodeRttiExposer)
|
|
);
|
|
tmpCursor.Reset();
|
|
if tmpCursor.MoveNext() then begin
|
|
FSequenceType := stElement;
|
|
tmpNode := (tmpCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
if tmpNode.HasChildNodes() then begin
|
|
tmpCursor := CreateCursorOn(
|
|
CreateChildrenCursor(tmpNode,cetRttiNode),
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_element,FOwner.FXSShortNames),TDOMNodeRttiExposer)
|
|
);
|
|
Result := tmpCursor;
|
|
end;
|
|
end;
|
|
end
|
|
end else begin
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
classDef : TPasClassType;
|
|
isArrayDef : Boolean;
|
|
arrayItems : TObjectList;
|
|
|
|
procedure ParseElement(AElement : TDOMNode);
|
|
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;
|
|
begin
|
|
locType := nil;
|
|
locTypeName := '';
|
|
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;
|
|
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 EWslParserException.Create('Invalid <element> definition : missing "name" or "ref" attribute.');
|
|
end;
|
|
locIsRefElement := True;
|
|
end;
|
|
locName := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
|
|
if locIsRefElement then begin
|
|
locName := ExtractNameFromQName(locName);
|
|
end;
|
|
if IsStrEmpty(locName) then
|
|
raise EWslParserException.Create('Invalid <element> definition : empty "name".');
|
|
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((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue);
|
|
end else begin
|
|
locTypeName := Format('%s_%s_Type',[FTypeName,locName]);
|
|
locType := TAbstractTypeParser.ExtractEmbeddedTypeFromElement(FOwner,AElement,FSymbols,locTypeName);
|
|
if ( locType = nil ) then begin
|
|
raise EWslParserException.CreateFmt('Invalid <element> definition : unable to determine the type.'#13'Type name : "%s"; Element name :"%s".',[FTypeName,locName]);
|
|
end;
|
|
FSymbols.CurrentModule.InterfaceSection.Declarations.Add(locType);
|
|
FSymbols.CurrentModule.InterfaceSection.Types.Add(locType);
|
|
if locType.InheritsFrom(TPasClassType) then begin
|
|
FSymbols.CurrentModule.InterfaceSection.Classes.Add(locType);
|
|
end;
|
|
end;
|
|
end;
|
|
if IsStrEmpty(locTypeName) then
|
|
raise EWslParserException.Create('Invalid <element> definition : empty "type".');
|
|
locType := FSymbols.FindElement(locTypeName);
|
|
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 := 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,FSymbols.CurrentModule.InterfaceSection,visDefault,'',0));
|
|
FSymbols.CurrentModule.InterfaceSection.Declarations.Add(locType);
|
|
FSymbols.CurrentModule.InterfaceSection.Types.Add(locType);
|
|
if not AnsiSameText(locTypeInternalName,locTypeName) then
|
|
FSymbols.RegisterExternalAlias(locType,locTypeName);
|
|
end;
|
|
|
|
locInternalEltName := locName;
|
|
locHasInternalName := IsReservedKeyWord(locInternalEltName);
|
|
if locHasInternalName then
|
|
locInternalEltName := Format('_%s',[locInternalEltName]);
|
|
|
|
locProp := TPasProperty(FSymbols.CreateElement(TPasProperty,locInternalEltName,classDef,visPublished,'',0));
|
|
classDef.Members.Add(locProp);
|
|
locProp.VarType := locType as TPasType;
|
|
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;}
|
|
|
|
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 EWslParserException.CreateFmt('Invalid "minOccurs" value : "%s.%s".',[FTypeName,locName]);
|
|
if ( locMinOccur < 0 ) then
|
|
raise EWslParserException.CreateFmt('Invalid "minOccurs" value : "%s.%s".',[FTypeName,locName]);
|
|
end;
|
|
locProp.ReadAccessorName := 'F' + locProp.Name;
|
|
locProp.WriteAccessorName := 'F' + locProp.Name;
|
|
if ( locMinOccur = 0 ) then begin
|
|
locProp.StoredAccessorName := 'Has' + locProp.Name;
|
|
end else begin
|
|
locProp.StoredAccessorName := 'True';
|
|
end;
|
|
|
|
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 EWslParserException.CreateFmt('Invalid "maxOccurs" value : "%s.%s".',[FTypeName,locName]);
|
|
if ( locMinOccur < 0 ) then
|
|
raise EWslParserException.CreateFmt('Invalid "maxOccurs" value : "%s.%s".',[FTypeName,locName]);
|
|
end;
|
|
end;
|
|
isArrayDef := locMaxOccurUnbounded or ( locMaxOccur > 1 );
|
|
if isArrayDef then begin
|
|
arrayItems.Add(locProp);
|
|
end;
|
|
if AnsiSameText(s_attribute,ExtractNameFromQName(AElement.NodeName)) then begin
|
|
FSymbols.SetPropertyAsAttribute(locProp,True);
|
|
end;
|
|
end;
|
|
|
|
procedure GenerateArrayTypes(
|
|
const AClassName : string;
|
|
AArrayPropList : TObjectList
|
|
);
|
|
var
|
|
locPropTyp : TPasProperty;
|
|
k : Integer;
|
|
locString : string;
|
|
locSym : TPasElement;
|
|
begin
|
|
for k := 0 to Pred(AArrayPropList.Count) do begin
|
|
locPropTyp := AArrayPropList[k] as TPasProperty;
|
|
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
|
|
);
|
|
FSymbols.CurrentModule.InterfaceSection.Declarations.Add(locSym);
|
|
FSymbols.CurrentModule.InterfaceSection.Types.Add(locSym);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ExtractSoapArray(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 EWslParserException.CreateFmt('Invalid type definition, attributes not found : "%s".',[FTypeName]);
|
|
end;
|
|
crs := CreateCursorOn(
|
|
CreateChildrenCursor(FDerivationNode,cetRttiNode),
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_attribute,FOwner.FXSShortNames),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 EWslParserException.CreateFmt('Invalid type definition, unable to find the "%s" attribute : "%s".',[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,FSymbols.CurrentModule.InterfaceSection,visDefault,'',0));
|
|
FSymbols.CurrentModule.InterfaceSection.Declarations.Add(locSym);
|
|
FSymbols.CurrentModule.InterfaceSection.Types.Add(locSym);
|
|
end;
|
|
if not locSym.InheritsFrom(TPasType) then
|
|
raise EWslParserException.CreateFmt('Invalid array type definition, invalid item type definition : "%s".',[FTypeName]);
|
|
Result := FSymbols.CreateArray(AInternalName,locSym as TPasType,s_item,s_item,asScoped);
|
|
if AHasInternalName then
|
|
FSymbols.RegisterExternalAlias(Result,ATypeName);
|
|
end;
|
|
|
|
function IsHeaderBlock() : Boolean;
|
|
var
|
|
strBuffer : string;
|
|
begin
|
|
Result := wst_findCustomAttribute(FOwner.FWsdlShortNames,FTypeNode,s_headerBlock,strBuffer) and AnsiSameText('true',Trim(strBuffer));
|
|
end;
|
|
|
|
function IsRecordType() : Boolean;
|
|
var
|
|
strBuffer : string;
|
|
begin
|
|
Result := wst_findCustomAttribute(FOwner.FWsdlShortNames,FTypeNode,s_record,strBuffer) and AnsiSameText('true',Trim(strBuffer));
|
|
end;
|
|
|
|
procedure ParseElementsAndAttributes(AEltCrs, AEltAttCrs : IObjectCursor);
|
|
begin
|
|
if Assigned(AEltCrs) then begin
|
|
AEltCrs.Reset();
|
|
while AEltCrs.MoveNext() do begin
|
|
ParseElement((AEltCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject);
|
|
end;
|
|
end;
|
|
if Assigned(AEltAttCrs) then begin
|
|
AEltAttCrs.Reset();
|
|
while AEltAttCrs.MoveNext() do begin
|
|
ParseElement((AEltAttCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
eltCrs, eltAttCrs : IObjectCursor;
|
|
internalName : string;
|
|
hasInternalName : Boolean;
|
|
arrayDef : TPasArrayType;
|
|
propTyp, tmpPropTyp : TPasProperty;
|
|
tmpClassDef : TPasClassType;
|
|
i : Integer;
|
|
recordType : TPasRecordType;
|
|
tmpRecVar : TPasVariable;
|
|
begin
|
|
ExtractBaseType();
|
|
eltCrs := ExtractElementCursor(eltAttCrs);
|
|
|
|
internalName := ExtractIdentifier(ATypeName);
|
|
hasInternalName := IsReservedKeyWord(internalName) or
|
|
( not IsValidIdent(internalName) ) or
|
|
//( FSymbols.IndexOf(internalName) <> -1 ) or
|
|
( not AnsiSameText(internalName,ATypeName) );
|
|
if hasInternalName then begin
|
|
internalName := Format('_%s',[internalName]);
|
|
end;
|
|
|
|
if ( FDerivationMode = dmRestriction ) and FSymbols.SameName(FBaseType,s_array) then begin
|
|
Result := ExtractSoapArray(internalName,hasInternalName);
|
|
end else begin
|
|
arrayItems := TObjectList.Create(False);
|
|
try
|
|
classDef := TPasClassType(FSymbols.CreateElement(TPasClassType,internalName,FSymbols.CurrentModule.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;
|
|
if ( classDef.AncestorType = nil ) then begin
|
|
if IsHeaderBlock() then
|
|
classDef.AncestorType := FSymbols.FindElementInModule('THeaderBlock',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType
|
|
else
|
|
classDef.AncestorType := FSymbols.FindElementInModule('TBaseComplexRemotable',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType;
|
|
end;
|
|
classDef.AncestorType.AddRef();
|
|
if Assigned(eltCrs) or Assigned(eltAttCrs) then begin
|
|
isArrayDef := False;
|
|
ParseElementsAndAttributes(eltCrs,eltAttCrs);
|
|
if ( arrayItems.Count > 0 ) then begin
|
|
if ( arrayItems.Count = 1 ) and ( GetElementCount(classDef.Members,TPasProperty) = 1 ) then begin
|
|
Result := nil;
|
|
propTyp := arrayItems[0] as TPasProperty;
|
|
arrayDef := FSymbols.CreateArray(internalName,propTyp.VarType,propTyp.Name,FSymbols.GetExternalName(propTyp),asScoped);
|
|
FreeAndNil(classDef);
|
|
Result := arrayDef;
|
|
if hasInternalName then
|
|
FSymbols.RegisterExternalAlias(arrayDef,ATypeName);
|
|
end else begin
|
|
GenerateArrayTypes(internalName,arrayItems);
|
|
tmpClassDef := classDef;
|
|
classDef := TPasClassType(FSymbols.CreateElement(TPasClassType,tmpClassDef.Name,FSymbols.CurrentModule.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));
|
|
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));
|
|
classDef.Members.Add(tmpPropTyp);
|
|
end;
|
|
end;
|
|
end;
|
|
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,FSymbols.CurrentModule.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;
|
|
end;
|
|
end;
|
|
FreeAndNil(tmpClassDef);
|
|
end;
|
|
except
|
|
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;
|
|
begin
|
|
Result := nil;
|
|
parentNode := FContentNode;
|
|
if parentNode.HasChildNodes() then begin;
|
|
frstCrsr := CreateChildrenCursor(parentNode,cetRttiNode);
|
|
locFilterStr := CreateQualifiedNameFilterStr(s_extension,FOwner.FXSShortNames) + ' or ' +
|
|
CreateQualifiedNameFilterStr(s_restriction,FOwner.FXSShortNames) ;
|
|
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,FOwner.FXSShortNames);
|
|
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 EWslParserException.CreateFmt('Invalid <%s> definition : missing "name" attribute.',[s_attribute]);
|
|
locName := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
|
|
if IsStrEmpty(locName) then
|
|
raise EWslParserException.CreateFmt('Invalid <%s> definition : empty "name".',[s_attribute]);
|
|
|
|
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 EWslParserException.CreateFmt('Invalid <%s> definition : missing "type" attribute.',[s_attribute]);
|
|
locTypeName := ExtractNameFromQName((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue);
|
|
if IsStrEmpty(locTypeName) then
|
|
raise EWslParserException.CreateFmt('Invalid <%s> definition : empty "type".',[s_attribute]);
|
|
locType := FSymbols.FindElement(locTypeName) as TPasType;
|
|
if not Assigned(locType) then begin
|
|
locType := TPasUnresolvedTypeRef(FSymbols.CreateElement(TPasUnresolvedTypeRef,locTypeName,FSymbols.CurrentModule.InterfaceSection,visPublic,'',0));
|
|
FSymbols.CurrentModule.InterfaceSection.Declarations.Add(locType);
|
|
FSymbols.CurrentModule.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 EWslParserException.CreateFmt('Invalid <%s> definition : empty "use".',[s_attribute]);
|
|
locStoreOptIdx := AnsiIndexText(locStoreOpt,[s_required,s_optional,s_prohibited]);
|
|
if ( locStoreOptIdx < 0 ) then
|
|
raise EWslParserException.CreateFmt('Invalid <%s> definition : invalid "use" value "%s".',[s_attribute,locStoreOpt]);
|
|
end else begin
|
|
locStoreOptIdx := 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 := 'Has' + 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 EWslParserException.Create('Invalid "complexeType.simpleType" definition : restriction/extension not found.');
|
|
|
|
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),FSymbols.CurrentModule.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
|
|
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,FSymbols.CurrentModule.InterfaceSection,visDefault,'',0));
|
|
TPasClassType(Result).ObjKind := okClass;
|
|
if hasInternalName then
|
|
FSymbols.RegisterExternalAlias(Result,ATypeName);
|
|
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 EWslParserException.CreateFmt('%s expected but %s found.',[s_complexType,ExtractNameFromQName(FTypeNode.NodeName)]);
|
|
CreateNodeCursors();
|
|
ExtractTypeName();
|
|
locContinue := True;
|
|
locSym := FSymbols.FindElement(FTypeName);
|
|
if Assigned(locSym) then begin
|
|
if not locSym.InheritsFrom(TPasType) then
|
|
raise EWslParserException.CreateFmt('Symbol found in the symbol table but is not a type definition : %s.',[FTypeName]);
|
|
locContinue := locSym.InheritsFrom(TPasUnresolvedTypeRef);
|
|
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;
|
|
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 EWslParserException.Create('Unable to find the <name> tag in the type node attributes.');
|
|
FTypeName := (locCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
|
|
end;
|
|
if IsStrEmpty(FTypeName) then
|
|
raise EWslParserException.Create('Invalid type name( the name is empty ).');
|
|
end;
|
|
|
|
function TSimpleTypeParser.ExtractContentType() : Boolean;
|
|
var
|
|
locCrs, locAttCrs : IObjectCursor;
|
|
tmpNode : TDOMNode;
|
|
begin
|
|
locCrs := CreateCursorOn(
|
|
FChildCursor.Clone() as IObjectCursor,
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_restriction,FOwner.FXSShortNames),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 := '';
|
|
if Assigned(tmpNode) then begin
|
|
FBaseName := ExtractNameFromQName(tmpNode.NodeValue);
|
|
end;
|
|
locCrs := CreateChildrenCursor(FRestrictionNode,cetRttiNode) as IObjectCursor;
|
|
if Assigned(locCrs) then begin
|
|
locCrs := CreateCursorOn(
|
|
locCrs,
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_enumeration,FOwner.FXSShortNames),TDOMNodeRttiExposer)
|
|
);
|
|
locCrs.Reset();
|
|
if locCrs.MoveNext() then begin
|
|
FIsEnum := True;
|
|
end else begin
|
|
if IsStrEmpty(FBaseName) then
|
|
raise EWslParserException.CreateFmt('Base type is not specified for the simple type, parsing : "%s".',[FTypeName]);
|
|
FIsEnum := False
|
|
end;
|
|
end else begin
|
|
if IsStrEmpty(FBaseName) then
|
|
raise EWslParserException.CreateFmt('Base type is not specified for the simple type, parsing : "%s".',[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,FOwner.FXSShortNames),TDOMNodeRttiExposer)
|
|
);
|
|
end;
|
|
|
|
var
|
|
locRes : TPasEnumType;
|
|
locOrder : Integer;
|
|
|
|
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 EWslParserException.CreateFmt('Invalid "enum" item node : no value attribute, type = "%s".',[FTypeName]);
|
|
locCrs.Reset();
|
|
if not locCrs.MoveNext() then
|
|
raise EWslParserException.CreateFmt('Invalid "enum" item node : no value attribute, type = "%s".',[FTypeName]);
|
|
tmpNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
locItemName := tmpNode.NodeValue;
|
|
if IsStrEmpty(locItemName) then
|
|
raise EWslParserException.CreateFmt('Invalid "enum" item node : the value attribute is empty, type = "%s".',[FTypeName]);
|
|
|
|
locInternalItemName := ExtractIdentifier(locItemName);
|
|
locHasInternalName := IsReservedKeyWord(locInternalItemName) or
|
|
( not IsValidIdent(locInternalItemName) ) or
|
|
( FSymbols.FindElementInModule(locInternalItemName,FSymbols.CurrentModule) <> nil ) or
|
|
FSymbols.IsEnumItemNameUsed(locInternalItemName) 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);
|
|
//locItem := TEnumItemDefinition.Create(locInternalItemName,locRes,locOrder);
|
|
if locHasInternalName then
|
|
FSymbols.RegisterExternalAlias(locItem,locItemName);
|
|
Inc(locOrder);
|
|
end;
|
|
|
|
var
|
|
locEnumCrs : IObjectCursor;
|
|
intrName : string;
|
|
hasIntrnName : Boolean;
|
|
begin
|
|
locEnumCrs := ExtractEnumCursor();
|
|
|
|
intrName := FTypeName;
|
|
hasIntrnName := IsReservedKeyWord(FTypeName) or
|
|
( ( FSymbols.FindElement(intrName) <> nil ) and ( not FSymbols.FindElement(intrName).InheritsFrom(TPasUnresolvedTypeRef) ) );
|
|
if hasIntrnName then
|
|
intrName := '_' + intrName;
|
|
|
|
locRes := TPasEnumType(FSymbols.CreateElement(TPasEnumType,Trim(intrName),FSymbols.CurrentModule.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
|
|
FreeAndNil(Result);
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
function TSimpleTypeParser.ParseOtherContent(): TPasType;
|
|
begin // todo : implement TSimpleTypeParser.ParseOtherContent
|
|
if IsStrEmpty(FBaseName) then
|
|
raise EWslParserException.CreateFmt('Invalid simple type definition : base type not provided, "%s".',[FTypeName]);
|
|
Result := TPasTypeAliasType(FSymbols.CreateElement(TPasTypeAliasType,FTypeName,FSymbols.CurrentModule.InterfaceSection,visDefault,'',0));
|
|
TPasTypeAliasType(Result).DestType := FSymbols.FindElement(FBaseName) 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 EWslParserException.CreateFmt('%s expected but %s found.',[s_simpleType,ExtractNameFromQName(FTypeNode.NodeName)]);
|
|
CreateNodeCursors();
|
|
ExtractTypeName();
|
|
locContinue := True;
|
|
locSym := FSymbols.FindElement(FTypeName);
|
|
if Assigned(locSym) then begin
|
|
if not locSym.InheritsFrom(TPasType) then
|
|
raise EWslParserException.CreateFmt('Symbol found in the symbol table but is not a type definition : %s.',[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';
|
|
Result := ParseOtherContent();
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
initialization
|
|
TAbstractTypeParser.RegisterParser(TSimpleTypeParser);
|
|
TAbstractTypeParser.RegisterParser(TComplexTypeParser);
|
|
|
|
finalization
|
|
FreeAndNil(FTypeParserList);
|
|
|
|
end.
|