diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas index 5b345738d..e867ae5cb 100644 --- a/wst/trunk/base_service_intf.pas +++ b/wst/trunk/base_service_intf.pas @@ -589,6 +589,7 @@ type const ATypeInfo : PTypeInfo );override; end; + TBaseComplexSimpleContentRemotableClass = class of TBaseComplexSimpleContentRemotable; { TComplexInt8UContentRemotable } @@ -1533,7 +1534,7 @@ type property TimeOut : PtrUInt read FTimeOut write FTimeOut; end; - TTypeRegistryItemOption = ( trioNonVisibleToMetadataService ); + TTypeRegistryItemOption = ( trioNonVisibleToMetadataService, trioNonQualifiedName ); TTypeRegistryItemOptions = set of TTypeRegistryItemOption; TTypeRegistry = class; TTypeRegistryItem = class; @@ -1555,10 +1556,28 @@ type {$ENDIF TRemotableTypeInitializer_Initialize} end; + TPropertyNameType = ( pntInternalName, pntExternalName ); + + { TPropertyItem } + + TPropertyItem = class + private + FExternalName: string; + FExtObject: TObject; + FInternalName: string; + FOptions: TTypeRegistryItemOptions; + public + property InternalName : string read FInternalName {write FInternalName}; + property ExternalName : string read FExternalName {write FExternalName}; + property ExtObject : TObject read FExtObject {write FExtObject}; + property Options : TTypeRegistryItemOptions read FOptions {write FOptions}; + end; + { TTypeRegistryItem } TTypeRegistryItem = class private + //FDefaultPropertyOptions: TTypeRegistryItemOptions; FOwner : TTypeRegistry; FDataType: PTypeInfo; FNameSpace: string; @@ -1566,12 +1585,14 @@ type FOptions: TTypeRegistryItemOptions; FPascalSynonyms : TStrings; FExternalSynonyms : TStrings; - FExternalNames : TStrings; - FInternalNames : TStrings; - private - procedure CreateInternalObjects();{$IFDEF USE_INLINE}inline;{$ENDIF} + FProperties : TObjectList; protected procedure Init(); virtual; + protected + function IndexOfProp( + const AName : string; + const ANameType : TPropertyNameType + ) : Integer; public constructor Create( AOwner : TTypeRegistry; @@ -1585,9 +1606,17 @@ type function IsSynonym(const APascalTypeName : string):Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} function IsExternalSynonym(const AExternalName : string):Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function FindProperty( + const AName : string; + const ANameType : TPropertyNameType + ) : TPropertyItem; procedure RegisterExternalPropertyName(const APropName, AExtPropName : string); virtual; function GetExternalPropertyName(const APropName : string) : string;{$IFDEF USE_INLINE}inline;{$ENDIF} function GetInternalPropertyName(const AExtPropName : string) : string;{$IFDEF USE_INLINE}inline;{$ENDIF} + procedure SetPropertyOptions( + const APropName : string; + const AOptions : TTypeRegistryItemOptions + ); virtual; procedure RegisterObject(const APropName : string; const AObject : TObject); function GetObject(const APropName : string) : TObject; @@ -1597,6 +1626,8 @@ type property NameSpace : string read FNameSpace; property DeclaredName : string read FDeclaredName; property Options : TTypeRegistryItemOptions read FOptions write FOptions; + //property DefaultPropertyOptions : TTypeRegistryItemOptions + //read FDefaultPropertyOptions write FDefaultPropertyOptions; end; TTypeRegistrySearchOption = ( trsoIncludeExternalSynonyms ); @@ -1782,6 +1813,7 @@ begin THeaderBlock.RegisterAttributeProperty('mustUnderstand'); ri := r.Register(sSOAP_ENV,TypeInfo(THeaderBlock),'THeaderBlock'); ri.Options := ri.Options + [trioNonVisibleToMetadataService]; + ri.SetPropertyOptions('mustUnderstand',[]); ri := r.Register(sSOAP_ENV,TypeInfo(TSimpleContentHeaderBlock)); ri.Options := ri.Options + [trioNonVisibleToMetadataService]; ri := r.Register(sSOAP_ENV,TypeInfo(THeaderBlockProxy)); @@ -3071,19 +3103,54 @@ end; { TTypeRegistryItem } -procedure TTypeRegistryItem.CreateInternalObjects(); -begin - if not Assigned(FExternalNames) then begin - FExternalNames := TStringList.Create(); - FInternalNames := TStringList.Create(); - end; -end; - procedure TTypeRegistryItem.Init(); begin end; +function TTypeRegistryItem.IndexOfProp( + const AName: string; + const ANameType : TPropertyNameType +) : Integer; +var + i : Integer; + locName : string; +begin + Result := -1; + if ( FProperties <> nil ) and ( FProperties.Count > 0 ) then begin + locName := LowerCase(AName); + if ( ANameType = pntInternalName ) then begin + for i := 0 to Pred(FProperties.Count) do begin + if ( locName = LowerCase(TPropertyItem(FProperties[i]).InternalName) ) then begin + Result := i; + Break; + end; + end; + end else begin + for i := 0 to Pred(FProperties.Count) do begin + if ( locName = LowerCase(TPropertyItem(FProperties[i]).ExternalName) ) then begin + Result := i; + Break; + end; + end; + end; + end; +end; + +function TTypeRegistryItem.FindProperty( + const AName: string; + const ANameType : TPropertyNameType +) : TPropertyItem; +var + i : Integer; +begin + i := IndexOfProp(AName,ANameType); + if ( i = -1 ) then + Result := nil + else + Result := TPropertyItem(FProperties[i]); +end; + constructor TTypeRegistryItem.Create( AOwner : TTypeRegistry; ANameSpace : String; @@ -3100,25 +3167,8 @@ 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 - if ( FExternalNames <> nil ) and ( FExternalNames.Count > 0 ) then - FreeObjects(); - FInternalNames.Free(); - FExternalNames.Free(); + FreeAndNil(FProperties); FPascalSynonyms.Free(); FExternalSynonyms.Free(); inherited Destroy(); @@ -3165,56 +3215,82 @@ begin end; procedure TTypeRegistryItem.RegisterExternalPropertyName(const APropName,AExtPropName: string); +var + i : Integer; + po : TPropertyItem; begin - if not Assigned(FExternalNames) then begin - CreateInternalObjects(); + i := IndexOfProp(APropName,pntInternalName); + if ( i = -1 ) then begin + if ( FProperties = nil ) then + FProperties := TObjectList.Create(True); + po := TPropertyItem.Create(); + FProperties.Add(po); + po.FInternalName := APropName; + //po.FOptions := Self.DefaultPropertyOptions; + end else begin + po := TPropertyItem(FProperties[i]); end; - FExternalNames.Values[APropName] := AExtPropName; - FInternalNames.Values[AExtPropName] := APropName; + po.FExternalName := AExtPropName; end; procedure TTypeRegistryItem.RegisterObject(const APropName : string; const AObject : TObject); var i : PtrInt; begin - if not Assigned(FExternalNames) then begin - CreateInternalObjects(); + i := IndexOfProp(APropName,pntInternalName); + if ( i = -1 ) then begin + RegisterExternalPropertyName(APropName,APropName); + i := IndexOfProp(APropName,pntInternalName); end; - i := FExternalNames.IndexOfName(APropName); - if ( i < 0 ) then begin - FExternalNames.Values[APropName] := APropName; - i := FExternalNames.IndexOfName(APropName); - end; - FExternalNames.Objects[i] := AObject; + TPropertyItem(FProperties[i]).FExtObject := AObject; end; function TTypeRegistryItem.GetObject(const APropName : string) : TObject; var - i : PtrInt; + p : TPropertyItem; begin - Result := nil; - if Assigned(FExternalNames) then begin - i := FExternalNames.IndexOfName(APropName); - if ( i >= 0 ) then - Result := FExternalNames.Objects[i]; - end; + p := FindProperty(APropName,pntInternalName); + if ( p = nil ) then + Result := nil + else + Result := p.ExtObject; end; function TTypeRegistryItem.GetExternalPropertyName(const APropName: string): string; +var + p : TPropertyItem; begin - if Assigned(FExternalNames) and ( FExternalNames.IndexOfName(APropName) <> -1 ) then begin - Result := FExternalNames.Values[APropName]; - end else begin - Result := APropName; - end; + p := FindProperty(APropName,pntInternalName); + if ( p = nil ) then + Result := APropName + else + Result := p.ExternalName; end; function TTypeRegistryItem.GetInternalPropertyName(const AExtPropName: string): string; +var + p : TPropertyItem; begin - if Assigned(FInternalNames) and ( FInternalNames.IndexOfName(AExtPropName) <> -1 ) then - Result := FInternalNames.Values[AExtPropName] + p := FindProperty(AExtPropName,pntExternalName); + if ( p = nil ) then + Result := AExtPropName else - Result := AExtPropName; + Result := p.InternalName; +end; + +procedure TTypeRegistryItem.SetPropertyOptions( + const APropName: string; + const AOptions: TTypeRegistryItemOptions +); +var + po : TPropertyItem; +begin + po := FindProperty(APropName,pntInternalName); + if ( po = nil ) then begin + RegisterExternalPropertyName(APropName,APropName); + po := FindProperty(APropName,pntInternalName); + end; + po.FOptions := AOptions; end; { TTypeRegistry } @@ -5160,6 +5236,17 @@ class procedure TBaseComplexSimpleContentRemotable.Save( const AName: string; const ATypeInfo: PTypeInfo ); +{$IFDEF USE_SERIALIZE} +var + locSerializer : TSimpleContentObjectSerializer; +begin + locSerializer := TSimpleContentObjectRegistryItem(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; @@ -5313,6 +5400,7 @@ begin AStore.SetSerializationStyle(oldSS); end; end; +{$ENDIF USE_SERIALIZE} class procedure TBaseComplexSimpleContentRemotable.Load( var AObject: TObject; @@ -5320,6 +5408,17 @@ class procedure TBaseComplexSimpleContentRemotable.Load( var AName: string; const ATypeInfo: PTypeInfo ); +{$IFDEF USE_SERIALIZE} +var + locSerializer : TSimpleContentObjectSerializer; +begin + locSerializer := TSimpleContentObjectRegistryItem(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; @@ -5484,6 +5583,7 @@ begin end; end; end; +{$ENDIF USE_SERIALIZE} { TComplexInt32SContentRemotable } @@ -6464,6 +6564,7 @@ begin if ( TypeRegistryInstance = nil ) then begin TypeRegistryInstance := TTypeRegistry.Create(); TypeRegistryInstance.RegisterInitializer(TBaseComplexRemotableInitializer); + TypeRegistryInstance.RegisterInitializer(TSimpleContentObjectRemotableInitializer); end; if ( SerializeOptionsRegistryInstance = nil ) then SerializeOptionsRegistryInstance := TSerializeOptionsRegistry.Create(); diff --git a/wst/trunk/base_soap_formatter.pas b/wst/trunk/base_soap_formatter.pas index c7f2aeeed..9b25b95ae 100644 --- a/wst/trunk/base_soap_formatter.pas +++ b/wst/trunk/base_soap_formatter.pas @@ -841,19 +841,18 @@ Var begin strNodeName := AName; if ( Style = Document ) then begin - 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 + namespaceLongName := ANameSpace; + if ( namespaceLongName <> '' ) then begin + 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; end; end; @@ -1024,15 +1023,18 @@ var begin strNodeName := AName; if ( Style = Document ) then begin - if ( ANameSpace = '' ) then - s := StackTop().NameSpace - else + if ( ANameSpace <> '' ) then begin + {if ( ANameSpace = '' ) then + s := StackTop().NameSpace + else + s := ANameSpace;} s := ANameSpace; - namespaceShortName := FindAttributeByValueInScope(s); - if not IsStrEmpty(namespaceShortName) then begin - s := ExtractNameSpaceShortName(namespaceShortName); - if not IsStrEmpty(s) then - strNodeName := s + ':' + strNodeName; + namespaceShortName := FindAttributeByValueInScope(s); + if not IsStrEmpty(namespaceShortName) then begin + s := ExtractNameSpaceShortName(namespaceShortName); + if not IsStrEmpty(s) then + strNodeName := s + ':' + strNodeName; + end; end; end; @@ -1884,7 +1886,7 @@ procedure TSOAPBaseFormatter.Put( const AData ); begin - Put('',AName,ATypeInfo,AData); + Put(StackTop().NameSpace,AName,ATypeInfo,AData); end; procedure TSOAPBaseFormatter.PutScopeInnerValue( @@ -2167,7 +2169,7 @@ function TSOAPBaseFormatter.Get( var AData ) : Boolean; begin - Result := Get(ATypeInfo,'',AName,AData); + Result := Get(ATypeInfo,StackTop().NameSpace,AName,AData); end; procedure TSOAPBaseFormatter.GetScopeInnerValue( diff --git a/wst/trunk/object_serializer.pas b/wst/trunk/object_serializer.pas index a3e1e5adc..6dca666e1 100644 --- a/wst/trunk/object_serializer.pas +++ b/wst/trunk/object_serializer.pas @@ -99,7 +99,39 @@ type property Target : TBaseComplexRemotableClass read FTarget; property Options : TObjectSerializerOptions read FOptions write FOptions; end; - + + TSimpleContentObjectSerializer = class + private + FSerializationInfos : TObjectList; + FTarget : TBaseComplexSimpleContentRemotableClass; + FRawPropList : PPropList; + FOptions : TObjectSerializerOptions; + private + procedure Prepare(ATypeRegistry : TTypeRegistry); + function FindInfo(const APropName : string) : TPropSerializationInfo; + procedure UpdateExternalName(const APropName, AExtPropName : string); + public + constructor Create( + ATargetClass : TBaseComplexSimpleContentRemotableClass; + 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 : TBaseComplexSimpleContentRemotableClass read FTarget; + property Options : TObjectSerializerOptions read FOptions write FOptions; + end; + TGetSerializerFunction = function() : TObjectSerializer of object; { TBaseComplexTypeRegistryItem } @@ -114,7 +146,24 @@ type procedure RegisterExternalPropertyName(const APropName, AExtPropName : string); override; function GetSerializer() : TObjectSerializer;{$IFDEF USE_INLINE}inline;{$ENDIF} end; - + + { TSimpleContentObjectRegistryItem } + + TSimpleContentObjectRegistryItem = class(TTypeRegistryItem) + private + FSerializer : TSimpleContentObjectSerializer; + protected + procedure Init(); override; + public + destructor Destroy();override; + procedure RegisterExternalPropertyName(const APropName, AExtPropName : string); override; + procedure SetPropertyOptions( + const APropName : string; + const AOptions : TTypeRegistryItemOptions + ); virtual; + function GetSerializer() : TSimpleContentObjectSerializer;{$IFDEF USE_INLINE}inline;{$ENDIF} + end; + { TBaseComplexRemotableInitializer } TBaseComplexRemotableInitializer = class(TRemotableTypeInitializer) @@ -128,7 +177,22 @@ type ) : Boolean;override; {$ENDIF TRemotableTypeInitializer_Initialize} end; - + + { TBaseComplexRemotableInitializer } + + TSimpleContentObjectRemotableInitializer = 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; + + implementation uses wst_consts; @@ -1208,6 +1272,7 @@ var serArray : array of TPropSerializationInfo; serInfo : TPropSerializationInfo; regItem, thisRegItem : TTypeRegistryItem; + regPropItem : TPropertyItem; st : TPropStoreType; clPL : PPropList; begin @@ -1229,18 +1294,40 @@ begin ppi := FRawPropList^[i]; st := IsStoredPropClass(cl,ppi); if ( st in [pstAlways,pstOptional] ) then begin + regPropItem := regItem.FindProperty(ppi^.Name,pntInternalName); 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 := ReaderInfoMap[ppi^.PropType^.Kind].Simple; - serInfo.FWriterProc := WriterInfoMap[ppi^.PropType^.Kind].Simple; - if Target.IsAttributeProperty(ppi^.Name) then - serInfo.FStyle := ssAttibuteSerialization - else + serInfo.FNameSpace := regItem.NameSpace; + if Target.IsAttributeProperty(ppi^.Name) then begin + serInfo.FStyle := ssAttibuteSerialization; + serInfo.FQualifiedName := True; + serInfo.FNameSpace := ''; + end else begin serInfo.FStyle := ssNodeSerialization; + end; + if ( regPropItem <> nil ) then begin + serInfo.FExternalName := regPropItem.ExternalName; + if ( trioNonQualifiedName in regPropItem.Options ) then begin + serInfo.FNameSpace := ''; + serInfo.FQualifiedName := True; + end; + end else begin + serInfo.FExternalName := serInfo.FName; + if ( trioNonQualifiedName in regItem.Options ) then begin + serInfo.FQualifiedName := True; + serInfo.FNameSpace := ''; + end; + end; + if serInfo.QualifiedName then begin + serInfo.FReaderProc := ReaderInfoMap[ppi^.PropType^.Kind].Qualified; + serInfo.FWriterProc := WriterInfoMap[ppi^.PropType^.Kind].Qualified; + end else begin + serInfo.FReaderProc := ReaderInfoMap[ppi^.PropType^.Kind].Simple; + serInfo.FWriterProc := WriterInfoMap[ppi^.PropType^.Kind].Simple; + end; end; end; //Check for inherited properties declared in other namespace @@ -1409,6 +1496,259 @@ begin end; end; +{ TSimpleContentObjectSerializer } + +procedure TSimpleContentObjectSerializer.Prepare(ATypeRegistry : TTypeRegistry); +var + thisRegItem, regItem : TTypeRegistryItem; + serArray : array of TPropSerializationInfo; + cl : TClass; + + procedure InitPropItem(const APropInfo : PPropInfo); + var + regPropItem : TPropertyItem; + serInfo : TPropSerializationInfo; + st : TPropStoreType; + begin + st := IsStoredPropClass(cl,APropInfo); + if ( st in [pstAlways,pstOptional] ) then begin + regPropItem := regItem.FindProperty(APropInfo^.Name,pntInternalName); + serInfo := TPropSerializationInfo.Create(); + serArray[APropInfo^.NameIndex] := serInfo; + serInfo.FName := APropInfo^.Name; + serInfo.FExternalName := serInfo.FName; + serInfo.FPersisteType := st; + serInfo.FPropInfo := APropInfo; + serInfo.FNameSpace := regItem.NameSpace; + serInfo.FStyle := ssAttibuteSerialization; + serInfo.FQualifiedName := True; + serInfo.FNameSpace := ''; + if ( regPropItem <> nil ) then begin + serInfo.FExternalName := regPropItem.ExternalName; + if not ( trioNonQualifiedName in regPropItem.Options ) then begin + serInfo.FNameSpace := regItem.NameSpace; + serInfo.FQualifiedName := True; + end; + end; + if serInfo.QualifiedName then begin + serInfo.FReaderProc := ReaderInfoMap[APropInfo^.PropType^.Kind].Qualified; + serInfo.FWriterProc := WriterInfoMap[APropInfo^.PropType^.Kind].Qualified; + end else begin + serInfo.FReaderProc := ReaderInfoMap[APropInfo^.PropType^.Kind].Simple; + serInfo.FWriterProc := WriterInfoMap[APropInfo^.PropType^.Kind].Simple; + end; + end; + end; + + procedure InheritedInitPropItem(const APropInfo : PPropInfo); + var + regPropItem : TPropertyItem; + serInfo : TPropSerializationInfo; + begin + serInfo := serArray[APropInfo^.NameIndex]; + if ( serInfo <> nil ) then begin + regPropItem := regItem.FindProperty(APropInfo^.Name,pntInternalName); + if ( regPropItem <> nil ) then begin + if not ( trioNonQualifiedName in regPropItem.Options ) then begin + serInfo.FNameSpace := regItem.NameSpace; + serInfo.FQualifiedName := True; + end; + end else begin + if ( thisRegItem.NameSpace <> regItem.NameSpace ) then begin + if ( serInfo.FNameSpace <> '' ) then begin + serInfo.FNameSpace := regItem.NameSpace; + serInfo.FQualifiedName := True; + serInfo.FReaderProc := ReaderInfoMap[APropInfo^.PropType^.Kind].Qualified; + serInfo.FWriterProc := WriterInfoMap[APropInfo^.PropType^.Kind].Qualified; + end; + end; + end; + end; + end; + +var + locObjTypeData : PTypeData; + locTypeInfo : PTypeInfo; + c, i : PtrInt; + 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 + InitPropItem(FRawPropList^[i]); + end; + //Check for inherited properties declared in other namespace + GetMem(clPL,c*SizeOf(Pointer)); + cl := cl.ClassParent; + while ( cl <> nil ) and ( cl <> TBaseComplexSimpleContentRemotable ) 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 + InheritedInitPropItem(clPL^[i]); + 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; + +function TSimpleContentObjectSerializer.FindInfo(const APropName: string): TPropSerializationInfo; +var + i : Integer; +begin + Result := nil; + if ( FSerializationInfos.Count > 0 ) then begin + for i := 0 to Pred(FSerializationInfos.Count) do begin + if SameText(APropName,TPropSerializationInfo(FSerializationInfos[i]).ExternalName) then begin + Result := TPropSerializationInfo(FSerializationInfos[i]); + Break; + end; + end; + end; +end; + +procedure TSimpleContentObjectSerializer.UpdateExternalName( + const APropName, + AExtPropName : string +); +var + itm : TPropSerializationInfo; +begin + itm := FindInfo(APropName); + if ( itm <> nil ) then + itm.FExternalName := AExtPropName; +end; + +constructor TSimpleContentObjectSerializer.Create( + ATargetClass : TBaseComplexSimpleContentRemotableClass; + ATypeRegistry : TTypeRegistry +); +begin + Assert(ATargetClass <> nil); + Assert(ATypeRegistry <> nil); + FTarget := ATargetClass; + FSerializationInfos := TObjectList.Create(True); + Prepare(ATypeRegistry); +end; + +destructor TSimpleContentObjectSerializer.Destroy(); +begin + if ( FRawPropList <> nil ) then + FreeMem(FRawPropList,GetTypeData(PTypeInfo(Target.ClassInfo))^.PropCount*SizeOf(Pointer)); + FSerializationInfos.Free(); + inherited Destroy(); +end; + +type + TBaseComplexSimpleContentRemotableCrack = class(TBaseComplexSimpleContentRemotable) end; + +procedure TSimpleContentObjectSerializer.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 ( osoDontDoBeginRead in Options ) or ( AStore.BeginObjectRead(AName,ATypeInfo) >= 0 ) then begin + try + if AStore.IsCurrentScopeNil() then + Exit; // ???? FreeAndNil(AObject); + if not Assigned(AObject) then + AObject := Target.Create(); + TBaseComplexSimpleContentRemotableCrack(AObject).LoadValue(AObject,AStore); + c := FSerializationInfos.Count; + if ( c > 0 ) then begin + AStore.SetSerializationStyle(ssAttibuteSerialization); + for i := 0 to Pred(c) do begin + locSerInfo := TPropSerializationInfo(FSerializationInfos[i]); + if ( not locSerInfo.ReaderProc(AObject,locSerInfo,AStore) ) and + ( locSerInfo.PersisteType = pstAlways ) + then begin + AStore.Error(SERR_ParamaterNotFound,[locSerInfo.ExternalName]); + end; + end; + end; + finally + if not ( osoDontDoBeginRead in Options ) then + AStore.EndScopeRead(); + AStore.SetSerializationStyle(oldSS); + end; + end; +end; + +procedure TSimpleContentObjectSerializer.Save( + AObject : TBaseRemotable; + AStore : IFormatterBase; + const AName : string; + const ATypeInfo : PTypeInfo +); +var + oldSS : TSerializationStyle; + i, c : PtrInt; + locSerInfo : TPropSerializationInfo; +begin + oldSS := AStore.GetSerializationStyle(); + if not ( osoDontDoBeginWrite in Options ) then + AStore.BeginObject(AName,ATypeInfo); + try + if not Assigned(AObject) then begin + AStore.NilCurrentScope(); + Exit; + end; + TBaseComplexSimpleContentRemotableCrack(AObject).SaveValue(AObject,AStore); + c := FSerializationInfos.Count; + if ( c > 0 ) then begin + AStore.SetSerializationStyle(ssAttibuteSerialization); + for i := 0 to Pred(c) do begin + locSerInfo := TPropSerializationInfo(FSerializationInfos[i]); + locSerInfo.WriterProc(AObject,locSerInfo,AStore); + end; + end; + finally + if not ( osoDontDoBeginWrite in Options ) then + AStore.EndScope(); + AStore.SetSerializationStyle(oldSS); + end; +end; + { TBaseComplexRemotableInitializer } class function TBaseComplexRemotableInitializer.CanHandle(ATypeInfo : PTypeInfo) : Boolean; @@ -1434,6 +1774,31 @@ begin end; {$ENDIF TRemotableTypeInitializer_Initialize} +{ TSimpleContentObjectRemotableInitializer } + +class function TSimpleContentObjectRemotableInitializer.CanHandle(ATypeInfo : PTypeInfo) : Boolean; +begin + Result := ( ATypeInfo <> nil ) and + ( ATypeInfo^.Kind = tkClass ) and + GetTypeData(ATypeInfo)^.ClassType.InheritsFrom(TBaseComplexSimpleContentRemotable); +end; + +class function TSimpleContentObjectRemotableInitializer.GetItemClass( + const ATypeInfo : PTypeInfo +) : TTypeRegistryItemClass; +begin + Result := TSimpleContentObjectRegistryItem; +end; + +{$IFDEF TRemotableTypeInitializer_Initialize} +class function TSimpleContentObjectRemotableInitializer.Initialize( + ATypeInfo : PTypeInfo; + ARegistryItem : TTypeRegistryItem +) : Boolean; +begin +end; +{$ENDIF TRemotableTypeInitializer_Initialize} + { TBaseComplexTypeRegistryItem } procedure TBaseComplexTypeRegistryItem.Init(); @@ -1462,4 +1827,43 @@ begin Result := FSerializer; end; +{ TSimpleContentObjectRegistryItem } + +procedure TSimpleContentObjectRegistryItem.Init(); +begin + inherited Init(); + if ( FSerializer <> nil ) then + FreeAndNil(FSerializer); + FSerializer := TSimpleContentObjectSerializer.Create(TBaseComplexSimpleContentRemotableClass(GetTypeData(DataType)^.ClassType),Owner); +end; + +destructor TSimpleContentObjectRegistryItem.Destroy(); +begin + FSerializer.Free(); + inherited Destroy(); +end; + +procedure TSimpleContentObjectRegistryItem.RegisterExternalPropertyName( + const APropName, + AExtPropName : string +); +begin + inherited RegisterExternalPropertyName(APropName, AExtPropName); + GetSerializer().UpdateExternalName(APropName,AExtPropName); +end; + +procedure TSimpleContentObjectRegistryItem.SetPropertyOptions( + const APropName: string; + const AOptions: TTypeRegistryItemOptions +); +begin + inherited SetPropertyOptions(APropName,AOptions); + Init(); +end; + +function TSimpleContentObjectRegistryItem.GetSerializer() : TSimpleContentObjectSerializer; +begin + Result := FSerializer; +end; + end. diff --git a/wst/trunk/synapse_http_protocol.pas b/wst/trunk/synapse_http_protocol.pas index 72af95493..c960f8772 100644 --- a/wst/trunk/synapse_http_protocol.pas +++ b/wst/trunk/synapse_http_protocol.pas @@ -168,6 +168,9 @@ var s : TBinaryString; {$ENDIF} begin +{$IFDEF WST_DBG} + TMemoryStream(ARequest).SaveToFile('request-1.log'); +{$ENDIF} FConnection.Document.Size := 0; FConnection.Headers.Add('soapAction:' + SoapAction); FConnection.Document.CopyFrom(ARequest,0); diff --git a/wst/trunk/tests/test_suite/files/write_header_simple_content_2.xml b/wst/trunk/tests/test_suite/files/write_header_simple_content_2.xml index ddb1ebe99..cbb6a94e5 100644 --- a/wst/trunk/tests/test_suite/files/write_header_simple_content_2.xml +++ b/wst/trunk/tests/test_suite/files/write_header_simple_content_2.xml @@ -6,7 +6,7 @@ xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"> sample header simple content value - another content + another content diff --git a/wst/trunk/tests/test_suite/test_soap_specific.pas b/wst/trunk/tests/test_suite/test_soap_specific.pas index 718bb0040..04ec2f4f0 100644 --- a/wst/trunk/tests/test_suite/test_soap_specific.pas +++ b/wst/trunk/tests/test_suite/test_soap_specific.pas @@ -590,7 +590,7 @@ begin locStream := TMemoryStream.Create(); try ser.SaveToStream(locStream); - //locStream.SaveToFile(wstExpandLocalFileName('write_header_simple_content_2.xml')); + locStream.SaveToFile(wstExpandLocalFileName('write_header_simple_content_2.xml')); locStream.Position := 0; ReadXMLFile(locDoc,locStream); ReadXMLFile(locExistDoc,wstExpandLocalFileName(TestFilesPath + 'write_header_simple_content_2.xml')); @@ -657,7 +657,7 @@ const ' xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">' + sLineBreak + ' ' + sLineBreak + ' sample header simple content value' + sLineBreak + - ' another content' + sLineBreak + + ' another content' + sLineBreak + ' ' + sLineBreak + ' ' + sLineBreak + ' ' + sLineBreak + @@ -688,8 +688,9 @@ begin CheckEquals('sample header simple content value',hdrA.Value,'Value'); CheckIs(cctx.GetHeader(1),TSampleSimpleContentHeaderBlock_B); hdrB := TSampleSimpleContentHeaderBlock_B(cctx.GetHeader(1)); - CheckEquals(0,hdrB.mustUnderstand,'mustUnderstand'); + CheckEquals(1,hdrB.mustUnderstand,'mustUnderstand'); CheckEquals('another content',hdrB.Value,'Value'); + CheckEquals(1210,hdrB.intAtt,'intAtt'); f.EndScopeRead(); finally FreeAndNil(strm); diff --git a/wst/trunk/tests/test_suite/testformatter_unit.pas b/wst/trunk/tests/test_suite/testformatter_unit.pas index 3e13a7afa..1a6158e10 100644 --- a/wst/trunk/tests/test_suite/testformatter_unit.pas +++ b/wst/trunk/tests/test_suite/testformatter_unit.pas @@ -6474,15 +6474,27 @@ initialization GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(TClass_B),'TClass_B'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(TClass_Float),'TClass_Float'); + GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt64SContent),'T_ComplexInt64SContent'); + GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt64UContent),'T_ComplexInt64UContent'); + GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt32SContent),'T_ComplexInt32SContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt32UContent),'T_ComplexInt32UContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt16SContent),'T_ComplexInt16SContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt16UContent),'T_ComplexInt16UContent'); + GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt8SContent),'T_ComplexInt8SContent'); + GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt8UContent),'T_ComplexInt8UContent'); + GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexFloatExtendedContent),'T_ComplexFloatExtendedContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexFloatDoubleContent),'T_ComplexFloatDoubleContent'); + GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexStringContent)); + GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexWideStringContent)); +{$IFDEF WST_UNICODESTRING} + GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexUnicodeStringContent)); +{$ENDIF WST_UNICODESTRING} + TClass_CplxSimpleContent.RegisterAttributeProperty('Elt_Exemple'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(TClass_CplxSimpleContent),'TClass_CplxSimpleContent').RegisterExternalPropertyName('Elt_Exemple', 'published'); diff --git a/wst/trunk/tests/test_suite/wst_test_suite.lpi b/wst/trunk/tests/test_suite/wst_test_suite.lpi index f9a5c5db3..db7a8837c 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite.lpi +++ b/wst/trunk/tests/test_suite/wst_test_suite.lpi @@ -238,7 +238,6 @@ -