From bc4dd0ba391328be69f613c091dde9766cc9087a Mon Sep 17 00:00:00 2001 From: inoussa Date: Thu, 11 Sep 2008 00:42:54 +0000 Subject: [PATCH] Part 2 * simple content header block implementation : TSimpleContentHeaderBlock * XSD/WSDL generator tests : header, simple content header, collection git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@550 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- wst/trunk/base_service_intf.pas | 87 ++++++++++++++++++++++ wst/trunk/object_serializer.pas | 16 +++- wst/trunk/type_lib_edtr/typ_lib_edtr.lpi | 2 +- wst/trunk/ws_helper/pascal_parser_intf.pas | 1 + wst/trunk/ws_helper/ws_parser_imp.pas | 9 +++ wst/trunk/ws_helper/xsd_consts.pas | 13 ++-- wst/trunk/ws_helper/xsd_generator.pas | 11 ++- 7 files changed, 125 insertions(+), 14 deletions(-) diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas index f054b8d64..f107159e5 100644 --- a/wst/trunk/base_service_intf.pas +++ b/wst/trunk/base_service_intf.pas @@ -78,6 +78,7 @@ type TBaseRemotable = class; THeaderBlock = class; + TSimpleContentHeaderBlock = class; //Utility interface used to configure its parent. IPropertyManager = Interface @@ -684,6 +685,29 @@ type property mustUnderstand : Integer read FmustUnderstand write SetmustUnderstand stored HasmustUnderstand; end; + { TSimpleContentHeaderBlock + Make a derived class of TSimpleContentHeaderBlock to handle a simple content + header block. + } + TSimpleContentHeaderBlock = class(THeaderBlock) + private + FValue : string; + public + class procedure Save( + AObject : TBaseRemotable; + AStore : IFormatterBase; + const AName : string; + const ATypeInfo : PTypeInfo + );override; + class procedure Load( + var AObject : TObject; + AStore : IFormatterBase; + var AName : string; + const ATypeInfo : PTypeInfo + );override; + property Value : string read FValue write FValue; + end; + { TObjectCollectionRemotable An implementation for array handling. The array items are "owned" by this class instance, so one has not to free them. @@ -1512,6 +1536,8 @@ begin THeaderBlock.RegisterAttributeProperty('mustUnderstand'); ri := r.Register(sSOAP_ENV,TypeInfo(THeaderBlock),'THeaderBlock'); ri.Options := ri.Options + [trioNonVisibleToMetadataService]; + ri := r.Register(sSOAP_ENV,TypeInfo(TSimpleContentHeaderBlock)); + ri.Options := ri.Options + [trioNonVisibleToMetadataService]; r.Register(sWST_BASE_NS,TypeInfo(TArrayOfStringRemotable),'TArrayOfStringRemotable').AddPascalSynonym('TArrayOfStringRemotable'); @@ -4302,6 +4328,67 @@ begin FmustUnderstand := 0; end; +{ TSimpleContentHeaderBlock } + +class procedure TSimpleContentHeaderBlock.Save( + AObject : TBaseRemotable; + AStore : IFormatterBase; + const AName : String; + const ATypeInfo : PTypeInfo +); +var + locSerializer : TObjectSerializer; +begin + locSerializer := TBaseComplexTypeRegistryItem(GetTypeRegistry().ItemByTypeInfo[ATypeInfo]).GetSerializer(); + if ( locSerializer <> nil ) then begin + if not ( osoDontDoBeginWrite in locSerializer.Options ) then + locSerializer.Options := locSerializer.Options + [osoDontDoBeginWrite]; + AStore.BeginObject(AName,ATypeInfo); + try + if ( AObject <> nil ) then + AStore.PutScopeInnerValue(TypeInfo(string),TSimpleContentHeaderBlock(AObject).Value); + locSerializer.Save(AObject,AStore,AName,ATypeInfo); + finally + AStore.EndScope(); + end; + end else begin + raise ETypeRegistryException.CreateFmt(SERR_NoSerializerFoThisType,[ATypeInfo^.Name]) + end; +end; + +class procedure TSimpleContentHeaderBlock.Load( + Var AObject : TObject; + AStore : IFormatterBase; + var AName : String; + const ATypeInfo : PTypeInfo +); +var + locSerializer : TObjectSerializer; + locStrBuffer : string; +begin + locSerializer := TBaseComplexTypeRegistryItem(GetTypeRegistry().ItemByTypeInfo[ATypeInfo]).GetSerializer(); + if ( locSerializer <> nil ) then begin + if not ( osoDontDoBeginRead in locSerializer.Options ) then + locSerializer.Options := locSerializer.Options + [osoDontDoBeginRead]; + if ( AStore.BeginObjectRead(AName,ATypeInfo) >= 0 ) then begin + try + if AStore.IsCurrentScopeNil() then + Exit; // ???? FreeAndNil(AObject); + if not Assigned(AObject) then + AObject := locSerializer.Target.Create(); + locStrBuffer := ''; + AStore.GetScopeInnerValue(TypeInfo(string),locStrBuffer); + TSimpleContentHeaderBlock(AObject).Value := locStrBuffer; + locSerializer.Read(AObject,AStore,AName,ATypeInfo); + finally + AStore.EndScopeRead(); + end; + end; + end else begin + raise ETypeRegistryException.CreateFmt(SERR_NoSerializerFoThisType,[ATypeInfo^.Name]) + end; +end; + { TStoredPropertyManager } procedure TStoredPropertyManager.Error(Const AMsg: string); diff --git a/wst/trunk/object_serializer.pas b/wst/trunk/object_serializer.pas index a94781333..f00d9279b 100644 --- a/wst/trunk/object_serializer.pas +++ b/wst/trunk/object_serializer.pas @@ -21,6 +21,9 @@ uses type + TObjectSerializerOption = ( osoDontDoBeginRead, osoDontDoBeginWrite ); + TObjectSerializerOptions = set of TObjectSerializerOption; + ESerializerException = class(EServiceException) end; @@ -66,6 +69,7 @@ type FSerializationInfos : TObjectList; FTarget : TBaseComplexRemotableClass; FRawPropList : PPropList; + FOptions : TObjectSerializerOptions; private procedure Prepare(ATypeRegistry : TTypeRegistry); public @@ -87,6 +91,7 @@ type const ATypeInfo : PTypeInfo ); property Target : TBaseComplexRemotableClass read FTarget; + property Options : TObjectSerializerOptions read FOptions write FOptions; end; TGetSerializerFunction = function() : TObjectSerializer of object; @@ -1079,7 +1084,7 @@ var locSerInfo : TPropSerializationInfo; begin oldSS := AStore.GetSerializationStyle(); - if ( AStore.BeginObjectRead(AName,ATypeInfo) >= 0 ) then begin + if ( osoDontDoBeginRead in Options ) or ( AStore.BeginObjectRead(AName,ATypeInfo) >= 0 ) then begin try if AStore.IsCurrentScopeNil() then Exit; // ???? FreeAndNil(AObject); @@ -1102,7 +1107,8 @@ begin end; end; finally - AStore.EndScopeRead(); + if not ( osoDontDoBeginRead in Options ) then + AStore.EndScopeRead(); AStore.SetSerializationStyle(oldSS); end; end; @@ -1120,7 +1126,8 @@ var locSerInfo : TPropSerializationInfo; begin oldSS := AStore.GetSerializationStyle(); - AStore.BeginObject(AName,ATypeInfo); + if not ( osoDontDoBeginWrite in Options ) then + AStore.BeginObject(AName,ATypeInfo); try if not Assigned(AObject) then begin AStore.NilCurrentScope(); @@ -1136,7 +1143,8 @@ begin end; end; finally - AStore.EndScope(); + if not ( osoDontDoBeginWrite in Options ) then + AStore.EndScope(); AStore.SetSerializationStyle(oldSS); end; end; diff --git a/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi b/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi index ed8d85898..c0fc2762e 100644 --- a/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi +++ b/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi @@ -209,7 +209,7 @@ - + diff --git a/wst/trunk/ws_helper/pascal_parser_intf.pas b/wst/trunk/ws_helper/pascal_parser_intf.pas index 2ea9626eb..fd63e3ce0 100644 --- a/wst/trunk/ws_helper/pascal_parser_intf.pas +++ b/wst/trunk/ws_helper/pascal_parser_intf.pas @@ -364,6 +364,7 @@ begin AddClassDef(Result,'TBaseComplexRemotable','TAbstractComplexRemotable',TPasNativeClassType); AddClassDef(Result,'THeaderBlock','TBaseComplexRemotable',TPasNativeClassType); + AddClassDef(Result,'TSimpleContentHeaderBlock','THeaderBlock',TPasNativeClassType); AddClassDef(Result,'TBaseArrayRemotable','TAbstractComplexRemotable',TPasNativeClassType); AddClassDef(Result,'TBaseObjectArrayRemotable','TBaseArrayRemotable',TPasNativeClassType); AddClassDef(Result,'TBaseSimpleTypeArrayRemotable','TBaseArrayRemotable',TPasNativeClassType); diff --git a/wst/trunk/ws_helper/ws_parser_imp.pas b/wst/trunk/ws_helper/ws_parser_imp.pas index c5a66d570..30f8b830b 100644 --- a/wst/trunk/ws_helper/ws_parser_imp.pas +++ b/wst/trunk/ws_helper/ws_parser_imp.pas @@ -873,6 +873,13 @@ var Result := wst_findCustomAttributeXsd(FContext.GetXsShortNames(),FTypeNode,s_WST_headerBlock,strBuffer) and AnsiSameText('true',Trim(strBuffer)); end; + function IsSimpleContentHeaderBlock() : Boolean; + var + strBuffer : string; + begin + Result := wst_findCustomAttributeXsd(FContext.GetXsShortNames(),FTypeNode,s_WST_headerBlockSimpleContent,strBuffer) and AnsiSameText('true',Trim(strBuffer)); + end; + function IsRecordType() : Boolean; var strBuffer : string; @@ -939,6 +946,8 @@ begin if ( classDef.AncestorType = nil ) then begin if IsHeaderBlock() then classDef.AncestorType := FSymbols.FindElementInModule('THeaderBlock',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType + else if IsSimpleContentHeaderBlock() then + classDef.AncestorType := FSymbols.FindElementInModule('TSimpleContentHeaderBlock',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType else classDef.AncestorType := FSymbols.FindElementInModule('TBaseComplexRemotable',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType; end; diff --git a/wst/trunk/ws_helper/xsd_consts.pas b/wst/trunk/ws_helper/xsd_consts.pas index 4bb098659..2f5d810fc 100644 --- a/wst/trunk/ws_helper/xsd_consts.pas +++ b/wst/trunk/ws_helper/xsd_consts.pas @@ -94,12 +94,13 @@ const s_xmlns = 'xmlns'; - s_WST = 'wst'; - s_WST_base_namespace = 'urn:wst_base'; - s_WST_collection = 'wst_collection'; - s_WST_headerBlock = 'wst_headerBlock'; - s_WST_record = 'wst_record'; - s_WST_storeType = 'StoreType'; + s_WST = 'wst'; + s_WST_base_namespace = 'urn:wst_base'; + s_WST_collection = 'wst_collection'; + s_WST_headerBlock = 'wst_headerBlock'; + s_WST_headerBlockSimpleContent = 'wst_headerBlockSimpleContent'; + s_WST_record = 'wst_record'; + s_WST_storeType = 'StoreType'; implementation diff --git a/wst/trunk/ws_helper/xsd_generator.pas b/wst/trunk/ws_helper/xsd_generator.pas index 786f97de2..0ad6a554b 100644 --- a/wst/trunk/ws_helper/xsd_generator.pas +++ b/wst/trunk/ws_helper/xsd_generator.pas @@ -674,10 +674,11 @@ var if ( Length(p.DefaultValue) > 0 ) then propNode.SetAttribute(s_default,p.DefaultValue); if AContainer.IsAttributeProperty(p) then begin - if AnsiSameText('Has',Copy(p.StoredAccessorName,1,3)) then - propNode.SetAttribute(s_use,'optional') - else + if AnsiSameText('Has',Copy(p.StoredAccessorName,1,3)) then begin + {propNode.SetAttribute(s_use,'optional')} + end else begin propNode.SetAttribute(s_use,'required'); + end; end else begin if AnsiSameText('Has',Copy(p.StoredAccessorName,1,3)) then propNode.SetAttribute(s_minOccurs,'0'); @@ -735,7 +736,11 @@ begin if trueParent.InheritsFrom(TPasNativeClassType) and AnsiSameText('THeaderBlock',trueParent.Name) then begin DeclareNameSpaceOf_WST(ADocument); DeclareAttributeOf_WST(cplxNode,s_WST_headerBlock,'true'); + end else if trueParent.InheritsFrom(TPasNativeClassType) and AnsiSameText('TSimpleContentHeaderBlock',trueParent.Name) then begin + DeclareNameSpaceOf_WST(ADocument); + DeclareAttributeOf_WST(cplxNode,s_WST_headerBlockSimpleContent,'true'); end; + if trueParent.InheritsFrom(TPasAliasType) then trueParent := GetUltimeType(trueParent); if trueParent.InheritsFrom(TPasNativeSimpleContentClassType) or