From 207e8f389b25ad6032821941cd65d9cfc237fdba Mon Sep 17 00:00:00 2001 From: inoussa Date: Tue, 30 Jun 2009 16:34:57 +0000 Subject: [PATCH] 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 --- wst/trunk/ws_helper/parserutils.pas | 28 ++++ wst/trunk/ws_helper/wsdl_generator.pas | 56 ++++++-- wst/trunk/ws_helper/wsdl_parser.pas | 183 ++++++++++++++++--------- wst/trunk/ws_helper/xsd_consts.pas | 1 + 4 files changed, 190 insertions(+), 78 deletions(-) diff --git a/wst/trunk/ws_helper/parserutils.pas b/wst/trunk/ws_helper/parserutils.pas index 5357d561f..fea9c315d 100644 --- a/wst/trunk/ws_helper/parserutils.pas +++ b/wst/trunk/ws_helper/parserutils.pas @@ -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; diff --git a/wst/trunk/ws_helper/wsdl_generator.pas b/wst/trunk/ws_helper/wsdl_generator.pas index d51c25e96..0cf5f6e10 100644 --- a/wst/trunk/ws_helper/wsdl_generator.pas +++ b/wst/trunk/ws_helper/wsdl_generator.pas @@ -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; diff --git a/wst/trunk/ws_helper/wsdl_parser.pas b/wst/trunk/ws_helper/wsdl_parser.pas index 0ed40f6b4..47951d591 100644 --- a/wst/trunk/ws_helper/wsdl_parser.pas +++ b/wst/trunk/ws_helper/wsdl_parser.pas @@ -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 diff --git a/wst/trunk/ws_helper/xsd_consts.pas b/wst/trunk/ws_helper/xsd_consts.pas index 855f002de..1832d2578 100644 --- a/wst/trunk/ws_helper/xsd_consts.pas +++ b/wst/trunk/ws_helper/xsd_consts.pas @@ -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';