SOAP "ID" and "href" handling in the serialized xml stream.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@730 8e941d3f-bd1b-0410-a28a-d453659cc2b4

wst/trunk/base_soap_formatter.pas

@@ -39,6 +39,7 @@ const
 
   sHEADER   = 'Header';
   sENVELOPE = 'Envelope';
+  sHREF     = 'href';
 
 type
 
@@ -60,7 +61,8 @@ type
     FScopeObject: TDOMNode;
     FScopeType: TScopeType;
   protected
-    function GetItemsCount() : Integer;virtual;
+    function GetItemsCount : Integer;virtual;
+    function GetActualNodeIfIsHRef(const ANode : TDOMNode) : TDOMNode;
   Public
     constructor Create(AScopeObject : TDOMNode;AScopeType : TScopeType);
     function FindNode(var ANodeName : string):TDOMNode;virtual;abstract;
@@ -437,6 +439,9 @@ type
 
   function BoolToSoapBool(const AValue : Boolean) : string;{$IFDEF USE_INLINE}inline;{$ENDIF}
   
+resourcestring
+  SERR_NodeNotFoundByID = 'Node not found with this ID in the document : %s.';
+
 implementation
 Uses {$IFDEF WST_DELPHI}XMLDoc,XMLIntf,{$ELSE}XMLWrite, XMLRead,wst_fpc_xml,{$ENDIF}
      StrUtils, imp_utils;
@@ -457,6 +462,41 @@ begin
   Result := GetNodeItemsCount(ScopeObject);
 end;
 
+function TStackItem.GetActualNodeIfIsHRef(const ANode: TDOMNode): TDOMNode;
+var
+  locAttrs : TDOMNamedNodeMap;
+
+  function FollowIfNeeded() : TDOMNode;
+  var
+    locNode : TDOMNode;
+    locHRefValue : DOMString;
+  begin
+    locNode := locAttrs.GetNamedItem(sHREF);
+    if ( locNode = nil ) or ( Length(locNode.NodeValue) = 0 ) then begin
+      Result := ANode;
+    end else begin
+      locHRefValue := locNode.NodeValue;
+      if ( locHRefValue[1] = '#' ) then
+        locHRefValue := Copy(locHRefValue,2,Length(locHRefValue));
+      Result := SelectSingleNode(Format('//*[@id=%s]',[locHRefValue]),locNode.OwnerDocument,True);
+      //ANode.OwnerDocument.GetElementById(locHRefValue);
+      if ( Result = nil ) then
+        raise ESOAPException.CreateFmt(SERR_NodeNotFoundByID,[locHRefValue]);
+    end;
+  end;
+
+begin
+  if ( ANode = nil ) then begin
+    Result := nil;
+  end else begin
+    locAttrs := ANode.Attributes;
+    if ( locAttrs <> nil ) and ( locAttrs.Length > 0 ) then
+      Result := FollowIfNeeded()
+    else
+      Result := ANode;
+  end;
+end;
+
 constructor TStackItem.Create(AScopeObject: TDOMNode; AScopeType: TScopeType);
 begin
   FScopeObject := AScopeObject;
@@ -503,6 +543,7 @@ begin
 {$ELSE}
   Result := ScopeObject.FindNode(ANodeName);
 {$ENDIF}
+  Result := GetActualNodeIfIsHRef(Result);
 end;
 
 { TAbstractArrayStackItem }
@@ -549,6 +590,7 @@ begin
   Result:= FItemList.Item[FIndex];
   Inc(FIndex);
   ANodeName := Result.NodeName;
+  Result := GetActualNodeIfIsHRef(Result);
 end;
 
 { TSOAPBaseFormatter }

wst/trunk/tests/test_suite/test_soap_specific.pas

@@ -135,6 +135,22 @@ type
     procedure read_header_simple_content_2();
   end;
   
+  THRefTestSession = class(TBaseComplexRemotable)
+  private
+    FSessionID : string;
+    FPartnerID : integer;
+  published
+    property SessionID : string read FSessionID write FSessionID;
+    property PartnerID : integer read FPartnerID write FPartnerID;
+  end;
+
+  { TTest_SoapFormatterClient }
+
+  TTest_SoapFormatterClient = class(TTestCase)
+  published
+    procedure test_soap_href_id();
+  end;
+
 implementation
 uses
   object_serializer, server_service_soap, test_suite_utils, soap_formatter;
