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:
inoussa 2009-06-30 16:34:57 +00:00
parent 8cb6651cbe
commit 207e8f389b
4 changed files with 190 additions and 78 deletions

View File

@ -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;

View File

@ -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;

View File

@ -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

View File

@ -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';