parameter access qualifiers in WSDL parsing and generation.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@884 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
parent
8cb6651cbe
commit
207e8f389b
@ -49,6 +49,7 @@ type
|
||||
|
||||
function IsStrEmpty(Const AStr : String):Boolean;
|
||||
function ExtractIdentifier(const AValue : string) : string ;
|
||||
function GetToken(var ABuffer : string; const ADelimiter : string) : string;
|
||||
{$IFDEF WST_HANDLE_DOC}
|
||||
function EncodeLineBreak(const AInStr : string) : string;
|
||||
function DecodeLineBreak(const AInStr : string) : string;
|
||||
@ -149,6 +150,33 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetToken(
|
||||
var ABuffer : string;
|
||||
const ADelimiter : string
|
||||
) : string;
|
||||
var
|
||||
locDelPos, locDelLength : Integer;
|
||||
begin
|
||||
Result := '';
|
||||
if IsStrEmpty(ABuffer) then begin
|
||||
ABuffer := '';
|
||||
end else begin
|
||||
locDelPos := Pos(ADelimiter,ABuffer);
|
||||
if ( locDelPos < 1 ) then begin
|
||||
Result := ABuffer;
|
||||
ABuffer := '';
|
||||
end else begin
|
||||
locDelLength := Length(ADelimiter);
|
||||
if ( locDelPos = 1 ) then begin
|
||||
ABuffer := Copy(ABuffer,(locDelLength + 1),(Length(ABuffer) - locDelLength));
|
||||
end else begin
|
||||
Result := Copy(ABuffer,1,(locDelPos - 1));
|
||||
ABuffer := Copy(ABuffer,(locDelPos + locDelLength),(Length(ABuffer) - locDelLength));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$IFDEF WST_HANDLE_DOC}
|
||||
const
|
||||
REPLACE_CHAR_A = '#'; TARGET_SEQUENCE_A = sLineBreak;
|
||||
|
@ -221,21 +221,47 @@ procedure TWsdlGenerator.GenerateServiceMessages(
|
||||
qryNode, rspNode : TDOMElement;
|
||||
ii, cc : Integer;
|
||||
pp : TPasArgument;
|
||||
prmAccessList : TStringList;
|
||||
prmAccessStr : string;
|
||||
docNode : TDOMNode;
|
||||
begin
|
||||
qryNode := CreateElement(s_message,ARootNode,Document);
|
||||
qryNode.SetAttribute(s_name,Format('%s',[ASymTable.GetExternalName(AOperation)]));
|
||||
rspNode := CreateElement(s_message,ARootNode,Document);
|
||||
rspNode.SetAttribute(s_name,Format('%sResponse',[ASymTable.GetExternalName(AOperation)]));
|
||||
cc := AOperation.ProcType.Args.Count;
|
||||
for ii := 0 to Pred(cc) do begin
|
||||
pp := TPasArgument(AOperation.ProcType.Args[ii]);
|
||||
if ( pp.Access in [argDefault, argConst] ) then
|
||||
GenerateParam(pp,qryNode)
|
||||
else if ( pp.Access in [argVar, argOut] ) then
|
||||
GenerateParam(pp,rspNode);
|
||||
end;
|
||||
if AOperation.InheritsFrom(TPasFunction) then begin
|
||||
GenerateResultParam(TPasFunctionType(AOperation.ProcType).ResultEl,rspNode);
|
||||
prmAccessList := TStringList.Create();
|
||||
try
|
||||
qryNode := CreateElement(s_message,ARootNode,Document);
|
||||
qryNode.SetAttribute(s_name,Format('%s',[ASymTable.GetExternalName(AOperation)]));
|
||||
rspNode := CreateElement(s_message,ARootNode,Document);
|
||||
rspNode.SetAttribute(s_name,Format('%sResponse',[ASymTable.GetExternalName(AOperation)]));
|
||||
cc := AOperation.ProcType.Args.Count;
|
||||
for ii := 0 to Pred(cc) do begin
|
||||
pp := TPasArgument(AOperation.ProcType.Args[ii]);
|
||||
if ( pp.Access in [argDefault, argConst, argVar] ) then begin
|
||||
GenerateParam(pp,qryNode);
|
||||
if ( pp.Access = argDefault ) then
|
||||
prmAccessList.Add(Format('%s=%s',[ASymTable.GetExternalName(pp),GetEnumName(TypeInfo(TArgumentAccess),Ord(pp.Access))]));
|
||||
end;
|
||||
if ( pp.Access in [argVar, argOut] ) then begin
|
||||
GenerateParam(pp,rspNode);
|
||||
end;
|
||||
end;
|
||||
if AOperation.InheritsFrom(TPasFunction) then begin
|
||||
GenerateResultParam(TPasFunctionType(AOperation.ProcType).ResultEl,rspNode);
|
||||
end;
|
||||
if ( prmAccessList.Count > 0 ) then begin
|
||||
docNode := Document.CreateElement(s_documentation);
|
||||
if qryNode.HasChildNodes() then
|
||||
qryNode.InsertBefore(docNode,qryNode.FirstChild)
|
||||
else
|
||||
qryNode.AppendChild(docNode);
|
||||
prmAccessStr := '';
|
||||
for ii := 0 to Pred(prmAccessList.Count) do begin
|
||||
prmAccessStr := prmAccessStr + ';' +
|
||||
prmAccessList.Names[ii] + '=' + prmAccessList.ValueFromIndex[ii];
|
||||
end;
|
||||
Delete(prmAccessStr,1,1);
|
||||
CreateElement(s_paramAccess,docNode,Document).SetAttribute(s_value,prmAccessStr);
|
||||
end;
|
||||
finally
|
||||
prmAccessList.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -280,7 +306,7 @@ var
|
||||
begin
|
||||
prtTypeNode := CreateElement(s_portType,ARootNode,Document);
|
||||
if ( Length(AContract.InterfaceGUID) > 0 ) then begin
|
||||
docNode := CreateElement(s_document,prtTypeNode,Document);
|
||||
docNode := CreateElement(s_documentation,prtTypeNode,Document);
|
||||
CreateElement(s_guid,docNode,Document).SetAttribute(s_value,AContract.InterfaceGUID);
|
||||
end else begin
|
||||
docNode := nil;
|
||||
|
@ -98,7 +98,8 @@ type
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses ws_parser_imp, dom_cursors, parserutils, StrUtils, xsd_consts;
|
||||
uses
|
||||
ws_parser_imp, dom_cursors, parserutils, StrUtils, xsd_consts, TypInfo;
|
||||
|
||||
type
|
||||
|
||||
@ -468,6 +469,48 @@ function TWsdlParser.ParseOperation(
|
||||
end;
|
||||
end;
|
||||
|
||||
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;
|
||||
|
||||
procedure ExtractMethod(
|
||||
const AMthdName : string;
|
||||
out AMthd : TPasProcedure
|
||||
@ -475,7 +518,7 @@ function TWsdlParser.ParseOperation(
|
||||
var
|
||||
tmpMthd : TPasProcedure;
|
||||
tmpMthdType : TPasProcedureType;
|
||||
|
||||
|
||||
procedure ParseInputMessage();
|
||||
var
|
||||
inMsg, strBuffer : string;
|
||||
@ -486,6 +529,8 @@ function TWsdlParser.ParseOperation(
|
||||
prmHasInternameName : Boolean;
|
||||
prmDef : TPasArgument;
|
||||
prmTypeDef : TPasType;
|
||||
prmAccess : TStringList;
|
||||
intBuffer : Integer;
|
||||
begin
|
||||
tmpMthdType := TPasProcedureType(SymbolTable.CreateElement(TPasProcedureType,'',tmpMthd,visDefault,'',0));
|
||||
tmpMthd.ProcType := tmpMthdType;
|
||||
@ -495,68 +540,80 @@ function TWsdlParser.ParseOperation(
|
||||
crs := CreatePartCursor(inMsgNode);
|
||||
if ( crs <> nil ) then begin
|
||||
crs.Reset();
|
||||
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);
|
||||
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,ExtractTypeHint(tmpNode));
|
||||
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;
|
||||
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);
|
||||
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,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;
|
||||
end;
|
||||
SymbolTable.RegisterExternalAlias(prmTypeDef,SymbolTable.GetExternalName(prmTypeDef));
|
||||
prmTypeDef.Name := prmTypeInternalName;
|
||||
end;
|
||||
finally
|
||||
prmAccess.Free();
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -1027,7 +1084,7 @@ var
|
||||
Result := '';
|
||||
tmpCrs := CreateCursorOn(
|
||||
CreateChildrenCursor(ANode,cetRttiNode),
|
||||
ParseFilter(CreateQualifiedNameFilterStr(s_document,FWsdlShortNames),TDOMNodeRttiExposer)
|
||||
ParseFilter(CreateQualifiedNameFilterStr(s_documentation,FWsdlShortNames),TDOMNodeRttiExposer)
|
||||
);
|
||||
tmpCrs.Reset();
|
||||
if tmpCrs.MoveNext() then begin
|
||||
|
@ -58,6 +58,7 @@ const
|
||||
s_operation = 'operation';
|
||||
s_optional : WideString = 'optional';
|
||||
s_output : WideString = 'output';
|
||||
s_paramAccess = 'ParamAccess';
|
||||
s_part : WideString = 'part';
|
||||
s_port : WideString = 'port';
|
||||
s_portType = 'portType';
|
||||
|
Loading…
Reference in New Issue
Block a user