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

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

wst/trunk/ws_helper/wsdl_generator.pas

@@ -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
+          if ( pp.Access in [argDefault, argConst, argVar] ) then begin
-          GenerateParam(pp,qryNode)
+            GenerateParam(pp,qryNode);
-        else if ( pp.Access in [argVar, argOut] ) then
+            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;

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

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