@@ -607,6 +623,57 @@ begin
   end;
 end;
 
+{ TTest_SoapFormatterClient }
+
+procedure TTest_SoapFormatterClient.test_soap_href_id();
+const
+  XML_SOURCE =
+         '<?xml version="1.0"?>'  + sLineBreak +
+         '<SOAP-ENV:Envelope '  + sLineBreak +
+         '  xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" '  + sLineBreak +
+         '  xmlns:xsd="http://www.w3.org/2001/XMLSchema" '  + sLineBreak +
+         '  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" '  + sLineBreak +
+         '  xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/">'  + sLineBreak +
+         '  '  + sLineBreak +
+         '  <SOAP-ENV:Body SOAP-ENV:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">'  + sLineBreak +
+         '    <NS1:GetSessionResponse xmlns:NS1="urn:WS_PlotjetIntfU-IWS_Plotjet" xmlns:NS2="urn:WS_PlotjetIntfU">'  + sLineBreak +
+         '      <NS2:TSession id="1" xsi:type="NS2:TSession">'  + sLineBreak +
+         '        <SessionID xsi:type="xsd:string">Some GID</SessionID>'  + sLineBreak +
+         '        <PartnerID xsi:type="xsd:int">12</PartnerID>'  + sLineBreak +
+         '      </NS2:TSession>'  + sLineBreak +
+         '      <return href="#1"/>'  + sLineBreak +
+         '    </NS1:GetSessionResponse>'  + sLineBreak +
+         '  </SOAP-ENV:Body>'  + sLineBreak +
+         '</SOAP-ENV:Envelope>';
+var
+  f : IFormatterClient;
+  strm : TMemoryStream;
+  strBuffer : ansistring;
+  cctx : ICallContext;
+  locReturn : THRefTestSession;
+  locStrPrmName : string;
+begin
+  f := soap_formatter.TSOAPFormatter.Create() as IFormatterClient;
+  strm := TMemoryStream.Create();
+  try
+    strBuffer := XML_SOURCE;
+    strm.Write(strBuffer[1],Length(strBuffer));
+    strm.Position := 0;
+    f.LoadFromStream(strm);
+    cctx := TSimpleCallContext.Create() as ICallContext;
+    f.BeginCallRead(cctx);
+      locReturn := nil;
+      locStrPrmName := 'return';
+      f.Get(TypeInfo(THRefTestSession),locStrPrmName,locReturn);
+      CheckNotNull(locReturn,'return');
+      CheckEquals('Some GID',locReturn.SessionID,'SessionID');
+      CheckEquals(12,locReturn.PartnerID,'PartnerID');
+    f.EndScopeRead();
+  finally
+    FreeAndNil(strm);
+  end;
+end;
+
 initialization
 
   GetTypeRegistry().Register(TSampleSimpleContentHeaderBlock_A.GetNameSpace(),TypeInfo(TSampleSimpleContentHeaderBlock_A));
@@ -618,9 +685,11 @@ initialization
   GetTypeRegistry().Register(TNameSpaceB_Class.GetNameSpace(),TypeInfo(TNameSpaceB_Class));
   GetTypeRegistry().Register(TNameSpaceC_Class.GetNameSpace(),TypeInfo(TNameSpaceC_Class));
   GetTypeRegistry().Register(ns_soap_test,TypeInfo(TSOAPTestEnum));
+  GetTypeRegistry().Register('urn:WS_PlotjetIntfU',TypeInfo(THRefTestSession),'TSession');
   
   RegisterTest('Serializer',TTest_SoapFormatterServerNameSpace.Suite);
   RegisterTest('Serializer',TTest_SoapFormatterHeader.Suite);
+  RegisterTest('Serializer',TTest_SoapFormatterClient.Suite);
   
 end.
 

wst/trunk/wst_delphi_xml.pas

@@ -34,7 +34,15 @@ type
 
   function FilterList(const ALIst : IDOMNodeList; const ANodeName : DOMString):IDOMNodeList;overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
   function FilterList(const ANode : TDOMNode; const ANodeName : DOMString):IDOMNodeList;overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
