2007-09-09 22:30:50 +00:00
|
|
|
{
|
|
|
|
This file is part of the Web Service Toolkit
|
|
|
|
Copyright (c) 2007 by Inoussa OUEDRAOGO
|
|
|
|
|
|
|
|
This file is provide under modified LGPL licence
|
|
|
|
( the files COPYING.modifiedLGPL and COPYING.LGPL).
|
|
|
|
|
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
}
|
|
|
|
{$INCLUDE wst_global.inc}
|
|
|
|
unit wsdl_parser;
|
|
|
|
|
|
|
|
interface
|
|
|
|
uses
|
|
|
|
Classes, SysUtils,
|
|
|
|
{$IFNDEF FPC}xmldom, wst_delphi_xml{$ELSE}DOM{$ENDIF},
|
|
|
|
cursor_intf, rtti_filters,
|
|
|
|
pastree, pascal_parser_intf, logger_intf, xsd_parser;
|
|
|
|
|
|
|
|
const
|
|
|
|
s_TRANSPORT = 'TRANSPORT';
|
|
|
|
s_FORMAT = 'FORMAT';
|
|
|
|
|
|
|
|
type
|
|
|
|
|
|
|
|
TWsdlSchemaParser = class(TCustomXsdSchemaParser)
|
|
|
|
end;
|
|
|
|
|
|
|
|
TParserMode = ( pmUsedTypes, pmAllTypes );
|
|
|
|
|
|
|
|
IParser = interface
|
|
|
|
['{DE9D8592-150A-4FEC-BCB8-9EDB702EC8E7}']
|
|
|
|
procedure Execute(const AMode : TParserMode; const AModuleName : string);
|
|
|
|
end;
|
|
|
|
|
2009-11-23 17:55:10 +00:00
|
|
|
{ TWsdlParser }
|
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
TWsdlParser = class(TInterfacedObject, IInterface, IParserContext, IParser)
|
|
|
|
private
|
|
|
|
FDoc : TXMLDocument;
|
|
|
|
FSymbols : TwstPasTreeContainer;
|
|
|
|
FModule : TPasModule;
|
2009-11-23 17:55:10 +00:00
|
|
|
FDocumentLocator : IDocumentLocator;
|
2007-09-09 22:30:50 +00:00
|
|
|
private
|
|
|
|
FTargetNameSpace : string;
|
|
|
|
FNameSpaceList : TStringList;
|
|
|
|
FXsdParsers : TStringList;
|
|
|
|
FWsdlShortNames : TStrings;
|
|
|
|
FSoapShortNames : TStrings;
|
|
|
|
FXSShortNames : TStrings;
|
|
|
|
FChildCursor : IObjectCursor;
|
|
|
|
FServiceCursor : IObjectCursor;
|
|
|
|
FBindingCursor : IObjectCursor;
|
|
|
|
FPortTypeCursor : IObjectCursor;
|
|
|
|
FMessageCursor : IObjectCursor;
|
|
|
|
FTypesCursor : IObjectCursor;
|
|
|
|
FSchemaCursor : IObjectCursor;
|
|
|
|
FOnMessage: TOnParserMessage;
|
2009-11-26 10:39:50 +00:00
|
|
|
FSimpleOptions : TParserOptions;
|
2011-08-29 02:59:57 +00:00
|
|
|
FIncludeList : TStringList;
|
2007-09-09 22:30:50 +00:00
|
|
|
private
|
|
|
|
procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string);
|
|
|
|
function AddNameSpace(const AValue : string) : TStrings;
|
2011-08-29 02:59:57 +00:00
|
|
|
procedure CreateIncludeList();
|
2007-09-09 22:30:50 +00:00
|
|
|
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 GetParser(const ANamespace : string) : IXsdPaser;
|
2009-09-02 12:24:19 +00:00
|
|
|
function ParseType(
|
|
|
|
const AName : string;
|
|
|
|
const AHint : string = '';
|
|
|
|
const ATypeOrElement : string = ''
|
|
|
|
) : TPasType;
|
2007-09-09 22:30:50 +00:00
|
|
|
procedure ParseTypes();
|
|
|
|
protected
|
|
|
|
function GetXsShortNames() : TStrings;
|
|
|
|
function GetSymbolTable() : TwstPasTreeContainer;
|
|
|
|
function FindNameSpace(const AShortName : string; out AResult : string) : Boolean;
|
|
|
|
function FindShortNamesForNameSpace(const ANameSpace : string) : TStrings;
|
|
|
|
function GetTargetNameSpace() : string;
|
|
|
|
function GetTargetModule() : TPasModule;
|
2009-11-23 17:55:10 +00:00
|
|
|
function GetDocumentLocator() : IDocumentLocator;
|
2011-08-29 02:59:57 +00:00
|
|
|
procedure SetDocumentLocator(ALocator : IDocumentLocator);
|
2009-11-26 10:39:50 +00:00
|
|
|
function GetSimpleOptions() : TParserOptions;
|
|
|
|
procedure SetSimpleOptions(const AValue : TParserOptions);
|
2011-08-29 02:59:57 +00:00
|
|
|
procedure AddIncludedDoc(ADocLocation : string);
|
|
|
|
function IsIncludedDoc(ADocLocation : string) : Boolean;
|
2007-09-09 22:30:50 +00:00
|
|
|
public
|
|
|
|
constructor Create(
|
|
|
|
ADoc : TXMLDocument;
|
|
|
|
ASymbols : TwstPasTreeContainer;
|
|
|
|
const ANotifier : TOnParserMessage = nil
|
|
|
|
);
|
|
|
|
destructor Destroy();override;
|
|
|
|
procedure Execute(const AMode : TParserMode; const AModuleName : string);
|
|
|
|
property SymbolTable : TwstPasTreeContainer read FSymbols;
|
|
|
|
|
|
|
|
property OnMessage : TOnParserMessage read FOnMessage write FOnMessage;
|
|
|
|
end;
|
|
|
|
|
|
|
|
implementation
|
2009-06-30 16:34:57 +00:00
|
|
|
uses
|
|
|
|
ws_parser_imp, dom_cursors, parserutils, StrUtils, xsd_consts, TypInfo;
|
2007-09-09 22:30:50 +00:00
|
|
|
|
|
|
|
|
|
|
|
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;
|
|
|
|
|
|
|
|
{ TWsdlParser }
|
|
|
|
|
|
|
|
function TWsdlParser.AddNameSpace(const AValue: string): TStrings;
|
|
|
|
var
|
|
|
|
i : PtrInt;
|
|
|
|
s : string;
|
|
|
|
ls : TStringList;
|
|
|
|
begin
|
|
|
|
s := AValue;//Trim(AValue);
|
|
|
|
i := FNameSpaceList.IndexOf(s);
|
|
|
|
if ( i < 0 ) then begin
|
|
|
|
ls := TStringList.Create();
|
|
|
|
FNameSpaceList.AddObject(s,ls);
|
|
|
|
ls.Duplicates := dupIgnore;
|
|
|
|
ls.Sorted := True;
|
|
|
|
Result := ls;
|
|
|
|
end else begin
|
|
|
|
Result := FNameSpaceList.Objects[i] as TStrings;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2011-08-29 02:59:57 +00:00
|
|
|
procedure TWsdlParser.CreateIncludeList();
|
|
|
|
begin
|
|
|
|
if (FIncludeList = nil) then begin
|
|
|
|
FIncludeList := TStringList.Create();
|
|
|
|
FIncludeList.Duplicates := dupIgnore;
|
|
|
|
FIncludeList.Sorted := True;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
constructor TWsdlParser.Create(
|
|
|
|
ADoc : TXMLDocument;
|
|
|
|
ASymbols : TwstPasTreeContainer;
|
|
|
|
const ANotifier : TOnParserMessage
|
|
|
|
);
|
|
|
|
begin
|
|
|
|
Assert(Assigned(ADoc));
|
|
|
|
Assert(Assigned(ASymbols));
|
|
|
|
inherited Create();
|
|
|
|
FDoc := ADoc;
|
|
|
|
if Assigned(ANotifier) then
|
|
|
|
FOnMessage := ANotifier;
|
|
|
|
|
|
|
|
FNameSpaceList := TStringList.Create();
|
|
|
|
FNameSpaceList.Duplicates := dupIgnore;
|
|
|
|
FNameSpaceList.Sorted := True;
|
|
|
|
|
|
|
|
FXsdParsers := TStringList.Create();
|
|
|
|
FXsdParsers.Duplicates := dupIgnore;
|
|
|
|
FXsdParsers.Sorted := True;
|
|
|
|
|
|
|
|
FSymbols := ASymbols;
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TWsdlParser.CreateWsdlNameFilter(const AName: WideString): IObjectFilter;
|
|
|
|
begin
|
|
|
|
Result := ParseFilter(CreateQualifiedNameFilterStr(AName,FWsdlShortNames),TDOMNodeRttiExposer);
|
|
|
|
end;
|
|
|
|
|
|
|
|
destructor TWsdlParser.Destroy();
|
|
|
|
|
|
|
|
procedure FreeList(AList : TStrings);
|
|
|
|
var
|
|
|
|
j : PtrInt;
|
|
|
|
begin
|
2011-11-15 19:11:17 +00:00
|
|
|
if Assigned(AList) and (AList.Count > 0) then begin
|
|
|
|
for j := Pred(AList.Count) downto 0 do begin
|
2007-09-09 22:30:50 +00:00
|
|
|
AList.Objects[j].Free();
|
|
|
|
AList.Objects[j] := nil;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
FreeAndNil(AList);
|
|
|
|
end;
|
|
|
|
|
|
|
|
begin
|
2011-08-29 02:59:57 +00:00
|
|
|
FreeAndNil(FIncludeList);
|
2007-09-09 22:30:50 +00:00
|
|
|
FreeList(FXsdParsers);
|
|
|
|
FreeList(FNameSpaceList);
|
|
|
|
inherited;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TWsdlParser.DoOnMessage(const AMsgType: TMessageType; const AMsg: string);
|
|
|
|
begin
|
|
|
|
if Assigned(FOnMessage) then begin
|
|
|
|
FOnMessage(AMsgType,AMsg);
|
|
|
|
end else if IsConsole then begin
|
2008-10-09 16:35:03 +00:00
|
|
|
if HasLogger() then
|
|
|
|
GetLogger().Log(AMsgType, AMsg);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
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;
|
|
|
|
|
|
|
|
function TWsdlParser.FindNameSpace(const AShortName: string; out AResult: string): Boolean;
|
|
|
|
var
|
|
|
|
i : PtrInt;
|
|
|
|
ls : TStrings;
|
|
|
|
begin
|
|
|
|
AResult := '';
|
|
|
|
Result := False;
|
|
|
|
for i := 0 to Pred(FNameSpaceList.Count) do begin
|
|
|
|
ls := FNameSpaceList.Objects[i] as TStrings;
|
|
|
|
if ( ls.IndexOf(AShortName) >= 0 ) then begin
|
|
|
|
AResult := FNameSpaceList[i];
|
|
|
|
Result := True;
|
|
|
|
Break;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TWsdlParser.FindShortNamesForNameSpace(const ANameSpace: string): TStrings;
|
|
|
|
var
|
|
|
|
i : PtrInt;
|
|
|
|
begin
|
|
|
|
i := FNameSpaceList.IndexOf(ANameSpace);
|
|
|
|
if ( i >= 0 ) then
|
|
|
|
Result := FNameSpaceList.Objects[i] as TStrings
|
|
|
|
else
|
|
|
|
Result := nil;
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TWsdlParser.GetSymbolTable() : TwstPasTreeContainer;
|
|
|
|
begin
|
|
|
|
Result := FSymbols;
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TWsdlParser.GetTargetModule() : TPasModule;
|
|
|
|
begin
|
|
|
|
Result := FModule;
|
|
|
|
end;
|
|
|
|
|
2009-11-23 17:55:10 +00:00
|
|
|
function TWsdlParser.GetDocumentLocator(): IDocumentLocator;
|
|
|
|
begin
|
|
|
|
Result := FDocumentLocator;
|
|
|
|
end;
|
|
|
|
|
2011-08-29 02:59:57 +00:00
|
|
|
procedure TWsdlParser.SetDocumentLocator(ALocator: IDocumentLocator);
|
2009-11-23 17:55:10 +00:00
|
|
|
begin
|
|
|
|
FDocumentLocator := ALocator;
|
|
|
|
end;
|
|
|
|
|
2009-11-26 10:39:50 +00:00
|
|
|
function TWsdlParser.GetSimpleOptions(): TParserOptions;
|
|
|
|
begin
|
|
|
|
Result := FSimpleOptions;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TWsdlParser.SetSimpleOptions(const AValue: TParserOptions);
|
|
|
|
begin
|
|
|
|
if ( AValue <> FSimpleOptions ) then
|
|
|
|
FSimpleOptions := AValue;
|
|
|
|
end;
|
|
|
|
|
2011-08-29 02:59:57 +00:00
|
|
|
procedure TWsdlParser.AddIncludedDoc(ADocLocation : string);
|
|
|
|
begin
|
|
|
|
if (FIncludeList = nil) then
|
|
|
|
CreateIncludeList();
|
|
|
|
FIncludeList.Add(ADocLocation);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TWsdlParser.IsIncludedDoc(ADocLocation : string) : Boolean;
|
|
|
|
begin
|
|
|
|
Result := (FIncludeList <> nil) and (FIncludeList.IndexOf(ADocLocation) <> -1);
|
|
|
|
end;
|
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
function TWsdlParser.GetTargetNameSpace() : string;
|
|
|
|
begin
|
|
|
|
Result := FTargetNameSpace;
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TWsdlParser.GetXsShortNames() : TStrings;
|
|
|
|
begin
|
|
|
|
Result := FXSShortNames;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TWsdlParser.Execute(const AMode: TParserMode; const AModuleName: string);
|
|
|
|
|
|
|
|
procedure ParseForwardDeclarations();
|
|
|
|
var
|
|
|
|
i, c : Integer;
|
|
|
|
sym, symNew : TPasElement;
|
|
|
|
typeCursor : IObjectCursor;
|
|
|
|
schmNode, tmpNode : TDOMNode;
|
|
|
|
s : string;
|
|
|
|
typeList : TList;
|
2009-09-02 12:24:19 +00:00
|
|
|
locXsdParser : IXsdPaser;
|
2007-09-09 22:30:50 +00:00
|
|
|
begin
|
|
|
|
if Assigned(FSchemaCursor) then begin
|
|
|
|
FSchemaCursor.Reset();
|
|
|
|
if FSchemaCursor.MoveNext() then begin
|
|
|
|
schmNode := (FSchemaCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
|
|
if schmNode.HasChildNodes() then begin
|
|
|
|
typeCursor := CreateChildrenCursor(schmNode,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));
|
2009-09-02 12:24:19 +00:00
|
|
|
locXsdParser := GetParser(schmNode.Attributes.GetNamedItem(s_targetNamespace).NodeValue);
|
|
|
|
symNew := locXsdParser.ParseType(FSymbols.GetExternalName(sym),tmpNode);
|
2007-09-09 22:30:50 +00:00
|
|
|
//symNew := ParseType(tmpNode.Attributes.GetNamedItem(s_name).NodeValue);
|
|
|
|
if ( sym <> symNew ) then begin
|
|
|
|
FModule.InterfaceSection.Declarations.Extract(sym);
|
|
|
|
FModule.InterfaceSection.Types.Extract(sym);
|
|
|
|
symNew.Name := sym.Name;
|
2008-12-17 21:29:09 +00:00
|
|
|
DoOnMessage(mtInfo,Format('forward type paring %s.',[symNew.Name]));
|
2007-09-09 22:30:50 +00:00
|
|
|
//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;
|
|
|
|
|
2011-08-29 02:59:57 +00:00
|
|
|
procedure FixUsesList();
|
|
|
|
var
|
|
|
|
locPrs : IParserContext;
|
|
|
|
k : PtrInt;
|
|
|
|
locModule : TPasModule;
|
|
|
|
locIntfUsesList : TList;
|
|
|
|
begin
|
|
|
|
locIntfUsesList := FModule.InterfaceSection.UsesList;
|
|
|
|
for k := 0 to Pred(FXsdParsers.Count) do begin
|
|
|
|
locPrs := (FXsdParsers.Objects[k] as TIntfObjectRef).Intf as IParserContext;
|
|
|
|
locModule := locPrs.GetTargetModule();
|
|
|
|
if (locModule <> nil) and (locModule <> FModule) and
|
|
|
|
(locIntfUsesList.IndexOf(locModule) = -1)
|
|
|
|
then begin
|
|
|
|
locModule.AddRef();
|
|
|
|
locIntfUsesList.Add(locModule);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
var
|
|
|
|
locSrvcCrs : IObjectCursor;
|
|
|
|
locObj : TDOMNodeRttiExposer;
|
2011-09-16 00:56:48 +00:00
|
|
|
locOldNameKinds : TElementNameKinds;
|
2007-09-09 22:30:50 +00:00
|
|
|
begin
|
2011-09-16 00:56:48 +00:00
|
|
|
locOldNameKinds := FSymbols.DefaultSearchNameKinds;
|
|
|
|
FSymbols.DefaultSearchNameKinds := [elkDeclaredName];
|
|
|
|
try
|
|
|
|
Prepare(AModuleName);
|
|
|
|
|
|
|
|
locSrvcCrs := FServiceCursor.Clone() as IObjectCursor;
|
|
|
|
locSrvcCrs.Reset();
|
|
|
|
while locSrvcCrs.MoveNext() do begin
|
|
|
|
locObj := locSrvcCrs.GetCurrent() as TDOMNodeRttiExposer;
|
|
|
|
ParseService(locObj.InnerObject);
|
|
|
|
end;
|
2007-09-09 22:30:50 +00:00
|
|
|
|
2011-09-16 00:56:48 +00:00
|
|
|
if ( AMode = pmAllTypes ) then begin
|
|
|
|
ParseTypes();
|
|
|
|
end;
|
2007-09-09 22:30:50 +00:00
|
|
|
|
2011-09-16 00:56:48 +00:00
|
|
|
ParseForwardDeclarations();
|
|
|
|
SymbolTable.SetCurrentModule(FModule);
|
|
|
|
ExtractNameSpace();
|
|
|
|
FixUsesList();
|
|
|
|
finally
|
|
|
|
FSymbols.DefaultSearchNameKinds := locOldNameKinds;
|
2007-09-09 22:30:50 +00:00
|
|
|
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;
|
2009-04-06 22:25:04 +00:00
|
|
|
|
|
|
|
function ExtractTypeHint(AElement : TDOMNode) : string;
|
|
|
|
begin
|
|
|
|
if not wst_findCustomAttributeXsd(FXSShortNames,AElement,s_WST_typeHint,Result) then
|
|
|
|
Result := '';
|
|
|
|
end;
|
2007-09-09 22:30:50 +00:00
|
|
|
|
2009-04-06 22:25:04 +00:00
|
|
|
function GetDataType(const AName, ATypeOrElement : string; const ATypeHint : string = ''):TPasType;
|
2007-09-09 22:30:50 +00:00
|
|
|
begin
|
|
|
|
try
|
2009-09-02 12:24:19 +00:00
|
|
|
Result := ParseType(AName,ATypeHint,ATypeOrElement);
|
2007-09-09 22:30:50 +00:00
|
|
|
except
|
|
|
|
on e : Exception do begin
|
|
|
|
DoOnMessage(mtError, e.Message + ' ' + AName + ' ' + ATypeOrElement);
|
|
|
|
raise;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2009-06-30 16:34:57 +00:00
|
|
|
procedure ParseParamAccess(AMessageNode : TDOMNode; AAccessList : TStrings);
|
|
|
|
var
|
|
|
|
nd : TDOMNode;
|
|
|
|
tmpCrs : IObjectCursor;
|
|
|
|
strBuffer, strToken : string;
|
|
|
|
begin
|
|
|
|
AAccessList.Clear();
|
|
|
|
tmpCrs := CreateCursorOn(
|
|
|
|
CreateChildrenCursor(AMessageNode,cetRttiNode),
|
|
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_documentation,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_paramAccess)]),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
|
|
|
|
strBuffer := Trim(nd.NodeValue);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
if ( Length(strBuffer) > 0 ) then begin
|
|
|
|
while True do begin
|
|
|
|
strToken := Trim(GetToken(strBuffer,';'));
|
|
|
|
if ( Length(strToken) = 0 ) then
|
|
|
|
Break;
|
|
|
|
if ( Pos('=',strToken) < 1 ) then
|
|
|
|
Break;
|
|
|
|
AAccessList.Add(strToken);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
procedure ExtractMethod(
|
|
|
|
const AMthdName : string;
|
|
|
|
out AMthd : TPasProcedure
|
|
|
|
);
|
|
|
|
var
|
|
|
|
tmpMthd : TPasProcedure;
|
|
|
|
tmpMthdType : TPasProcedureType;
|
2009-06-30 16:34:57 +00:00
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
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;
|
2009-06-30 16:34:57 +00:00
|
|
|
prmAccess : TStringList;
|
|
|
|
intBuffer : Integer;
|
2007-09-09 22:30:50 +00:00
|
|
|
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();
|
2009-06-30 16:34:57 +00:00
|
|
|
prmAccess := TStringList.Create();
|
|
|
|
try
|
|
|
|
ParseParamAccess(inMsgNode,prmAccess);
|
|
|
|
while crs.MoveNext() do begin
|
|
|
|
tmpNode := TDOMNodeRttiExposer(crs.GetCurrent()).InnerObject;
|
|
|
|
if ( tmpNode.Attributes = nil ) or ( tmpNode.Attributes.Length < 1 ) then begin
|
|
|
|
raise EXsdInvalidDefinitionException.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 EXsdInvalidDefinitionException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
|
|
|
|
end;
|
|
|
|
prmName := TDOMNodeRttiExposer(tmpCrs.GetCurrent()).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 EXsdInvalidDefinitionException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
|
|
|
|
end;
|
|
|
|
prmTypeName := TDOMNodeRttiExposer(tmpCrs.GetCurrent()).NodeValue;
|
|
|
|
prmTypeType := TDOMNodeRttiExposer(tmpCrs.GetCurrent()).NodeName;
|
|
|
|
if IsStrEmpty(prmName) or IsStrEmpty(prmTypeName) or IsStrEmpty(prmTypeType) then begin
|
|
|
|
raise EXsdInvalidDefinitionException.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);
|
2009-09-02 12:24:19 +00:00
|
|
|
if AnsiSameText(prmInternameName,tmpMthd.Name) or
|
|
|
|
AnsiSameText(prmInternameName,ExtractNameFromQName(prmTypeName))
|
|
|
|
then begin
|
2009-06-30 16:34:57 +00:00
|
|
|
prmInternameName := prmInternameName + 'Param';
|
|
|
|
end;
|
2010-10-01 20:44:10 +00:00
|
|
|
prmInternameName := ExtractIdentifier(prmInternameName);
|
2009-06-30 16:34:57 +00:00
|
|
|
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,ExtractTypeHint(tmpNode));
|
|
|
|
prmDef := TPasArgument(SymbolTable.CreateElement(TPasArgument,prmInternameName,tmpMthdType,visDefault,'',0));
|
|
|
|
tmpMthdType.Args.Add(prmDef);
|
|
|
|
prmDef.ArgType := prmTypeDef;
|
|
|
|
prmTypeDef.AddRef();
|
|
|
|
prmDef.Access := argConst;
|
|
|
|
strBuffer := Trim(prmAccess.Values[prmName]);
|
|
|
|
if ( Length(strBuffer) > 0 ) then begin
|
|
|
|
intBuffer := GetEnumValue(TypeInfo(TArgumentAccess),strBuffer);
|
|
|
|
if ( intBuffer > -1 ) then
|
|
|
|
prmDef.Access := TArgumentAccess(intBuffer);
|
|
|
|
end;
|
|
|
|
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;
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
end;
|
2009-06-30 16:34:57 +00:00
|
|
|
finally
|
|
|
|
prmAccess.Free();
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure ParseOutputMessage();
|
2008-09-10 01:46:45 +00:00
|
|
|
|
|
|
|
function FindIndexOfResultArg(AArgList : TList) : PtrInt;
|
|
|
|
const RESULT_ARG_NAMES : array[0..5] of string = ( 'result', 'return', '_result', 'result_', '_return', 'return_' );
|
|
|
|
var
|
|
|
|
p, q : PtrInt;
|
|
|
|
idx_found : Boolean;
|
|
|
|
resItemName : string;
|
|
|
|
arg : TPasArgument;
|
|
|
|
begin
|
|
|
|
Result := -1;
|
|
|
|
idx_found := False;
|
|
|
|
p := Low(RESULT_ARG_NAMES);
|
|
|
|
while ( not idx_found ) and ( p <= High(RESULT_ARG_NAMES) ) do begin
|
|
|
|
resItemName := RESULT_ARG_NAMES[p];
|
|
|
|
for q := 0 to Pred(AArgList.Count) do begin
|
|
|
|
arg := TPasArgument(AArgList[q]);
|
|
|
|
if ( arg.Access = argOut ) and ( LowerCase(arg.Name) = resItemName ) then begin
|
|
|
|
idx_found := True;
|
|
|
|
Break;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
Inc(p);
|
|
|
|
end;
|
|
|
|
if idx_found then
|
|
|
|
Result := q
|
|
|
|
else
|
|
|
|
Result := AArgList.Count - 1;
|
|
|
|
end;
|
|
|
|
|
2007-09-09 22:30:50 +00:00
|
|
|
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;
|
2008-09-10 01:46:45 +00:00
|
|
|
j : PtrInt;
|
2007-09-09 22:30:50 +00:00
|
|
|
arg_a, arg_b : TPasArgument;
|
2008-09-10 01:46:45 +00:00
|
|
|
resArgIndex : PtrInt;
|
2009-05-15 19:01:13 +00:00
|
|
|
prmNameColisionWithInputParam : Boolean;
|
|
|
|
prmTypeEntity : TPasType;
|
2007-09-09 22:30:50 +00:00
|
|
|
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
|
2009-04-06 22:25:04 +00:00
|
|
|
tmpNode := TDOMNodeRttiExposer(crs.GetCurrent()).InnerObject;
|
2007-09-09 22:30:50 +00:00
|
|
|
if ( tmpNode.Attributes = nil ) or ( tmpNode.Attributes.Length < 1 ) then
|
|
|
|
raise EXsdInvalidDefinitionException.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 EXsdInvalidDefinitionException.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 EXsdInvalidDefinitionException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
|
2009-04-06 22:25:04 +00:00
|
|
|
prmTypeName := TDOMNodeRttiExposer(tmpCrs.GetCurrent()).NodeValue;
|
|
|
|
prmTypeType := TDOMNodeRttiExposer(tmpCrs.GetCurrent()).NodeName;
|
2007-09-09 22:30:50 +00:00
|
|
|
if IsStrEmpty(prmName) or IsStrEmpty(prmTypeName) or IsStrEmpty(prmTypeType) then
|
|
|
|
raise EXsdInvalidDefinitionException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
|
|
|
|
if SameText(s_document,ASoapBindingStyle) and
|
|
|
|
AnsiSameText(prmTypeType,s_element)
|
|
|
|
then begin
|
|
|
|
prmName := ExtractNameFromQName(prmTypeName);
|
|
|
|
end;
|
2010-10-11 12:28:07 +00:00
|
|
|
prmInternameName := Trim(prmName);
|
|
|
|
if AnsiSameText(prmInternameName,tmpMthd.Name) or
|
|
|
|
AnsiSameText(prmInternameName,ExtractNameFromQName(prmTypeName))
|
|
|
|
then begin
|
2007-09-09 22:30:50 +00:00
|
|
|
prmInternameName := prmInternameName + 'Param';
|
2010-10-11 12:28:07 +00:00
|
|
|
end;
|
|
|
|
|
2010-10-01 20:44:10 +00:00
|
|
|
prmInternameName := ExtractIdentifier(prmInternameName);
|
2007-09-09 22:30:50 +00:00
|
|
|
prmHasInternameName := IsReservedKeyWord(prmInternameName) or
|
2009-05-15 19:01:13 +00:00
|
|
|
( not IsValidIdent(prmInternameName) );
|
2007-09-09 22:30:50 +00:00
|
|
|
if prmHasInternameName then
|
|
|
|
prmInternameName := '_' + prmInternameName;
|
2009-05-15 19:01:13 +00:00
|
|
|
prmNameColisionWithInputParam := ( GetParameterIndex(tmpMthdType,prmInternameName) >= 0 );
|
|
|
|
prmTypeEntity := GetDataType(prmTypeName,prmTypeType,ExtractTypeHint(tmpNode));
|
2007-09-09 22:30:50 +00:00
|
|
|
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);
|
2009-05-15 19:01:13 +00:00
|
|
|
prmDef.ArgType := prmTypeEntity;
|
2007-09-09 22:30:50 +00:00
|
|
|
prmDef.ArgType.AddRef();
|
|
|
|
prmDef.Access := argOut;
|
|
|
|
if prmHasInternameName then begin
|
|
|
|
SymbolTable.RegisterExternalAlias(prmDef,prmName);
|
|
|
|
end;
|
|
|
|
end else begin
|
2009-05-15 19:01:13 +00:00
|
|
|
if prmNameColisionWithInputParam and ( prmDef.ArgType = prmTypeEntity ) then begin
|
2007-09-09 22:30:50 +00:00
|
|
|
prmDef.Access := argVar;
|
|
|
|
end else begin
|
|
|
|
prmInternameName := '_' + prmInternameName;
|
|
|
|
prmDef := TPasArgument(SymbolTable.CreateElement(TPasArgument,prmInternameName,tmpMthdType,visDefault,'',0));
|
2009-05-15 19:01:13 +00:00
|
|
|
prmDef.ArgType := prmTypeEntity;
|
2007-09-09 22:30:50 +00:00
|
|
|
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;
|
2008-09-10 01:46:45 +00:00
|
|
|
resArgIndex := FindIndexOfResultArg(locProcType.Args);
|
|
|
|
for j := 0 to ( locProcType.Args.Count - 1 ) do begin
|
|
|
|
if ( j <> resArgIndex ) then 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;
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
2008-09-10 01:46:45 +00:00
|
|
|
j := resArgIndex;
|
2007-09-09 22:30:50 +00:00
|
|
|
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
|
|
|
|
locMthd := nil;
|
|
|
|
if not ExtractOperationName(mthdName) then
|
|
|
|
raise EXsdParserAssertException.CreateFmt('Operation Attribute not found : "%s"',[s_name]);
|
2009-11-26 10:39:50 +00:00
|
|
|
DoOnMessage(mtInfo,Format('Parsing operation "%s"',[mthdName]));
|
2007-09-09 22:30:50 +00:00
|
|
|
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;
|
|
|
|
|
|
|
|
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);
|
2009-11-09 09:58:51 +00:00
|
|
|
if ( SymbolTable.FindBinding(bindingName) = nil ) then begin
|
|
|
|
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;
|
|
|
|
if IsStrEmpty(locSoapBindingStyle) then
|
|
|
|
locSoapBindingStyle := s_document;
|
|
|
|
intfDef := ParsePortType(typeNode,bindingNode,locSoapBindingStyle);
|
|
|
|
bdng := SymbolTable.AddBinding(bindingName,intfDef);
|
|
|
|
bdng.Address := ExtractAddress();
|
|
|
|
bdng.BindingStyle := StrToBindingStyle(locSoapBindingStyle);
|
|
|
|
end;
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
2009-11-09 09:58:51 +00:00
|
|
|
end;
|
2007-09-09 22:30:50 +00:00
|
|
|
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();
|
2010-07-01 22:30:37 +00:00
|
|
|
while tmpCrs.MoveNext() do begin
|
2007-09-09 22:30:50 +00:00
|
|
|
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),
|
2009-06-30 16:34:57 +00:00
|
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_documentation,FWsdlShortNames),TDOMNodeRttiExposer)
|
2007-09-09 22:30:50 +00:00
|
|
|
);
|
|
|
|
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
|
|
|
|
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 EXsdParserAssertException.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
|
2009-11-26 10:39:50 +00:00
|
|
|
DoOnMessage(mtInfo,Format('Parsing the port type "%s"',[ansiStrBuffer]));
|
2007-09-09 22:30:50 +00:00
|
|
|
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 EXsdInvalidDefinitionException.CreateFmt('Invalid element definition : "%s".',[elt.Name]);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
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;
|
|
|
|
|
2009-09-02 12:24:19 +00:00
|
|
|
function TWsdlParser.ParseType(
|
|
|
|
const AName : string;
|
|
|
|
const AHint : string;
|
|
|
|
const ATypeOrElement : string
|
|
|
|
) : TPasType;
|
2007-09-09 22:30:50 +00:00
|
|
|
var
|
|
|
|
localName, spaceShort, spaceLong : string;
|
|
|
|
locPrs : IXsdPaser;
|
|
|
|
xsdModule : TPasModule;
|
2009-09-02 12:24:19 +00:00
|
|
|
locTypeKind : string;
|
2007-09-09 22:30:50 +00:00
|
|
|
begin
|
|
|
|
ExplodeQName(AName,localName,spaceShort);
|
|
|
|
if ( FXSShortNames.IndexOf(spaceShort) >= 0 ) then begin
|
|
|
|
xsdModule := SymbolTable.FindModule(s_xs);
|
2009-04-06 22:25:04 +00:00
|
|
|
Result := nil;
|
|
|
|
if not IsStrEmpty(AHint) then
|
|
|
|
Result := SymbolTable.FindElementInModule(AHint,xsdModule,[elkName]) as TPasType;
|
|
|
|
if ( Result = nil ) then
|
|
|
|
Result := SymbolTable.FindElementInModule(localName,xsdModule) as TPasType;
|
2007-09-09 22:30:50 +00:00
|
|
|
if ( Result = nil ) then
|
|
|
|
raise EXsdTypeNotFoundException.CreateFmt('Type not found : "%s".',[AName]);
|
|
|
|
end else begin
|
|
|
|
if not FindNameSpace(spaceShort,spaceLong) then
|
|
|
|
raise EXsdParserAssertException.CreateFmt('Unable to resolve the namespace : "%s".',[spaceShort]);
|
|
|
|
locPrs := GetParser(spaceLong);
|
2009-09-02 12:24:19 +00:00
|
|
|
if ( ATypeOrElement = s_element ) then
|
|
|
|
locTypeKind := s_element
|
|
|
|
else
|
|
|
|
locTypeKind := '';
|
|
|
|
Result := locPrs.ParseType(AName,locTypeKind);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TWsdlParser.ParseTypes();
|
|
|
|
var
|
|
|
|
locPrs : IXsdPaser;
|
|
|
|
i : PtrInt;
|
|
|
|
begin
|
|
|
|
for i := 0 to Pred(FXsdParsers.Count) do begin
|
|
|
|
locPrs := (FXsdParsers.Objects[i] as TIntfObjectRef).Intf as IXsdPaser;
|
|
|
|
locPrs.ParseTypes();
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TWsdlParser.Prepare(const AModuleName: string);
|
|
|
|
|
|
|
|
function ExtractTargetNameSpace(ANode : TDOMNode) : string;
|
|
|
|
var
|
|
|
|
locDomObj : TDOMNode;
|
|
|
|
begin
|
|
|
|
locDomObj := ANode;
|
|
|
|
if ( locDomObj.Attributes = nil ) then
|
|
|
|
raise EXsdParserAssertException.Create('Invalid document.');
|
|
|
|
locDomObj := locDomObj.Attributes.GetNamedItem(s_targetNamespace);
|
|
|
|
if Assigned(locDomObj) then
|
|
|
|
Result := locDomObj.NodeValue;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure CreateXsdParsers();
|
|
|
|
var
|
|
|
|
locDomObj : TDOMNode;
|
|
|
|
locPrs : IXsdPaser;
|
2009-11-23 17:55:10 +00:00
|
|
|
locPrsCtx : IParserContext;
|
2007-09-09 22:30:50 +00:00
|
|
|
ns : string;
|
2009-11-23 17:55:10 +00:00
|
|
|
locDocLocator : IDocumentLocator;
|
2007-09-09 22:30:50 +00:00
|
|
|
begin
|
|
|
|
if Assigned(FSchemaCursor) then begin
|
2009-11-23 17:55:10 +00:00
|
|
|
locDocLocator := GetDocumentLocator();
|
2007-09-09 22:30:50 +00:00
|
|
|
FSchemaCursor.Reset();
|
|
|
|
while FSchemaCursor.MoveNext() do begin
|
|
|
|
locDomObj := (FSchemaCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
|
|
|
|
locPrs := TWsdlSchemaParser.Create(FDoc,locDomObj,FSymbols,Self);
|
|
|
|
locPrs.SetNotifier(FOnMessage);
|
2009-11-23 17:55:10 +00:00
|
|
|
locPrsCtx := locPrs as IParserContext;
|
|
|
|
locPrsCtx.SetDocumentLocator(locDocLocator);
|
2009-11-26 10:39:50 +00:00
|
|
|
locPrsCtx.SetSimpleOptions(Self.GetSimpleOptions());
|
2007-09-09 22:30:50 +00:00
|
|
|
ns := (locPrs as IParserContext).GetTargetNameSpace();
|
|
|
|
FXsdParsers.AddObject(ns,TIntfObjectRef.Create(locPrs));
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
locAttCursor : IObjectCursor;
|
|
|
|
locObj : TDOMNodeRttiExposer;
|
|
|
|
begin
|
|
|
|
locAttCursor := CreateAttributesCursor(FDoc.DocumentElement,cetRttiNode);
|
|
|
|
FChildCursor := CreateChildrenCursor(FDoc.DocumentElement,cetRttiNode);
|
|
|
|
|
|
|
|
FTargetNameSpace := ExtractTargetNameSpace(FDoc.DocumentElement);
|
|
|
|
CreateWstInterfaceSymbolTable(SymbolTable);
|
|
|
|
|
|
|
|
FModule := TPasModule(SymbolTable.CreateElement(TPasModule,AModuleName,SymbolTable.Package,visDefault,'',0));
|
|
|
|
SymbolTable.Package.Modules.Add(FModule);
|
|
|
|
SymbolTable.RegisterExternalAlias(FModule,FTargetNameSpace);
|
2010-02-27 16:17:21 +00:00
|
|
|
FModule.InterfaceSection := TInterfaceSection(SymbolTable.CreateElement(TInterfaceSection,'',FModule,visDefault,'',0));
|
2007-09-09 22:30:50 +00:00
|
|
|
|
|
|
|
FPortTypeCursor := nil;
|
|
|
|
|
|
|
|
FWsdlShortNames := AddNameSpace(s_wsdl);
|
|
|
|
ExtractNameSpaceShortNames(locAttCursor,FWsdlShortNames,s_wsdl,nfaRaiseException,True,EXsdParserException);
|
|
|
|
FSoapShortNames := AddNameSpace(s_soap);
|
|
|
|
ExtractNameSpaceShortNames(locAttCursor,FSoapShortNames,s_soap,nfaRaiseException,False,EXsdParserException);
|
|
|
|
FXSShortNames := AddNameSpace(s_xs);
|
|
|
|
ExtractNameSpaceShortNames(locAttCursor,FXSShortNames,s_xs,nfaNone,True,EXsdParserException);
|
|
|
|
|
|
|
|
BuildNameSpaceList(locAttCursor,FNameSpaceList);
|
|
|
|
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,
|
2008-10-17 20:31:55 +00:00
|
|
|
TAggregatedFilter.Create(
|
|
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_schema,FXSShortNames),TDOMNodeRttiExposer),
|
|
|
|
TQualifiedNameObjectFilter.Create(s_schema,s_xs),
|
|
|
|
fcOr
|
|
|
|
)
|
2007-09-09 22:30:50 +00:00
|
|
|
);
|
2008-10-17 20:31:55 +00:00
|
|
|
{ FSchemaCursor := CreateCursorOn(
|
|
|
|
FSchemaCursor,
|
|
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_schema,FXSShortNames),TDOMNodeRttiExposer)
|
|
|
|
);}
|
2007-09-09 22:30:50 +00:00
|
|
|
FSchemaCursor.Reset();
|
2008-09-21 16:59:30 +00:00
|
|
|
if FSchemaCursor.MoveNext() then begin
|
|
|
|
FSchemaCursor.Reset();
|
|
|
|
end else begin
|
|
|
|
FSchemaCursor := CreateCursorOn(
|
|
|
|
CreateChildrenCursor(locObj.InnerObject,cetRttiNode),
|
|
|
|
ParseFilter(Format('%s=%s',[s_NODE_NAME,QuotedStr(s_schema)]),TDOMNodeRttiExposer)
|
|
|
|
);
|
|
|
|
FSchemaCursor.Reset();
|
|
|
|
end;
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
FMessageCursor := CreateCursorOn(
|
|
|
|
FChildCursor.Clone() as IObjectCursor,
|
|
|
|
ParseFilter(CreateQualifiedNameFilterStr(s_message,FWsdlShortNames),TDOMNodeRttiExposer)
|
|
|
|
);
|
|
|
|
FMessageCursor.Reset();
|
|
|
|
CreateXsdParsers();
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TWsdlParser.GetParser(const ANamespace: string): IXsdPaser;
|
|
|
|
var
|
|
|
|
i : PtrInt;
|
2010-10-11 12:28:07 +00:00
|
|
|
p, p1 : IXsdPaser;
|
2007-09-09 22:30:50 +00:00
|
|
|
begin
|
2010-10-11 12:28:07 +00:00
|
|
|
Result := nil;
|
|
|
|
i := FXsdParsers.IndexOf(ANamespace);
|
|
|
|
if ( i >= 0 ) then begin
|
|
|
|
Result := (FXsdParsers.Objects[i] as TIntfObjectRef).Intf as IXsdPaser;
|
|
|
|
end else begin
|
|
|
|
for i := 0 to Pred(FXsdParsers.Count) do begin
|
|
|
|
p := (FXsdParsers.Objects[i] as TIntfObjectRef).Intf as IXsdPaser;
|
|
|
|
p1 := p.FindParser(ANamespace);
|
|
|
|
if (p1 <> nil) then begin
|
|
|
|
Result := p1;
|
|
|
|
Break;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
if (Result = nil) then
|
2008-09-21 16:59:30 +00:00
|
|
|
raise EXsdParserAssertException.CreateFmt('Unable to find the parser, namespace : "%s".',[ANamespace]);
|
2007-09-09 22:30:50 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
end.
|