diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas index 5cddc7962..e19286d5d 100644 --- a/wst/trunk/base_service_intf.pas +++ b/wst/trunk/base_service_intf.pas @@ -1638,6 +1638,7 @@ type FPascalSynonyms : TStrings; FExternalSynonyms : TStrings; FProperties : TObjectList; + procedure SetOptions(AValue: TTypeRegistryItemOptions); protected procedure Init(); virtual; protected @@ -1678,7 +1679,7 @@ type property DataType : PTypeInfo read FDataType; property NameSpace : string read FNameSpace; property DeclaredName : string read FDeclaredName; - property Options : TTypeRegistryItemOptions read FOptions write FOptions; + property Options : TTypeRegistryItemOptions read FOptions write SetOptions; //property DefaultPropertyOptions : TTypeRegistryItemOptions //read FDefaultPropertyOptions write FDefaultPropertyOptions; end; @@ -1884,12 +1885,12 @@ begin THeaderBlock.RegisterAttributeProperty('mustUnderstand'); ri := r.Register(sSOAP_ENV,TypeInfo(THeaderBlock),'THeaderBlock'); - ri.Options := ri.Options + [trioNonVisibleToMetadataService]; + ri.Options := ri.Options + [trioNonVisibleToMetadataService,trioQualifiedAttribute]; ri.SetPropertyOptions('mustUnderstand',[]); ri := r.Register(sSOAP_ENV,TypeInfo(TSimpleContentHeaderBlock)); - ri.Options := ri.Options + [trioNonVisibleToMetadataService]; + ri.Options := ri.Options + [trioNonVisibleToMetadataService,trioQualifiedAttribute]; ri := r.Register(sSOAP_ENV,TypeInfo(THeaderBlockProxy)); - ri.Options := ri.Options + [trioNonVisibleToMetadataService]; + ri.Options := ri.Options + [trioNonVisibleToMetadataService,trioQualifiedAttribute]; r.Register(sWST_BASE_NS,TypeInfo(TArrayOfStringRemotable),'TArrayOfStringRemotable').AddPascalSynonym('TArrayOfStringRemotable'); @@ -3163,6 +3164,14 @@ end; { TTypeRegistryItem } +procedure TTypeRegistryItem.SetOptions(AValue: TTypeRegistryItemOptions); +begin + if (FOptions = AValue) then + Exit; + FOptions := AValue; + Init(); +end; + procedure TTypeRegistryItem.Init(); begin @@ -3353,7 +3362,7 @@ procedure TTypeRegistryItem.AddOptions( const AOptions: TTypeRegistryItemOptions ); begin - FOptions := FOptions + AOptions; + Options := Options + AOptions; end; { TTypeRegistry } diff --git a/wst/trunk/base_soap_formatter.pas b/wst/trunk/base_soap_formatter.pas index 0404b8be6..988c87d2f 100644 --- a/wst/trunk/base_soap_formatter.pas +++ b/wst/trunk/base_soap_formatter.pas @@ -888,9 +888,10 @@ Var begin strNodeName := AName; if (Style = Document) and - ( ( (FSerializationStyle = ssNodeSerialization) and not(StackTop().ElementFormUnqualified) ) or + (ANameSpace <> '') + {( ( (FSerializationStyle = ssNodeSerialization) and not(StackTop().ElementFormUnqualified) ) or ( (FSerializationStyle = ssAttibuteSerialization) and not(StackTop().AttributeFormUnqualified)) - ) + )} then begin namespaceLongName := ANameSpace; if ( namespaceLongName <> '' ) then begin @@ -1074,11 +1075,12 @@ var begin strNodeName := AName; if (Style = Document) and - ( not(HasScope()) or + (ANameSpace <> '') + {( not(HasScope()) or ( ( (FSerializationStyle = ssNodeSerialization) and not(StackTop().ElementFormUnqualified) ) or ( (FSerializationStyle = ssAttibuteSerialization) and not(StackTop().AttributeFormUnqualified)) ) - ) + )} then begin if ( ANameSpace <> '' ) then begin {if ( ANameSpace = '' ) then @@ -1426,6 +1428,7 @@ begin end; StackTop().SetNameSpace(nmspc); StackTop().ElementFormUnqualified := trioUnqualifiedElement in typData.Options; + StackTop().AttributeFormUnqualified := not(trioQualifiedAttribute in typData.Options); end; procedure TSOAPBaseFormatter.BeginArray( @@ -1558,8 +1561,8 @@ begin nsStr := Copy(nsStr,Succ(AnsiPos(':',nsStr)),MaxInt); End; if not(HasScope()) or - ( (Style = Document) and - not(StackTop().ElementFormUnqualified) + ( (Style = Document) {and + not(StackTop().ElementFormUnqualified) } ) then begin scpStr := nsStr + ':' + scpStr; @@ -1665,6 +1668,7 @@ begin ( (AScopeType = stArray) and (AStyle = asScoped) ) then begin StackTop().ElementFormUnqualified := trioUnqualifiedElement in typData.Options; + StackTop().AttributeFormUnqualified := not(trioQualifiedAttribute in typData.Options); end; end; Result := StackTop().GetItemsCount(); @@ -1979,7 +1983,7 @@ procedure TSOAPBaseFormatter.Put( const AData ); begin - Put(StackTop().NameSpace,AName,ATypeInfo,AData); + Put('',AName,ATypeInfo,AData); end; procedure TSOAPBaseFormatter.PutScopeInnerValue( @@ -2264,7 +2268,7 @@ function TSOAPBaseFormatter.Get( var AData ) : Boolean; begin - Result := Get(ATypeInfo,StackTop().NameSpace,AName,AData); + Result := Get(ATypeInfo,'',AName,AData); end; procedure TSOAPBaseFormatter.GetScopeInnerValue( diff --git a/wst/trunk/object_serializer.pas b/wst/trunk/object_serializer.pas index 28d4c9c22..9b23dc8f9 100644 --- a/wst/trunk/object_serializer.pas +++ b/wst/trunk/object_serializer.pas @@ -1355,7 +1355,9 @@ begin eltFormEmpty := ([trioQualifiedElement,trioUnqualifiedElement]*regItem.Options) = []; attFormEmpty := ([trioQualifiedAttribute,trioUnqualifiedAttribute]*regItem.Options) = []; qualifiedElt := (trioQualifiedElement in regItem.Options) and not(trioUnqualifiedElement in regItem.Options); + qualifiedElt := eltFormEmpty or qualifiedElt; qualifiedAtt := (trioQualifiedAttribute in regItem.Options) and not(trioUnqualifiedAttribute in regItem.Options); + qualifiedAtt := not(attFormEmpty) and qualifiedAtt; GetPropList(locTypeInfo,FRawPropList); try for i := 0 to Pred(c) do begin @@ -1369,24 +1371,18 @@ begin serInfo.FPersisteType := st; serInfo.FPropInfo := ppi; serInfo.FNameSpace := regItem.NameSpace; - if Target.IsAttributeProperty(ppi^.Name) then begin - serInfo.FStyle := ssAttibuteSerialization; - serInfo.FQualifiedName := True; - serInfo.FNameSpace := ''; - end else begin + if Target.IsAttributeProperty(ppi^.Name) then + serInfo.FStyle := ssAttibuteSerialization + else serInfo.FStyle := ssNodeSerialization; - end; if ( regPropItem <> nil ) then serInfo.FExternalName := regPropItem.ExternalName else serInfo.FExternalName := serInfo.FName; - if (serInfo.FStyle = ssNodeSerialization) then begin - if not(eltFormEmpty) then - serInfo.FQualifiedName := qualifiedElt; - end else begin - if not(attFormEmpty) then - serInfo.FQualifiedName := qualifiedAtt; - end; + if (serInfo.FStyle = ssNodeSerialization) then + serInfo.FQualifiedName := qualifiedElt + else + serInfo.FQualifiedName := qualifiedAtt; if serInfo.QualifiedName then begin serInfo.FReaderProc := ReaderInfoMap[ppi^.PropType^.Kind].Qualified; serInfo.FWriterProc := WriterInfoMap[ppi^.PropType^.Kind].Qualified; @@ -1405,15 +1401,44 @@ begin GetPropInfos(PTypeInfo(cl.ClassInfo),clPL); regItem := ATypeRegistry.Find(PTypeInfo(cl.ClassInfo),True); if ( regItem <> nil ) then begin + eltFormEmpty := ([trioQualifiedElement,trioUnqualifiedElement]*regItem.Options) = []; + attFormEmpty := ([trioQualifiedAttribute,trioUnqualifiedAttribute]*regItem.Options) = []; + qualifiedElt := (trioQualifiedElement in regItem.Options) and not(trioUnqualifiedElement in regItem.Options); + qualifiedElt := eltFormEmpty or qualifiedElt; + qualifiedAtt := (trioQualifiedAttribute in regItem.Options) and not(trioUnqualifiedAttribute in regItem.Options); + qualifiedAtt := not(attFormEmpty) and qualifiedAtt; 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 := ReaderInfoMap[ppi^.PropType^.Kind].Qualified; - serInfo.FWriterProc := WriterInfoMap[ppi^.PropType^.Kind].Qualified; + if (serInfo.Style = ssNodeSerialization) then begin + if qualifiedElt then begin + if not(serInfo.FQualifiedName) or (thisRegItem.NameSpace <> regItem.NameSpace) then begin + serInfo.FNameSpace := regItem.NameSpace; + serInfo.FQualifiedName := True; + serInfo.FReaderProc := ReaderInfoMap[ppi^.PropType^.Kind].Qualified; + serInfo.FWriterProc := WriterInfoMap[ppi^.PropType^.Kind].Qualified; + end; + end else begin + serInfo.FNameSpace := ''; + serInfo.FQualifiedName := False; + serInfo.FReaderProc := ReaderInfoMap[ppi^.PropType^.Kind].Simple; + serInfo.FWriterProc := WriterInfoMap[ppi^.PropType^.Kind].Simple; + end; + end else begin + if qualifiedAtt then begin + if not(serInfo.FQualifiedName) or (thisRegItem.NameSpace <> regItem.NameSpace) then begin + serInfo.FNameSpace := regItem.NameSpace; + serInfo.FQualifiedName := True; + serInfo.FReaderProc := ReaderInfoMap[ppi^.PropType^.Kind].Qualified; + serInfo.FWriterProc := WriterInfoMap[ppi^.PropType^.Kind].Qualified; + end; + end else begin + serInfo.FNameSpace := ''; + serInfo.FQualifiedName := False; + serInfo.FReaderProc := ReaderInfoMap[ppi^.PropType^.Kind].Simple; + serInfo.FWriterProc := WriterInfoMap[ppi^.PropType^.Kind].Simple; + end; end; end; end; @@ -1588,7 +1613,7 @@ var serInfo.FExternalName := serInfo.FName; serInfo.FPersisteType := st; serInfo.FPropInfo := APropInfo; - serInfo.FNameSpace := regItem.NameSpace; + //serInfo.FNameSpace := regItem.NameSpace; serInfo.FStyle := ssAttibuteSerialization; serInfo.FQualifiedName := True; serInfo.FNameSpace := ''; @@ -1877,7 +1902,9 @@ end; procedure TBaseComplexTypeRegistryItem.Init(); begin inherited Init(); - FSerializer := TObjectSerializer.Create(TBaseComplexRemotableClass(GetTypeData(DataType)^.ClassType),Owner); + if (FSerializer = nil) then + FSerializer := TObjectSerializer.Create(TBaseComplexRemotableClass(GetTypeData(DataType)^.ClassType),Owner); + FSerializer.Prepare(Self.Owner); end; destructor TBaseComplexTypeRegistryItem.Destroy(); diff --git a/wst/trunk/tests/test_suite/test_soap_specific.pas b/wst/trunk/tests/test_suite/test_soap_specific.pas index 33211dd51..1e4d34780 100644 --- a/wst/trunk/tests/test_suite/test_soap_specific.pas +++ b/wst/trunk/tests/test_suite/test_soap_specific.pas @@ -172,12 +172,61 @@ type property PartnerID : integer read FPartnerID write FPartnerID; end; + TShapeProperties = class(TBaseComplexRemotable) + private + FAreaFormula : UnicodeString; + FExtendedName : UnicodeString; + published + property AreaFormula : UnicodeString read FAreaFormula write FAreaFormula; + property ExtendedName : UnicodeString read FExtendedName write FExtendedName; + end; + + TPositionPoint = class(TBaseComplexRemotable) + private + FX : integer; + FY : integer; + FUnits : UnicodeString; + published + property X : integer read FX write FX; + property Y : integer read FY write FY; + property Units : UnicodeString read FUnits write FUnits; + end; + + TShape = class(TBaseComplexRemotable) + const NS = 'wst.test.form'; + private + FName : UnicodeString; + FProperties : TShapeProperties; + public + constructor Create();override; + procedure FreeObjectProperties();override; + published + property Name : UnicodeString read FName write FName; + property Properties : TShapeProperties read FProperties write FProperties; + end; + + TRectShape = class(TShape) + private + FWidth : integer; + FOrigine : TPositionPoint; + FHeight : integer; + public + constructor Create();override; + procedure FreeObjectProperties();override; + published + property Width : integer read FWidth write FWidth; + property Origine : TPositionPoint read FOrigine write FOrigine; + property Height : integer read FHeight write FHeight; + end; + { TTest_SoapFormatterClient } TTest_SoapFormatterClient = class(TTestCase) published procedure test_soap_href_id(); procedure inline_namespace(); + procedure read_element_attribute_forms(); + procedure write_element_attribute_forms(); end; { TTest_THeaderBlockProxy } @@ -227,6 +276,36 @@ begin Result := 'NBS3'; end; +{ TShape } + +constructor TShape.Create(); +begin + inherited Create(); + FProperties := TShapeProperties.Create(); +end; + +procedure TShape.FreeObjectProperties(); +begin + if Assigned(FProperties) then + FreeAndNil(FProperties); + inherited FreeObjectProperties(); +end; + +{ TRectShape } + +constructor TRectShape.Create(); +begin + inherited Create(); + FOrigine := TPositionPoint.Create(); +end; + +procedure TRectShape.FreeObjectProperties(); +begin + if Assigned(FOrigine) then + FreeAndNil(FOrigine); + inherited FreeObjectProperties(); +end; + { TTest_SoapFormatterServerNameSpace } procedure TTest_SoapFormatterServerNameSpace.namespace_declared_env(); @@ -973,6 +1052,135 @@ begin end; end; +procedure TTest_SoapFormatterClient.read_element_attribute_forms(); +const + XML_SOURCE = + '' + sLineBreak + + '' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' Rectangle' + sLineBreak + + ' ' + sLineBreak + + ' Heigth * Width' + sLineBreak + + ' ' + sLineBreak + + ' 456' + sLineBreak + + ' ' + sLineBreak + + ' 7' + sLineBreak + + ' 8' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ''; +var + f : IFormatterClient; + strm : TMemoryStream; + strBuffer : ansistring; + cctx : ICallContext; + x : TRectShape; + locStrPrmName : string; +begin + x := nil; + f := soap_formatter.TSOAPFormatter.Create() as IFormatterClient; + f.GetPropertyManager().SetProperty('Style','Document'); + f.GetPropertyManager().SetProperty('EncodingStyle','Literal'); + 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); + f.BeginCallRead(TSimpleCallContext.Create()); + x := TRectShape.Create(); + locStrPrmName := 'Shape'; + f.Get(TypeInfo(TRectShape), locStrPrmName, x); + f.EndScopeRead(); + CheckEquals('Rectangle',x.Name,'Name'); + CheckEquals('A Rectangle Shape',x.Properties.ExtendedName,'x.Properties.ExtendedName'); + CheckEquals('Heigth * Width',x.Properties.AreaFormula,'x.Properties.AreaFormula'); + CheckEquals(123,x.Height,'Height'); + CheckEquals(456,x.Width,'Width'); + CheckEquals(7,x.Origine.X,'x.Origine.X'); + CheckEquals(8,x.Origine.Y,'x.Origine.Y'); + finally + FreeAndNil(x); + FreeAndNil(strm); + end; +end; + +procedure TTest_SoapFormatterClient.write_element_attribute_forms(); +const + XML_SOURCE = + '' + sLineBreak + + '' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' Rectangle' + sLineBreak + + ' ' + sLineBreak + + ' Heigth * Width' + sLineBreak + + ' ' + sLineBreak + + ' 456' + sLineBreak + + ' ' + sLineBreak + + ' 7' + sLineBreak + + ' 8' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ''; +var + f : IFormatterClient; + strm : TMemoryStream; + strBuffer : ansistring; + x : TRectShape; + locDoc, locExistDoc : TXMLDocument; +begin + locDoc := nil; + locExistDoc := nil; + strm := nil; + x := TRectShape.Create(); + try + x.Name := 'Rectangle'; + x.Properties.ExtendedName := 'A Rectangle Shape'; + x.Properties.AreaFormula := 'Heigth * Width'; + x.Height := 123; + x.Width := 456; + x.Origine.X := 7; + x.Origine.Y := 8; + x.Origine.Units := 'Meters'; + f := TSOAPFormatter.Create() as IFormatterClient; + f.GetPropertyManager().SetProperty('Style','Document'); + f.GetPropertyManager().SetProperty('EncodingStyle','Literal'); + f.BeginCall('CreateRect','ShapeBO',TSimpleCallContext.Create() as ICallContext); + f.Put('Shape',TypeInfo(TRectShape),x); + f.EndCall(); + strm := TMemoryStream.Create(); + f.SaveToStream(strm); + strm.Position := 0; + ReadXMLFile(locDoc,strm); + + strm.Clear(); + strBuffer := XML_SOURCE; + strm.Write(strBuffer[1],Length(strBuffer)); + strm.Position := 0; + ReadXMLFile(locExistDoc,strm); + Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.'); + finally + ReleaseDomNode(locDoc); + ReleaseDomNode(locExistDoc); + FreeAndNil(x); + FreeAndNil(strm); + end; +end; + { THeaderProxyTestObject } procedure THeaderProxyTestObject.SetDestructionCount(const AValue: PInteger); @@ -1061,7 +1269,10 @@ end; initialization - GetTypeRegistry().Register(TSampleSimpleContentHeaderBlock_A.GetNameSpace(),TypeInfo(TSampleSimpleContentHeaderBlock_A)); + GetTypeRegistry().Register( + TSampleSimpleContentHeaderBlock_A.GetNameSpace(), + TypeInfo(TSampleSimpleContentHeaderBlock_A) + ); TSampleSimpleContentHeaderBlock_B.RegisterAttributeProperty('intAtt'); GetTypeRegistry().Register(TSampleSimpleContentHeaderBlock_B.GetNameSpace(),TypeInfo(TSampleSimpleContentHeaderBlock_B)); @@ -1074,6 +1285,19 @@ initialization GetTypeRegistry().Register(ns_soap_test,TypeInfo(TLoginInfos),'LoginInfos').AddExternalSynonym('NamedLoginInfos'); GetTypeRegistry().Register(ns_soap_test,TypeInfo(THeaderProxyTestObject)); + TRectShape.RegisterAttributeProperty('Height'); + TShapeProperties.RegisterAttributeProperty('ExtendedName'); + TPositionPoint.RegisterAttributeProperty('Units'); + GetTypeRegistry().Register(TRectShape.NS,TypeInfo(TShape),'TShape'); + GetTypeRegistry().Register( + TRectShape.NS,TypeInfo(TRectShape),'TRectShape' + ).AddOptions([trioUnqualifiedElement]); + GetTypeRegistry().Register( + TRectShape.NS,TypeInfo(TShapeProperties), + 'TShapeProperties' + ).AddOptions([trioUnqualifiedElement,trioQualifiedAttribute]); + GetTypeRegistry().Register(TRectShape.NS,TypeInfo(TPositionPoint),'TPositionPoint'); + RegisterTest('Serializer',TTest_SoapFormatterServerNameSpace.Suite); RegisterTest('Serializer',TTest_SoapFormatterHeader.Suite); diff --git a/wst/trunk/tests/test_suite/testformatter_unit.pas b/wst/trunk/tests/test_suite/testformatter_unit.pas index b31540d11..eae9dc9cf 100644 --- a/wst/trunk/tests/test_suite/testformatter_unit.pas +++ b/wst/trunk/tests/test_suite/testformatter_unit.pas @@ -5036,8 +5036,8 @@ begin s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); - // if not IsStrEmpty(AFilename) then - // s.SaveToFile(wstExpandLocalFileName(AFilename)); + //if not IsStrEmpty(AFilename) then + //s.SaveToFile(wstExpandLocalFileName(AFilename)); a := TClass_B.Create(); f := CreateFormatter(TypeInfo(TClass_B));