-  
+  function SelectSingleNode(
+    const AXPathExpression : DOMString;
+    const AContextNode     : TDOMNode;
+    const AErrorIfMore     : Boolean
+  ) : TDOMNode;
+
+resourcestring
+  SERR_XpathExpectingOneNode = 'Xpath expression expecting a single node while got %d node : %s.';
+
 implementation
 uses XmlDoc;
 
@@ -168,7 +176,7 @@ type
     );
   end;
 
-function FilterList(const ALIst : IDOMNodeList; const ANodeName : widestring):IDOMNodeList ;
+function FilterList(const ALIst : IDOMNodeList; const ANodeName : DOMString):IDOMNodeList ;
 begin
   Result := TDOMNodeSelectListImp.Create(ALIst,ANodeName);
 end;
@@ -178,6 +186,25 @@ begin
   Result := FilterList(ANode.ChildNodes,ANodeName);
 end;
 
+function SelectSingleNode(
+  const AXPathExpression : DOMString;
+  const AContextNode     : TDOMNode;
+  const AErrorIfMore     : Boolean
+) : TDOMNode;
+var
+  locSelect : IDOMNodeSelect;
+  ns : TDOMNodeList;
+begin
+  Result := nil;
+  locSelect := AContextNode as IDOMNodeSelect;
+  ns := locSelect.selectNodes(AXPathExpression);
+  if ( ns <> nil ) and ( ns.length > 0 ) then begin
+    if AErrorIfMore and ( ns.length > 1 ) then
+      raise Exception.CreateFmt(SERR_XpathExpectingOneNode,[ns.length,AXPathExpression]);
+    Result := ns[0];
+  end;
+end;
+
 { TDOMNodeSelectListImp }
 
 constructor TDOMNodeSelectListImp.Create(

wst/trunk/wst_fpc_xml.pas

@@ -24,6 +24,12 @@ type
   end;
 
   function FilterList(const ANode : TDOMNode; const ANodeName : DOMString) : TDOMNodeList ;
+  function SelectSingleNode(
+    const AXPathExpression : DOMString;
+    const AContextNode     : TDOMNode;
+    const AErrorIfMore     : Boolean
+  ) : TDOMNode;
+
 
   function GetNodeItemsCount(const ANode : TDOMNode): Integer;
   function GetNodeListCount(ANodeList : TDOMNodeList) : Integer ;overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
@@ -36,8 +42,13 @@ type
 
   function NodeToBuffer(ANode : TDOMNode):string ;
   
+resourcestring
+  SERR_NoNodeXpathExpression = 'This XPath expression does not correspond to node(s) : %s.';
+  SERR_XpathExpectingOneNode = 'Xpath expression expecting a single node while got %d node : %s.';
+
 implementation
-uses XMLWrite;
+uses
+  XMLWrite, xpath;
 
 function GetNodeItemsCount(const ANode : TDOMNode): Integer;
 var
@@ -109,6 +120,29 @@ begin
   Result := TDOMNodeSelectListImp.Create(ANode,ANodeName);
 end;
 
+function SelectSingleNode(
+  const AXPathExpression : DOMString;
+  const AContextNode     : TDOMNode;
+  const AErrorIfMore     : Boolean
+) : TDOMNode;
+var
+  xp_res : TXPathVariable;
+  ns : TNodeSet;
+begin
+  Result := nil;
+  xp_res := EvaluateXPathExpression(AXPathExpression,AContextNode);
+  if ( xp_res <> nil ) then begin
+    if not xp_res.InheritsFrom(TXPathNodeSetVariable) then
+      raise Exception.CreateFmt(SERR_NoNodeXpathExpression,[AXPathExpression]);
+    ns := xp_res.AsNodeSet;
+    if ( ns <> nil ) and ( ns.Count > 0 ) then begin
+      if AErrorIfMore and ( ns.Count > 1 ) then
+        raise Exception.CreateFmt(SERR_XpathExpectingOneNode,[ns.Count,AXPathExpression]);
+      Result := TDOMNode(ns[0]);
+    end;
+  end;
+end;
+
 { TDOMNodeSelectListImp }
 
 type