You've already forked lazarus-ccr
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:
@ -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,7 +221,12 @@ procedure TWsdlGenerator.GenerateServiceMessages(
|
||||
qryNode, rspNode : TDOMElement;
|
||||
ii, cc : Integer;
|
||||
pp : TPasArgument;
|
||||
prmAccessList : TStringList;
|
||||
prmAccessStr : string;
|
||||
docNode : TDOMNode;
|
||||
begin
|
||||
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);
|
||||
@ -229,14 +234,35 @@ procedure TWsdlGenerator.GenerateServiceMessages(
|
||||
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
|
||||
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;
|
||||
|
||||
Var
|
||||
@ -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
|
||||
@ -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,6 +540,9 @@ function TWsdlParser.ParseOperation(
|
||||
crs := CreatePartCursor(inMsgNode);
|
||||
if ( crs <> nil ) then begin
|
||||
crs.Reset();
|
||||
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
|
||||
@ -546,6 +594,12 @@ function TWsdlParser.ParseOperation(
|
||||
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;
|
||||
@ -558,6 +612,9 @@ function TWsdlParser.ParseOperation(
|
||||
prmTypeDef.Name := prmTypeInternalName;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
prmAccess.Free();
|
||||
end;
|
||||
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';
|
||||
|
Reference in New Issue
Block a user