diff --git a/wst/trunk/base_binary_formatter.pas b/wst/trunk/base_binary_formatter.pas index 3c49f4ace..4b29bf58e 100644 --- a/wst/trunk/base_binary_formatter.pas +++ b/wst/trunk/base_binary_formatter.pas @@ -21,6 +21,7 @@ uses {$DEFINE wst_binary_header} const + sBINARY_FORMAT_NAME = 'wst-binary'; sROOT = 'ROOT'; sSCOPE_INNER_NAME = 'INNER_VAL'; sFORMAT = 'format'; @@ -123,6 +124,8 @@ type function IsCurrentScopeNil():Boolean;virtual;abstract; property ScopeObject : PDataBuffer Read FScopeObject; property ScopeType : TScopeType Read FScopeType; + + function GetScopeItemNames(const AReturnList : TStrings) : Integer;virtual;abstract; End; { TObjectStackItem } @@ -141,6 +144,7 @@ type function GetInnerBuffer():PDataBuffer;override; procedure NilCurrentScope();override; function IsCurrentScopeNil():Boolean;override; + function GetScopeItemNames(const AReturnList : TStrings) : Integer;override; End; { TArrayStackItem } @@ -161,6 +165,7 @@ type function GetInnerBuffer():PDataBuffer;overload;override; procedure NilCurrentScope();override; function IsCurrentScopeNil():Boolean;override; + function GetScopeItemNames(const AReturnList : TStrings) : Integer;override; End; { TBaseBinaryFormatter } @@ -272,7 +277,8 @@ type public constructor Create();override; destructor Destroy();override; - + function GetFormatName() : string; + procedure Clear(); procedure BeginObject( @@ -327,6 +333,7 @@ type var AData ); function ReadBuffer(const AName : string) : string; + procedure WriteBuffer(const AValue : string); procedure SaveToStream(AStream : TStream); procedure LoadFromStream(AStream : TStream); @@ -776,6 +783,21 @@ begin end; //---------------------------------------------------------------- +function TObjectStackItem.GetScopeItemNames(const AReturnList: TStrings): Integer; +var + locBuffer : PObjectBufferItem; +begin + AReturnList.Clear(); + if Assigned(ScopeObject) and ( ScopeObject^.ObjectData^.Count > 0 ) then begin + locBuffer := ScopeObject^.ObjectData^.Head; + while Assigned(locBuffer) do begin + AReturnList.Add(locBuffer^.Data^.Name); + locBuffer := locBuffer^.Next; + end; + end; + Result := AReturnList.Count; +end; + { TBaseBinaryFormatter } procedure TBaseBinaryFormatter.ClearStack(); @@ -1122,10 +1144,10 @@ begin Result := StackTop().GetItemCount(); end; -function TBaseBinaryFormatter.GetScopeItemNames(const AReturnList : TStrings - ) : Integer; +function TBaseBinaryFormatter.GetScopeItemNames(const AReturnList : TStrings) : Integer; begin - + CheckScope(); + Result := StackTop.GetScopeItemNames(AReturnList); end; procedure TBaseBinaryFormatter.EndScopeRead(); @@ -1600,6 +1622,29 @@ begin inherited Destroy(); end; +function TBaseBinaryFormatter.GetFormatName() : string; +begin + Result := sBINARY_FORMAT_NAME; +end; + +procedure TBaseBinaryFormatter.WriteBuffer(const AValue: string); +var + locStore : IDataStoreReader; + bffr : PDataBuffer; + locStream : TStringStream; +begin + CheckScope(); + locStream := TStringStream.Create(AValue); + try + locStream.Position := 0; + locStore := CreateBinaryReader(locStream); + bffr := LoadObjectFromStream(locStore); + AddObj(StackTop.ScopeObject,bffr); + finally + locStream.Free(); + end; +end; + { TArrayStackItem } constructor TArrayStackItem.Create(const AScopeObject: PDataBuffer); @@ -1662,4 +1707,19 @@ begin Result := False; end; +function TArrayStackItem.GetScopeItemNames(const AReturnList: TStrings): Integer; +var + locBuffer : PDataBufferList; + i : PtrInt; +begin + AReturnList.Clear(); + if Assigned(ScopeObject) and ( ScopeObject^.ArrayData^.Count > 0 ) then begin + locBuffer := ScopeObject^.ArrayData^.Items; + for i := 0 to Pred(ScopeObject^.ArrayData^.Count) do begin + AReturnList.Add(locBuffer^[i]^.Name); + end; + end; + Result := AReturnList.Count; +end; + end. diff --git a/wst/trunk/base_json_formatter.pas b/wst/trunk/base_json_formatter.pas index c8ab727ae..c33ed1a17 100644 --- a/wst/trunk/base_json_formatter.pas +++ b/wst/trunk/base_json_formatter.pas @@ -110,6 +110,7 @@ type public procedure SetSerializationStyle(const ASerializationStyle : TSerializationStyle); function GetSerializationStyle():TSerializationStyle; + function GetFormatName() : string; procedure Clear(); procedure BeginObject( @@ -163,6 +164,7 @@ type var AData ); function ReadBuffer(const AName : string) : string; + procedure WriteBuffer(const AValue : string); procedure SaveToStream(AStream : TStream); procedure LoadFromStream(AStream : TStream); @@ -231,7 +233,12 @@ begin Result := FSerializationStyle; end; -function TJsonRpcBaseFormatter.GetCurrentScope() : string; +function TJsonRpcBaseFormatter.GetFormatName(): string; +begin + Result := 'json'; +end; + +function TJsonRpcBaseFormatter.GetCurrentScope : string; begin CheckScope(); Result := ''; @@ -349,6 +356,11 @@ begin end; +procedure TJsonRpcBaseFormatter.WriteBuffer(const AValue: string); +begin + +end; + procedure TJsonRpcBaseFormatter.SaveToStream(AStream : TStream); begin diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas index 925adda69..795b50a16 100644 --- a/wst/trunk/base_service_intf.pas +++ b/wst/trunk/base_service_intf.pas @@ -132,6 +132,7 @@ type IFormatterBase = Interface ['{2AB3BF54-B7D6-4C46-8245-133C8775E9C1}'] + function GetFormatName() : string; procedure SetSerializationStyle(const ASerializationStyle : TSerializationStyle); function GetSerializationStyle():TSerializationStyle; function GetCurrentScope():string; @@ -188,6 +189,8 @@ type var AData ); function ReadBuffer(const AName : string) : string; + //Please use this method if and _only_ if you do not have another way achieve your aim! + procedure WriteBuffer(const AValue : string); procedure SaveToStream(AStream : TStream); procedure LoadFromStream(AStream : TStream); @@ -1238,15 +1241,10 @@ const function IsStoredPropClass(AClass : TClass;PropInfo : PPropInfo) : TPropStoreType; -{$IFDEF FPC} - {$IFDEF FPC_211} +{$IFDEF HAS_FORMAT_SETTINGS} var wst_FormatSettings : TFormatSettings; - {$ENDIF} -{$ELSE} -var - wst_FormatSettings : TFormatSettings; -{$ENDIF} +{$ENDIF HAS_FORMAT_SETTINGS} implementation uses imp_utils, record_rtti; @@ -3512,7 +3510,7 @@ begin lst.Delimiter := PROP_LIST_DELIMITER; lst.DelimitedText := APropsStr; for i := 0 to Pred(lst.Count) do - SetProperty(lst.Names[i],lst.ValueFromIndex[i]); + SetProperty(lst.Names[i],lst.Values[lst.Names[i]]); finally lst.Free(); end; @@ -4860,15 +4858,15 @@ begin end; initialization -{$IFDEF FPC} - {$IFDEF FPC_211} - wst_FormatSettings := DefaultFormatSettings; - wst_FormatSettings.DecimalSeparator := '.'; +{$IFDEF HAS_FORMAT_SETTINGS} + {$IFDEF FPC} + wst_FormatSettings := DefaultFormatSettings; + wst_FormatSettings.DecimalSeparator := '.'; + {$ELSE} + GetLocaleFormatSettings(GetThreadLocale(),wst_FormatSettings); + wst_FormatSettings.DecimalSeparator := '.'; {$ENDIF} -{$ELSE} - GetLocaleFormatSettings(GetThreadLocale(),wst_FormatSettings); - wst_FormatSettings.DecimalSeparator := '.'; -{$ENDIF} +{$ENDIF HAS_FORMAT_SETTINGS} TypeRegistryInstance := TTypeRegistry.Create(); SerializeOptionsRegistryInstance := TSerializeOptionsRegistry.Create(); diff --git a/wst/trunk/base_soap_formatter.pas b/wst/trunk/base_soap_formatter.pas index b6189ac43..d875b7316 100644 --- a/wst/trunk/base_soap_formatter.pas +++ b/wst/trunk/base_soap_formatter.pas @@ -73,6 +73,8 @@ type property EmbeddedScopeCount : Integer read FEmbeddedScopeCount; function BeginEmbeddedScope() : Integer; function EndEmbeddedScope() : Integer; + + function GetScopeItemNames(const AReturnList : TStrings) : Integer;virtual; End; { TObjectStackItem } @@ -286,6 +288,7 @@ type public constructor Create();override; destructor Destroy();override; + function GetFormatName() : string; procedure Clear(); procedure BeginObject( @@ -339,6 +342,7 @@ type var AData ); function ReadBuffer(const AName : string) : string; + procedure WriteBuffer(const AValue : string); procedure SaveToStream(AStream : TStream); procedure LoadFromStream(AStream : TStream); @@ -390,6 +394,17 @@ begin Result := FEmbeddedScopeCount; end; +function TStackItem.GetScopeItemNames(const AReturnList: TStrings): Integer; +var + i : Integer; +begin + AReturnList.Clear(); + for i := 0 to Pred(GetItemsCount()) do begin + AReturnList.Add(ScopeObject.childNodes.Item[i].nodeName); + end; + Result := AReturnList.Count; +end; + { TObjectStackItem } function TObjectStackItem.FindNode(var ANodeName: string): TDOMNode; @@ -497,7 +512,8 @@ end; function TSOAPBaseFormatter.GetScopeItemNames(const AReturnList : TStrings) : Integer; begin - + CheckScope(); + Result := StackTop().GetScopeItemNames(AReturnList); end; procedure TSOAPBaseFormatter.EndScopeRead(); @@ -769,7 +785,9 @@ function TSOAPBaseFormatter.PutFloat( Var s, frmt : string; prcsn : Integer; -{$IFDEF FPC} {$IFNDEF FPC_211} i : Integer; {$ENDIF}{$ENDIF} +{$IFNDEF HAS_FORMAT_SETTINGS} + i : Integer; +{$ENDIF HAS_FORMAT_SETTINGS} begin Case GetTypeData(ATypeInfo)^.FloatType Of ftSingle, @@ -779,18 +797,14 @@ begin ftExtended : prcsn := 15; End; frmt := '#.' + StringOfChar('#',prcsn) + 'E-0'; -{$IFDEF FPC} - {$IFDEF FPC_211} +{$IFDEF HAS_FORMAT_SETTINGS} s := FormatFloat(frmt,AData,wst_FormatSettings); - {$ELSE} +{$ELSE} s := FormatFloat(frmt,AData); i := Pos(',',s); - If ( i > 0 ) Then + if ( i > 0 ) then s[i] := '.'; - {$ENDIF} -{$ELSE} - s := FormatFloat(frmt,AData,wst_FormatSettings); -{$ENDIF} +{$ENDIF HAS_FORMAT_SETTINGS} Result := InternalPutData(AName,ATypeInfo,s); end; @@ -881,16 +895,11 @@ procedure TSOAPBaseFormatter.GetFloat( var AData : Extended ); begin -{$IFDEF FPC} - {$IFDEF FPC_211} - AData := StrToFloatDef(Trim(GetNodeValue(AName)),0,wst_FormatSettings); - {$ELSE} - AData := StrToFloatDef(Trim(GetNodeValue(AName)),0); - {$ENDIF} +{$IFDEF HAS_FORMAT_SETTINGS} + AData := StrToFloatDef(Trim(GetNodeValue(AName)),0,wst_FormatSettings); {$ELSE} - AData := StrToFloatDef(Trim(GetNodeValue(AName)),0,wst_FormatSettings); -{$ENDIF} - //AData := StrToFloatDef(Trim(GetNodeValue(AName)),0,wst_FormatSettings); + AData := StrToFloatDef(TranslateDotToDecimalSeperator(Trim(GetNodeValue(AName))),0); +{$ENDIF HAS_FORMAT_SETTINGS} end; procedure TSOAPBaseFormatter.GetStr( @@ -1729,15 +1738,11 @@ begin end; tkFloat : begin -{$IFDEF FPC} - {$IFDEF FPC_211} +{$IFDEF HAS_FORMAT_SETTINGS} floatDt := StrToFloatDef(Trim(dataBuffer),0,wst_FormatSettings); - {$ELSE} - floatDt := StrToFloatDef(Trim(dataBuffer),0); - {$ENDIF} {$ELSE} - floatDt := StrToFloatDef(Trim(dataBuffer),0,wst_FormatSettings); -{$ENDIF} + floatDt := StrToFloatDef(TranslateDotToDecimalSeperator(Trim(dataBuffer)),0); +{$ENDIF HAS_FORMAT_SETTINGS} case GetTypeData(ATypeInfo)^.FloatType of ftSingle : Single(AData) := floatDt; ftDouble : Double(AData) := floatDt; @@ -1805,6 +1810,30 @@ begin Raise ESOAPException.CreateFmt(AMsg,AArgs); end; +function TSOAPBaseFormatter.GetFormatName() : string; +begin + Result := sPROTOCOL_NAME; +end; + +procedure TSOAPBaseFormatter.WriteBuffer(const AValue: string); +var + strm : TStringStream; + locDoc : TwstXMLDocument; + locNode : TDOMNode; +begin + CheckScope(); + locDoc := nil; + strm := TStringStream.Create(AValue); + try + ReadXMLFile(locDoc,strm); + locNode := locDoc.DocumentElement.CloneNode(True {$IFDEF FPC}, StackTop().ScopeObject.OwnerDocument{$ENDIF}); + StackTop().ScopeObject.AppendChild(locNode); + finally + ReleaseDomNode(locDoc); + strm.Free(); + end; +end; + { TScopedArrayStackItem } function TScopedArrayStackItem.CreateList(const ANodeName : string): TDOMNodeList; diff --git a/wst/trunk/base_xmlrpc_formatter.pas b/wst/trunk/base_xmlrpc_formatter.pas index e9894d016..4d2c5880c 100644 --- a/wst/trunk/base_xmlrpc_formatter.pas +++ b/wst/trunk/base_xmlrpc_formatter.pas @@ -57,7 +57,7 @@ const 'string', 'int', 'boolean', 'double', 'dateTime.iso8601', 'base64', 'struct', 'array' ); - + type { ESOAPException } @@ -65,7 +65,7 @@ type end; TFoundState = ( fsNone, fsFoundNonNil, fsFoundNil ); - + { TStackItem } TStackItem = class @@ -87,6 +87,8 @@ type property ScopeType : TScopeType Read FScopeType; property ItemsCount : Integer read GetItemsCount; property FoundState : TFoundState read FFoundState; + + function GetScopeItemNames(const AReturnList : TStrings) : Integer;virtual;abstract; end; { TObjectStackItem } @@ -98,21 +100,36 @@ type Const AName : string; const ADataType : TXmlRpcDataType ):TDOMNode;override; + + function GetScopeItemNames(const AReturnList : TStrings) : Integer;override; + end; + + TBaseArrayStackItem = class(TStackItem) + private + FItemList : TDOMNodeList; + FIndex : Integer; + FIndexStack : array of Integer; + FIndexStackIDX : Integer; + private + function PushIndex(const AValue : Integer) : Integer; + function PopIndex() : Integer; + public + destructor Destroy();override; + function GetScopeItemNames(const AReturnList : TStrings) : Integer;override; end; { TArrayStackItem } - TArrayStackItem = class(TStackItem) + TArrayStackItem = class(TBaseArrayStackItem) private - FItemList : TDOMNodeList; - FIndex : Integer; FDataScope : TDOMNode; protected procedure EnsureListCreated(); function GetItemsCount() : Integer;override; function CreateList():TDOMNodeList; + function PushIndex(const AValue : Integer) : Integer; + function PopIndex() : Integer; public - destructor Destroy();override; function FindNode(var ANodeName : string):TDOMNode;override; function CreateBuffer( Const AName : string; @@ -122,16 +139,12 @@ type { TParamsArrayStackItem } - TParamsArrayStackItem = class(TStackItem) - private - FItemList : TDOMNodeList; - FIndex : Integer; + TParamsArrayStackItem = class(TBaseArrayStackItem) protected procedure EnsureListCreated(); function GetItemsCount() : Integer;override; function CreateList():TDOMNodeList; public - destructor Destroy();override; function FindNode(var ANodeName : string):TDOMNode;override; function CreateBuffer( Const AName : string; @@ -287,6 +300,7 @@ type public constructor Create();override; destructor Destroy();override; + function GetFormatName() : string; procedure Clear(); procedure BeginObject( @@ -340,6 +354,7 @@ type var AData ); function ReadBuffer(const AName : string) : string; + procedure WriteBuffer(const AValue : string); procedure SaveToStream(AStream : TStream); procedure LoadFromStream(AStream : TStream); @@ -444,6 +459,35 @@ begin nd.AppendChild(Result); end; +function TObjectStackItem.GetScopeItemNames(const AReturnList: TStrings): Integer; +var + memberNode, tmpNode : TDOMNode; + i : Integer; + chilNodes : TDOMNodeList; +begin + AReturnList.Clear(); + if ScopeObject.HasChildNodes() then begin + memberNode := ScopeObject.FirstChild; + while ( memberNode <> nil ) do begin + if memberNode.HasChildNodes() then begin + chilNodes := memberNode.ChildNodes; + for i := 0 to Pred(GetNodeListCount(chilNodes)) do begin + tmpNode := chilNodes.Item[i]; + if AnsiSameText(sNAME,tmpNode.NodeName) then begin + if ( tmpNode.FirstChild <> nil ) then + AReturnList.Add(tmpNode.FirstChild.NodeValue) + else + AReturnList.Add(''); + Break; + end; + end; + end; + memberNode := memberNode.NextSibling; + end; + end; + Result := AReturnList.Count; +end; + { TArrayStackItem } procedure TArrayStackItem.EnsureListCreated(); @@ -472,13 +516,6 @@ begin end; end; -destructor TArrayStackItem.Destroy(); -begin - if Assigned(FItemList) then - ReleaseDomNode(FItemList); - inherited Destroy(); -end; - function TArrayStackItem.FindNode(var ANodeName: string): TDOMNode; begin EnsureListCreated(); @@ -516,6 +553,26 @@ begin nd.AppendChild(Result); end; +function TArrayStackItem.PushIndex(const AValue: Integer): Integer; +begin + if ( FIndexStackIDX = Length(FIndexStack) ) then begin + if ( Length(FIndexStack) = 0 ) then + FIndexStackIDX := -1; + SetLength(FIndexStack, Length(FIndexStack) + 4); + end; + Result := FIndex; + Inc(FIndexStackIDX); + FIndexStack[FIndexStackIDX] := AValue; +end; + +function TArrayStackItem.PopIndex() : Integer; +begin + if ( Length(FIndexStack) = 0 ) or ( FIndexStackIDX < 0 ) then + raise EXmlRpcException.Create('TArrayStackItem.PopIndex() >> No saved index.'); + FIndex := FIndexStack[FIndexStackIDX]; + Dec(FIndexStackIDX); +end; + { TXmlRpcBaseFormatter } procedure TXmlRpcBaseFormatter.ClearStack(); @@ -564,10 +621,10 @@ begin Result := InternalBeginScopeRead(AScopeName,ATypeInfo,stArray,AStyle,AItemName); end; -function TXmlRpcBaseFormatter.GetScopeItemNames(const AReturnList : TStrings - ) : Integer; +function TXmlRpcBaseFormatter.GetScopeItemNames(const AReturnList : TStrings) : Integer; begin - + CheckScope(); + Result := StackTop.GetScopeItemNames(AReturnList); end; procedure TXmlRpcBaseFormatter.EndScopeRead(); @@ -858,16 +915,11 @@ procedure TXmlRpcBaseFormatter.GetFloat( var AData : Extended ); begin -{$IFDEF FPC} - {$IFDEF FPC_211} - AData := StrToFloatDef(Trim(GetNodeValue(AName)),0,wst_FormatSettings); - {$ELSE} - AData := StrToFloatDef(Trim(GetNodeValue(AName)),0); - {$ENDIF} +{$IFDEF HAS_FORMAT_SETTINGS} + AData := StrToFloatDef(Trim(GetNodeValue(AName)),0,wst_FormatSettings); {$ELSE} - AData := StrToFloatDef(Trim(GetNodeValue(AName)),0,wst_FormatSettings); -{$ENDIF} - //AData := StrToFloatDef(Trim(GetNodeValue(AName)),0,wst_FormatSettings); + AData := StrToFloatDef(TranslateDotToDecimalSeperator(Trim(GetNodeValue(AName))),0); +{$ENDIF HAS_FORMAT_SETTINGS} end; procedure TXmlRpcBaseFormatter.GetStr( @@ -1375,16 +1427,11 @@ begin end; tkFloat : begin -{$IFDEF FPC} - {$IFDEF FPC_211} +{$IFDEF HAS_FORMAT_SETTINGS} floatDt := StrToFloatDef(Trim(dataBuffer),0,wst_FormatSettings); - {$ELSE} - floatDt := StrToFloatDef(Trim(dataBuffer),0); - {$ENDIF} {$ELSE} - floatDt := StrToFloatDef(Trim(dataBuffer),0,wst_FormatSettings); -{$ENDIF} - //floatDt := StrToFloatDef(Trim(dataBuffer),0,wst_FormatSettings); + floatDt := StrToFloatDef(TranslateDotToDecimalSeperator(Trim(dataBuffer)),0); +{$ENDIF HAS_FORMAT_SETTINGS} case GetTypeData(ATypeInfo)^.FloatType of ftSingle : Single(AData) := floatDt; ftDouble : Double(AData) := floatDt; @@ -1440,7 +1487,30 @@ procedure TXmlRpcBaseFormatter.Error(const AMsg: string;const AArgs: array of co begin Raise EXmlRpcException.CreateFmt(AMsg,AArgs); end; + +function TXmlRpcBaseFormatter.GetFormatName() : string; +begin + Result := sPROTOCOL_NAME; +end; +procedure TXmlRpcBaseFormatter.WriteBuffer(const AValue: string); +var + strm : TStringStream; + locDoc : TwstXMLDocument; + locNode : TDOMNode; +begin + CheckScope(); + locDoc := nil; + strm := TStringStream.Create(AValue); + try + ReadXMLFile(locDoc,strm); + locNode := locDoc.DocumentElement.CloneNode(True {$IFDEF FPC}, StackTop().ScopeObject.OwnerDocument{$ENDIF}); + StackTop().ScopeObject.AppendChild(locNode); + finally + ReleaseDomNode(locDoc); + strm.Free(); + end; +end; { TParamsArrayStackItem } @@ -1470,13 +1540,6 @@ begin end; end; -destructor TParamsArrayStackItem.Destroy(); -begin - if Assigned(FItemList) then - ReleaseDomNode(FItemList); - inherited Destroy(); -end; - function TParamsArrayStackItem.FindNode(var ANodeName: string): TDOMNode; begin EnsureListCreated(); @@ -1511,4 +1574,55 @@ begin valueNode.AppendChild(Result); end; +{ TBaseArrayStackItem } + +destructor TBaseArrayStackItem.Destroy; +begin + SetLength(FIndexStack,0); + if Assigned(FItemList) then + ReleaseDomNode(FItemList); + inherited Destroy(); +end; + +function TBaseArrayStackItem.GetScopeItemNames(const AReturnList: TStrings): Integer; +var + i : Integer; + locName : string; +begin + AReturnList.Clear(); + PushIndex(0); + try + locName := ''; + for i := 0 to Pred(GetItemsCount()) do begin + FindNode(locName); + AReturnList.Add(locName); + end; + finally + PopIndex(); + end; + Result := AReturnList.Count; +end; + +function TBaseArrayStackItem.PopIndex() : Integer; +begin + if ( Length(FIndexStack) = 0 ) or ( FIndexStackIDX < 0 ) then + raise EXmlRpcException.Create('TArrayStackItem.PopIndex() >> No saved index.'); + Result := FIndex; + FIndex := FIndexStack[FIndexStackIDX]; + Dec(FIndexStackIDX); +end; + +function TBaseArrayStackItem.PushIndex(const AValue: Integer): Integer; +begin + if ( FIndexStackIDX = Length(FIndexStack) ) then begin + if ( Length(FIndexStack) = 0 ) then + FIndexStackIDX := -1; + SetLength(FIndexStack, Length(FIndexStack) + 4); + end; + Inc(FIndexStackIDX); + Result := FIndex; + FIndex := AValue; + FIndexStack[FIndexStackIDX] := Result; +end; + end. diff --git a/wst/trunk/imp_utils.pas b/wst/trunk/imp_utils.pas index 518ffbfb6..c394a2efb 100644 --- a/wst/trunk/imp_utils.pas +++ b/wst/trunk/imp_utils.pas @@ -45,6 +45,7 @@ Type function IsStrEmpty(Const AStr:String):Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} function GetToken(var ABuffer : string; const ADelimiter : string): string; function ExtractOptionName(const ACompleteName : string):string; + function TranslateDotToDecimalSeperator(const Value: string) : string; implementation uses wst_types; @@ -86,6 +87,17 @@ begin Result := Trim(Result); end; +function TranslateDotToDecimalSeperator(const Value: string) : string; +var + i : PtrInt; +begin + Result := Value; + for i := 1 to length(Result) do begin + if ( Result[i] = '.' ) then + Result[i] := DecimalSeparator; + end; +end; + { TPublishedPropertyManager } procedure TPublishedPropertyManager.Error(const AMsg: string); @@ -124,9 +136,9 @@ begin end; procedure TPublishedPropertyManager.SetProperties(const APropsStr: string); -Var +var lst : TStringList; - i : Integer; + i : PtrInt; begin If IsStrEmpty(APropsStr) Then Exit; @@ -135,8 +147,8 @@ begin lst.QuoteChar := #0; lst.Delimiter := PROP_LIST_DELIMITER; lst.DelimitedText := APropsStr; - For i := 0 To Pred(lst.Count) Do - SetProperty(lst.Names[i],lst.ValueFromIndex[i]); + for i := 0 to Pred(lst.Count) do + SetProperty(lst.Names[i],lst.Values[lst.Names[i]]); Finally lst.Free(); End; diff --git a/wst/trunk/tests/test_suite/testformatter_unit.pas b/wst/trunk/tests/test_suite/testformatter_unit.pas index 1544341ce..75b20da76 100644 --- a/wst/trunk/tests/test_suite/testformatter_unit.pas +++ b/wst/trunk/tests/test_suite/testformatter_unit.pas @@ -30,6 +30,9 @@ type TTestEnum = ( teOne, teTwo, teThree, teFour ); + TArrayOfStringRemotableSample = class(TArrayOfStringRemotable) + end; + { TClass_A } TClass_A = class(TBaseComplexRemotable) @@ -334,59 +337,65 @@ type { TTestFormatter } - TTestFormatter= class(TTestFormatterSimpleType) + TTestFormatter = class(TTestFormatterSimpleType) + protected + class function GetFormaterName() : string;virtual;abstract; published procedure Test_Int_WithClass; - + procedure Test_Float_WithClass; procedure Test_Enum_Bool_String_WithClass; - + procedure Test_CplxInt64SimpleContent_WithClass; procedure Test_CplxInt32SimpleContent_WithClass; procedure Test_CplxInt16SimpleContent_WithClass; procedure Test_CplxInt8SimpleContent_WithClass; - + procedure Test_CplxFloatExtendedSimpleContent_WithClass; procedure Test_CplxStringSimpleContent_WithClass; - + procedure Test_Object(); procedure Test_Object_Nil(); procedure Test_StringArray(); procedure Test_StringArray_Embedded(); procedure Test_StringArrayZeroLength(); procedure Test_BooleanArray(); - + procedure Test_Int8UArray(); procedure Test_Int8SArray(); - + procedure Test_Int16SArray(); procedure Test_Int16UArray(); - + procedure Test_Int32UArray(); procedure Test_Int32SArray(); - + procedure Test_Int64SArray(); procedure Test_Int64UArray(); - + procedure Test_FloatSingleArray(); procedure Test_FloatDoubleArray(); procedure Test_FloatExtendedArray(); procedure Test_FloatCurrencyArray(); - + procedure Test_ComplexInt32S(); - + procedure Test_Record_simple(); procedure Test_Record_nested(); - + procedure test_GetScopeItemNames(); + procedure test_GetFormaterName(); end; { TTestBinaryFormatter } TTestBinaryFormatter= class(TTestFormatter) protected + class function GetFormaterName() : string;override; function CreateFormatter(ARootType : PTypeInfo):IFormatterBase;override; + published + procedure test_WriteBuffer(); end; { TTestBinaryFormatterAttributes } @@ -400,7 +409,10 @@ type TTestSOAPFormatter= class(TTestFormatter) protected + class function GetFormaterName() : string;override; function CreateFormatter(ARootType : PTypeInfo):IFormatterBase;override; + published + procedure test_WriteBuffer(); end; { TTestSOAPFormatterAttributes } @@ -416,12 +428,15 @@ type protected function CreateFormatter(ARootType : PTypeInfo):IFormatterBase;override; end; - + TTestXmlRpcFormatter= class(TTestFormatter) protected + class function GetFormaterName() : string;override; function CreateFormatter(ARootType : PTypeInfo):IFormatterBase;override; function Support_ComplextType_with_SimpleContent():Boolean;override; function Support_nil():Boolean;override; + published + procedure test_WriteBuffer(); end; { TTestArray } @@ -530,6 +545,152 @@ uses base_binary_formatter, base_soap_formatter, base_xmlrpc_formatter, record_r server_service_xmlrpc, xmlrpc_formatter, binary_streamer, server_binary_formatter, binary_formatter; +function CompareNodes(const A,B : PDataBuffer) : Boolean;overload;forward; + +function CompareObjectBuffers(const A,B : PObjectBuffer) : Boolean;overload; +var + ca, cb : PObjectBufferItem; + ok : Boolean; +begin + if ( A = nil ) and ( B = nil ) then begin + Result := True + end else if ( A <> nil ) and ( B <> nil ) then begin + if ( A^.NilObject = B^.NilObject ) and + ( A^.Count = B^.Count ) and + ( CompareNodes(A^.InnerData,B^.InnerData) ) + then begin + if ( A^.Count > 0 ) then begin + ca := A^.Head; + cb := B^.Head; + while Assigned(ca) do begin + if not CompareNodes(ca^.Data,cb^.Data) then + Break; + ca := ca^.Next; + cb := cb^.Next; + end; + ok := ( ca = nil ); + end else begin + ok := True; + end; + end else begin + ok := False; + end; + if ok then + Result := CompareObjectBuffers(A^.Attributes,B^.Attributes); + end else begin + Result := False; + end; +end; + +function CompareObjectBuffers(const A,B : PArrayBuffer) : Boolean;overload; +var + i : Integer; + ok : Boolean; +begin + if ( A = nil ) and ( B = nil ) then begin + Result := ok + end else if ( A <> nil ) and ( B <> nil ) then begin + if ( A^.Count = B^.Count ) then begin + ok := True; + if ( A^.Count > 0 ) then begin + for i := 0 to Pred(A^.Count) do begin + if not CompareNodes(A^.Items^[i],B^.Items^[i]) then begin + ok := False; + Break; + end; + end; + end; + if ok then + ok := CompareObjectBuffers(A^.Attributes,B^.Attributes); + end else begin + ok := False; + end; + end else begin + Result := ok; + end; + Result := ok; +end; + +function CompareNodes(const A,B : PDataBuffer) : Boolean;overload; +var + ca, cb : PObjectBufferItem; + i : PtrInt; + ok : Boolean; +begin + if ( A = nil ) and ( B = nil ) then begin + ok := True; + end else if ( A <> nil ) and ( B <> nil ) then begin + ok := False; + if ( A^.DataType = B^.DataType ) and + ( A^.Name = B^.Name ) + then begin + case A^.DataType of + dtInt8U,dtInt8S : ok := ( A^.Int8U = A^.Int8U ); + dtInt16U,dtInt16S : ok := ( A^.Int16U = A^.Int16U ); + dtInt32U,dtInt32S : ok := ( A^.Int32U = A^.Int32U ); + dtInt64U,dtInt64S : ok := ( A^.Int64U = A^.Int64U ); + dtBool : ok := ( A^.BoolData = A^.BoolData ); + dtEnum : ok := ( A^.EnumData = A^.EnumData ); + dtSingle : ok := ( A^.SingleData = A^.SingleData ); + dtDouble : ok := ( A^.DoubleData = A^.DoubleData ); + dtExtended : ok := ( A^.ExtendedData = A^.ExtendedData ); + dtCurrency : ok := ( A^.CurrencyData = A^.CurrencyData ); + dtString : ok := ( A^.StrData = A^.StrData ); + dtObject : ok := CompareObjectBuffers(A^.ObjectData,B^.ObjectData); + dtArray : ok := CompareObjectBuffers(A^.ArrayData,B^.ArrayData); + end; + end; + end else begin + ok := False; + end; + Result := ok; +end; + +function CompareNodes(const A,B : TDOMNode) : Boolean;overload; +var + ca, cb : TDOMNode; + i : PtrInt; +begin + if ( A = nil ) and ( B = nil ) then begin + Result := True; + end else if ( A <> nil ) and ( B <> nil ) then begin + Result := False; + if ( A.NodeName = B.NodeName ) and + ( A.NodeValue = B.NodeValue ) + then begin + if ( ( A.FirstChild = nil ) and ( B.FirstChild = nil ) ) or + ( ( A.FirstChild <> nil ) and ( B.FirstChild <> nil ) ) + then begin + ca := a.FirstChild; + cb := b.FirstChild; + while ( ca <> nil ) do begin + if not CompareNodes(ca,cb) then + Exit; + ca := ca.NextSibling; + cb := cb.NextSibling; + end; + if ( ( A.Attributes = nil ) and ( B.Attributes = nil ) ) or + ( ( A.Attributes <> nil ) and ( B.Attributes <> nil ) ) + then begin + if ( A.Attributes <> nil ) then begin + if ( A.Attributes.Length <> B.Attributes.Length ) then + Exit; + if ( A.Attributes.Length > 0 ) then begin + for i := 0 to Pred(A.Attributes.Length) do begin + if not CompareNodes(A.Attributes.Item[i],B.Attributes.Item[i]) then + Exit; + end; + end; + end; + Result := True; + end; + end; + end; + end else begin + Result := False; + end; +end; + function TTestFormatterSimpleType.Support_ComplextType_with_SimpleContent( ): Boolean; begin Result := True; @@ -2717,10 +2878,12 @@ Var a, b : TClass_A; x : string; ls : TStringList; + intv : TArrayOfStringRemotableSample; begin ls := nil; s := Nil; b := nil; + intv := nil; a := TClass_A.Create(); try a.Val_Bool := False; @@ -2728,17 +2891,25 @@ begin a.Val_String := '123'; a.Val_32S := 55; b := TClass_A.Create(); - + intv := TArrayOfStringRemotableSample.Create(); + intv.SetLength(3); + intv[0] := 'wst'; + intv[1] := 'azerty'; + intv[2] := 'qwerty'; + f := CreateFormatter(TypeInfo(TClass_A)); f.BeginObject('Root',TypeInfo(TClass_A)); f.Put('a',TypeInfo(TClass_A),a); f.Put('b',TypeInfo(TClass_A),b); + f.Put('intv',TypeInfo(TArrayOfStringRemotable),intv); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); + FreeAndNil(b); + FreeAndNil(intv); ls := TStringList.Create(); f := CreateFormatter(TypeInfo(TClass_A)); @@ -2746,13 +2917,37 @@ begin f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_A)); - CheckEquals(0, f.GetScopeItemNames(ls), 'GetScopeItemNames.Count()'); - Check( ls.IndexOf('Val_Bool') >= 0 ); - Check( ls.IndexOf('Val_Enum') >= 0 ); - Check( ls.IndexOf('Val_String') >= 0 ); - Check( ls.IndexOf('Val_32S') >= 0 ); + CheckEquals(3, f.GetScopeItemNames(ls), 'GetScopeItemNames.Count(Root)'); + Check( ls.IndexOf('a') >= 0 ); + Check( ls.IndexOf('b') >= 0 ); + Check( ls.IndexOf('intv') >= 0 ); + x := 'a'; + f.BeginObjectRead(x,TypeInfo(TClass_A)); + CheckEquals(4, f.GetScopeItemNames(ls), 'GetScopeItemNames.Count(a)'); + Check( ls.IndexOf('Val_Bool') >= 0 ); + Check( ls.IndexOf('Val_Enum') >= 0 ); + Check( ls.IndexOf('Val_String') >= 0 ); + Check( ls.IndexOf('Val_32S') >= 0 ); + f.EndScopeRead(); + + x := 'b'; + f.BeginObjectRead(x,TypeInfo(TClass_A)); + CheckEquals(4, f.GetScopeItemNames(ls), 'GetScopeItemNames.Count(b)'); + Check( ls.IndexOf('Val_Bool') >= 0 ); + Check( ls.IndexOf('Val_Enum') >= 0 ); + Check( ls.IndexOf('Val_String') >= 0 ); + Check( ls.IndexOf('Val_32S') >= 0 ); + f.EndScopeRead(); + + x := 'intv'; + f.BeginArrayRead(x,TypeInfo(TArrayOfStringRemotableSample),asScoped,'OI'); + CheckEquals(3, f.GetScopeItemNames(ls), 'GetScopeItemNames.Count(intv)'); + //Check( ls.IndexOf('OI') >= 0 ); + f.EndScopeRead(); + f.EndScopeRead(); finally + intv.Free(); ls.Free(); b.Free();; a.Free(); @@ -2769,6 +2964,51 @@ begin //Result.BeginObject('root',Nil); end; +class function TTestBinaryFormatter.GetFormaterName(): string; +begin + Result := 'wst-binary'; +end; + +procedure TTestBinaryFormatter.test_WriteBuffer(); +var + bw : IDataStore; + br : IDataStoreReader; + f : IFormatterBase; + strm : TStringStream; + a, b, tmp : PDataBuffer; + locBuffer : string; +begin + a := CreateObjBuffer(dtObject,'a',nil); + CreateObjBuffer(dtString,'aa',a)^.StrData^.Data := 'val_aa'; + tmp := CreateObjBuffer(dtObject,'b',a); + tmp := CreateObjBuffer(dtObject,'c',tmp); + CreateObjBuffer(dtInt32U,'i',tmp)^.Int32S := 1210; + CreateObjBuffer(dtString,'s',tmp)^.StrData^.Data := 's string sample'; + b := nil; + strm := TStringStream.Create(''); + try + bw := CreateBinaryWriter(strm); + SaveObjectToStream(a,bw); + strm.Position := 0; + locBuffer := strm.DataString; + + f := TBaseBinaryFormatter.Create() as IFormatterBase; + //f.BeginObject('Root',TypeInfo(TClass_A)); //done in the constructor! + f.WriteBuffer(locBuffer); + //f.EndScope(); + strm.Size := 0; + f.SaveToStream(strm); + strm.Position := 0; + br := CreateBinaryReader(strm); + b := LoadObjectFromStream(br); + Check(CompareNodes(a,b^.ObjectData^.Head^.Data)); + finally + strm.Free(); + ClearObj(a); + ClearObj(b); + end; +end; + { TTestSOAPFormatter } function TTestSOAPFormatter.CreateFormatter(ARootType : PTypeInfo):IFormatterBase; @@ -2777,6 +3017,53 @@ begin Result.BeginObject('Env',ARootType) end; +class function TTestSOAPFormatter.GetFormaterName(): string; +begin + Result := 'SOAP'; +end; + +procedure TTestSOAPFormatter.test_WriteBuffer(); +const + s_XML_BUFFER = + ' ' + + ' ' + + ' ' + + ' ' + + ' -76 ' + + ' wst record sample ' + + ' ' + + ' ' + + ''; +var + f : IFormatterBase; + strm : TMemoryStream; + da, db : TXMLDocument; +begin + f := TSOAPBaseFormatter.Create() as IFormatterBase; + f.BeginObject('Root',TypeInfo(TClass_A)); + f.WriteBuffer(s_XML_BUFFER); + f.EndScope(); + da := nil; + db := nil; + strm := TMemoryStream.Create(); + try + f.SaveToStream(strm); + strm.Position := 0; + ReadXMLFile(da,strm); + + strm.Size := 0; + strm.WriteBuffer(s_XML_BUFFER[1],Length(s_XML_BUFFER)); + strm.Position := 0; + ReadXMLFile(db,strm); + + Check(CompareNodes(da.DocumentElement.FirstChild,db.DocumentElement)); + finally + ReleaseDomNode(da); + ReleaseDomNode(db); + strm.Free(); + end; +end; + { TClass_B } procedure TClass_B.SetObjProp(const AValue: TClass_A); @@ -3399,6 +3686,11 @@ begin Result := TXmlRpcBaseFormatter.Create() as IFormatterBase; end; +class function TTestXmlRpcFormatter.GetFormaterName(): string; +begin + Result := 'XMLRPC'; +end; + function TTestXmlRpcFormatter.Support_ComplextType_with_SimpleContent(): Boolean; begin Result := False; @@ -3409,6 +3701,48 @@ begin Result := False; end; +procedure TTestXmlRpcFormatter.test_WriteBuffer(); +const + s_XML_BUFFER = + ' ' + + ' ' + + ' ' + + ' ' + + ' -76 ' + + ' wst record sample ' + + ' ' + + ' ' + + ''; +var + f : IFormatterBase; + strm : TMemoryStream; + da, db : TXMLDocument; +begin + f := TXmlRpcBaseFormatter.Create() as IFormatterBase; + f.BeginObject('Root',TypeInfo(TClass_A)); + f.WriteBuffer(s_XML_BUFFER); + f.EndScope(); + da := nil; + db := nil; + strm := TMemoryStream.Create(); + try + f.SaveToStream(strm); + strm.Position := 0; + ReadXMLFile(da,strm); + + strm.Size := 0; + strm.WriteBuffer(s_XML_BUFFER[1],Length(s_XML_BUFFER)); + strm.Position := 0; + ReadXMLFile(db,strm); + + Check(CompareNodes(da.DocumentElement.FirstChild,db.DocumentElement)); + finally + ReleaseDomNode(da); + ReleaseDomNode(db); + strm.Free(); + end; +end; + { TTest_SoapFormatterExceptionBlock } function TTest_SoapFormatterExceptionBlock.CreateFormatter() : IFormatterResponse; @@ -3913,6 +4247,14 @@ begin end; end; +procedure TTestFormatter.test_GetFormaterName(); +var + f : IFormatterBase; +begin + f := CreateFormatter(TypeInfo(TClass_A)); + CheckEquals(Self.GetFormaterName(),f.GetFormatName()); +end; + initialization RegisterStdTypes(); GetTypeRegistry().Register(sXSD_NS,TypeInfo(TTestEnum),'TTestEnum').RegisterExternalPropertyName('teOne', '1'); @@ -3927,10 +4269,10 @@ initialization GetTypeRegistry().Register(sXSD_NS,TypeInfo(T_ComplexInt16SContent),'T_ComplexInt16SContent'); GetTypeRegistry().Register(sXSD_NS,TypeInfo(T_ComplexInt16UContent),'T_ComplexInt16UContent'); - + GetTypeRegistry().Register(sXSD_NS,TypeInfo(T_ComplexFloatExtendedContent),'T_ComplexFloatExtendedContent'); GetTypeRegistry().Register(sXSD_NS,TypeInfo(T_ComplexFloatDoubleContent),'T_ComplexFloatDoubleContent'); - + TClass_CplxSimpleContent.RegisterAttributeProperty('Elt_Exemple'); GetTypeRegistry().Register(sXSD_NS,TypeInfo(TClass_CplxSimpleContent),'TClass_CplxSimpleContent').RegisterExternalPropertyName('Elt_Exemple', 'published'); @@ -3938,6 +4280,10 @@ initialization RegisterExternalPropertyName(sARRAY_ITEM,'abc'); RegisterExternalPropertyName(sARRAY_STYLE,sEmbedded); end; + with GetTypeRegistry().Register(sWST_BASE_NS,TypeInfo(TArrayOfStringRemotableSample),'TArrayOfStringRemotableSample') do begin + RegisterExternalPropertyName(sARRAY_ITEM,'OI'); + RegisterExternalPropertyName(sARRAY_STYLE,sScoped); + end; GetTypeRegistry().Register(sWST_BASE_NS,TypeInfo(TTestSmallRecord),'TTestSmallRecord').RegisterExternalPropertyName('__FIELDS__','fieldSmallint;fieldWord;fieldString'); {$IFNDEF WST_RECORD_RTTI} diff --git a/wst/trunk/tests/test_suite/wst_test_suite.lpi b/wst/trunk/tests/test_suite/wst_test_suite.lpi index 3ae6b5d0d..b774d6969 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite.lpi +++ b/wst/trunk/tests/test_suite/wst_test_suite.lpi @@ -7,7 +7,7 @@ - + @@ -27,7 +27,7 @@ - + @@ -40,12 +40,12 @@ - - + + - + @@ -69,8 +69,8 @@ - - + + @@ -79,8 +79,8 @@ - - + + @@ -93,8 +93,8 @@ - - + + @@ -176,7 +176,7 @@ - + @@ -191,21 +191,21 @@ - + - + - + @@ -219,21 +219,21 @@ - + - + - - + + @@ -243,7 +243,7 @@ - + @@ -251,7 +251,7 @@ - + @@ -259,46 +259,46 @@ - + - + - + - + - + - + - + @@ -309,56 +309,50 @@ - - - - - - - - + + - - + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + @@ -366,9 +360,9 @@ - - - + + + @@ -376,9 +370,9 @@ - - - + + + @@ -386,9 +380,9 @@ - - - + + + @@ -396,9 +390,9 @@ - - - + + + @@ -406,326 +400,221 @@ - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - + - - + + - + - - + + - + - - + + - - - - - - - - - + + + - - - - - - - - - - - - + + + + + + + - + - - + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - + - - + + - - - + + + - + - - + + - - + + - + - - + + - - + + - + - - + + - - - + + + - - - + + + - - - + + + - + - - + + - - + + - - + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + @@ -763,11 +652,15 @@ - + + + + + diff --git a/wst/trunk/wst_global.inc b/wst/trunk/wst_global.inc index f0f72fb97..b2830a8be 100644 --- a/wst/trunk/wst_global.inc +++ b/wst/trunk/wst_global.inc @@ -3,21 +3,29 @@ {$DEFINE HAS_QWORD} {$UNDEF WST_INTF_DOM} //{$DEFINE USE_INLINE} -{$ELSE} + {$IF Defined(FPC_VERSION) and (FPC_VERSION = 2) } + {$IF Defined(FPC_RELEASE) and (FPC_RELEASE > 0) } + {$define FPC_211} + {$IFEND} + {$IFEND} + {$IF Defined(FPC_211)} + {$DEFINE HAS_FORMAT_SETTINGS} + {$IFEND} +{$ENDIF} + +{$IFNDEF FPC} {$UNDEF HAS_QWORD} {$UNDEF USE_INLINE} {$DEFINE WST_RECORD_RTTI} {$DEFINE WST_INTF_DOM} + {$IFDEF VER150} + {$DEFINE HAS_FORMAT_SETTINGS} + {$ENDIF} {$ENDIF} {$IFDEF CPU86} {$DEFINE HAS_COMP} {$ENDIF} -{$IFDEF FPC} - {$IF Defined(FPC_VERSION) and (FPC_VERSION = 2) } - {$IF Defined(FPC_RELEASE) and (FPC_RELEASE > 0) } - {$define FPC_211} - {$IFEND} - {$IFEND} -{$ENDIF} + +