Add XmlRPC date support

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

wst/trunk/base_xmlrpc_formatter.pas

@@ -17,7 +17,12 @@ interface
 
 uses
   Classes, SysUtils, TypInfo, Contnrs,
-  {$IFNDEF FPC}xmldom, wst_delphi_xml{$ELSE}DOM{$ENDIF},
+{$IFDEF WST_DELPHI}
+  xmldom, wst_delphi_xml, 
+{$ENDIF WST_DELPHI}
+{$IFDEF FPC}
+  DOM, XMLWrite, XMLRead,wst_fpc_xml,
+{$ENDIF FPC}
   base_service_intf;
 
 const
@@ -44,6 +49,9 @@ const
   XML_RPC_FALSE = '0';
   XML_RPC_TRUE  = '1';
 
+  stXmlRpcDate    = stBase + 3;
+  stSimpleContent = stXmlRpcDate + 1;
+
 type
 
   TwstXMLDocument = {$IFNDEF FPC}wst_delphi_xml.TXMLDocument{$ELSE}TXMLDocument{$ENDIF};
@@ -92,6 +100,10 @@ type
     property FoundState : TFoundState read FFoundState;
 
     function GetScopeItemNames(const AReturnList : TStrings) : Integer;virtual;abstract;
+    procedure CreateInnerBuffer(
+      const AText : DOMString;
+      const ADoc  : TXMLDocument
+    ); virtual;
   end;
 
   { TObjectStackItem }
@@ -155,6 +167,18 @@ type
     ):TDOMNode;override;
   end;
 
+  { TSimpleTypeStackItem }
+
+  TSimpleTypeStackItem = class(TStackItem)
+  public
+    function FindNode(var ANodeName : string):TDOMNode; override;
+    function CreateBuffer(
+      Const AName     : string;
+      const ADataType : TXmlRpcDataType
+    ):TDOMNode; override;
+    function GetScopeItemNames(const AReturnList : TStrings) : Integer; override;
+  end;
+
 {$M+}
 
   { TXmlRpcBaseFormatter }
@@ -442,8 +466,8 @@ type
 {$M-}
 
 implementation
-Uses {$IFNDEF FPC}XMLDoc,XMLIntf,{$ELSE}XMLWrite, XMLRead,wst_fpc_xml,{$ENDIF}
-     imp_utils;
+uses
+  Imp_utils, wst_consts;
 
 { TStackItem }
 
@@ -463,6 +487,14 @@ begin
   FScopeType := AScopeType;
 end;
 
+procedure TStackItem.CreateInnerBuffer(
+  const AText : DOMString;
+  const ADoc  : TXMLDocument
+);
+begin
+  ScopeObject.AppendChild(ADoc.CreateTextNode(AText));
+end;
+
 { TObjectStackItem }
 
 function TObjectStackItem.FindNode(var ANodeName: string): TDOMNode;
@@ -1223,8 +1255,16 @@ procedure TXmlRpcBaseFormatter.BeginObject(
   const AName      : string;
   const ATypeInfo  : PTypeInfo
 );
+var
+  locScopeType : TScopeType;
 begin
-  BeginScope(AName,'','',stObject,asNone);
+  if ( ATypeInfo^.Kind = tkClass ) and
+     ( GetTypeData(ATypeInfo)^.ClassType.InheritsFrom(TDateRemotable) )
+  then
+    locScopeType := stXmlRpcDate
+  else
+    locScopeType := stObject;
+  BeginScope(AName,'','',locScopeType,asNone);
 end;
 
 procedure TXmlRpcBaseFormatter.BeginArray(
@@ -1269,10 +1309,13 @@ Var
   e : TDOMNode;
   dtType : TXmlRpcDataType;
 begin
-  if ( AScopeType = stArray ) then
-    dtType := xdtArray
+  case AScopeType of
+    stXmlRpcDate      : dtType := xdtDateTime;
+    stSimpleContent   : dtType := xdtString;
+    stArray           : dtType := xdtArray;
     else
                         dtType := xdtStruct;
+  end;
   if HasScope() then begin
     e := StackTop().CreateBuffer(AScopeName,dtType);
   end else begin
@@ -1281,8 +1324,10 @@ begin
   end;
   if ( AScopeType = stObject ) then begin
     PushStack(e);
-  end else begin
+  end else if ( AScopeType = stArray ) then begin
     PushStack(e,AStyle,'');
+  end else begin
+    FStack.Push(TSimpleTypeStackItem.Create(e,AScopeType));
   end;
 end;
 
@@ -1588,7 +1633,8 @@ begin
         dataBuffer := wst_FormatFloat(ATypeInfo,floatDt);
       end;
   end;
-  StackTop().ScopeObject.AppendChild(FDoc.CreateTextNode(dataBuffer));
+  StackTop().CreateInnerBuffer(dataBuffer,FDoc);
+  //StackTop().ScopeObject.AppendChild(FDoc.CreateTextNode(dataBuffer));
 end;
 
 function TXmlRpcBaseFormatter.Get(
@@ -2034,4 +2080,27 @@ begin
   FIndexStack[FIndexStackIDX] := Result;
 end;
 
+{ TSimpleTypeStackItem }
+
+{$WARNINGS OFF}
+function TSimpleTypeStackItem.FindNode(var ANodeName: string): TDOMNode;
+begin
+  raise EXmlRpcException.CreateFmt(SERR_InsupportedOperation,['FindNode']);
+end;
+
+function TSimpleTypeStackItem.CreateBuffer(
+  const AName: string;
+  const ADataType: TXmlRpcDataType
+) : TDOMNode;
+begin
+  raise EXmlRpcException.CreateFmt(SERR_InsupportedOperation,['CreateBuffer']);
+end;
+
+function TSimpleTypeStackItem.GetScopeItemNames(const AReturnList: TStrings): Integer;
+begin
+  raise EXmlRpcException.CreateFmt(SERR_InsupportedOperation,['GetScopeItemNames']);
+end;
+{$WARNINGS ON}
+
+
 end.

wst/trunk/wst_consts.pas

@@ -17,6 +17,7 @@ unit wst_consts;
 interface
 
 resourcestring
+  SERR_InsupportedOperation        = 'Insupported operation : "%s".';
   SERR_InvalidArrayLength          = 'Invalid array length : %d.';
   SERR_InvalidCollectionLength     = 'Invalid collection length : %d.';
   SERR_InvalidHourOffetValue       = '"%d" is not a valid hour offset value.';