pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Part 2

Browse Source 
* 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
This commit is contained in:
inoussa
2008-09-11 00:42:54 +00:00
parent 975833fadc
commit bc4dd0ba39
7 changed files with 125 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

87
wst/trunk/base_service_intf.pas
View File

@ -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);

16
wst/trunk/object_serializer.pas
View File

@ -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;

2
wst/trunk/type_lib_edtr/typ_lib_edtr.lpi
View File

@ -209,7 +209,7 @@
</CodeGeneration>
<Linking>
<Debugging>
<UseLineInfoUnit Value="False"/>
<GenerateDebugInfo Value="True"/>
<StripSymbols Value="True"/>
</Debugging>
<LinkSmart Value="True"/>

1
wst/trunk/ws_helper/pascal_parser_intf.pas
View File

@ -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);

9
wst/trunk/ws_helper/ws_parser_imp.pas
View File

@ -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;

13
wst/trunk/ws_helper/xsd_consts.pas
View File

@ -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

11
wst/trunk/ws_helper/xsd_generator.pas
View File

@ -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