From 7296df02a0429548dd538a09433cff50a457bd4f Mon Sep 17 00:00:00 2001 From: inoussa Date: Sun, 24 Aug 2008 13:33:06 +0000 Subject: [PATCH] +Serialization of compound element ( TBaseComplexRemotable ) is now handle by TObjectSerializer that can read/write elements of different name spaces +Fix server side SOAP headers reading. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@533 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- wst/trunk/base_binary_formatter.pas | 55 +- wst/trunk/base_json_formatter.pas | 53 +- wst/trunk/base_service_intf.pas | 265 +++- wst/trunk/base_soap_formatter.pas | 155 ++- wst/trunk/base_xmlrpc_formatter.pas | 50 +- wst/trunk/binary_formatter.pas | 12 +- wst/trunk/imp_utils.pas | 36 +- wst/trunk/json_formatter.pas | 9 - wst/trunk/metadata_wsdl.pas | 3 - wst/trunk/object_serializer.pas | 1229 +++++++++++++++++ wst/trunk/record_rtti.pas | 4 +- wst/trunk/server_service_soap.pas | 4 +- wst/trunk/service_intf.pas | 2 - wst/trunk/soap_formatter.pas | 17 - .../test_suite/delphi/gui_wst_test_suite.dpr | 4 +- .../files/class_properties_default.xsd | 1 + .../files/soap_multi_namespace_object.xml | 42 + .../tests/test_suite/test_generators.pas | 4 +- wst/trunk/tests/test_suite/test_json.pas | 2 +- wst/trunk/tests/test_suite/test_registry.pas | 178 +++ .../tests/test_suite/test_soap_specific.pas | 427 ++++++ .../tests/test_suite/test_suite_utils.pas | 2 +- wst/trunk/tests/test_suite/test_support.pas | 318 ++++- .../tests/test_suite/test_wst_cursors.pas | 8 +- .../tests/test_suite/testformatter_unit.pas | 48 +- wst/trunk/tests/test_suite/wst_test_suite.lpr | 2 +- .../tests/test_suite/wst_test_suite_gui.lpi | 11 +- .../tests/test_suite/wst_test_suite_gui.lpr | 2 +- wst/trunk/wst_global.inc | 3 + wst/trunk/xmlrpc_formatter.pas | 17 - 30 files changed, 2761 insertions(+), 202 deletions(-) create mode 100644 wst/trunk/object_serializer.pas create mode 100644 wst/trunk/tests/test_suite/files/soap_multi_namespace_object.xml create mode 100644 wst/trunk/tests/test_suite/test_registry.pas create mode 100644 wst/trunk/tests/test_suite/test_soap_specific.pas diff --git a/wst/trunk/base_binary_formatter.pas b/wst/trunk/base_binary_formatter.pas index ce28b3762..91eb6bd3a 100644 --- a/wst/trunk/base_binary_formatter.pas +++ b/wst/trunk/base_binary_formatter.pas @@ -175,6 +175,7 @@ type FRootData : PDataBuffer; FStack : TObjectStack; FSerializationStyle : TSerializationStyle; + FPropMngr : IPropertyManager; {$IFDEF wst_binary_header} FHeaderEnterCount : Integer; {$ENDIF} @@ -278,6 +279,7 @@ type constructor Create();override; destructor Destroy();override; function GetFormatName() : string; + function GetPropertyManager():IPropertyManager; procedure Clear(); @@ -318,16 +320,28 @@ type Const AName : String; Const ATypeInfo : PTypeInfo; Const AData - ); + );overload; + procedure Put( + const ANameSpace : string; + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData + );overload; procedure PutScopeInnerValue( const ATypeInfo : PTypeInfo; const AData ); procedure Get( - Const ATypeInfo : PTypeInfo; - Var AName : String; - Var AData - ); + const ATypeInfo : PTypeInfo; + var AName : string; + var AData + );overload; + procedure Get( + const ATypeInfo : PTypeInfo; + const ANameSpace : string; + var AName : string; + var AData + );overload; procedure GetScopeInnerValue( const ATypeInfo : PTypeInfo; var AData @@ -361,7 +375,9 @@ type procedure PrintObj(const ARoot: PDataBuffer; const ALevel : Integer; const APrinterProc : TDBGPinterProc); implementation - +uses + imp_utils; + {$INCLUDE wst_rtl_imp.inc} procedure PrintObj(const ARoot: PDataBuffer; const ALevel : Integer; const APrinterProc : TDBGPinterProc); @@ -1253,6 +1269,16 @@ begin End; end; +procedure TBaseBinaryFormatter.Put( + const ANameSpace : string; + const AName : String; + const ATypeInfo : PTypeInfo; + const AData +); +begin + Put(AName,ATypeInfo,AData); +end; + procedure TBaseBinaryFormatter.PutScopeInnerValue( const ATypeInfo : PTypeInfo; const AData @@ -1482,6 +1508,16 @@ begin End; end; +procedure TBaseBinaryFormatter.Get( + const ATypeInfo : PTypeInfo; + const ANameSpace : string; + var AName : string; + var AData +); +begin + Get(ATypeInfo,AName,AData); +end; + procedure TBaseBinaryFormatter.GetScopeInnerValue( const ATypeInfo : PTypeInfo; var AData @@ -1627,6 +1663,13 @@ begin Result := sBINARY_FORMAT_NAME; end; +function TBaseBinaryFormatter.GetPropertyManager() : IPropertyManager; +begin + If Not Assigned(FPropMngr) Then + FPropMngr := TPublishedPropertyManager.Create(Self); + Result := FPropMngr; +end; + procedure TBaseBinaryFormatter.WriteBuffer(const AValue: string); var locStore : IDataStoreReader; diff --git a/wst/trunk/base_json_formatter.pas b/wst/trunk/base_json_formatter.pas index 00f96e807..0a63f9a77 100644 --- a/wst/trunk/base_json_formatter.pas +++ b/wst/trunk/base_json_formatter.pas @@ -180,6 +180,7 @@ type TJsonRpcBaseFormatter = class(TSimpleFactoryItem,IFormatterBase) private + FPropMngr : IPropertyManager; FRootData : TJSONData; FSerializationStyle : TSerializationStyle; FStack : TObjectStack; @@ -276,6 +277,7 @@ type procedure SetSerializationStyle(const ASerializationStyle : TSerializationStyle); function GetSerializationStyle():TSerializationStyle; function GetFormatName() : string; + function GetPropertyManager():IPropertyManager; procedure Clear(); procedure BeginObject( @@ -314,16 +316,28 @@ type Const AName : String; Const ATypeInfo : PTypeInfo; Const AData - ); + );overload; + procedure Put( + const ANameSpace : string; + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData + );overload; procedure PutScopeInnerValue( const ATypeInfo : PTypeInfo; const AData ); procedure Get( - Const ATypeInfo : PTypeInfo; - Var AName : String; - Var AData - ); + const ATypeInfo : PTypeInfo; + var AName : string; + var AData + );overload; + procedure Get( + const ATypeInfo : PTypeInfo; + const ANameSpace : string; + var AName : string; + var AData + );overload; procedure GetScopeInnerValue( const ATypeInfo : PTypeInfo; var AData @@ -344,7 +358,7 @@ type implementation -uses jsonparser; +uses jsonparser, imp_utils; { TJsonRpcBaseFormatter } @@ -556,6 +570,13 @@ begin Result := s_json; end; +function TJsonRpcBaseFormatter.GetPropertyManager() : IPropertyManager; +begin + If Not Assigned(FPropMngr) Then + FPropMngr := TPublishedPropertyManager.Create(Self); + Result := FPropMngr; +end; + function TJsonRpcBaseFormatter.GetCurrentScope : string; begin CheckScope(); @@ -785,6 +806,16 @@ begin End; end; +procedure TJsonRpcBaseFormatter.Put( + const ANameSpace : string; + const AName : String; + const ATypeInfo : PTypeInfo; + const AData +); +begin + Put(AName,ATypeInfo,AData); +end; + procedure TJsonRpcBaseFormatter.PutScopeInnerValue(const ATypeInfo : PTypeInfo; const AData); var locName : string; @@ -951,6 +982,16 @@ begin End; end; +procedure TJsonRpcBaseFormatter.Get( + const ATypeInfo : PTypeInfo; + const ANameSpace : string; + var AName : string; + var AData +); +begin + Get(ATypeInfo,AName,AData); +end; + procedure TJsonRpcBaseFormatter.GetScopeInnerValue(const ATypeInfo : PTypeInfo; var AData); var locName : string; diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas index d832768f1..051a5c97a 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 GetPropertyManager():IPropertyManager; function GetFormatName() : string; procedure SetSerializationStyle(const ASerializationStyle : TSerializationStyle); function GetSerializationStyle():TSerializationStyle; @@ -174,16 +175,28 @@ type Const AName : String; Const ATypeInfo : PTypeInfo; Const AData - ); + );overload; + procedure Put( + const ANameSpace : string; + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData + );overload; procedure PutScopeInnerValue( const ATypeInfo : PTypeInfo; const AData ); procedure Get( - Const ATypeInfo : PTypeInfo; - Var AName : String; - Var AData - ); + const ATypeInfo : PTypeInfo; + var AName : string; + var AData + );overload; + procedure Get( + const ATypeInfo : PTypeInfo; + const ANameSpace : string; + var AName : string; + var AData + );overload; procedure GetScopeInnerValue( const ATypeInfo : PTypeInfo; var AData @@ -294,6 +307,10 @@ type procedure Assign(Source: TPersistent); override; function Equal(const ACompareTo : TBaseRemotable) : Boolean;override; + procedure LoadFromStream(AStream : TStream); + procedure LoadFromFile(const AFileName : string); + procedure SaveToStream(AStream : TStream); + procedure SaveToFile(const AFileName : string); property BinaryData : TBinaryString read FBinaryData write FBinaryData; property EncodedString : string read GetEncodedString write SetEncodedString; end; @@ -621,7 +638,7 @@ type private FBinaryData : TBinaryString; private - function GetEncodedString() : string; + function GetEncodedString : string; procedure SetEncodedString(const AValue : string); protected class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override; @@ -629,6 +646,10 @@ type public procedure Assign(Source: TPersistent); override; function Equal(const ACompareTo : TBaseRemotable) : Boolean;override; + procedure LoadFromStream(AStream : TStream); + procedure LoadFromFile(const AFileName : string); + procedure SaveToStream(AStream : TStream); + procedure SaveToFile(const AFileName : string); property BinaryData : TBinaryString read FBinaryData write FBinaryData; property EncodedString : string read GetEncodedString write SetEncodedString; end; @@ -1277,11 +1298,31 @@ type TTypeRegistryItemOption = ( trioNonVisibleToMetadataService ); TTypeRegistryItemOptions = set of TTypeRegistryItemOption; + TTypeRegistry = class; + TTypeRegistryItem = class; + TTypeRegistryItemClass = class of TTypeRegistryItem; + + TRemotableTypeInitializerClass = class of TRemotableTypeInitializer; + { TRemotableTypeInitializer } + + TRemotableTypeInitializer = class + public + class function CanHandle(ATypeInfo : PTypeInfo) : Boolean;virtual; + class function GetItemClass(const ATypeInfo : PTypeInfo) : TTypeRegistryItemClass;virtual; +{$IFDEF TRemotableTypeInitializer_Initialize} + class function Initialize( + ATypeInfo : PTypeInfo; + ARegistryItem : TTypeRegistryItem + ) : Boolean;virtual;abstract; +{$ENDIF TRemotableTypeInitializer_Initialize} + end; + { TTypeRegistryItem } TTypeRegistryItem = class private + FOwner : TTypeRegistry; FDataType: PTypeInfo; FNameSpace: string; FDeclaredName : string; @@ -1293,10 +1334,11 @@ type procedure CreateInternalObjects();{$IFDEF USE_INLINE}inline;{$ENDIF} public constructor Create( + AOwner : TTypeRegistry; ANameSpace : string; ADataType : PTypeInfo; Const ADeclaredName : string = '' - ); + );virtual; destructor Destroy();override; function AddPascalSynonym(const ASynonym : string):TTypeRegistryItem; function IsSynonym(const APascalTypeName : string):Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} @@ -1308,6 +1350,7 @@ type procedure RegisterObject(const APropName : string; const AObject : TObject); function GetObject(const APropName : string) : TObject; + property Owner : TTypeRegistry read FOwner; property DataType : PTypeInfo read FDataType; property NameSpace : string read FNameSpace; property DeclaredName : string read FDeclaredName; @@ -1317,14 +1360,21 @@ type { TTypeRegistry } TTypeRegistry = class - Private + private FList : TObjectList; + FInitializerList : TClassList; + private + function GetItemClassFor(const ATypeInfo : PTypeInfo) : TTypeRegistryItemClass; +{$IFDEF TRemotableTypeInitializer_Initialize} + procedure InitializeItem(AItem : TTypeRegistryItem); +{$ENDIF TRemotableTypeInitializer_Initialize} function GetCount: Integer;{$IFDEF USE_INLINE}inline;{$ENDIF} function GetItemByIndex(Index: Integer): TTypeRegistryItem;{$IFDEF USE_INLINE}inline;{$ENDIF} function GetItemByTypeInfo(Index: PTypeInfo): TTypeRegistryItem; - Public + public constructor Create(); destructor Destroy();override; + procedure RegisterInitializer(AInitializer : TRemotableTypeInitializerClass); function IndexOf(Const ATypeInfo : PTypeInfo):Integer; function Add(AItem:TTypeRegistryItem):Integer; function Register( @@ -1338,7 +1388,7 @@ type Property Count : Integer Read GetCount; Property Item[Index:Integer] : TTypeRegistryItem Read GetItemByIndex;default; Property ItemByTypeInfo[Index:PTypeInfo] : TTypeRegistryItem Read GetItemByTypeInfo; - End; + end; TPropStoreType = ( pstNever, pstOptional, pstAlways ); @@ -1398,7 +1448,8 @@ var {$ENDIF HAS_FORMAT_SETTINGS} implementation -uses imp_utils, record_rtti, basex_encode; +uses + imp_utils, record_rtti, basex_encode, object_serializer; type @@ -1730,8 +1781,10 @@ begin Result := FList[i] as TSerializeOptions; for j := 0 to Pred(c) do begin ri := FList[j] as TSerializeOptions; - for k := 0 to Pred(ri.AttributeFieldCount) do begin - Result.FAttributeFieldList.Add(ri.FAttributeFieldList[k]); + if AElementClass.InheritsFrom(ri.ElementClass) then begin + for k := 0 to Pred(ri.AttributeFieldCount) do begin + Result.FAttributeFieldList.Add(ri.FAttributeFieldList[k]); + end; end; end; end; @@ -1792,6 +1845,17 @@ class procedure TBaseComplexRemotable.Save( const AName : String; const ATypeInfo : PTypeInfo ); +{$IFDEF USE_SERIALIZE} +var + locSerializer : TObjectSerializer; +begin + locSerializer := TBaseComplexTypeRegistryItem(GetTypeRegistry().ItemByTypeInfo[ATypeInfo]).GetSerializer(); + if ( locSerializer <> nil ) then + locSerializer.Save(AObject,AStore,AName,ATypeInfo) + else + raise ETypeRegistryException.CreateFmt(SERR_NoSerializerFoThisType,[ATypeInfo^.Name]) +end; +{$ELSE USE_SERIALIZE} Var propList : PPropList; i, propCount, propListLen : Integer; @@ -1949,6 +2013,7 @@ begin AStore.SetSerializationStyle(oldSS); end; end; +{$ENDIF USE_SERIALIZE} Type TFloatExtendedType = Extended; @@ -1958,6 +2023,17 @@ class procedure TBaseComplexRemotable.Load( var AName : String; const ATypeInfo : PTypeInfo ); +{$IFDEF USE_SERIALIZE} +var + locSerializer : TObjectSerializer; +begin + locSerializer := TBaseComplexTypeRegistryItem(GetTypeRegistry().ItemByTypeInfo[ATypeInfo]).GetSerializer(); + if ( locSerializer <> nil ) then + locSerializer.Read(AObject,AStore,AName,ATypeInfo) + else + raise ETypeRegistryException.CreateFmt(SERR_NoSerializerFoThisType,[ATypeInfo^.Name]) +end; +{$ELSE USE_SERIALIZE} Var propList : PPropList; i, propCount, propListLen : Integer; @@ -2134,6 +2210,7 @@ begin end; end; end; +{$ENDIF USE_SERIALIZE} { TBaseObjectArrayRemotable } @@ -2633,11 +2710,13 @@ begin end; constructor TTypeRegistryItem.Create( + AOwner : TTypeRegistry; ANameSpace : String; ADataType : PTypeInfo; Const ADeclaredName : String ); begin + FOwner := AOwner; FNameSpace := ANameSpace; FDataType := ADataType; FDeclaredName := Trim(ADeclaredName); @@ -2646,10 +2725,26 @@ begin end; destructor TTypeRegistryItem.Destroy(); + + procedure FreeObjects(); + var + j, k : PtrInt; + obj : TObject; + begin + j := FExternalNames.Count; + for k := 0 to Pred(j) do begin + obj := FExternalNames.Objects[k]; + if ( obj <> nil ) then + obj.Free(); + end; + end; + begin - FreeAndNil(FInternalNames); - FreeAndNil(FExternalNames); - FreeAndNil(FSynonymTable); + if ( FExternalNames <> nil ) and ( FExternalNames.Count > 0 ) then + FreeObjects(); + FInternalNames.Free(); + FExternalNames.Free(); + FSynonymTable.Free(); inherited Destroy(); end; @@ -2728,6 +2823,41 @@ end; { TTypeRegistry } +function TTypeRegistry.GetItemClassFor(const ATypeInfo : PTypeInfo) : TTypeRegistryItemClass; +var + i, c : PtrInt; + locInitializer : TRemotableTypeInitializerClass; +begin + Result := TTypeRegistryItem; + c := FInitializerList.Count; + if ( c > 0 ) then begin + for i := Pred(c) downto 0 do begin + locInitializer := TRemotableTypeInitializerClass(FInitializerList[i]); + if locInitializer.CanHandle(ATypeInfo) then begin + Result := locInitializer.GetItemClass(ATypeInfo); + Break; + end; + end; + end; +end; + +{$IFDEF TRemotableTypeInitializer_Initialize} +procedure TTypeRegistry.InitializeItem(AItem : TTypeRegistryItem); +var + i, c : PtrInt; + locInitializer : TRemotableTypeInitializerClass; +begin + c := FInitializerList.Count; + if ( c > 0 ) then begin + for i := Pred(c) downto 0 do begin + locInitializer := TRemotableTypeInitializerClass(FInitializerList[i]); + if locInitializer.CanHandle(AItem.DataType) and locInitializer.Initialize(AItem.DataType,AItem) then + Break; + end; + end; +end; +{$ENDIF TRemotableTypeInitializer_Initialize} + function TTypeRegistry.GetCount: Integer; begin Result := FList.Count; @@ -2754,14 +2884,22 @@ constructor TTypeRegistry.Create(); begin Inherited Create(); FList := TObjectList.Create(True); + FInitializerList := TClassList.Create(); end; destructor TTypeRegistry.Destroy(); begin - FreeAndNil(FList); + FInitializerList.Free(); + FList.Free(); inherited Destroy(); end; +procedure TTypeRegistry.RegisterInitializer(AInitializer : TRemotableTypeInitializerClass); +begin + if ( FInitializerList.IndexOf(AInitializer) = -1 ) then + FInitializerList.Add(AInitializer); +end; + function TTypeRegistry.IndexOf(Const ATypeInfo: PTypeInfo): Integer; begin For Result := 0 To Pred(Count) Do Begin @@ -2791,9 +2929,15 @@ var i : Integer; begin i := IndexOf(ADataType); - if ( i = -1 ) then - i := Add(TTypeRegistryItem.Create(ANameSpace,ADataType,ADeclaredName)); - Result := Item[i]; + if ( i = -1 ) then begin + Result := GetItemClassFor(ADataType).Create(Self,ANameSpace,ADataType,ADeclaredName); + i := Add(Result); +{$IFDEF TRemotableTypeInitializer_Initialize} + InitializeItem(Result); +{$ENDIF TRemotableTypeInitializer_Initialize} + end else begin + Result := Item[i]; + end; end; function TTypeRegistry.Find(ATypeInfo : PTypeInfo; Const AExact : Boolean):TTypeRegistryItem; @@ -4274,13 +4418,15 @@ class function TAbstractComplexRemotable.IsAttributeProperty(const AProperty: sh var ri : TSerializeOptions; pc : TClass; + sor : TSerializeOptionsRegistry; begin Result := False; if ( Self = TBaseComplexRemotable ) then Exit; + sor := GetSerializeOptionsRegistry(); pc := Self; while Assigned(pc) and pc.InheritsFrom(TBaseComplexRemotable) do begin - ri := GetSerializeOptionsRegistry().Find(TBaseComplexRemotableClass(pc)); + ri := sor.Find(TBaseComplexRemotableClass(pc)); if Assigned(ri) then begin Result := ri.IsAttributeField(AProperty); Exit; @@ -5615,7 +5761,7 @@ end; { TBase64StringRemotable } -function TBase64StringRemotable.GetEncodedString() : string; +function TBase64StringRemotable.GetEncodedString : string; begin Result := Base64Encode(BinaryData); end; @@ -5676,9 +5822,37 @@ begin ( TBase64StringRemotable(ACompareTo).BinaryData = Self.BinaryData ); end; +procedure TBase64StringRemotable.LoadFromStream(AStream : TStream); +begin + BinaryData := LoadBufferFromStream(AStream); +end; + +procedure TBase64StringRemotable.LoadFromFile(const AFileName : string); +begin + BinaryData := LoadBufferFromFile(AFileName); +end; + +procedure TBase64StringRemotable.SaveToStream(AStream : TStream); +begin + if ( Length(FBinaryData) > 0 ) then + AStream.Write(FBinaryData[1],Length(FBinaryData)); +end; + +procedure TBase64StringRemotable.SaveToFile(const AFileName : string); +var + locStream : TFileStream; +begin + locStream := TFileStream.Create(AFileName,fmCreate); + try + SaveToStream(locStream); + finally + locStream.Free(); + end; +end; + { TBase64StringExtRemotable } -function TBase64StringExtRemotable.GetEncodedString() : string; +function TBase64StringExtRemotable.GetEncodedString : string; begin Result := Base64Encode(BinaryData); end; @@ -5712,6 +5886,34 @@ begin ( TBase64StringExtRemotable(ACompareTo).BinaryData = Self.BinaryData ); end; +procedure TBase64StringExtRemotable.LoadFromStream(AStream : TStream); +begin + BinaryData := LoadBufferFromStream(AStream); +end; + +procedure TBase64StringExtRemotable.LoadFromFile(const AFileName : string); +begin + BinaryData := LoadBufferFromFile(AFileName); +end; + +procedure TBase64StringExtRemotable.SaveToStream(AStream : TStream); +begin + if ( Length(FBinaryData) > 0 ) then + AStream.Write(FBinaryData[1],Length(FBinaryData)); +end; + +procedure TBase64StringExtRemotable.SaveToFile(const AFileName : string); +var + locStream : TFileStream; +begin + locStream := TFileStream.Create(AFileName,fmCreate); + try + SaveToStream(locStream); + finally + locStream.Free(); + end; +end; + procedure TBase64StringExtRemotable.Assign(Source: TPersistent); begin if Assigned(Source) and Source.InheritsFrom(TBase64StringExtRemotable) then begin @@ -5732,8 +5934,10 @@ begin {$ENDIF} {$ENDIF HAS_FORMAT_SETTINGS} - if ( TypeRegistryInstance = nil ) then + if ( TypeRegistryInstance = nil ) then begin TypeRegistryInstance := TTypeRegistry.Create(); + TypeRegistryInstance.RegisterInitializer(TBaseComplexRemotableInitializer); + end; if ( SerializeOptionsRegistryInstance = nil ) then SerializeOptionsRegistryInstance := TSerializeOptionsRegistry.Create(); RegisterStdTypes(); @@ -5963,6 +6167,19 @@ begin Result := '-' + Result; end; +{ TRemotableTypeInitializer } + +class function TRemotableTypeInitializer.CanHandle(ATypeInfo : PTypeInfo) : Boolean; +begin + Result := False; +end; + +class function TRemotableTypeInitializer.GetItemClass(const ATypeInfo : PTypeInfo) : TTypeRegistryItemClass; +begin + Result := TTypeRegistryItem; +end; + + initialization initialize_base_service_intf(); diff --git a/wst/trunk/base_soap_formatter.pas b/wst/trunk/base_soap_formatter.pas index 30a529c7d..d61015108 100644 --- a/wst/trunk/base_soap_formatter.pas +++ b/wst/trunk/base_soap_formatter.pas @@ -128,6 +128,7 @@ type TSOAPBaseFormatter = class(TSimpleFactoryItem,IFormatterBase) private + FPropMngr : IPropertyManager; FContentType: string; FEncodingStyle: TSOAPEncodingStyle; FStyle: TSOAPDocumentStyle; @@ -148,31 +149,37 @@ type procedure CheckScope();{$IFDEF USE_INLINE}inline;{$ENDIF} function InternalPutData( + const ANameSpace : string; Const AName : String; Const ATypeInfo : PTypeInfo; Const AData : string ):TDOMNode; function PutEnum( + const ANameSpace : string; Const AName : String; Const ATypeInfo : PTypeInfo; Const AData : TEnumIntType ):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF} function PutBool( + const ANameSpace : string; Const AName : String; Const ATypeInfo : PTypeInfo; Const AData : Boolean ):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF} function PutInt64( + const ANameSpace : string; Const AName : String; Const ATypeInfo : PTypeInfo; Const AData : Int64 ):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF} function PutStr( + const ANameSpace : string; Const AName : String; Const ATypeInfo : PTypeInfo; Const AData : String ):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF} function PutFloat( + const ANameSpace : string; Const AName : String; Const ATypeInfo : PTypeInfo; Const AData : Extended @@ -188,36 +195,42 @@ type const AData : Pointer );{$IFDEF USE_INLINE}inline;{$ENDIF} - function GetNodeValue(var AName : String):DOMString; + function GetNodeValue(const ANameSpace : string; var AName : String):DOMString; procedure GetEnum( Const ATypeInfo : PTypeInfo; + const ANameSpace : string; Var AName : String; Var AData : TEnumIntType );{$IFDEF USE_INLINE}inline;{$ENDIF} procedure GetBool( Const ATypeInfo : PTypeInfo; + const ANameSpace : string; Var AName : String; Var AData : Boolean );{$IFDEF USE_INLINE}inline;{$ENDIF} {$IFDEF FPC} procedure GetInt( Const ATypeInfo : PTypeInfo; + const ANameSpace : string; Var AName : String; Var AData : Integer );{$IFDEF USE_INLINE}inline;{$ENDIF} {$ENDIF} procedure GetInt64( Const ATypeInfo : PTypeInfo; + const ANameSpace : string; Var AName : String; Var AData : Int64 );{$IFDEF USE_INLINE}inline;{$ENDIF} procedure GetFloat( Const ATypeInfo : PTypeInfo; + const ANameSpace : string; Var AName : String; Var AData : Extended );{$IFDEF USE_INLINE}inline;{$ENDIF} procedure GetStr( Const ATypeInfo : PTypeInfo; + const ANameSpace : string; Var AName : String; Var AData : String );{$IFDEF USE_INLINE}inline;{$ENDIF} @@ -289,6 +302,7 @@ type constructor Create();override; destructor Destroy();override; function GetFormatName() : string; + function GetPropertyManager():IPropertyManager; procedure Clear(); procedure BeginObject( @@ -324,10 +338,16 @@ type procedure EndHeader(); procedure Put( - const AName : string; - const ATypeInfo : PTypeInfo; - const AData - ); + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData + );overload; + procedure Put( + const ANameSpace : string; + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData + );overload; procedure PutScopeInnerValue( const ATypeInfo : PTypeInfo; const AData @@ -336,7 +356,13 @@ type const ATypeInfo : PTypeInfo; var AName : string; var AData - ); + );overload; + procedure Get( + const ATypeInfo : PTypeInfo; + const ANameSpace : string; + var AName : string; + var AData + );overload; procedure GetScopeInnerValue( const ATypeInfo : PTypeInfo; var AData @@ -686,6 +712,7 @@ begin end; function TSOAPBaseFormatter.InternalPutData( + const ANameSpace : string; const AName : String; const ATypeInfo : PTypeInfo; const AData : string @@ -696,9 +723,17 @@ Var begin strNodeName := AName; if ( Style = Document ) then begin - namespaceShortName := Copy(FindAttributeByValueInScope(StackTop().NameSpace),AnsiPos(':',namespaceShortName) + 1,MaxInt); - if not IsStrEmpty(namespaceShortName) then begin - s := ExtractNameSpaceShortName(namespaceShortName); + if ( ANameSpace = '' ) then + namespaceLongName := StackTop().NameSpace + else + namespaceLongName := ANameSpace; + s := FindAttributeByValueInScope(namespaceLongName); + if IsStrEmpty(s) then begin + namespaceShortName := 'ns' + IntToStr(NextNameSpaceCounter()); + AddScopeAttribute('xmlns:'+namespaceShortName, namespaceLongName); + strNodeName := s + ':' + strNodeName; + end else begin + s := ExtractNameSpaceShortName(s); if not IsStrEmpty(s) then strNodeName := s + ':' + strNodeName; end; @@ -734,12 +769,14 @@ begin end; function TSOAPBaseFormatter.PutEnum( + const ANameSpace : string; const AName: String; const ATypeInfo: PTypeInfo; const AData: TEnumIntType ): TDOMNode; begin Result := InternalPutData( + ANameSpace, AName, ATypeInfo, GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetExternalPropertyName(GetEnumName(ATypeInfo,AData)) @@ -747,30 +784,33 @@ begin end; function TSOAPBaseFormatter.PutBool( + const ANameSpace : string; const AName : String; const ATypeInfo : PTypeInfo; const AData : Boolean ): TDOMNode; begin - Result := InternalPutData(AName,ATypeInfo,BoolToSoapBool(AData)); + Result := InternalPutData(ANameSpace,AName,ATypeInfo,BoolToSoapBool(AData)); end; function TSOAPBaseFormatter.PutInt64( + const ANameSpace : string; const AName : String; const ATypeInfo : PTypeInfo; const AData : Int64 ): TDOMNode; begin - Result := InternalPutData(AName,ATypeInfo,IntToStr(AData)); + Result := InternalPutData(ANameSpace,AName,ATypeInfo,IntToStr(AData)); end; function TSOAPBaseFormatter.PutStr( + const ANameSpace : string; const AName: String; const ATypeInfo: PTypeInfo; const AData: String ):TDOMNode; begin - Result := InternalPutData(AName,ATypeInfo,AData); + Result := InternalPutData(ANameSpace,AName,ATypeInfo,AData); end; procedure TSOAPBaseFormatter.PutObj( @@ -792,6 +832,7 @@ begin end; function TSOAPBaseFormatter.PutFloat( + const ANameSpace : string; const AName : String; const ATypeInfo : PTypeInfo; const AData : Extended @@ -819,17 +860,21 @@ begin if ( i > 0 ) then s[i] := '.'; {$ENDIF HAS_FORMAT_SETTINGS} - Result := InternalPutData(AName,ATypeInfo,s); + Result := InternalPutData(ANameSpace,AName,ATypeInfo,s); end; -function TSOAPBaseFormatter.GetNodeValue(var AName: String): DOMString; -Var +function TSOAPBaseFormatter.GetNodeValue(const ANameSpace : string; var AName: String): DOMString; +var locElt : TDOMNode; namespaceShortName, strNodeName, s : string; begin strNodeName := AName; if ( Style = Document ) then begin - namespaceShortName := Copy(FindAttributeByValueInScope(StackTop().NameSpace),AnsiPos(':',namespaceShortName) + 1,MaxInt); + if ( ANameSpace = '' ) then + s := StackTop().NameSpace + else + s := ANameSpace; + namespaceShortName := FindAttributeByValueInScope(s); if not IsStrEmpty(namespaceShortName) then begin s := ExtractNameSpaceShortName(namespaceShortName); if not IsStrEmpty(s) then @@ -855,13 +900,14 @@ end; procedure TSOAPBaseFormatter.GetEnum( const ATypeInfo: PTypeInfo; + const ANameSpace : string; var AName: String; var AData: TEnumIntType ); Var locBuffer : String; begin - locBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(GetNodeValue(AName)); + locBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(GetNodeValue(ANameSpace,AName)); If IsStrEmpty(locBuffer) Then AData := 0 Else @@ -870,13 +916,14 @@ End; procedure TSOAPBaseFormatter.GetBool( const ATypeInfo : PTypeInfo; + const ANameSpace : string; var AName : String; var AData : Boolean ); Var locBuffer : String; begin - locBuffer := LowerCase(Trim(GetNodeValue(AName))); + locBuffer := LowerCase(Trim(GetNodeValue(ANameSpace,AName))); If IsStrEmpty(locBuffer) Then AData := False Else @@ -886,43 +933,47 @@ end; {$IFDEF FPC} procedure TSOAPBaseFormatter.GetInt( const ATypeInfo: PTypeInfo; + const ANameSpace : string; var AName: String; var AData: Integer ); begin - AData := StrToIntDef(Trim(GetNodeValue(AName)),0); + AData := StrToIntDef(Trim(GetNodeValue(ANameSpace,AName)),0); end; {$ENDIF} procedure TSOAPBaseFormatter.GetInt64( const ATypeInfo : PTypeInfo; + const ANameSpace : string; var AName : String; var AData : Int64 ); begin - AData := StrToInt64Def(Trim(GetNodeValue(AName)),0); + AData := StrToInt64Def(Trim(GetNodeValue(ANameSpace,AName)),0); end; procedure TSOAPBaseFormatter.GetFloat( const ATypeInfo : PTypeInfo; + const ANameSpace : string; var AName : String; var AData : Extended ); begin {$IFDEF HAS_FORMAT_SETTINGS} - AData := StrToFloatDef(Trim(GetNodeValue(AName)),0,wst_FormatSettings); + AData := StrToFloatDef(Trim(GetNodeValue(ANameSpace,AName)),0,wst_FormatSettings); {$ELSE} - AData := StrToFloatDef(TranslateDotToDecimalSeperator(Trim(GetNodeValue(AName))),0); + AData := StrToFloatDef(TranslateDotToDecimalSeperator(Trim(GetNodeValue(ANameSpace:=;,AName))),0); {$ENDIF HAS_FORMAT_SETTINGS} end; procedure TSOAPBaseFormatter.GetStr( const ATypeInfo : PTypeInfo; + const ANameSpace : string; var AName : String; var AData : String ); begin - AData := GetNodeValue(AName); + AData := GetNodeValue(ANameSpace,AName); end; procedure TSOAPBaseFormatter.GetObj( @@ -1319,7 +1370,8 @@ function TSOAPBaseFormatter.ReadHeaders(ACallContext: ICallContext): Integer; s := sXML_NS else s := sXML_NS + ':' + nsSN; - nsLN := FindAttributeByNameInScope(s); + if not FindAttributeByNameInNode(s,ANode,nsLN) then + nsLN := FindAttributeByNameInScope(s); Result := GetTypeRegistry().FindByDeclaredName(Copy(ndName,Succ(j),MaxInt),nsLN); end; @@ -1402,6 +1454,7 @@ begin end; procedure TSOAPBaseFormatter.Put( + const ANameSpace : string; const AName: String; const ATypeInfo: PTypeInfo; const AData @@ -1418,12 +1471,12 @@ begin tkInt64{$IFDEF FPC},tkQWord{$ENDIF} : Begin int64Data := Int64(AData); - PutInt64(AName,ATypeInfo,int64Data); + PutInt64(ANameSpace,AName,ATypeInfo,int64Data); End; tkLString{$IFDEF FPC},tkAString{$ENDIF} : Begin strData := String(AData); - PutStr(AName,ATypeInfo,strData); + PutStr(ANameSpace,AName,ATypeInfo,strData); End; tkClass : Begin @@ -1438,7 +1491,7 @@ begin tkBool : Begin boolData := Boolean(AData); - PutBool(AName,ATypeInfo,boolData); + PutBool(ANameSpace,AName,ATypeInfo,boolData); End; {$ENDIF} tkInteger, tkEnumeration : @@ -1448,7 +1501,7 @@ begin ( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) ) then begin boolData := Boolean(AData); - PutBool(AName,ATypeInfo,boolData); + PutBool(ANameSpace,AName,ATypeInfo,boolData); end else begin {$ENDIF} enumData := 0; @@ -1461,9 +1514,9 @@ begin otULong : enumData := LongInt(AData); End; If ( ATypeInfo^.Kind = tkInteger ) Then - PutInt64(AName,ATypeInfo,enumData) + PutInt64(ANameSpace,AName,ATypeInfo,enumData) Else - PutEnum(AName,ATypeInfo,enumData); + PutEnum(ANameSpace,AName,ATypeInfo,enumData); {$IFDEF WST_DELPHI} end; {$ENDIF} @@ -1478,11 +1531,20 @@ begin ftCurr : floatDt := Currency(AData); ftComp : floatDt := Comp(AData); End; - PutFloat(AName,ATypeInfo,floatDt); + PutFloat(ANameSpace,AName,ATypeInfo,floatDt); End; End; end; +procedure TSOAPBaseFormatter.Put( + const AName : String; + const ATypeInfo : PTypeInfo; + const AData +); +begin + Put('',AName,ATypeInfo,AData); +end; + procedure TSOAPBaseFormatter.PutScopeInnerValue( const ATypeInfo : PTypeInfo; const AData @@ -1610,6 +1672,7 @@ end; procedure TSOAPBaseFormatter.Get( const ATypeInfo : PTypeInfo; + const ANameSpace : string; var AName : String; var AData ); @@ -1626,13 +1689,13 @@ begin tkInt64{$IFDEF FPC},tkQWord{$ENDIF} : Begin int64Data := 0; - GetInt64(ATypeInfo,AName,int64Data); + GetInt64(ATypeInfo,ANameSpace,AName,int64Data); Int64(AData) := int64Data; End; tkLString{$IFDEF FPC},tkAString{$ENDIF} : Begin strData := ''; - GetStr(ATypeInfo,AName,strData); + GetStr(ATypeInfo,ANameSpace,AName,strData); String(AData) := strData; End; tkClass : @@ -1650,7 +1713,7 @@ begin tkBool : Begin boolData := False; - GetBool(ATypeInfo,AName,boolData); + GetBool(ATypeInfo,ANameSpace,AName,boolData); Boolean(AData) := boolData; End; {$ENDIF} @@ -1661,15 +1724,15 @@ begin ( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) ) then begin boolData := False; - GetBool(ATypeInfo,AName,boolData); + GetBool(ATypeInfo,ANameSpace,AName,boolData); Boolean(AData) := boolData; end else begin {$ENDIF} enumData := 0; If ( ATypeInfo^.Kind = tkInteger ) Then - GetInt64(ATypeInfo,AName,enumData) + GetInt64(ATypeInfo,ANameSpace,AName,enumData) Else - GetEnum(ATypeInfo,AName,enumData); + GetEnum(ATypeInfo,ANameSpace,AName,enumData); Case GetTypeData(ATypeInfo)^.OrdType Of otSByte : ShortInt(AData) := enumData; otUByte : Byte(AData) := enumData; @@ -1685,7 +1748,7 @@ begin tkFloat : Begin floatDt := 0; - GetFloat(ATypeInfo,AName,floatDt); + GetFloat(ATypeInfo,ANameSpace,AName,floatDt); Case GetTypeData(ATypeInfo)^.FloatType Of ftSingle : Single(AData) := floatDt; ftDouble : Double(AData) := floatDt; @@ -1699,6 +1762,15 @@ begin End; end; +procedure TSOAPBaseFormatter.Get( + const ATypeInfo : PTypeInfo; + var AName : string; + var AData +); +begin + Get(ATypeInfo,'',AName,AData); +end; + procedure TSOAPBaseFormatter.GetScopeInnerValue( const ATypeInfo : PTypeInfo; var AData @@ -1829,6 +1901,13 @@ begin Result := sPROTOCOL_NAME; end; +function TSOAPBaseFormatter.GetPropertyManager() : IPropertyManager; +begin + If Not Assigned(FPropMngr) Then + FPropMngr := TPublishedPropertyManager.Create(Self); + Result := FPropMngr; +end; + procedure TSOAPBaseFormatter.WriteBuffer(const AValue: string); var strm : TStringStream; diff --git a/wst/trunk/base_xmlrpc_formatter.pas b/wst/trunk/base_xmlrpc_formatter.pas index a91b364bb..a2dc1b0b8 100644 --- a/wst/trunk/base_xmlrpc_formatter.pas +++ b/wst/trunk/base_xmlrpc_formatter.pas @@ -158,6 +158,7 @@ type TXmlRpcBaseFormatter = class(TSimpleFactoryItem,IFormatterBase) private + FPropMngr : IPropertyManager; FContentType: string; FDoc : TXMLDocument; FStack : TObjectStack; @@ -301,6 +302,7 @@ type constructor Create();override; destructor Destroy();override; function GetFormatName() : string; + function GetPropertyManager():IPropertyManager; procedure Clear(); procedure BeginObject( @@ -339,16 +341,28 @@ type Const AName : String; Const ATypeInfo : PTypeInfo; Const AData - ); + );overload; + procedure Put( + const ANameSpace : string; + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData + );overload; procedure PutScopeInnerValue( const ATypeInfo : PTypeInfo; const AData ); procedure Get( - Const ATypeInfo : PTypeInfo; - Var AName : String; - Var AData - ); + const ATypeInfo : PTypeInfo; + var AName : string; + var AData + );overload; + procedure Get( + const ATypeInfo : PTypeInfo; + const ANameSpace : string; + var AName : string; + var AData + );overload; procedure GetScopeInnerValue( const ATypeInfo : PTypeInfo; var AData @@ -1183,6 +1197,15 @@ begin End; end; +procedure TXmlRpcBaseFormatter.Put( + const ANameSpace : string; + const AName : String; + const ATypeInfo : PTypeInfo; const AData +); +begin + Put(AName,ATypeInfo,AData); +end; + procedure TXmlRpcBaseFormatter.PutScopeInnerValue( const ATypeInfo : PTypeInfo; const AData @@ -1374,6 +1397,16 @@ begin End; end; +procedure TXmlRpcBaseFormatter.Get( + const ATypeInfo : PTypeInfo; + const ANameSpace : string; + var AName : string; + var AData +); +begin + Get(ATypeInfo,AName,AData); +end; + procedure TXmlRpcBaseFormatter.GetScopeInnerValue( const ATypeInfo : PTypeInfo; var AData @@ -1493,6 +1526,13 @@ begin Result := sPROTOCOL_NAME; end; +function TXmlRpcBaseFormatter.GetPropertyManager() : IPropertyManager; +begin + If Not Assigned(FPropMngr) Then + FPropMngr := TPublishedPropertyManager.Create(Self); + Result := FPropMngr; +end; + procedure TXmlRpcBaseFormatter.WriteBuffer(const AValue: string); var strm : TStringStream; diff --git a/wst/trunk/binary_formatter.pas b/wst/trunk/binary_formatter.pas index 34fbcf700..ec9548ad1 100644 --- a/wst/trunk/binary_formatter.pas +++ b/wst/trunk/binary_formatter.pas @@ -32,13 +32,10 @@ Type {$M+} TBinaryFormatter = class(TBaseBinaryFormatter,IFormatterClient) private - FPropMngr : IPropertyManager; FCallProcedureName : string; FCallTarget : String; protected public - function GetPropertyManager():IPropertyManager; - procedure BeginCall( const AProcName, ATarget : string; @@ -55,7 +52,7 @@ Type { TBinaryCallMaker } TBinaryCallMaker = class(TSimpleFactoryItem,ICallMaker) - Private + private FPropMngr : IPropertyManager; Public constructor Create();override; @@ -69,13 +66,6 @@ Type implementation -function TBinaryFormatter.GetPropertyManager(): IPropertyManager; -begin - If Not Assigned(FPropMngr) Then - FPropMngr := TPublishedPropertyManager.Create(Self); - Result := FPropMngr; -end; - procedure TBinaryFormatter.BeginCall( const AProcName, ATarget : string; diff --git a/wst/trunk/imp_utils.pas b/wst/trunk/imp_utils.pas index c394a2efb..04cf5c740 100644 --- a/wst/trunk/imp_utils.pas +++ b/wst/trunk/imp_utils.pas @@ -17,7 +17,7 @@ interface uses Classes, SysUtils, TypInfo, - base_service_intf; + wst_types, base_service_intf; Type @@ -47,8 +47,11 @@ Type function ExtractOptionName(const ACompleteName : string):string; function TranslateDotToDecimalSeperator(const Value: string) : string; + function LoadBufferFromFile(const AFileName : string) : TBinaryString; + function LoadBufferFromStream(AStream : TStream) : TBinaryString; + + implementation -uses wst_types; function IsStrEmpty(Const AStr:String):Boolean; begin @@ -98,6 +101,35 @@ begin end; end; +function LoadBufferFromStream(AStream : TStream) : TBinaryString; +var + len : Int64; +begin + len := AStream.Size; + SetLength(Result,len); + if ( len > 0 ) then begin + try + AStream.Seek(0,soBeginning); + AStream.Read(Result[1],len); + except + SetLength(Result,0); + raise; + end; + end; +end; + +function LoadBufferFromFile(const AFileName : string) : TBinaryString; +var + locStream : TStream; +begin + locStream := TFileStream.Create(AFileName,fmOpenRead); + try + Result := LoadBufferFromStream(locStream); + finally + locStream.Free(); + end; +end; + { TPublishedPropertyManager } procedure TPublishedPropertyManager.Error(const AMsg: string); diff --git a/wst/trunk/json_formatter.pas b/wst/trunk/json_formatter.pas index 887c18dcd..75ee5e175 100644 --- a/wst/trunk/json_formatter.pas +++ b/wst/trunk/json_formatter.pas @@ -28,7 +28,6 @@ type TJsonRpcFormatter = class(TJsonRpcBaseFormatter,IFormatterClient) private - FPropMngr : IPropertyManager; FCallProcedureName : string; FCallTarget : string; FVersion : string; @@ -37,7 +36,6 @@ type procedure SetVersion(const AValue : string); public constructor Create();override; - function GetPropertyManager():IPropertyManager; procedure BeginCall( const AProcName, @@ -129,13 +127,6 @@ begin SetVersion(s_json_rpc_version_10); end; -function TJsonRpcFormatter.GetPropertyManager() : IPropertyManager; -begin - If Not Assigned(FPropMngr) Then - FPropMngr := TPublishedPropertyManager.Create(Self); - Result := FPropMngr; -end; - procedure TJsonRpcFormatter.BeginCall( const AProcName, ATarget : string; ACallContext : ICallContext diff --git a/wst/trunk/metadata_wsdl.pas b/wst/trunk/metadata_wsdl.pas index 7db59a792..ef1ab592d 100644 --- a/wst/trunk/metadata_wsdl.pas +++ b/wst/trunk/metadata_wsdl.pas @@ -91,14 +91,12 @@ const sWSDL_NS = 'http://schemas.xmlsoap.org/wsdl/'; sSOAP_NS = 'http://schemas.xmlsoap.org/wsdl/soap/'; sSOAP = 'soap'; - sSOAP_ENC_NS = 'http://schemas.xmlsoap.org/soap/encoding/'; sXMLNS = 'xmlns'; sXSD_NS = 'http://www.w3.org/2001/XMLSchema'; sXSD = 'xsd'; sTNS = 'tns'; sSOAP_ACTION = 'soapAction'; - sSOAP_ENCODED = 'encoded'; sSOAP_ENCODING_STYLE = 'encodingStyle'; sSOAP_RPC = 'rpc'; sSOAP_TRANSPORT = 'http://schemas.xmlsoap.org/soap/http'; @@ -127,7 +125,6 @@ const sTRANSPORT = 'transport'; sTYPE = 'type'; sUNBOUNDED = 'unbounded'; - sUSE = 'use'; sVALUE = 'value'; sWSDL_DEFINITIONS = 'definitions'; diff --git a/wst/trunk/object_serializer.pas b/wst/trunk/object_serializer.pas new file mode 100644 index 000000000..72adf5f2a --- /dev/null +++ b/wst/trunk/object_serializer.pas @@ -0,0 +1,1229 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2008 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +} +{$INCLUDE wst_global.inc} +unit object_serializer; + +interface + +uses + Classes, SysUtils, TypInfo, Contnrs, + base_service_intf, wst_types; + +type + + ESerializerException = class(EServiceException) + end; + + TPropSerializationInfo = class; + + TPropertyReadProc = procedure( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase + ); + TPropertyWriteProc = TPropertyReadProc; + + { TPropSerializationInfo } + + TPropSerializationInfo = class + private + FExternalName : string; + FName : string; + FNameSpace : string; + FPersisteType : TPropStoreType; + FPropInfo : PPropInfo; + FQualifiedName : Boolean; + FReaderProc : TPropertyReadProc; + FStyle : TSerializationStyle; + FWriterProc : TPropertyWriteProc; + public + property Name : string read FName; + property ExternalName : string read FExternalName; + // NameSpace apply only if ( QualifiedName = True ) + property NameSpace : string read FNameSpace; + property Style : TSerializationStyle read FStyle; + property PersisteType : TPropStoreType read FPersisteType; + property PropInfo : PPropInfo read FPropInfo; + property QualifiedName : Boolean read FQualifiedName; + property ReaderProc : TPropertyReadProc read FReaderProc; + property WriterProc : TPropertyWriteProc read FWriterProc; + end; + + { TObjectSerializer } + + TObjectSerializer = class + private + FSerializationInfos : TObjectList; + FTarget : TBaseComplexRemotableClass; + FRawPropList : PPropList; + private + procedure Prepare(ATypeRegistry : TTypeRegistry); + public + constructor Create( + ATargetClass : TBaseComplexRemotableClass; + ATypeRegistry : TTypeRegistry + ); + destructor Destroy();override; + procedure Read( + var AObject : TObject; + AStore : IFormatterBase; + var AName : string; + const ATypeInfo : PTypeInfo + ); + procedure Save( + AObject : TBaseRemotable; + AStore : IFormatterBase; + const AName : string; + const ATypeInfo : PTypeInfo + ); + property Target : TBaseComplexRemotableClass read FTarget; + end; + + TGetSerializerFunction = function() : TObjectSerializer of object; + + { TBaseComplexTypeRegistryItem } + + TBaseComplexTypeRegistryItem = class(TTypeRegistryItem) + private + FGetterLock : PtrInt; + FSerializer : TObjectSerializer; + FGetFunction : TGetSerializerFunction; + private + function FirstGetter() : TObjectSerializer; + function StaticGetter() : TObjectSerializer; + public + constructor Create( + AOwner : TTypeRegistry; + ANameSpace : string; + ADataType : PTypeInfo; + Const ADeclaredName : string = '' + );override; + destructor Destroy(); + function GetSerializer() : TObjectSerializer;{$IFDEF USE_INLINE}inline;{$ENDIF} + end; + + { TBaseComplexRemotableInitializer } + + TBaseComplexRemotableInitializer = class(TRemotableTypeInitializer) + public + class function CanHandle(ATypeInfo : PTypeInfo) : Boolean;override; + class function GetItemClass(const ATypeInfo : PTypeInfo) : TTypeRegistryItemClass;override; +{$IFDEF TRemotableTypeInitializer_Initialize} + class function Initialize( + ATypeInfo : PTypeInfo; + ARegistryItem : TTypeRegistryItem + ) : Boolean;override; +{$ENDIF TRemotableTypeInitializer_Initialize} + end; + +resourcestring + SERR_NoReaderProc = 'No reader proc for that type, Prop : "(%s : %s)".'; + SERR_NoSerializerFoThisType = 'No serializer for this type : %s.'; + SERR_SerializerInitializationException = 'Unable to initialize the serializer of that type : "%s".'; + +implementation +{$IFDEF WST_DELPHI} + {$IFDEF MSWINDOWS} +uses + Windows; + {$ENDIF MSWINDOWS} +{$ENDIF WST_DELPHI} + + +procedure ErrorProc( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +begin + raise Exception.CreateFmt(SERR_NoReaderProc,[APropInfo.Name,APropInfo.FPropInfo^.Name]); +end; + +type + TEnumBuffer = record + case TOrdType of + otSByte : (ShortIntData : ShortInt); + otUByte : (ByteData : Byte); + otSWord : (SmallIntData : SmallInt); + otUWord : (WordData : Word); + otSLong : (SLongIntData : LongInt); + otULong : (ULongIntData : LongWord); + end; + TFloatBuffer = record + case TFloatType of + ftSingle : (SingleData : Single); + ftDouble : (DoubleData : Double); + ftExtended : (ExtendedData : Extended); + ftCurr : (CurrencyData : Currency); + ftComp : (CompData : Comp); + end; + TFloatExtendedType = Extended; + +// Simple readers +{$IFDEF HAS_TKBOOL} +procedure BoolReader( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + locName : string; + locData : Boolean; +begin + locData := False; + locName := APropInfo.ExternalName; + AStore.Get(APropInfo.PropInfo^.PropType,locName,locData); + SetOrdProp(AObject,APropInfo.PropInfo,Ord(locData)); +end; +{$ENDIF HAS_TKBOOL} + +procedure ClassReader( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + locName : string; + objData : TObject; + objDataCreateHere : Boolean; +begin + locName := APropInfo.ExternalName; + objData := GetObjectProp(AObject,APropInfo.PropInfo); + objDataCreateHere := not Assigned(objData); + try + AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,objData); + if objDataCreateHere then + SetObjectProp(AObject,APropInfo.PropInfo,objData); + finally + if objDataCreateHere and ( objData <> GetObjectProp(AObject,APropInfo.PropInfo) ) then + FreeAndNil(objData); + end; +end; + +procedure FloatReader( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + propName : string; + floatBuffer : TFloatBuffer; + floatDt : TFloatExtendedType; + pt : PTypeInfo; +begin + floatBuffer.ExtendedData := 0; + propName := APropInfo.ExternalName; + pt := APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF}; + case GetTypeData(pt)^.FloatType of + ftSingle : + begin + AStore.Get(pt,propName,floatBuffer.SingleData); + floatDt := floatBuffer.SingleData; + end; + ftDouble : + begin + AStore.Get(pt,propName,floatBuffer.DoubleData); + floatDt := floatBuffer.DoubleData; + end; + ftExtended : + begin + AStore.Get(pt,propName,floatBuffer.ExtendedData); + floatDt := floatBuffer.ExtendedData; + end; + ftCurr : + begin + AStore.Get(pt,propName,floatBuffer.CurrencyData); + floatDt := floatBuffer.CurrencyData; + end; + ftComp : + begin + AStore.Get(pt,propName,floatBuffer.CompData); + floatDt := floatBuffer.CompData; + end; + end; + SetFloatProp(AObject,APropInfo.PropInfo,floatDt); +end; + +procedure IntEnumReader( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + propName : string; + int64Data : Int64; + enumData : TEnumBuffer; + pt : PTypeInfo; +{$IFDEF WST_DELPHI} + boolData : Boolean; +{$ENDIF WST_DELPHI} +begin + propName := APropInfo.ExternalName; + pt := APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF}; +{$IFDEF WST_DELPHI} + if ( pt^.Kind = tkEnumeration ) and + ( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) ) + then begin + AStore.Get(pt,propName,boolData); + SetPropValue(AObject,propName,boolData); + end else begin +{$ENDIF} + enumData.ULongIntData := 0; + Case GetTypeData(pt)^.OrdType Of + otSByte : + Begin + AStore.Get(pt,propName,enumData.ShortIntData); + int64Data := enumData.ShortIntData; + End; + otUByte : + Begin + AStore.Get(pt,propName,enumData.ByteData); + int64Data := enumData.ByteData; + End; + otSWord : + Begin + AStore.Get(pt,propName,enumData.SmallIntData); + int64Data := enumData.SmallIntData; + End; + otUWord : + Begin + AStore.Get(pt,propName,enumData.WordData); + int64Data := enumData.WordData; + End; + otSLong: + Begin + AStore.Get(pt,propName,enumData.SLongIntData); + int64Data := enumData.SLongIntData; + End; + otULong : + Begin + AStore.Get(pt,propName,enumData.ULongIntData); + int64Data := enumData.ULongIntData; + End; + End; + SetOrdProp(AObject,APropInfo.PropInfo,int64Data); +{$IFDEF WST_DELPHI} + end; +{$ENDIF} +end; + +procedure Int64Reader( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + locName : string; + locData : Int64; +begin + locData := 0; + locName := APropInfo.ExternalName; + AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,locData); + SetInt64Prop(AObject,APropInfo.PropInfo,locData); +end; + +procedure StringReader( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + locName : string; + locData : string; +begin + locData := ''; + locName := APropInfo.ExternalName; + AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,locData); + SetStrProp(AObject,APropInfo.PropInfo,locData); +end; + +// Qualified readers +{$IFDEF HAS_TKBOOL} +procedure BoolReaderQualifier( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + locName : string; + locData : Boolean; +begin + locData := False; + locName := APropInfo.ExternalName; + AStore.Get(APropInfo.PropInfo^.PropType,APropInfo.NameSpace,locName,locData); + SetOrdProp(AObject,APropInfo.PropInfo,Ord(locData)); +end; +{$ENDIF HAS_TKBOOL} + +procedure ClassReaderQualified( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + locName : string; + objData : TObject; + objDataCreateHere : Boolean; +begin + locName := APropInfo.ExternalName; + objData := GetObjectProp(AObject,APropInfo.PropInfo); + objDataCreateHere := not Assigned(objData); + try + AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,objData); + if objDataCreateHere then + SetObjectProp(AObject,APropInfo.PropInfo,objData); + finally + if objDataCreateHere and ( objData <> GetObjectProp(AObject,APropInfo.PropInfo) ) then + FreeAndNil(objData); + end; +end; + +procedure FloatReaderQualified( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + propName : string; + floatBuffer : TFloatBuffer; + floatDt : TFloatExtendedType; + pt : PTypeInfo; +begin + floatBuffer.ExtendedData := 0; + propName := APropInfo.ExternalName; + pt := APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF}; + case GetTypeData(pt)^.FloatType of + ftSingle : + begin + AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.SingleData); + floatDt := floatBuffer.SingleData; + end; + ftDouble : + begin + AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.DoubleData); + floatDt := floatBuffer.DoubleData; + end; + ftExtended : + begin + AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.ExtendedData); + floatDt := floatBuffer.ExtendedData; + end; + ftCurr : + begin + AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.CurrencyData); + floatDt := floatBuffer.CurrencyData; + end; + ftComp : + begin + AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.CompData); + floatDt := floatBuffer.CompData; + end; + end; + SetFloatProp(AObject,APropInfo.PropInfo,floatDt); +end; + +procedure Int64ReaderQualified( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + locName : string; + locData : Int64; +begin + locData := 0; + locName := APropInfo.ExternalName; + AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,locData); + SetInt64Prop(AObject,APropInfo.PropInfo,locData); +end; + +procedure IntEnumReaderQualified( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + propName : string; + int64Data : Int64; + enumData : TEnumBuffer; + pt : PTypeInfo; +{$IFDEF WST_DELPHI} + boolData : Boolean; +{$ENDIF WST_DELPHI} +begin + propName := APropInfo.ExternalName; + pt := APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF}; +{$IFDEF WST_DELPHI} + if ( pt^.Kind = tkEnumeration ) and + ( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) ) + then begin + AStore.Get(pt,APropInfo.NameSpace,propName,boolData); + SetPropValue(AObject,propName,boolData); + end else begin +{$ENDIF} + enumData.ULongIntData := 0; + Case GetTypeData(pt)^.OrdType Of + otSByte : + Begin + AStore.Get(pt,APropInfo.NameSpace,propName,enumData.ShortIntData); + int64Data := enumData.ShortIntData; + End; + otUByte : + Begin + AStore.Get(pt,APropInfo.NameSpace,propName,enumData.ByteData); + int64Data := enumData.ByteData; + End; + otSWord : + Begin + AStore.Get(pt,APropInfo.NameSpace,propName,enumData.SmallIntData); + int64Data := enumData.SmallIntData; + End; + otUWord : + Begin + AStore.Get(pt,APropInfo.NameSpace,propName,enumData.WordData); + int64Data := enumData.WordData; + End; + otSLong: + Begin + AStore.Get(pt,APropInfo.NameSpace,propName,enumData.SLongIntData); + int64Data := enumData.SLongIntData; + End; + otULong : + Begin + AStore.Get(pt,APropInfo.NameSpace,propName,enumData.ULongIntData); + int64Data := enumData.ULongIntData; + End; + End; + SetOrdProp(AObject,APropInfo.PropInfo,int64Data); +{$IFDEF WST_DELPHI} + end; +{$ENDIF} +end; + +procedure StringReaderQualified( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + locName : string; + locData : string; +begin + locData := ''; + locName := APropInfo.ExternalName; + AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,locData); + SetStrProp(AObject,APropInfo.PropInfo,locData); +end; + +// Simple Writers +{$IFDEF HAS_TKBOOL} +procedure BoolWriter( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + locName : string; + locData : Boolean; +begin + locName := APropInfo.ExternalName; + locData := Boolean(GetOrdProp(AObject,APropInfo.PropInfo)); + AStore.Put(locName,APropInfo.PropInfo^.PropType,locData); +end; +{$ENDIF HAS_TKBOOL} + +procedure ClassWriter( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + locName : string; + locData : Tobject; +begin + locName := APropInfo.ExternalName; + locData := GetObjectProp(AObject,APropInfo.PropInfo); + AStore.Put(locName,APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locData); +end; + +procedure FloatWriter( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + prpName : string; + floatDt : TFloatBuffer; + pt : PTypeInfo; +begin + prpName := APropInfo.ExternalName; + pt := APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF}; + case GetTypeData(pt)^.FloatType of + ftSingle : + begin + floatDt.SingleData := GetFloatProp(AObject,APropInfo.PropInfo); + AStore.Put(prpName,pt,floatDt.SingleData); + end; + ftDouble : + begin + floatDt.DoubleData := GetFloatProp(AObject,APropInfo.PropInfo); + AStore.Put(prpName,pt,floatDt.DoubleData); + end; + ftExtended : + begin + floatDt.ExtendedData := Extended(GetFloatProp(AObject,APropInfo.PropInfo)); + AStore.Put(prpName,pt,floatDt.ExtendedData); + end; + ftCurr : + begin + floatDt.CurrencyData := GetFloatProp(AObject,APropInfo.PropInfo); + AStore.Put(prpName,pt,floatDt.CurrencyData); + end; +{$IFDEF HAS_COMP} + ftComp : + begin + floatDt.CompData := GetFloatProp(AObject,APropInfo.PropInfo); + AStore.Put(prpName,pt,floatDt.CompData); + end; +{$ENDIF} + end; +end; + +procedure IntEnumWriter( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + prpName : string; + enumData : TEnumBuffer; + pt : PTypeInfo; +{$IFDEF WST_DELPHI} + boolData : Boolean; +{$ENDIF WST_DELPHI} +begin + prpName := APropInfo.ExternalName; + pt := APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF}; +{$IFDEF WST_DELPHI} + if ( pt^.Kind = tkEnumeration ) and + ( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) ) + then begin + boolData := Boolean(GetOrdProp(AObject,APropInfo.PropInfo)); + AStore.Put(prpName,pt,boolData); + end else begin +{$ENDIF WST_DELPHI} + FillChar(enumData,SizeOf(enumData),#0); + case GetTypeData(pt)^.OrdType of + otSByte : + begin + enumData.ShortIntData := ShortInt(GetOrdProp(AObject,APropInfo.PropInfo)); + AStore.Put(prpName,pt,enumData.ShortIntData); + end; + otUByte : + begin + enumData.ByteData := Byte(GetOrdProp(AObject,APropInfo.PropInfo)); + AStore.Put(prpName,pt,enumData.ByteData); + end; + otSWord : + begin + enumData.SmallIntData := SmallInt(GetOrdProp(AObject,APropInfo.PropInfo)); + AStore.Put(prpName,pt,enumData.SmallIntData); + end; + otUWord : + begin + enumData.WordData := Word(GetOrdProp(AObject,APropInfo.PropInfo)); + AStore.Put(prpName,pt,enumData.WordData); + end; + otSLong : + begin + enumData.SLongIntData := LongInt(GetOrdProp(AObject,APropInfo.PropInfo)); + AStore.Put(prpName,pt,enumData.SLongIntData); + end; + otULong : + begin + enumData.ULongIntData := LongWord(GetOrdProp(AObject,APropInfo.PropInfo)); + AStore.Put(prpName,pt,enumData.ULongIntData); + end; + end; +{$IFDEF WST_DELPHI} + end; +{$ENDIF WST_DELPHI} +end; + +procedure Int64Writer( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + locName : string; + locData : Int64; +begin + locName := APropInfo.ExternalName; + locData := GetInt64Prop(AObject,APropInfo.PropInfo); + AStore.Put(locName,APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locData); +end; + +procedure StringWriter( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + locName : string; + locData : string; +begin + locName := APropInfo.ExternalName; + locData := GetStrProp(AObject,APropInfo.PropInfo); + AStore.Put(locName,APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locData); +end; + + +// Qualified writers +{$IFDEF HAS_TKBOOL} +procedure BoolWriterQualified( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + locName : string; + locData : Boolean; +begin + locName := APropInfo.ExternalName; + locData := Boolean(GetOrdProp(AObject,APropInfo.PropInfo)); + AStore.Put(APropInfo.NameSpace,locName,APropInfo.PropInfo^.PropType,locData); +end; +{$ENDIF HAS_TKBOOL} + +procedure ClassWriterQualified( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + locName : string; + locData : Tobject; +begin + locName := APropInfo.ExternalName; + locData := GetObjectProp(AObject,APropInfo.PropInfo); + AStore.Put(APropInfo.NameSpace,locName,APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locData); +end; + +procedure FloatWriterQualified( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + prpName : string; + floatDt : TFloatBuffer; + pt : PTypeInfo; +begin + prpName := APropInfo.ExternalName; + pt := APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF}; + case GetTypeData(pt)^.FloatType of + ftSingle : + begin + floatDt.SingleData := GetFloatProp(AObject,APropInfo.PropInfo); + AStore.Put(APropInfo.NameSpace,prpName,pt,floatDt.SingleData); + end; + ftDouble : + begin + floatDt.DoubleData := GetFloatProp(AObject,APropInfo.PropInfo); + AStore.Put(APropInfo.NameSpace,prpName,pt,floatDt.DoubleData); + end; + ftExtended : + begin + floatDt.ExtendedData := Extended(GetFloatProp(AObject,APropInfo.PropInfo)); + AStore.Put(APropInfo.NameSpace,prpName,pt,floatDt.ExtendedData); + end; + ftCurr : + begin + floatDt.CurrencyData := GetFloatProp(AObject,APropInfo.PropInfo); + AStore.Put(APropInfo.NameSpace,prpName,pt,floatDt.CurrencyData); + end; +{$IFDEF HAS_COMP} + ftComp : + begin + floatDt.CompData := GetFloatProp(AObject,APropInfo.PropInfo); + AStore.Put(APropInfo.NameSpace,prpName,pt,floatDt.CompData); + end; +{$ENDIF} + end; +end; + +procedure IntEnumWriterQualified( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + prpName : string; + enumData : TEnumBuffer; + pt : PTypeInfo; +{$IFDEF WST_DELPHI} + boolData : Boolean; +{$ENDIF WST_DELPHI} +begin + prpName := APropInfo.ExternalName; + pt := APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF}; +{$IFDEF WST_DELPHI} + if ( pt^.Kind = tkEnumeration ) and + ( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) ) + then begin + boolData := Boolean(GetOrdProp(AObject,APropInfo.PropInfo)); + AStore.Put(APropInfo.NameSpace,prpName,pt,boolData); + end else begin +{$ENDIF WST_DELPHI} + FillChar(enumData,SizeOf(enumData),#0); + case GetTypeData(pt)^.OrdType of + otSByte : + begin + enumData.ShortIntData := ShortInt(GetOrdProp(AObject,APropInfo.PropInfo)); + AStore.Put(APropInfo.NameSpace,prpName,pt,enumData.ShortIntData); + end; + otUByte : + begin + enumData.ByteData := Byte(GetOrdProp(AObject,APropInfo.PropInfo)); + AStore.Put(APropInfo.NameSpace,prpName,pt,enumData.ByteData); + end; + otSWord : + begin + enumData.SmallIntData := SmallInt(GetOrdProp(AObject,APropInfo.PropInfo)); + AStore.Put(APropInfo.NameSpace,prpName,pt,enumData.SmallIntData); + end; + otUWord : + begin + enumData.WordData := Word(GetOrdProp(AObject,APropInfo.PropInfo)); + AStore.Put(APropInfo.NameSpace,prpName,pt,enumData.WordData); + end; + otSLong : + begin + enumData.SLongIntData := LongInt(GetOrdProp(AObject,APropInfo.PropInfo)); + AStore.Put(APropInfo.NameSpace,prpName,pt,enumData.SLongIntData); + end; + otULong : + begin + enumData.ULongIntData := LongWord(GetOrdProp(AObject,APropInfo.PropInfo)); + AStore.Put(APropInfo.NameSpace,prpName,pt,enumData.ULongIntData); + end; + end; +{$IFDEF WST_DELPHI} + end; +{$ENDIF WST_DELPHI} +end; + +procedure Int64WriterQualified( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + locName : string; + locData : Int64; +begin + locName := APropInfo.ExternalName; + locData := GetInt64Prop(AObject,APropInfo.PropInfo); + AStore.Put(APropInfo.NameSpace,locName,APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locData); +end; + +procedure StringWriterQualified( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +); +var + locName : string; + locData : string; +begin + locName := APropInfo.ExternalName; + locData := GetStrProp(AObject,APropInfo.PropInfo); + AStore.Put(APropInfo.NameSpace,locName,APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locData); +end; + + + +type + TReaderWriterInfo = record + Simple : TPropertyReadProc; + Qualified : TPropertyReadProc; + end; + +var +{$IFDEF FPC} + ReaderWriterInfoMap : array[0..1] of array[TTypeKind] of TReaderWriterInfo = ( + ( // Readers + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkUnknown + ( Simple : {$IFDEF FPC}@{$ENDIF}IntEnumReader; Qualified : {$IFDEF FPC}@{$ENDIF}IntEnumReaderQualified ;) , //tkInteger + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkChar + ( Simple : {$IFDEF FPC}@{$ENDIF}IntEnumReader; Qualified : {$IFDEF FPC}@{$ENDIF}IntEnumReaderQualified ;) , //tkEnumeration + ( Simple : {$IFDEF FPC}@{$ENDIF}FloatReader; Qualified : {$IFDEF FPC}@{$ENDIF}FloatReaderQualified ;) , //tkFloat + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkSet + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkMethod + ( Simple : {$IFDEF FPC}@{$ENDIF}StringReader; Qualified : {$IFDEF FPC}@{$ENDIF}StringReaderQualified ;) , //tkSString + ( Simple : {$IFDEF FPC}@{$ENDIF}StringReader; Qualified : {$IFDEF FPC}@{$ENDIF}StringReaderQualified ;) , //tkLString + ( Simple : {$IFDEF FPC}@{$ENDIF}StringReader; Qualified : {$IFDEF FPC}@{$ENDIF}StringReaderQualified ;) , //tkAString + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkWString + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkVariant + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkArray + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkRecord + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkInterface + ( Simple : {$IFDEF FPC}@{$ENDIF}ClassReader; Qualified : {$IFDEF FPC}@{$ENDIF}ClassReaderQualified ;) , //tkClass + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkObject + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkWChar + ( Simple : {$IFDEF FPC}@{$ENDIF}BoolReader; Qualified : {$IFDEF FPC}@{$ENDIF}BoolReaderQualifier ;) , //tkBool + ( Simple : {$IFDEF FPC}@{$ENDIF}Int64Reader; Qualified : {$IFDEF FPC}@{$ENDIF}Int64ReaderQualified ;) , //tkInt64 + ( Simple : {$IFDEF FPC}@{$ENDIF}Int64Reader; Qualified : {$IFDEF FPC}@{$ENDIF}Int64ReaderQualified ;) , //tkQWord + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkDynArray + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) //tkInterfaceRaw + ), + ( // Writers + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkUnknown + ( Simple : {$IFDEF FPC}@{$ENDIF}IntEnumWriter; Qualified : {$IFDEF FPC}@{$ENDIF}IntEnumWriterQualified ;) , //tkInteger + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkChar + ( Simple : {$IFDEF FPC}@{$ENDIF}IntEnumWriter; Qualified : {$IFDEF FPC}@{$ENDIF}IntEnumWriterQualified ;) , //tkEnumeration + ( Simple : {$IFDEF FPC}@{$ENDIF}FloatWriter; Qualified : {$IFDEF FPC}@{$ENDIF}FloatWriterQualified ;) , //tkFloat + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkSet + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkMethod + ( Simple : {$IFDEF FPC}@{$ENDIF}StringWriter; Qualified : {$IFDEF FPC}@{$ENDIF}StringWriterQualified ;) , //tkSString + ( Simple : {$IFDEF FPC}@{$ENDIF}StringWriter; Qualified : {$IFDEF FPC}@{$ENDIF}StringWriterQualified ;) , //tkLString + ( Simple : {$IFDEF FPC}@{$ENDIF}StringWriter; Qualified : {$IFDEF FPC}@{$ENDIF}StringWriterQualified ;) , //tkAString + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkWString + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkVariant + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkArray + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkRecord + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkInterface + ( Simple : {$IFDEF FPC}@{$ENDIF}ClassWriter; Qualified : {$IFDEF FPC}@{$ENDIF}ClassWriterQualified ;) , //tkClass + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkObject + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkWChar + ( Simple : {$IFDEF FPC}@{$ENDIF}BoolWriter; Qualified : {$IFDEF FPC}@{$ENDIF}BoolWriterQualified ;) , //tkBool + ( Simple : {$IFDEF FPC}@{$ENDIF}Int64Writer; Qualified : {$IFDEF FPC}@{$ENDIF}Int64WriterQualified ;) , //tkInt64 + ( Simple : {$IFDEF FPC}@{$ENDIF}Int64Writer; Qualified : {$IFDEF FPC}@{$ENDIF}Int64WriterQualified ;) , //tkQWord + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkDynArray + ( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) //tkInterfaceRaw + ) + ); +{$ENDIF FPC} + +{$IFDEF WST_DELPHI} + ReaderWriterInfoMap : array[0..1] of array[TTypeKind] of TReaderWriterInfo = ( + ( // Readers + ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkUnknown + ( Simple : IntEnumReader; Qualified : IntEnumReaderQualified ;) , //tkInteger + ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkChar + ( Simple : IntEnumReader; Qualified : IntEnumReaderQualified ;) , //tkEnumeration + ( Simple : FloatReader; Qualified : FloatReaderQualified ;) , //tkFloat + ( Simple : StringReader; Qualified : StringReaderQualified ;) , //tkString + ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkSet + ( Simple : ClassReader; Qualified : ClassReaderQualified ;) , //tkClass + ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkMethod + ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkWChar + ( Simple : StringReader; Qualified : StringReaderQualified ;) , //tkLString + ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkWString + ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkVariant + ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkArray + ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkRecord + ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkInterface + ( Simple : Int64Reader; Qualified : Int64ReaderQualified ;) , //tkInt64 + ( Simple : ErrorProc; Qualified : ErrorProc ;) //tkDynArray + ), + ( // Writers + ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkUnknown + ( Simple : IntEnumWriter; Qualified : IntEnumWriterQualified ;) , //tkInteger + ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkChar + ( Simple : IntEnumWriter; Qualified : IntEnumWriterQualified ;) , //tkEnumeration + ( Simple : FloatWriter; Qualified : FloatWriterQualified ;) , //tkFloat + ( Simple : StringWriter; Qualified : StringWriterQualified ;) , //tkSString + ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkSet + ( Simple : ClassWriter; Qualified : ClassWriterQualified ;) , //tkClass + ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkMethod + ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkWChar + ( Simple : StringWriter; Qualified : StringWriterQualified ;) , //tkLString + ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkWString + ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkVariant + ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkArray + ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkRecord + ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkInterface + ( Simple : Int64Writer; Qualified : Int64WriterQualified ;) , //tkInt64 + ( Simple : ErrorProc; Qualified : ErrorProc ;) //tkDynArray + ) + ); +{$ENDIF WST_DELPHI} + +{ TObjectSerializer } + +procedure TObjectSerializer.Prepare(ATypeRegistry : TTypeRegistry); +var + locObjTypeData : PTypeData; + locTypeInfo : PTypeInfo; + c, i : PtrInt; + ppi : PPropInfo; + cl : TClass; + serArray : array of TPropSerializationInfo; + serInfo : TPropSerializationInfo; + regItem, thisRegItem : TTypeRegistryItem; + st : TPropStoreType; + clPL : PPropList; +begin + FSerializationInfos.Clear(); + locTypeInfo := PTypeInfo(Target.ClassInfo); + locObjTypeData := GetTypeData(locTypeInfo); + c := locObjTypeData^.PropCount; + if ( c > 0 ) then begin + clPL := nil; + SetLength(serArray,c); + try + FillChar(Pointer(serArray)^,SizeOf(TPropSerializationInfo)*c,#0); + cl := Target; + thisRegItem := ATypeRegistry.ItemByTypeInfo[locTypeInfo]; + regItem := thisRegItem; + GetPropList(locTypeInfo,FRawPropList); + try + for i := 0 to Pred(c) do begin + ppi := FRawPropList^[i]; + st := IsStoredPropClass(cl,ppi); + if ( st in [pstAlways,pstOptional] ) then begin + serInfo := TPropSerializationInfo.Create(); + serArray[ppi^.NameIndex] := serInfo; + serInfo.FExternalName := regItem.GetExternalPropertyName(ppi^.Name); + serInfo.FName := ppi^.Name; + serInfo.FPersisteType := st; + serInfo.FPropInfo := ppi; + serInfo.FReaderProc := ReaderWriterInfoMap[0][ppi^.PropType^.Kind].Simple; + serInfo.FWriterProc := ReaderWriterInfoMap[1][ppi^.PropType^.Kind].Simple; + if Target.IsAttributeProperty(ppi^.Name) then + serInfo.FStyle := ssAttibuteSerialization + else + serInfo.FStyle := ssNodeSerialization; + end; + end; + //Check for inherited properties declared in other namespace + GetMem(clPL,c*SizeOf(Pointer)); + cl := cl.ClassParent; + while ( cl <> nil ) and ( cl <> TBaseComplexRemotable ) do begin + c := GetTypeData(PTypeInfo(cl.ClassInfo))^.PropCount; + if ( c > 0 ) then begin + GetPropInfos(PTypeInfo(cl.ClassInfo),clPL); + regItem := ATypeRegistry.Find(PTypeInfo(cl.ClassInfo),True); + if ( regItem <> nil ) then begin + for i := 0 to Pred(c) do begin + ppi := clPL^[i]; + serInfo := serArray[ppi^.NameIndex]; + if ( serInfo <> nil ) then begin + if ( thisRegItem.NameSpace <> regItem.NameSpace ) then begin + serInfo.FNameSpace := regItem.NameSpace; + serInfo.FQualifiedName := True; + serInfo.FReaderProc := ReaderWriterInfoMap[0][ppi^.PropType^.Kind].Qualified; + serInfo.FWriterProc := ReaderWriterInfoMap[1][ppi^.PropType^.Kind].Qualified; + end; + end; + end; + end; + end; + cl := cl.ClassParent; + end; + // Fill the list now + for i := 0 to Pred(Length(serArray)) do begin + if ( serArray[i] <> nil ) then begin + FSerializationInfos.Add(serArray[i]); + serArray[i] := nil; + end; + end; + except + for i := 0 to Pred(locObjTypeData^.PropCount) do + serArray[i].Free(); + raise; + end; + finally + if ( clPL <> nil ) then + FreeMem(clPL,locObjTypeData^.PropCount*SizeOf(Pointer)); + SetLength(serArray,0); + end; + end; +end; + +constructor TObjectSerializer.Create( + ATargetClass : TBaseComplexRemotableClass; + ATypeRegistry : TTypeRegistry +); +begin + Assert(ATargetClass <> nil); + Assert(ATypeRegistry <> nil); + FTarget := ATargetClass; + FSerializationInfos := TObjectList.Create(True); + Prepare(ATypeRegistry); +end; + +destructor TObjectSerializer.Destroy(); +begin + if ( FRawPropList <> nil ) then + FreeMem(FRawPropList,GetTypeData(PTypeInfo(Target.ClassInfo))^.PropCount*SizeOf(Pointer)); + FSerializationInfos.Free(); + inherited Destroy(); +end; + +procedure TObjectSerializer.Read( + var AObject : TObject; + AStore : IFormatterBase; + var AName : string; + const ATypeInfo : PTypeInfo +); +var + oldSS : TSerializationStyle; + i, c : PtrInt; + locSerInfo : TPropSerializationInfo; +begin + oldSS := AStore.GetSerializationStyle(); + if ( AStore.BeginObjectRead(AName,ATypeInfo) >= 0 ) then begin + try + if AStore.IsCurrentScopeNil() then + Exit; // ???? FreeAndNil(AObject); + if not Assigned(AObject) then + AObject := Target.Create(); + c := FSerializationInfos.Count; + if ( c > 0 ) then begin + for i := 0 to Pred(c) do begin + locSerInfo := TPropSerializationInfo(FSerializationInfos[i]); + if ( locSerInfo.Style <> AStore.GetSerializationStyle() ) then + AStore.SetSerializationStyle(locSerInfo.Style); + try + locSerInfo.ReaderProc(AObject,locSerInfo,AStore); + except + on e : EBaseRemoteException do begin + if ( locSerInfo.PersisteType = pstAlways ) then + raise; + end; + end; + end; + end; + finally + AStore.EndScopeRead(); + AStore.SetSerializationStyle(oldSS); + end; + end; +end; + +procedure TObjectSerializer.Save( + AObject : TBaseRemotable; + AStore : IFormatterBase; + const AName : string; + const ATypeInfo : PTypeInfo +); +var + oldSS : TSerializationStyle; + i, c : PtrInt; + locSerInfo : TPropSerializationInfo; +begin + oldSS := AStore.GetSerializationStyle(); + AStore.BeginObject(AName,ATypeInfo); + try + if not Assigned(AObject) then begin + AStore.NilCurrentScope(); + Exit; + end; + c := FSerializationInfos.Count; + if ( c > 0 ) then begin + for i := 0 to Pred(c) do begin + locSerInfo := TPropSerializationInfo(FSerializationInfos[i]); + if ( locSerInfo.Style <> AStore.GetSerializationStyle() ) then + AStore.SetSerializationStyle(locSerInfo.Style); + locSerInfo.WriterProc(AObject,locSerInfo,AStore); + end; + end; + finally + AStore.EndScope(); + AStore.SetSerializationStyle(oldSS); + end; +end; + +{ TBaseComplexRemotableInitializer } + +class function TBaseComplexRemotableInitializer.CanHandle(ATypeInfo : PTypeInfo) : Boolean; +begin + Result := ( ATypeInfo <> nil ) and + ( ATypeInfo^.Kind = tkClass ) and + GetTypeData(ATypeInfo)^.ClassType.InheritsFrom(TBaseComplexRemotable); +end; + +class function TBaseComplexRemotableInitializer.GetItemClass( + const ATypeInfo : PTypeInfo +) : TTypeRegistryItemClass; +begin + Result := TBaseComplexTypeRegistryItem; +end; + +{$IFDEF TRemotableTypeInitializer_Initialize} +class function TBaseComplexRemotableInitializer.Initialize( + ATypeInfo : PTypeInfo; + ARegistryItem : TTypeRegistryItem +) : Boolean; +begin +end; +{$ENDIF TRemotableTypeInitializer_Initialize} + +{ TBaseComplexTypeRegistryItem } + +function TBaseComplexTypeRegistryItem.FirstGetter() : TObjectSerializer; +var + oldValue : PtrInt; +begin + if ( InterlockedCompareExchange(Pointer(FGetterLock),Pointer(1),Pointer(0)) = Pointer(0) ) then begin + try + FSerializer := TObjectSerializer.Create(TBaseComplexRemotableClass(GetTypeData(DataType)^.ClassType),Owner); + except + InterLockedDecrement(FGetterLock); + raise; + end; + FGetFunction := {$IFDEF FPC}@{$ENDIF}StaticGetter; + InterLockedIncrement(FGetterLock); + end else begin + repeat + //this is a way t get the value of "FGetterLock" without altering it. + oldValue := PtrInt(InterlockedCompareExchange(Pointer(FGetterLock),Pointer(1),Pointer(12))); + //this is a busy wait! + until ( oldValue <> 1 ); + if ( oldValue <> 2 ) then + raise ESerializerException.CreateFmt(SERR_SerializerInitializationException,[DataType^.Name]); + end; + Result := FSerializer; +end; + +function TBaseComplexTypeRegistryItem.StaticGetter() : TObjectSerializer; +begin + Result := FSerializer; +end; + +constructor TBaseComplexTypeRegistryItem.Create( + AOwner : TTypeRegistry; + ANameSpace : string; + ADataType : PTypeInfo; + const ADeclaredName : string +); +begin + inherited Create(AOwner, ANameSpace, ADataType, ADeclaredName); + FGetFunction := {$IFDEF FPC}@{$ENDIF}FirstGetter; +end; + +destructor TBaseComplexTypeRegistryItem.Destroy(); +begin + FSerializer.Free(); + inherited Destroy(); +end; + +function TBaseComplexTypeRegistryItem.GetSerializer() : TObjectSerializer; +begin + Result := FGetFunction(); +end; + +end. diff --git a/wst/trunk/record_rtti.pas b/wst/trunk/record_rtti.pas index 97d93f30a..f46682a8b 100644 --- a/wst/trunk/record_rtti.pas +++ b/wst/trunk/record_rtti.pas @@ -45,13 +45,13 @@ type public constructor Create(const AData : PRecordTypeData; const AFieldList : string); destructor Destroy();override; - function GetRecordTypeData() : PRecordTypeData; + function GetRecordTypeData() : PRecordTypeData;{$IFDEF USE_INLINE}inline;{$ENDIF} function FindField(const AFieldName : shortstring) : PRecordFieldInfo; function GetField(const AFieldName : shortstring) : PRecordFieldInfo; end; function MakeRecordTypeInfo(ARawTypeInfo : PTypeInfo) : PRecordTypeData; - procedure FreeRecordTypeInfo(ATypeInfo : PRecordTypeData); + procedure FreeRecordTypeInfo(ATypeInfo : PRecordTypeData);{$IFDEF USE_INLINE}inline;{$ENDIF} {$IFDEF WST_RECORD_RTTI} function MakeRawTypeInfo( diff --git a/wst/trunk/server_service_soap.pas b/wst/trunk/server_service_soap.pas index 7dbc2a648..0ca340696 100644 --- a/wst/trunk/server_service_soap.pas +++ b/wst/trunk/server_service_soap.pas @@ -80,6 +80,8 @@ end; procedure TSOAPFormatter.BeginCallResponse(Const AProcName,ATarget:string); begin + if ( FCallContext = nil ) then + FCallContext := TSimpleCallContext.Create(); Clear(); Prepare(); WriteHeaders(FCallContext); @@ -97,7 +99,7 @@ end; procedure TSOAPFormatter.BeginCallRead(ACallContext : ICallContext); Var envNd : TDOMElement; - hdrNd, bdyNd, mthdNd, tmpNode : TDOMNode; + hdrNd, bdyNd, mthdNd : TDOMNode; s,nsShortName,eltName : string; doc : TXMLDocument; begin diff --git a/wst/trunk/service_intf.pas b/wst/trunk/service_intf.pas index a1b5efd13..6d3d4acc0 100644 --- a/wst/trunk/service_intf.pas +++ b/wst/trunk/service_intf.pas @@ -38,8 +38,6 @@ Type //The client formater interface, used to marshall parameters. IFormatterClient = Interface(IFormatterBase) ['{73746BC7-CA43-4C00-8789-71E23033C3B2}'] - function GetPropertyManager():IPropertyManager; - procedure BeginCall( const AProcName, ATarget : string; diff --git a/wst/trunk/soap_formatter.pas b/wst/trunk/soap_formatter.pas index d56f53e2d..be04e2052 100644 --- a/wst/trunk/soap_formatter.pas +++ b/wst/trunk/soap_formatter.pas @@ -30,13 +30,9 @@ type {$M+} TSOAPFormatter = class(TSOAPBaseFormatter,IFormatterClient) private - FPropMngr : IPropertyManager; FCallProcedureName : string; FCallTarget : String; public - destructor Destroy();override; - function GetPropertyManager():IPropertyManager; - procedure BeginCall( const AProcName, ATarget : string; @@ -73,19 +69,6 @@ implementation { TSOAPFormatter } -destructor TSOAPFormatter.Destroy(); -begin - FPropMngr := nil; - inherited Destroy(); -end; - -function TSOAPFormatter.GetPropertyManager(): IPropertyManager; -begin - If Not Assigned(FPropMngr) Then - FPropMngr := TPublishedPropertyManager.Create(Self); - Result := FPropMngr; -end; - procedure TSOAPFormatter.BeginCall( const AProcName, ATarget : string; diff --git a/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dpr b/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dpr index 5d10a49ce..24e06ac20 100644 --- a/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dpr +++ b/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dpr @@ -23,7 +23,9 @@ uses test_suite_utils in '..\test_suite_utils.pas', test_std_cursors in '..\test_std_cursors.pas', test_rtti_filter in '..\test_rtti_filter.pas', - test_wst_cursors in '..\test_wst_cursors.pas'; + test_wst_cursors in '..\test_wst_cursors.pas', + test_registry in '..\test_registry.pas', + test_soap_specific in '..\test_soap_specific.pas'; {$R *.res} diff --git a/wst/trunk/tests/test_suite/files/class_properties_default.xsd b/wst/trunk/tests/test_suite/files/class_properties_default.xsd index 903a3e6f1..18c59c240 100644 --- a/wst/trunk/tests/test_suite/files/class_properties_default.xsd +++ b/wst/trunk/tests/test_suite/files/class_properties_default.xsd @@ -1,3 +1,4 @@ + diff --git a/wst/trunk/tests/test_suite/files/soap_multi_namespace_object.xml b/wst/trunk/tests/test_suite/files/soap_multi_namespace_object.xml new file mode 100644 index 000000000..fa22795a4 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/soap_multi_namespace_object.xml @@ -0,0 +1,42 @@ + + + + + + true + steTwo + 1210 + 123456 + sample string. + + + true + steThree + 456 + 78945 + Sample string inherited from TNameSpaceA_Class. + true + WST sample string, local to NameSpace.B + + + This property should be in : NameSpace.C + + false + steOne + 0 + 0 + This property should be in : NameSpace.A + + + false + steFour + 789 + 64 + This inherited property should be in : NameSpace.A + true + local elemet. This property should be in : NameSpace.B + + + + + diff --git a/wst/trunk/tests/test_suite/test_generators.pas b/wst/trunk/tests/test_suite/test_generators.pas index 039ffdb81..a0271a8ff 100644 --- a/wst/trunk/tests/test_suite/test_generators.pas +++ b/wst/trunk/tests/test_suite/test_generators.pas @@ -105,7 +105,7 @@ begin g.Execute(tr,mdl.Name); WriteXMLFile(locDoc,'.\class_properties_default.xsd'); locExistDoc := LoadXmlFromFilesList('class_properties_default.xsd'); - Check(CompareNodes(locExistDoc,locDoc),'generated document differs from the existent one.'); + Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.'); finally ReleaseDomNode(locExistDoc); ReleaseDomNode(locDoc); @@ -246,7 +246,7 @@ begin g.Execute(tr,mdl.Name); WriteXMLFile(locDoc,'.\class_extent_native_type.xsd'); locExistDoc := LoadXmlFromFilesList('class_extent_native_type.xsd'); - Check(CompareNodes(locExistDoc,locDoc),'generated document differs from the existent one.'); + Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.'); finally ReleaseDomNode(locExistDoc); ReleaseDomNode(locDoc); diff --git a/wst/trunk/tests/test_suite/test_json.pas b/wst/trunk/tests/test_suite/test_json.pas index b9d5f36f0..af12e3b42 100644 --- a/wst/trunk/tests/test_suite/test_json.pas +++ b/wst/trunk/tests/test_suite/test_json.pas @@ -101,7 +101,7 @@ var strm : TMemoryStream; locParser : TJSONParser; root, errorNodeObj : TJSONObject; - errorNode, tmpNode : TJSONData; + errorNode : TJSONData; excpt_code, excpt_msg : string; begin root := nil; diff --git a/wst/trunk/tests/test_suite/test_registry.pas b/wst/trunk/tests/test_suite/test_registry.pas new file mode 100644 index 000000000..c1def4d11 --- /dev/null +++ b/wst/trunk/tests/test_suite/test_registry.pas @@ -0,0 +1,178 @@ +{ This file is part of the Web Service Toolkit + Copyright (c) 2006, 2007 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +} +{$INCLUDE wst_global.inc} +unit test_registry; + +interface + +uses + Classes, SysUtils, +{$IFDEF FPC} + fpcunit, testregistry, +{$ELSE} + TestFrameWork, +{$ENDIF} + TypInfo, + wst_types, base_service_intf; + +const + s_sample_namespace = 'org.wst.sample'; + +type + + { TClass_A } + + TClass_A = class(TBaseComplexRemotable) + private + FIntProp : Integer; + FStrProp : string; + published + // StrProp is an attribute property in this class ! + property StrProp : string read FStrProp write FStrProp; + property IntProp : Integer read FIntProp write FIntProp; + end; + + { TClass_B } + + TClass_B = class(TBaseComplexRemotable) + private + FIntProp : Integer; + FStrProp : string; + published + property StrProp : string read FStrProp write FStrProp; + property IntProp : Integer read FIntProp write FIntProp; + end; + + TClass_C = class(TBaseComplexRemotable) + private + FIntProp : Integer; + FStrProp : string; + published + property StrProp : string read FStrProp write FStrProp; + //IntProp is an attribute property + property IntProp : Integer read FIntProp write FIntProp; + end; + + { TTest_TTypeRegistry } + + TTest_TTypeRegistry = class(TTestCase) + protected + published + procedure Register(); + procedure Register_with_declared_name(); + procedure isAttributeProperty(); + procedure register_external_prop(); + procedure synonym_procs(); + end; + +implementation + +{ TTest_TTypeRegistry } + +procedure TTest_TTypeRegistry.Register(); +var + reg : TTypeRegistry; + regItem0 : TTypeRegistryItem; + c : PtrInt; +begin + reg := TTypeRegistry.Create(); + try + CheckEquals(0, reg.Count, 'Count'); + c := reg.Count; + regItem0 := reg.Register(s_sample_namespace,TypeInfo(TClass_A)); + CheckEquals( ( c + 1 ), reg.Count, 'Count'); + CheckSame(regItem0,reg.Find(TypeInfo(TClass_A),True)); + CheckSame(regItem0,reg.ItemByTypeInfo[TypeInfo(TClass_A)]); + Check(regItem0.DataType = TypeInfo(TClass_A),'Item.DataType'); + CheckEquals(TClass_A.ClassName,regItem0.DeclaredName); + CheckEquals(s_sample_namespace,regItem0.NameSpace); + finally + reg.Free(); + end; +end; + +procedure TTest_TTypeRegistry.Register_with_declared_name(); +const s_declared_name = 'sample_declared_name'; +var + reg : TTypeRegistry; + regItem0 : TTypeRegistryItem; + c : PtrInt; +begin + reg := TTypeRegistry.Create(); + try + CheckEquals(0, reg.Count, 'Count'); + c := reg.Count; + regItem0 := reg.Register(s_sample_namespace,TypeInfo(TClass_A),s_declared_name); + CheckEquals( ( c + 1 ), reg.Count, 'Count'); + CheckSame(regItem0,reg.Find(TypeInfo(TClass_A),True)); + CheckSame(regItem0,reg.ItemByTypeInfo[TypeInfo(TClass_A)]); + Check(regItem0.DataType = TypeInfo(TClass_A),'Item.DataType'); + CheckEquals(s_declared_name,regItem0.DeclaredName); + CheckEquals(s_sample_namespace,regItem0.NameSpace); + finally + reg.Free(); + end; +end; + +procedure TTest_TTypeRegistry.isAttributeProperty(); +begin + Check(TClass_A.IsAttributeProperty('StrProp')); + Check(not TClass_A.IsAttributeProperty('IntProp')); + Check(not TClass_B.IsAttributeProperty('StrProp')); + Check(TClass_C.IsAttributeProperty('IntProp')); + Check(not TClass_C.IsAttributeProperty('StrProp')); +end; + +procedure TTest_TTypeRegistry.register_external_prop(); +const s_ext_name = 'sample_external_name'; +var + reg : TTypeRegistry; + regItem : TTypeRegistryItem; +begin + reg := TTypeRegistry.Create(); + try + regItem := reg.Register(s_sample_namespace,TypeInfo(TClass_A)); + regItem.RegisterExternalPropertyName('StrProp',s_ext_name); + CheckEquals(s_ext_name,regItem.GetExternalPropertyName('StrProp')); + CheckEquals('StrProp',regItem.GetInternalPropertyName(s_ext_name)); + finally + reg.Free(); + end; +end; + +procedure TTest_TTypeRegistry.synonym_procs(); +const s_ext_name = 'sample_external_name'; +var + reg : TTypeRegistry; + regItem : TTypeRegistryItem; +begin + reg := TTypeRegistry.Create(); + try + regItem := reg.Register(s_sample_namespace,TypeInfo(TClass_A)); + regItem.AddPascalSynonym(s_ext_name); + Check(regItem.IsSynonym(s_ext_name)); + CheckSame(regItem, reg.Find(s_ext_name)); + finally + reg.Free(); + end; +end; + +initialization + GetTypeRegistry().Register(s_sample_namespace,TypeInfo(TClass_A)); + TClass_A.RegisterAttributeProperty('StrProp'); + GetTypeRegistry().Register(s_sample_namespace,TypeInfo(TClass_B)); + GetTypeRegistry().Register(s_sample_namespace,TypeInfo(TClass_C)); + TClass_C.RegisterAttributeProperty('IntProp'); + + RegisterTest('Registry',TTest_TTypeRegistry.Suite); +end. + diff --git a/wst/trunk/tests/test_suite/test_soap_specific.pas b/wst/trunk/tests/test_suite/test_soap_specific.pas new file mode 100644 index 000000000..9b27d2176 --- /dev/null +++ b/wst/trunk/tests/test_suite/test_soap_specific.pas @@ -0,0 +1,427 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006, 2007 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +} +{$INCLUDE wst_global.inc} +unit test_soap_specific; + +interface + +uses + Classes, SysUtils, +{$IFDEF FPC} + fpcunit, testutils, testregistry, DOM, XmlRead, XmlWrite, wst_fpc_xml, +{$ENDIF} +{$IFNDEF FPC} + TestFrameWork, ActiveX, wst_delphi_xml, +{$ENDIF} + TypInfo, + base_service_intf, wst_types, server_service_intf, service_intf; + +const + ns_soap_test = 'soap.test.namespace'; + +type + + TSOAPTestEnum = ( steOne, steTwo, steThree, steFour ); + + { NBHeader } + + NBHeader = class(THeaderBlock) + private + FSessionID : string; + FUserID : string; + public + class procedure Load( + var AObject : TObject; + AStore : IFormatterBase; + var AName : string; + const ATypeInfo : PTypeInfo + );override; + class function GetNameSpace() : string; + published + property UserID : string read FUserID write FUserID; + property SessionID : string read FSessionID write FSessionID; + end; + + { TNameSpaceA_Class } + + TNameSpaceA_Class = class(TBaseComplexRemotable) + private + FQualified_Val_Bool : boolean; + FQualified_Val_Enum : TSOAPTestEnum; + FQualified_Val_Int64 : Integer; + FQualified_Val_Integer : Integer; + FQualified_Val_String : string; + public + class function GetNameSpace() : string;virtual; + published + property Qualified_Val_Bool : boolean read FQualified_Val_Bool write FQualified_Val_Bool; + property Qualified_Val_Enum : TSOAPTestEnum read FQualified_Val_Enum write FQualified_Val_Enum; + property Qualified_Val_Integer : Integer read FQualified_Val_Integer write FQualified_Val_Integer; + property Qualified_Val_Int64 : Integer read FQualified_Val_Int64 write FQualified_Val_Int64; + property Qualified_Val_String : string Read FQualified_Val_String Write FQualified_Val_String; + end; + + { TNameSpaceB_Class } + + TNameSpaceB_Class = class(TNameSpaceA_Class) + private + FVal_Bool : Boolean; + FVal_String : string; + public + class function GetNameSpace() : string;override; + published + property Val_Bool : Boolean Read FVal_Bool Write FVal_Bool; + property Val_String : string Read FVal_String Write FVal_String; + end; + + { TNameSpaceC_Class } + + TNameSpaceC_Class = class(TBaseComplexRemotable) + private + FProp_A : TNameSpaceA_Class; + FProp_B : TNameSpaceB_Class; + FProp_String : string; + public + constructor Create();override; + destructor Destroy();override; + class function GetNameSpace() : string;virtual; + published + property Prop_String : string Read FProp_String Write FProp_String; + property Prop_A : TNameSpaceA_Class read FProp_A write FProp_A; + property Prop_B : TNameSpaceB_Class read FProp_B write FProp_B; + end; + + { TTest_SoapFormatterServerNameSpace } + + TTest_SoapFormatterServerNameSpace = class(TTestCase) + published + procedure namespace_declared_env(); + procedure received_header(); + procedure multi_namespace_object_write(); + procedure multi_namespace_object_read(); + end; + +implementation +uses + object_serializer, server_service_soap, test_suite_utils; + +function GetFileFullName(const AFileName: string): string; +var + locFileName : string; +begin +{$IFDEF FPC} + Result := Format('.%sfiles%s%s',[PathDelim,PathDelim,AFileName]); +{$ENDIF} +{$IFDEF DELPHI} + Result := Format('..%sfiles%s%s',[PathDelim,PathDelim,AFileName]); +{$ENDIF} +end; + +function LoadXmlFromFilesList(const AFileName: string): TXMLDocument; +begin + ReadXMLFile(Result,GetFileFullName(AFileName)); +end; + +{ NBHeader } + +class procedure NBHeader.Load( + var AObject : TObject; + AStore : IFormatterBase; + var AName : string; + const ATypeInfo : PTypeInfo +); +var + locSerializer : TObjectSerializer; +begin + locSerializer := TObjectSerializer.Create(Self,GetTypeRegistry()); + try + locSerializer.Read(AObject,AStore,AName,ATypeInfo); + finally + locSerializer.Free(); + end; +end; + +class function NBHeader.GetNameSpace() : string; +begin + Result := 'NBS3'; +end; + +{ TTest_SoapFormatterServerNameSpace } + +procedure TTest_SoapFormatterServerNameSpace.namespace_declared_env(); +const + XML_SOURCE = + ' ' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ''; +var + f : IFormatterResponse; + strm : TMemoryStream; + strBuffer : ansistring; + cctx : ICallContext; +begin + f := server_service_soap.TSOAPFormatter.Create() as IFormatterResponse; + 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); + strBuffer := f.GetCallProcedureName(); + CheckEquals('GetVersion',strBuffer, 'GetCallProcedureName()'); + f.EndScopeRead(); + finally + FreeAndNil(strm); + end; +end; + +procedure TTest_SoapFormatterServerNameSpace.received_header(); +const + XML_SOURCE = + '' + sLineBreak + + '' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' AL00287DE' + sLineBreak + + ' KvyxXkK9PAta4zLtm6PA' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ''; +var + f : IFormatterResponse; + strm : TMemoryStream; + strBuffer : ansistring; + cctx : ICallContext; + hdr : NBHeader; +begin + f := server_service_soap.TSOAPFormatter.Create() as IFormatterResponse; + 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); + CheckEquals(0,cctx.GetHeaderCount([hdOut]),'Ouput header count'); + CheckEquals(1,cctx.GetHeaderCount([hdIn]),'Input header count'); + CheckIs(cctx.GetHeader(0),NBHeader); + hdr := NBHeader(cctx.GetHeader(0)); + CheckEquals(1,hdr.mustUnderstand,'mustUnderstand'); + CheckEquals('AL00287DE',hdr.UserID,'UserID'); + CheckEquals('KvyxXkK9PAta4zLtm6PA',hdr.SessionID); + strBuffer := f.GetCallProcedureName(); + CheckEquals('getSelbst',strBuffer, 'GetCallProcedureName()'); + f.EndScopeRead(); + finally + FreeAndNil(strm); + end; +end; + +procedure TTest_SoapFormatterServerNameSpace.multi_namespace_object_write(); +var + f : IFormatterResponse; + strm : TMemoryStream; + a : TNameSpaceA_Class; + b : TNameSpaceB_Class; + c : TNameSpaceC_Class; + locDoc, locExistDoc : TXMLDocument; +begin + locDoc := nil; + locExistDoc := nil; + c := nil; + b := nil; + strm := nil; + f := server_service_soap.TSOAPFormatter.Create() as IFormatterResponse; + f.GetPropertyManager().SetProperty('Style','Document'); + f.GetPropertyManager().SetProperty('EncodingStyle','Literal'); + a := TNameSpaceA_Class.Create(); + try + a.Qualified_Val_Bool := True; + a.Qualified_Val_Enum := steTwo; + a.Qualified_Val_Integer := 1210; + a.Qualified_Val_Int64 := 123456; + a.Qualified_Val_String := 'sample string.'; + b := TNameSpaceB_Class.Create(); + b.Val_Bool := True; + b.Val_String := 'WST sample string, local to ' + b.GetNameSpace(); + b.Qualified_Val_Bool := True; + b.Qualified_Val_Enum := steThree; + b.Qualified_Val_Integer := 456; + b.Qualified_Val_Int64 := 78945; + b.Qualified_Val_String := 'Sample string inherited from TNameSpaceA_Class.'; + c := TNameSpaceC_Class.Create(); + c.Prop_String := 'This property should be in : ' + c.GetNameSpace() ; + c.Prop_A.Qualified_Val_String := 'This property should be in : ' + a.GetNameSpace() ; + c.Prop_B.Val_Bool := True; + c.Prop_B.Val_String := 'local elemet. This property should be in : ' + b.GetNameSpace() ; + c.Prop_B.Qualified_Val_Bool := False; + c.Prop_B.Qualified_Val_Enum := steFour; + c.Prop_B.Qualified_Val_Integer := 789; + c.Prop_B.Qualified_Val_Int64 := 64; + c.Prop_B.Qualified_Val_String := 'This inherited property should be in : ' + a.GetNameSpace() ; + f.BeginCallResponse('SampleProc','SampleService'); + f.Put('a',TypeInfo(TNameSpaceA_Class),a); + f.Put('b',TypeInfo(TNameSpaceB_Class),b); + f.Put('c',TypeInfo(TNameSpaceC_Class),c); + f.EndCallResponse(); + strm := TMemoryStream.Create(); + f.SaveToStream(strm); + strm.SaveToFile('soap_multi_namespace_object.xml'); + + strm.Position := 0; + ReadXMLFile(locDoc,strm); + locExistDoc := LoadXmlFromFilesList('soap_multi_namespace_object.xml'); + Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.'); + finally + ReleaseDomNode(locExistDoc); + ReleaseDomNode(locDoc); + c.Free(); + b.Free(); + a.Free(); + strm.Free(); + end; +end; + +procedure TTest_SoapFormatterServerNameSpace.multi_namespace_object_read(); +var + f : IFormatterResponse; + strm : TMemoryStream; + a, a_readed : TNameSpaceA_Class; + b, b_readed : TNameSpaceB_Class; + c, c_readed : TNameSpaceC_Class; + locDoc, locExistDoc : TXMLDocument; + strName : string; +begin + locDoc := nil; + locExistDoc := nil; + c := nil; + b := nil; + strm := nil; + f := server_service_soap.TSOAPFormatter.Create() as IFormatterResponse; + f.GetPropertyManager().SetProperty('Style','Document'); + f.GetPropertyManager().SetProperty('EncodingStyle','Literal'); + a := TNameSpaceA_Class.Create(); + try + a.Qualified_Val_Bool := True; + a.Qualified_Val_Enum := steTwo; + a.Qualified_Val_Integer := 1210; + a.Qualified_Val_Int64 := 123456; + a.Qualified_Val_String := 'sample string.'; + b := TNameSpaceB_Class.Create(); + b.Val_Bool := True; + b.Val_String := 'WST sample string, local to ' + b.GetNameSpace(); + b.Qualified_Val_Bool := True; + b.Qualified_Val_Enum := steThree; + b.Qualified_Val_Integer := 456; + b.Qualified_Val_Int64 := 78945; + b.Qualified_Val_String := 'Sample string inherited from TNameSpaceA_Class.'; + c := TNameSpaceC_Class.Create(); + c.Prop_String := 'This property should be in : ' + c.GetNameSpace() ; + c.Prop_A.Qualified_Val_String := 'This property should be in : ' + a.GetNameSpace() ; + c.Prop_B.Val_Bool := True; + c.Prop_B.Val_String := 'local elemet. This property should be in : ' + b.GetNameSpace() ; + c.Prop_B.Qualified_Val_Bool := False; + c.Prop_B.Qualified_Val_Enum := steFour; + c.Prop_B.Qualified_Val_Integer := 789; + c.Prop_B.Qualified_Val_Int64 := 64; + c.Prop_B.Qualified_Val_String := 'This inherited property should be in : ' + a.GetNameSpace() ; + strm := TMemoryStream.Create(); + strm.LoadFromFile(GetFileFullName('soap_multi_namespace_object.xml')); + strm.Position := 0; + f.LoadFromStream(strm); + a_readed := TNameSpaceA_Class.Create(); + b_readed := TNameSpaceB_Class.Create(); + c_readed := TNameSpaceC_Class.Create(); + f.BeginCallRead(TSimpleCallContext.Create()); + strName := 'a'; + f.Get(TypeInfo(TNameSpaceA_Class),strName,a_readed); + strName := 'b'; + f.Get(TypeInfo(TNameSpaceB_Class),strName,b_readed); + strName := 'c'; + f.Get(TypeInfo(TNameSpaceC_Class),strName,c_readed); + f.EndScopeRead(); + + Check(a.Equal(a_readed) and a_readed.Equal(a),'a'); + Check(b.Equal(b_readed) and b_readed.Equal(b),'b'); + Check(c.Equal(c_readed) and c_readed.Equal(c),'c'); + finally + ReleaseDomNode(locExistDoc); + ReleaseDomNode(locDoc); + c.Free(); + b.Free(); + a.Free(); + strm.Free(); + end; +end; + +{ TNameSpaceA_Class } + +class function TNameSpaceA_Class.GetNameSpace() : string; +begin + Result := 'NameSpace.A'; +end; + +{ TNameSpaceB_Class } + +class function TNameSpaceB_Class.GetNameSpace() : string; +begin + Result := 'NameSpace.B'; +end; + +{ TNameSpaceC_Class } + +constructor TNameSpaceC_Class.Create(); +begin + inherited Create(); + FProp_A := TNameSpaceA_Class.Create(); + FProp_B := TNameSpaceB_Class.Create(); +end; + +destructor TNameSpaceC_Class.Destroy(); +begin + FreeAndNil(FProp_B); + FreeAndNil(FProp_A); + inherited Destroy(); +end; + +class function TNameSpaceC_Class.GetNameSpace() : string; +begin + Result := 'NameSpace.C'; +end; + +initialization + GetTypeRegistry().Register(NBHeader.GetNameSpace(),TypeInfo(NBHeader),'NBHeader'); + GetTypeRegistry().Register(TNameSpaceA_Class.GetNameSpace(),TypeInfo(TNameSpaceA_Class)); + GetTypeRegistry().Register(TNameSpaceB_Class.GetNameSpace(),TypeInfo(TNameSpaceB_Class)); + GetTypeRegistry().Register(TNameSpaceC_Class.GetNameSpace(),TypeInfo(TNameSpaceC_Class)); + GetTypeRegistry().Register(ns_soap_test,TypeInfo(TSOAPTestEnum)); + + RegisterTest('Serializer',TTest_SoapFormatterServerNameSpace.Suite); + +end. + diff --git a/wst/trunk/tests/test_suite/test_suite_utils.pas b/wst/trunk/tests/test_suite/test_suite_utils.pas index 6a20a3ea9..aa551da87 100644 --- a/wst/trunk/tests/test_suite/test_suite_utils.pas +++ b/wst/trunk/tests/test_suite/test_suite_utils.pas @@ -57,7 +57,7 @@ begin 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 + if not CompareNodes(A.Attributes.Item[i],B.Attributes.GetNamedItem(A.Attributes.Item[i].NodeName)) then Exit; end; end; diff --git a/wst/trunk/tests/test_suite/test_support.pas b/wst/trunk/tests/test_suite/test_support.pas index 90d73de28..d1df543b3 100644 --- a/wst/trunk/tests/test_suite/test_support.pas +++ b/wst/trunk/tests/test_suite/test_support.pas @@ -22,7 +22,7 @@ uses TestFrameWork, {$ENDIF} TypInfo, - wst_types, base_service_intf; + wst_types, base_service_intf, imp_utils; type @@ -352,6 +352,10 @@ type procedure Equal(); procedure SetBinaryData(); procedure SetEncodedString(); + procedure LoadFromStream(); + procedure LoadFromFile(); + procedure SaveToStream(); + procedure SaveToFile(); end; { TTest_TBase64StringExtRemotable } @@ -362,6 +366,10 @@ type procedure test_Assign(); procedure SetBinaryData(); procedure SetEncodedString(); + procedure LoadFromStream(); + procedure LoadFromFile(); + procedure SaveToStream(); + procedure SaveToFile(); end; { TClass_A_CollectionRemotable } @@ -389,6 +397,14 @@ type procedure IndexOf(); end; + { TTest_Procedures } + + TTest_Procedures = class(TTestCase) + published + procedure test_LoadBufferFromStream(); + procedure test_LoadBufferFromFile(); + end; + implementation uses Math, basex_encode; @@ -2171,7 +2187,6 @@ begin end; procedure TTest_TDateRemotable.ParseDate(); -const sDATE = '1976-10-12T23:34:56'; var s : string; objd : TDateRemotable; @@ -2901,6 +2916,129 @@ begin end; end; +procedure TTest_TBase64StringRemotable.LoadFromStream(); +var + locLoadedBuffer : TBase64StringRemotable; + locBuffer : TBinaryString; + pBytePtr : PByte; + locStream : TMemoryStream; + i : PtrInt; +begin + SetLength(locBuffer,255); + pBytePtr := PByte(@(locBuffer[1])); + for i := 0 to 255 do begin + pBytePtr^ := i; + Inc(pBytePtr); + end; + locLoadedBuffer := nil; + locStream := TMemoryStream.Create(); + try + locStream.Write(locBuffer[1],Length(locBuffer)); + locLoadedBuffer := TBase64StringRemotable.Create(); + locLoadedBuffer.LoadFromStream(locStream); + Check( locLoadedBuffer.BinaryData = locBuffer ); + finally + locLoadedBuffer.Free(); + locStream.Free(); + end; +end; + +procedure TTest_TBase64StringRemotable.LoadFromFile(); +var + locLoadedBuffer : TBase64StringRemotable; + locBuffer : TBinaryString; + pBytePtr : PByte; + locStream : TMemoryStream; + i : PtrInt; + locFileName : string; +begin + SetLength(locBuffer,255); + pBytePtr := PByte(@(locBuffer[1])); + for i := 0 to 255 do begin + pBytePtr^ := i; + Inc(pBytePtr); + end; + locLoadedBuffer := nil; + locStream := TMemoryStream.Create(); + try + locStream.Write(locBuffer[1],Length(locBuffer)); + locFileName := 'test_LoadBufferFromFile.bin'; + locStream.SaveToFile(locFileName); + locLoadedBuffer := TBase64StringRemotable.Create(); + locLoadedBuffer.LoadFromFile(locFileName); + Check( locLoadedBuffer.BinaryData = locBuffer ); + finally + locLoadedBuffer.Free(); + locStream.Free(); + end; +end; + +procedure TTest_TBase64StringRemotable.SaveToStream(); +var + locObj : TBase64StringRemotable; + locBuffer : TBinaryString; + pBytePtr : PByte; + locStream : TMemoryStream; + i : PtrInt; +begin + SetLength(locBuffer,255); + pBytePtr := PByte(@(locBuffer[1])); + for i := 0 to 255 do begin + pBytePtr^ := i; + Inc(pBytePtr); + end; + locObj := nil; + locStream := TMemoryStream.Create(); + try + locObj := TBase64StringRemotable.Create(); + locObj.BinaryData := locBuffer; + locObj.SaveToStream(locStream); + Check( locStream.Size = Length(locObj.BinaryData) ); + SetLength(locBuffer,locStream.Size); + locStream.Position := 0; + locStream.Read(locBuffer[1],Length(locBuffer)); + Check( locBuffer = locObj.BinaryData ); + finally + locObj.Free(); + locStream.Free(); + end; +end; + +procedure TTest_TBase64StringRemotable.SaveToFile(); +var + locObj : TBase64StringRemotable; + locBuffer : TBinaryString; + pBytePtr : PByte; + locStream : TFileStream; + i : PtrInt; + locFileName : string; +begin + SetLength(locBuffer,255); + pBytePtr := PByte(@(locBuffer[1])); + for i := 0 to 255 do begin + pBytePtr^ := i; + Inc(pBytePtr); + end; + locStream := nil; + locObj := TBase64StringRemotable.Create(); + try + locObj.BinaryData := locBuffer; + locFileName := 'test_LoadBufferFromFile.bin'; + DeleteFile(locFileName); + locObj.SaveToFile(locFileName); + Check(FileExists(locFileName)); + locStream := TFileStream.Create(locFileName,fmOpenRead); + Check( locStream.Size = Length(locObj.BinaryData) ); + SetLength(locBuffer,locStream.Size); + locStream.Position := 0; + locStream.Read(locBuffer[1],Length(locBuffer)); + Check( locBuffer = locObj.BinaryData ); + finally + locObj.Free(); + locStream.Free(); + end; +end; + { TTest_TBase64StringExtRemotable } procedure TTest_TBase64StringExtRemotable.Equal(); @@ -2994,6 +3132,129 @@ begin end; end; +procedure TTest_TBase64StringExtRemotable.LoadFromStream(); +var + locLoadedBuffer : TBase64StringExtRemotable; + locBuffer : TBinaryString; + pBytePtr : PByte; + locStream : TMemoryStream; + i : PtrInt; +begin + SetLength(locBuffer,255); + pBytePtr := PByte(@(locBuffer[1])); + for i := 0 to 255 do begin + pBytePtr^ := i; + Inc(pBytePtr); + end; + locLoadedBuffer := nil; + locStream := TMemoryStream.Create(); + try + locStream.Write(locBuffer[1],Length(locBuffer)); + locLoadedBuffer := TBase64StringExtRemotable.Create(); + locLoadedBuffer.LoadFromStream(locStream); + Check( locLoadedBuffer.BinaryData = locBuffer ); + finally + locLoadedBuffer.Free(); + locStream.Free(); + end; +end; + +procedure TTest_TBase64StringExtRemotable.LoadFromFile(); +var + locLoadedBuffer : TBase64StringExtRemotable; + locBuffer : TBinaryString; + pBytePtr : PByte; + locStream : TMemoryStream; + i : PtrInt; + locFileName : string; +begin + SetLength(locBuffer,255); + pBytePtr := PByte(@(locBuffer[1])); + for i := 0 to 255 do begin + pBytePtr^ := i; + Inc(pBytePtr); + end; + locLoadedBuffer := nil; + locStream := TMemoryStream.Create(); + try + locStream.Write(locBuffer[1],Length(locBuffer)); + locFileName := 'test_LoadBufferFromFile.bin'; + locStream.SaveToFile(locFileName); + locLoadedBuffer := TBase64StringExtRemotable.Create(); + locLoadedBuffer.LoadFromFile(locFileName); + Check( locLoadedBuffer.BinaryData = locBuffer ); + finally + locLoadedBuffer.Free(); + locStream.Free(); + end; +end; + +procedure TTest_TBase64StringExtRemotable.SaveToStream(); +var + locObj : TBase64StringExtRemotable; + locBuffer : TBinaryString; + pBytePtr : PByte; + locStream : TMemoryStream; + i : PtrInt; +begin + SetLength(locBuffer,255); + pBytePtr := PByte(@(locBuffer[1])); + for i := 0 to 255 do begin + pBytePtr^ := i; + Inc(pBytePtr); + end; + locObj := nil; + locStream := TMemoryStream.Create(); + try + locObj := TBase64StringExtRemotable.Create(); + locObj.BinaryData := locBuffer; + locObj.SaveToStream(locStream); + Check( locStream.Size = Length(locObj.BinaryData) ); + SetLength(locBuffer,locStream.Size); + locStream.Position := 0; + locStream.Read(locBuffer[1],Length(locBuffer)); + Check( locBuffer = locObj.BinaryData ); + finally + locObj.Free(); + locStream.Free(); + end; +end; + +procedure TTest_TBase64StringExtRemotable.SaveToFile(); +var + locObj : TBase64StringExtRemotable; + locBuffer : TBinaryString; + pBytePtr : PByte; + locStream : TFileStream; + i : PtrInt; + locFileName : string; +begin + SetLength(locBuffer,255); + pBytePtr := PByte(@(locBuffer[1])); + for i := 0 to 255 do begin + pBytePtr^ := i; + Inc(pBytePtr); + end; + locStream := nil; + locObj := TBase64StringExtRemotable.Create(); + try + locObj.BinaryData := locBuffer; + locFileName := 'test_LoadBufferFromFile.bin'; + DeleteFile(locFileName); + locObj.SaveToFile(locFileName); + Check(FileExists(locFileName)); + locStream := TFileStream.Create(locFileName,fmOpenRead); + Check( locStream.Size = Length(locObj.BinaryData) ); + SetLength(locBuffer,locStream.Size); + locStream.Position := 0; + locStream.Read(locBuffer[1],Length(locBuffer)); + Check( locBuffer = locObj.BinaryData ); + finally + locObj.Free(); + locStream.Free(); + end; +end; + procedure TTest_TBase64StringExtRemotable.test_Assign(); const ITER = 100; var @@ -3243,6 +3504,57 @@ begin end; end; +{ TTest_Procedures } + +procedure TTest_Procedures.test_LoadBufferFromStream(); +var + locBuffer, locLoadedBuffer : TBinaryString; + pBytePtr : PByte; + locStream : TMemoryStream; + i : PtrInt; +begin + SetLength(locBuffer,255); + pBytePtr := PByte(@(locBuffer[1])); + for i := 0 to 255 do begin + pBytePtr^ := i; + Inc(pBytePtr); + end; + locStream := TMemoryStream.Create(); + try + locStream.Write(locBuffer[1],Length(locBuffer)); + locLoadedBuffer := LoadBufferFromStream(locStream); + Check( locLoadedBuffer = locBuffer ); + finally + locStream.Free(); + end; +end; + +procedure TTest_Procedures.test_LoadBufferFromFile(); +var + locBuffer, locLoadedBuffer : TBinaryString; + pBytePtr : PByte; + locStream : TMemoryStream; + i : PtrInt; + locFileName : string; +begin + SetLength(locBuffer,255); + pBytePtr := PByte(@(locBuffer[1])); + for i := 0 to 255 do begin + pBytePtr^ := i; + Inc(pBytePtr); + end; + locStream := TMemoryStream.Create(); + try + locStream.Write(locBuffer[1],Length(locBuffer)); + locFileName := 'test_LoadBufferFromFile.bin'; + locStream.SaveToFile(locFileName); + locLoadedBuffer := LoadBufferFromFile(locFileName); + Check( locLoadedBuffer = locBuffer ); + finally + locStream.Free(); + end; +end; + initialization RegisterTest('Support',TTest_TObjectCollectionRemotable.Suite); RegisterTest('Support',TTest_TBaseComplexRemotable.Suite); @@ -3273,5 +3585,7 @@ initialization RegisterTest('Support',TTest_TBase64StringRemotable.Suite); RegisterTest('Support',TTest_TBase64StringExtRemotable.Suite); + RegisterTest('Support',TTest_Procedures.Suite); + end. diff --git a/wst/trunk/tests/test_suite/test_wst_cursors.pas b/wst/trunk/tests/test_suite/test_wst_cursors.pas index 572ecfd91..9b562cd77 100644 --- a/wst/trunk/tests/test_suite/test_wst_cursors.pas +++ b/wst/trunk/tests/test_suite/test_wst_cursors.pas @@ -4,7 +4,7 @@ unit test_wst_cursors; interface uses - Classes, SysUtils, Contnrs, + Classes, SysUtils, {$IFDEF FPC} fpcunit, testutils, testregistry, {$ELSE} @@ -109,7 +109,7 @@ const O_COUNT = 100; var x : IObjectCursor; ls : TBaseObjectArrayRemotable; - c, i : Integer; + i : Integer; begin ls := TTClass_A_ArrayRemotable.Create(); try @@ -182,7 +182,7 @@ const O_COUNT = 100; var x : IFilterableObjectCursor; ls : TBaseObjectArrayRemotable; - c, i : Integer; + i : Integer; f : IObjectFilter; fcr : TRttiFilterCreator; begin @@ -445,7 +445,7 @@ const O_COUNT = 100; var x : IObjectCursor; ls : TObjectCollectionRemotable; - c, i : PtrInt; + i : PtrInt; begin ls := TTClass_A_CollectionRemotable.Create(); try diff --git a/wst/trunk/tests/test_suite/testformatter_unit.pas b/wst/trunk/tests/test_suite/testformatter_unit.pas index eb211f86e..d1afe677c 100644 --- a/wst/trunk/tests/test_suite/testformatter_unit.pas +++ b/wst/trunk/tests/test_suite/testformatter_unit.pas @@ -517,14 +517,8 @@ type published procedure Assign(); end; - - { TTest_SoapFormatterServerNameSpace } - TTest_SoapFormatterServerNameSpace = class(TTestCase) - published - procedure namespace_declared_env(); - end; - + implementation uses base_binary_formatter, base_soap_formatter, base_xmlrpc_formatter, record_rtti, Math, imp_utils @@ -537,7 +531,7 @@ uses base_binary_formatter, base_soap_formatter, base_xmlrpc_formatter, record_r , server_service_soap, soap_formatter, server_service_xmlrpc, xmlrpc_formatter, binary_streamer, server_binary_formatter, binary_formatter, - test_suite_utils; + test_suite_utils, object_serializer; function CompareNodes(const A,B : PDataBuffer) : Boolean;overload;forward; @@ -4245,41 +4239,9 @@ begin end; end; -{ TTest_SoapFormatterServerNameSpace } -procedure TTest_SoapFormatterServerNameSpace.namespace_declared_env(); -const - XML_SOURCE = - ' ' + sLineBreak + - ' ' + sLineBreak + - ' ' + sLineBreak + - ' ' + sLineBreak + - ' ' + sLineBreak + - ''; -var - f : IFormatterResponse; - strm : TMemoryStream; - strBuffer : ansistring; - cctx : ICallContext; -begin - f := server_service_soap.TSOAPFormatter.Create() as IFormatterResponse; - 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); - strBuffer := f.GetCallProcedureName(); - CheckEquals('GetVersion',strBuffer, 'GetCallProcedureName()'); - f.EndScopeRead(); - finally - FreeAndNil(strm); - end; -end; + + initialization RegisterStdTypes(); @@ -4345,5 +4307,5 @@ initialization RegisterTest('Serializer',TTest_XmlRpcFormatterExceptionBlock.Suite); RegisterTest('Serializer',TTest_BinaryFormatterExceptionBlock.Suite); RegisterTest('Serializer',TTest_TStringBufferRemotable.Suite); - RegisterTest('Serializer',TTest_SoapFormatterServerNameSpace.Suite); + end. diff --git a/wst/trunk/tests/test_suite/wst_test_suite.lpr b/wst/trunk/tests/test_suite/wst_test_suite.lpr index 9886dc947..45dc9b858 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite.lpr +++ b/wst/trunk/tests/test_suite/wst_test_suite.lpr @@ -19,7 +19,7 @@ uses xsd_consts, base_json_formatter, wsdl_parser, test_support, basex_encode, test_basex_encode, json_formatter, server_service_json, test_json, test_suite_utils, test_generators, test_std_cursors, test_rtti_filter, -test_wst_cursors; +test_wst_cursors, test_registry; Const ShortOpts = 'alh'; diff --git a/wst/trunk/tests/test_suite/wst_test_suite_gui.lpi b/wst/trunk/tests/test_suite/wst_test_suite_gui.lpi index b65b3c28a..d20455479 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite_gui.lpi +++ b/wst/trunk/tests/test_suite/wst_test_suite_gui.lpi @@ -34,7 +34,7 @@ - + @@ -111,10 +111,15 @@ - + - + + + + + + diff --git a/wst/trunk/tests/test_suite/wst_test_suite_gui.lpr b/wst/trunk/tests/test_suite/wst_test_suite_gui.lpr index 53b4f2c4d..0ffd64cb1 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite_gui.lpr +++ b/wst/trunk/tests/test_suite/wst_test_suite_gui.lpr @@ -17,7 +17,7 @@ uses xsd_consts, base_json_formatter, wsdl_parser, test_support, basex_encode, test_basex_encode, json_formatter, server_service_json, test_json, test_suite_utils, test_generators, fpcunittestrunner, test_std_cursors, - test_rtti_filter, rtti_filters, wst_cursors, test_wst_cursors; + test_rtti_filter, rtti_filters, wst_cursors, test_wst_cursors, test_registry, test_soap_specific; begin Application.Initialize; diff --git a/wst/trunk/wst_global.inc b/wst/trunk/wst_global.inc index 88fd9e633..7541c7581 100644 --- a/wst/trunk/wst_global.inc +++ b/wst/trunk/wst_global.inc @@ -1,3 +1,6 @@ +{$DEFINE USE_SERIALIZE} +{$UNDEF TRemotableTypeInitializer_Initialize} + {$WARNINGS OFF} {$IFDEF FPC} diff --git a/wst/trunk/xmlrpc_formatter.pas b/wst/trunk/xmlrpc_formatter.pas index 9dc6dc3ac..86f625d99 100644 --- a/wst/trunk/xmlrpc_formatter.pas +++ b/wst/trunk/xmlrpc_formatter.pas @@ -30,13 +30,9 @@ type {$M+} TXmlRpcFormatter = class(TXmlRpcBaseFormatter,IFormatterClient) private - FPropMngr : IPropertyManager; FCallProcedureName : string; FCallTarget : String; public - destructor Destroy();override; - function GetPropertyManager():IPropertyManager; - procedure BeginCall( const AProcName, ATarget : string; @@ -73,19 +69,6 @@ implementation { TXmlRpcFormatter } -destructor TXmlRpcFormatter.Destroy(); -begin - FPropMngr := nil; - inherited Destroy(); -end; - -function TXmlRpcFormatter.GetPropertyManager(): IPropertyManager; -begin - If Not Assigned(FPropMngr) Then - FPropMngr := TPublishedPropertyManager.Create(Self); - Result := FPropMngr; -end; - procedure TXmlRpcFormatter.BeginCall( const AProcName, ATarget : string;