From 49b0c3d15949eb502feca4e3c4b087b29035e51b Mon Sep 17 00:00:00 2001 From: inoussa Date: Sun, 25 Mar 2007 23:47:16 +0000 Subject: [PATCH] soapAction parsing for operation, soap:address ( location ) parsing TServiceOperation now has Properties ( see IModuleMetadataMngr.SetServiceCustomData ), Code has been refactored to use ParseFilter() instead using TRttiFilterCreator git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@136 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- wst/trunk/base_binary_formatter.pas | 8 +- wst/trunk/base_service_intf.pas | 93 ++-- wst/trunk/base_soap_formatter.pas | 27 +- wst/trunk/metadata_repository.pas | 38 ++ wst/trunk/tests/ebay/test_ebay_gui.lpi | 272 +++++----- wst/trunk/tests/ebay/umain.pas | 2 +- .../tests/test_suite/testformatter_unit.pas | 21 + wst/trunk/tests/test_suite/wst_test_suite.lpi | 358 +++++++------ wst/trunk/ws_helper/generator.pas | 94 +++- wst/trunk/ws_helper/parserdefs.pas | 27 +- wst/trunk/ws_helper/ws_helper.lpi | 246 ++++----- wst/trunk/ws_helper/ws_parser.pas | 4 - wst/trunk/ws_helper/wsdl2pas_imp.pas | 492 +++++++++--------- 13 files changed, 961 insertions(+), 721 deletions(-) diff --git a/wst/trunk/base_binary_formatter.pas b/wst/trunk/base_binary_formatter.pas index c1476c702..12d767f2a 100644 --- a/wst/trunk/base_binary_formatter.pas +++ b/wst/trunk/base_binary_formatter.pas @@ -267,6 +267,7 @@ type ); procedure BeginArray( Const AName : string; + Const ATypeInfo : PTypeInfo; Const AItemTypeInfo : PTypeInfo; Const ABounds : Array Of Integer ); @@ -999,7 +1000,12 @@ begin PushStack(FRootData,stObject); end; -procedure TBaseBinaryFormatter.BeginArray(const AName: string;const AItemTypeInfo: PTypeInfo; const ABounds: array of Integer); +procedure TBaseBinaryFormatter.BeginArray( + Const AName : string; + Const ATypeInfo : PTypeInfo; + Const AItemTypeInfo : PTypeInfo; + Const ABounds : Array Of Integer +); Var i, j, k : Integer; begin diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas index 2d73edaa1..f26306bee 100644 --- a/wst/trunk/base_service_intf.pas +++ b/wst/trunk/base_service_intf.pas @@ -24,8 +24,11 @@ const stObject = stBase + 1; stArray = stBase + 2; -Type +type + { standart data types defines } anyURI = type string; + token = type string; + float = Single; TScopeType = Integer; THeaderDirection = ( hdOut, hdIn ); @@ -118,6 +121,7 @@ type ); procedure BeginArray( Const AName : string; + Const ATypeInfo : PTypeInfo; Const AItemTypeInfo : PTypeInfo; Const ABounds : Array Of Integer ); @@ -265,6 +269,12 @@ type //class function FormatDate(const ADate : TDateTime):string;override; //class function ParseDate(const ABuffer : string):TDateTime;override; end; + + TTimeRemotable = class(TBaseDateRemotable) + protected + //class function FormatDate(const ADate : TDateTime):string;override; + //class function ParseDate(const ABuffer : string):TDateTime;override; + end; TAbstractComplexRemotableClass = class of TAbstractComplexRemotable; @@ -498,6 +508,7 @@ type TBaseArrayRemotable = class(TAbstractComplexRemotable) protected + class function GetItemName():string;virtual; procedure CheckIndex(const AIndex : Integer); function GetLength():Integer;virtual;abstract; public @@ -1118,6 +1129,7 @@ begin r.Register(sXSD_NS,TypeInfo(TDateRemotable),'dateTime').AddPascalSynonym('TDateRemotable'); r.Register(sXSD_NS,TypeInfo(TDurationRemotable),'duration').AddPascalSynonym('TDurationRemotable'); + r.Register(sXSD_NS,TypeInfo(TTimeRemotable),'time').AddPascalSynonym('TTimeRemotable'); ri := r.Register(sWST_BASE_NS,TypeInfo(TBaseArrayRemotable),'TBaseArrayRemotable'); ri.Options := ri.Options + [trioNonVisibleToMetadataService]; @@ -1706,6 +1718,7 @@ Var i,j : Integer; nativObj : TBaseObjectArrayRemotable; itm : TObject; + itmName : string; begin If Assigned(AObject) Then Begin Assert(AObject.InheritsFrom(TBaseObjectArrayRemotable)); @@ -1714,11 +1727,12 @@ begin End Else j := 0; itmTypInfo := PTypeInfo(GetItemClass().ClassInfo); - AStore.BeginArray(AName,itmTypInfo,[0,Pred(j)]); + AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),itmTypInfo,[0,Pred(j)]); Try + itmName := GetItemName(); For i := 0 To Pred(j) Do Begin itm := nativObj.Item[i]; - AStore.Put(sARRAY_ITEM,itmTypInfo,itm); + AStore.Put(itmName,itmTypInfo,itm); End; Finally AStore.EndScope(); @@ -2218,6 +2232,7 @@ class procedure TBaseSimpleTypeArrayRemotable.Save( var i,j : Integer; nativObj : TBaseSimpleTypeArrayRemotable; + itmName : string; begin if Assigned(AObject) then begin Assert(AObject.InheritsFrom(TBaseSimpleTypeArrayRemotable)); @@ -2226,10 +2241,11 @@ begin end else begin j := 0; end; - AStore.BeginArray(AName,GetItemTypeInfo(),[0,Pred(j)]); + AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),GetItemTypeInfo(),[0,Pred(j)]); try + itmName := GetItemName(); for i := 0 to Pred(j) do begin - nativObj.SaveItem(AStore,sARRAY_ITEM,i); + nativObj.SaveItem(AStore,itmName,i); end; finally AStore.EndScope(); @@ -2288,7 +2304,7 @@ procedure TArrayOfStringRemotable.SaveItem( const AIndex : Integer ); begin - AStore.Put(sARRAY_ITEM,TypeInfo(ansistring),FData[AIndex]); + AStore.Put(AName,TypeInfo(ansistring),FData[AIndex]); end; procedure TArrayOfStringRemotable.LoadItem( @@ -2298,7 +2314,7 @@ procedure TArrayOfStringRemotable.LoadItem( var sName : string; begin - sName := sARRAY_ITEM; + sName := GetItemName(); AStore.Get(TypeInfo(ansistring),sName,FData[AIndex]); end; @@ -2320,6 +2336,17 @@ end; { TBaseArrayRemotable } +class function TBaseArrayRemotable.GetItemName(): string; +var + tri : TTypeRegistryItem; +begin + tri := GetTypeRegistry().Find(PTypeInfo(Self.ClassInfo),False); + if Assigned(tri) then + Result := Trim(tri.GetExternalPropertyName(sARRAY_ITEM)); + if ( System.Length(Result) = 0 ) then + Result := sARRAY_ITEM; +end; + procedure TBaseArrayRemotable.CheckIndex(const AIndex : Integer); begin if ( AIndex < 0 ) or ( AIndex >= Length ) then @@ -2354,14 +2381,14 @@ end; procedure TArrayOfBooleanRemotable.SaveItem(AStore: IFormatterBase; const AName: String; const AIndex: Integer); begin - AStore.Put(sARRAY_ITEM,TypeInfo(Boolean),FData[AIndex]); + AStore.Put(AName,TypeInfo(Boolean),FData[AIndex]); end; procedure TArrayOfBooleanRemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); var sName : string; begin - sName := sARRAY_ITEM; + sName := GetItemName(); AStore.Get(TypeInfo(Boolean),sName,FData[AIndex]); end; @@ -2403,14 +2430,14 @@ end; procedure TArrayOfInt8URemotable.SaveItem(AStore: IFormatterBase; const AName: String; const AIndex: Integer); begin - AStore.Put(sARRAY_ITEM,TypeInfo(Byte),FData[AIndex]); + AStore.Put(AName,TypeInfo(Byte),FData[AIndex]); end; procedure TArrayOfInt8URemotable.LoadItem(AStore: IFormatterBase; const AIndex: Integer); var sName : string; begin - sName := sARRAY_ITEM; + sName := GetItemName(); AStore.Get(TypeInfo(Byte),sName,FData[AIndex]); end; @@ -2452,14 +2479,14 @@ end; procedure TArrayOfInt8SRemotable.SaveItem(AStore: IFormatterBase; const AName: String; const AIndex: Integer); begin - AStore.Put(sARRAY_ITEM,TypeInfo(ShortInt),FData[AIndex]); + AStore.Put(AName,TypeInfo(ShortInt),FData[AIndex]); end; procedure TArrayOfInt8SRemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); var sName : string; begin - sName := sARRAY_ITEM; + sName := GetItemName(); AStore.Get(TypeInfo(ShortInt),sName,FData[AIndex]); end; @@ -2501,14 +2528,14 @@ end; procedure TArrayOfInt16SRemotable.SaveItem(AStore: IFormatterBase; const AName: String; const AIndex: Integer); begin - AStore.Put(sARRAY_ITEM,TypeInfo(SmallInt),FData[AIndex]); + AStore.Put(AName,TypeInfo(SmallInt),FData[AIndex]); end; procedure TArrayOfInt16SRemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); var sName : string; begin - sName := sARRAY_ITEM; + sName := GetItemName(); AStore.Get(TypeInfo(SmallInt),sName,FData[AIndex]); end; @@ -2550,14 +2577,14 @@ end; procedure TArrayOfInt16URemotable.SaveItem(AStore: IFormatterBase; const AName: String; const AIndex: Integer); begin - AStore.Put(sARRAY_ITEM,TypeInfo(Word),FData[AIndex]); + AStore.Put(AName,TypeInfo(Word),FData[AIndex]); end; procedure TArrayOfInt16URemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); var sName : string; begin - sName := sARRAY_ITEM; + sName := GetItemName(); AStore.Get(TypeInfo(Word),sName,FData[AIndex]); end; @@ -2599,14 +2626,14 @@ end; procedure TArrayOfInt32URemotable.SaveItem(AStore: IFormatterBase; const AName: String; const AIndex: Integer); begin - AStore.Put(sARRAY_ITEM,TypeInfo(LongWord),FData[AIndex]); + AStore.Put(AName,TypeInfo(LongWord),FData[AIndex]); end; procedure TArrayOfInt32URemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); var sName : string; begin - sName := sARRAY_ITEM; + sName := GetItemName(); AStore.Get(TypeInfo(LongWord),sName,FData[AIndex]); end; @@ -2648,14 +2675,14 @@ end; procedure TArrayOfInt32SRemotable.SaveItem(AStore: IFormatterBase; const AName: String; const AIndex: Integer); begin - AStore.Put(sARRAY_ITEM,TypeInfo(LongInt),FData[AIndex]); + AStore.Put(AName,TypeInfo(LongInt),FData[AIndex]); end; procedure TArrayOfInt32SRemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); var sName : string; begin - sName := sARRAY_ITEM; + sName := GetItemName(); AStore.Get(TypeInfo(LongInt),sName,FData[AIndex]); end; @@ -2697,14 +2724,14 @@ end; procedure TArrayOfInt64SRemotable.SaveItem(AStore: IFormatterBase; const AName: String; const AIndex: Integer); begin - AStore.Put(sARRAY_ITEM,TypeInfo(Int64),FData[AIndex]); + AStore.Put(AName,TypeInfo(Int64),FData[AIndex]); end; procedure TArrayOfInt64SRemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); var sName : string; begin - sName := sARRAY_ITEM; + sName := GetItemName(); AStore.Get(TypeInfo(Int64),sName,FData[AIndex]); end; @@ -2746,14 +2773,14 @@ end; procedure TArrayOfInt64URemotable.SaveItem(AStore: IFormatterBase; const AName: String; const AIndex: Integer); begin - AStore.Put(sARRAY_ITEM,TypeInfo(QWord),FData[AIndex]); + AStore.Put(AName,TypeInfo(QWord),FData[AIndex]); end; procedure TArrayOfInt64URemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); var sName : string; begin - sName := sARRAY_ITEM; + sName := GetItemName(); AStore.Get(TypeInfo(QWord),sName,FData[AIndex]); end; @@ -2795,14 +2822,14 @@ end; procedure TArrayOfFloatSingleRemotable.SaveItem(AStore: IFormatterBase; const AName: String; const AIndex: Integer); begin - AStore.Put(sARRAY_ITEM,TypeInfo(Single),FData[AIndex]); + AStore.Put(AName,TypeInfo(Single),FData[AIndex]); end; procedure TArrayOfFloatSingleRemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); var sName : string; begin - sName := sARRAY_ITEM; + sName := GetItemName(); AStore.Get(TypeInfo(Single),sName,FData[AIndex]); end; @@ -2844,14 +2871,14 @@ end; procedure TArrayOfFloatDoubleRemotable.SaveItem(AStore: IFormatterBase; const AName: String; const AIndex: Integer); begin - AStore.Put(sARRAY_ITEM,TypeInfo(Double),FData[AIndex]); + AStore.Put(AName,TypeInfo(Double),FData[AIndex]); end; procedure TArrayOfFloatDoubleRemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); var sName : string; begin - sName := sARRAY_ITEM; + sName := GetItemName(); AStore.Get(TypeInfo(Double),sName,FData[AIndex]); end; @@ -2893,14 +2920,14 @@ end; procedure TArrayOfFloatExtendedRemotable.SaveItem(AStore: IFormatterBase; const AName: String; const AIndex: Integer); begin - AStore.Put(sARRAY_ITEM,TypeInfo(Extended),FData[AIndex]); + AStore.Put(AName,TypeInfo(Extended),FData[AIndex]); end; procedure TArrayOfFloatExtendedRemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); var sName : string; begin - sName := sARRAY_ITEM; + sName := GetItemName(); AStore.Get(TypeInfo(Extended),sName,FData[AIndex]); end; @@ -2942,14 +2969,14 @@ end; procedure TArrayOfFloatCurrencyRemotable.SaveItem(AStore: IFormatterBase; const AName: String; const AIndex: Integer); begin - AStore.Put(sARRAY_ITEM,TypeInfo(Currency),FData[AIndex]); + AStore.Put(AName,TypeInfo(Currency),FData[AIndex]); end; procedure TArrayOfFloatCurrencyRemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); var sName : string; begin - sName := sARRAY_ITEM; + sName := GetItemName(); AStore.Get(TypeInfo(Currency),sName,FData[AIndex]); end; diff --git a/wst/trunk/base_soap_formatter.pas b/wst/trunk/base_soap_formatter.pas index acb0bc4cb..021bac5f6 100644 --- a/wst/trunk/base_soap_formatter.pas +++ b/wst/trunk/base_soap_formatter.pas @@ -235,6 +235,7 @@ Type ); procedure BeginArray( Const AName : string; + Const ATypeInfo : PTypeInfo; Const AItemTypeInfo : PTypeInfo; Const ABounds : Array Of Integer ); @@ -903,15 +904,17 @@ begin end; procedure TSOAPBaseFormatter.BeginArray( - const AName : string; - const AItemTypeInfo : PTypeInfo; - const ABounds : array of Integer + Const AName : string; + Const ATypeInfo : PTypeInfo; + Const AItemTypeInfo : PTypeInfo; + Const ABounds : Array Of Integer ); Var typData : TTypeRegistryItem; nmspc,nmspcSH : string; i,j, k : Integer; strNodeName : string; + xsiNmspcSH : string; begin If ( Length(ABounds) < 2 ) Then Error('Invalid array bounds.'); @@ -921,18 +924,20 @@ begin If ( k < 0 ) Then Error('Invalid array bounds.'); k := j - i + 1; - typData := GetTypeRegistry().Find(AItemTypeInfo,False); + typData := GetTypeRegistry().Find(ATypeInfo,False); If Not Assigned(typData) Then - Error('Array item''type not registered.'); + Error('Array type not registered.'); nmspc := typData.NameSpace; If IsStrEmpty(nmspc) Then nmspcSH := 'tns' Else Begin nmspcSH := FindAttributeByValueInScope(nmspc); - If IsStrEmpty(nmspcSH) Then Begin + if IsStrEmpty(nmspcSH) then begin nmspcSH := 'ns' + IntToStr(NextNameSpaceCounter()); AddScopeAttribute('xmlns:'+nmspcSH, nmspc); - End; + end else begin + nmspcSH := Copy(nmspcSH,Length('xmlns:')+1,MaxInt); + end; End; if ( Style = Document ) then begin @@ -946,10 +951,14 @@ begin if ( EncodingStyle = Encoded ) then begin //AddScopeAttribute(sXSI_TYPE,nmspc); //SOAP-ENC:arrayType="xsd:int[2]" - AddScopeAttribute( + {AddScopeAttribute( Format('%s:%s',[sSOAP_ENC_ABR,sARRAY_TYPE]) , Format('%s:%s[%d]',[nmspcSH,typData.DeclaredName,k]) - ); + );} + xsiNmspcSH := GetNameSpaceShortName(sXSI_NS,True); + if not IsStrEmpty(xsiNmspcSH) then + xsiNmspcSH := xsiNmspcSH + ':'; + AddScopeAttribute(xsiNmspcSH + sTYPE,Format('%s:%s',[nmspcSH,typData.DeclaredName])); end; StackTop().SetNameSpace(nmspc); end; diff --git a/wst/trunk/metadata_repository.pas b/wst/trunk/metadata_repository.pas index be795bce8..972ec63fa 100644 --- a/wst/trunk/metadata_repository.pas +++ b/wst/trunk/metadata_repository.pas @@ -59,6 +59,7 @@ type Name : ShortString; OperationsCount : Byte; Operations : PServiceOperation; + Properties : PPropertyData; end; PServiceRepository = ^TServiceRepository; @@ -81,6 +82,12 @@ type out ARepository : PServiceRepository ):Integer; procedure ClearRepository(var ARepository : PServiceRepository); + procedure SetServiceCustomData( + const ARepName : shortstring; + const AServiceName : shortstring; + const ADataName, + AData : string + ); procedure SetOperationCustomData( const ARepName : shortstring; const AServiceName : shortstring; @@ -211,6 +218,8 @@ begin end; Freemem(AService^.Operations, k * SizeOf(PServiceOperation^) ); AService^.Operations := nil; + ClearProperties(AService^.Properties); + AService^.Properties := nil; end; if AFreeService then Freemem(AService,SizeOf(PService^)); @@ -276,6 +285,7 @@ var po : PServiceOperation; begin AService^.Name := rdr.ReadStr(); + AService^.Properties := nil; k := rdr.ReadInt8U(); if ( k > 0 ) then begin AService^.Operations := GetMem( k * SizeOf(PServiceOperation^) ); @@ -354,6 +364,7 @@ var po : PServiceOperation; begin ADestService^.Name := ASrcService^.Name; + ADestService^.Properties := CloneProperties(ASrcService^.Properties); k := ASrcService^.OperationsCount; if ( k > 0 ) then begin ADestService^.Operations := GetMem( k * SizeOf(PServiceOperation^) ); @@ -435,6 +446,12 @@ type out ARepository : PServiceRepository ):Integer; procedure ClearRepository(var ARepository : PServiceRepository); + procedure SetServiceCustomData( + const ARepName : shortstring; + const AServiceName : shortstring; + const ADataName, + AData : string + ); procedure SetOperationCustomData( const ARepName : shortstring; const AServiceName : shortstring; @@ -613,6 +630,27 @@ begin Result := nil; end; +procedure TModuleMetadataMngr.SetServiceCustomData( + const ARepName : shortstring; + const AServiceName : shortstring; + const ADataName, + AData : string +); +var + i : Integer; + rp : PServiceRepository; + sp : PService; +begin + i := FindInnerListIndex(ARepName); + if ( i < 0 ) then + i := InternalLoadRepository(ARepName); + rp := FRepositories[i]; + sp := FindService(rp,AServiceName); + if not Assigned(sp) then + raise EMetadataException.CreateFmt('Service non found : "%s"',[AServiceName]); + Add(sp^.Properties,ADataName,AData); +end; + function FindOperation( const AServ : PService; const AOperationName : shortstring diff --git a/wst/trunk/tests/ebay/test_ebay_gui.lpi b/wst/trunk/tests/ebay/test_ebay_gui.lpi index a27bdf793..237794e0a 100644 --- a/wst/trunk/tests/ebay/test_ebay_gui.lpi +++ b/wst/trunk/tests/ebay/test_ebay_gui.lpi @@ -7,7 +7,7 @@ - + @@ -26,14 +26,14 @@ - + - + @@ -41,10 +41,10 @@ - + - + @@ -53,47 +53,47 @@ - - - + - - - - + + + + - - - + + + + + - + - + - - + + @@ -105,32 +105,36 @@ - + - - - + + + + + - + - - - + + + + + @@ -138,250 +142,264 @@ - - + + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - - - - - - - - - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - + - + diff --git a/wst/trunk/tests/ebay/umain.pas b/wst/trunk/tests/ebay/umain.pas index 741d289af..e05af0c78 100644 --- a/wst/trunk/tests/ebay/umain.pas +++ b/wst/trunk/tests/ebay/umain.pas @@ -6,7 +6,7 @@ interface uses Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls, - Buttons, StdCtrls, ComCtrls, eBaySvc_intf; + Buttons, StdCtrls, ComCtrls; type diff --git a/wst/trunk/tests/test_suite/testformatter_unit.pas b/wst/trunk/tests/test_suite/testformatter_unit.pas index f35f3292e..2cf342c44 100644 --- a/wst/trunk/tests/test_suite/testformatter_unit.pas +++ b/wst/trunk/tests/test_suite/testformatter_unit.pas @@ -418,6 +418,14 @@ type procedure FormatDate(); procedure ParseDate(); end; + + { TTest_TTimeRemotable } + + TTest_TTimeRemotable = class(TTestCase) + published + procedure FormatDate(); + procedure ParseDate(); + end; implementation uses base_binary_formatter, base_soap_formatter; @@ -2967,6 +2975,18 @@ begin Fail('Write me!'); end; +{ TTest_TTimeRemotable } + +procedure TTest_TTimeRemotable.FormatDate(); +begin + Fail('Write me!'); +end; + +procedure TTest_TTimeRemotable.ParseDate(); +begin + Fail('Write me!'); +end; + initialization RegisterStdTypes(); GetTypeRegistry().Register(sXSD_NS,TypeInfo(TTestEnum),'TTestEnum').RegisterExternalPropertyName('teOne', '1'); @@ -2997,4 +3017,5 @@ initialization RegisterTest(TTestBinaryFormatterAttributes); RegisterTest(TTest_TDateRemotable); RegisterTest(TTest_TDurationRemotable); + RegisterTest(TTest_TTimeRemotable); end. diff --git a/wst/trunk/tests/test_suite/wst_test_suite.lpi b/wst/trunk/tests/test_suite/wst_test_suite.lpi index 3100941d8..a79a6e53f 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite.lpi +++ b/wst/trunk/tests/test_suite/wst_test_suite.lpi @@ -27,7 +27,7 @@ - + @@ -40,9 +40,9 @@ - - - + + + @@ -66,23 +66,22 @@ - - + + + - - - + - - + + - + @@ -90,12 +89,11 @@ - - + + + - - - + @@ -122,353 +120,345 @@ - - - - - - - - - + + + - - + + + - - - + + + - - - - - + + + + + + + - - - + + + - - + + - - + + - - - + + + - - + + - - - + + + - - - - - - - - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - - - - - - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - + + - - + + - - - + + + - - + + + + + + + + - - + + - - + + - - + + - - + + - - + + - + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + + + + diff --git a/wst/trunk/ws_helper/generator.pas b/wst/trunk/ws_helper/generator.pas index 40d8c1ccd..2c7c87b61 100644 --- a/wst/trunk/ws_helper/generator.pas +++ b/wst/trunk/ws_helper/generator.pas @@ -159,6 +159,7 @@ type procedure GenerateEnum(ASymbol : TEnumTypeDefinition); procedure GenerateArray(ASymbol : TArrayDefinition); + procedure GenerateCustomMetadatas(); function GetDestUnitName():string; public constructor Create( @@ -177,14 +178,13 @@ Const sPROXY_BASE_CLASS = 'TBaseProxy'; sBINDER_BASE_CLASS = 'TBaseServiceBinder'; sIMP_BASE_CLASS = 'TBaseServiceImplementation'; sSERIALIZER_CLASS = 'IFormatterClient'; - RETURN_PARAM_NAME = 'return'; + //RETURN_PARAM_NAME = 'return'; RETURN_VAL_NAME = 'returnVal'; sNAME_SPACE = 'sNAME_SPACE'; + sUNIT_NAME = 'sUNIT_NAME'; sPRM_NAME = 'strPrmName'; sLOC_SERIALIZER = 'locSerializer'; - //sRES_TYPE_INFO = 'resTypeInfo'; - //sLOC_TYPE_INFO = 'locTypeInfo'; { TProxyGenerator } @@ -776,7 +776,7 @@ Var prm := AMthd.Parameter[prmCnt]; If prm.DataType.NeedFinalization() Then Begin if prm.DataType.InheritsFrom(TClassTypeDefinition) then begin - WriteLn('Pointer(%s) := Nil;',[RETURN_VAL_NAME]); + WriteLn('TObject(%s) := Nil;',[RETURN_VAL_NAME]); end else begin WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkInterface] ) Then',[prm.DataType.Name]); IncIndent(); @@ -790,7 +790,7 @@ Var prm := AMthd.Parameter[k]; If prm.DataType.NeedFinalization() Then Begin if prm.DataType.InheritsFrom(TClassTypeDefinition) then begin - WriteLn('Pointer(%s) := Nil;',[prm.Name]); + WriteLn('TObject(%s) := Nil;',[prm.Name]); end else begin WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkObject,tkInterface] ) Then',[prm.DataType.Name]); IncIndent(); @@ -846,7 +846,7 @@ Var prm := AMthd.Parameter[prmCnt]; If prm.DataType.NeedFinalization() Then Begin if prm.DataType.InheritsFrom(TClassTypeDefinition) then - WriteLn('If Assigned(Pointer(%s)) Then',[RETURN_VAL_NAME]) + WriteLn('If Assigned(TObject(%s)) Then',[RETURN_VAL_NAME]) else WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind = tkClass ) And Assigned(Pointer(%s)) Then',[prm.DataType.Name,RETURN_VAL_NAME]); IncIndent(); @@ -1270,6 +1270,7 @@ begin IncIndent(); Indent();WriteLn('sNAME_SPACE = %s;',[QuotedStr(FSymbolTable.ExternalName)]); + Indent();WriteLn('sUNIT_NAME = %s;',[QuotedStr(FSymbolTable.Name)]); DecIndent(); WriteLn(''); @@ -1282,6 +1283,7 @@ begin SetCurrentStream(FImpStream); WriteLn(''); WriteLn('Implementation'); + WriteLn('uses metadata_repository;'); FImpTempStream.WriteLn('initialization'); end; @@ -1756,11 +1758,83 @@ begin FImpTempStream.Indent(); FImpTempStream.WriteLn('GetTypeRegistry().Register(%s,TypeInfo(%s),%s);',[sNAME_SPACE,ASymbol.Name,QuotedStr(ASymbol.ExternalName)]); + if ( ASymbol.ItemName <> ASymbol.ItemExternalName ) then begin + FImpTempStream.WriteLn( + 'GetTypeRegistry().ItemByTypeInfo[%s].RegisterExternalPropertyName(''item'',%s);', + [ASymbol.Name,QuotedStr(ASymbol.ItemExternalName)] + ); + end; +end; + +procedure TInftGenerator.GenerateCustomMetadatas(); + + procedure WriteOperationDatas(AInftDef : TInterfaceDefinition; AOp : TMethodDefinition); + var + k : Integer; + pl : TStrings; + begin + pl := AOp.Properties; + for k := 0 to Pred(pl.Count) do begin + if not IsStrEmpty(pl.ValueFromIndex[k]) then begin + Indent();WriteLn('mm.SetOperationCustomData('); + IncIndent(); + Indent(); WriteLn('%s,',[sUNIT_NAME]); + Indent(); WriteLn('%s,',[QuotedStr(AInftDef.Name)]); + Indent(); WriteLn('%s,',[QuotedStr(AOp.Name)]); + Indent(); WriteLn('%s,',[QuotedStr(pl.Names[k])]); + Indent(); WriteLn('%s' ,[QuotedStr(pl.ValueFromIndex[k])]); + DecIndent(); + Indent();WriteLn(');'); + end; + end; + end; + + procedure WriteServiceDatas(AIntf : TInterfaceDefinition); + var + k : Integer; + begin + if not IsStrEmpty(AIntf.Address) then begin + Indent();WriteLn('mm.SetServiceCustomData('); + IncIndent(); + Indent(); WriteLn('%s,',[sUNIT_NAME]); + Indent(); WriteLn('%s,',[QuotedStr(AIntf.Name)]); + Indent(); WriteLn('%s,',[QuotedStr('Address')]); + Indent(); WriteLn('%s' ,[QuotedStr(AIntf.Address)]); + DecIndent(); + Indent();WriteLn(');'); + end; + + for k := 0 to Pred(AIntf.MethodCount) do begin + WriteOperationDatas(AIntf,AIntf.Method[k]); + end; + end; + +var + i : Integer; +begin + SetCurrentStream(FImpStream); + IncIndent(); + + NewLine();NewLine(); + WriteLn('procedure Register_%s_ServiceMetadata();',[SymbolTable.Name]); + WriteLn('var'); + Indent(); WriteLn('mm : IModuleMetadataMngr;'); + WriteLn('begin'); + Indent();WriteLn('mm := GetModuleMetadataMngr();'); + Indent();WriteLn('mm.SetRepositoryNameSpace(%s, %s);',[sUNIT_NAME,sNAME_SPACE]); + for i := 0 to Pred(SymbolTable.Count) do begin + if SymbolTable.Item[i] is TInterfaceDefinition then begin + WriteServiceDatas(SymbolTable.Item[i] as TInterfaceDefinition); + end; + end; + + WriteLn('end;'); + DecIndent(); end; function TInftGenerator.GetDestUnitName(): string; begin - Result := Format('%s_intf',[SymbolTable.Name]); + Result := SymbolTable.Name; end; constructor TInftGenerator.Create( @@ -1865,6 +1939,12 @@ begin end; end; + NewLine(); + IncIndent(); + Indent(); WriteLn('procedure Register_%s_ServiceMetadata();',[SymbolTable.Name]); + DecIndent(); + GenerateCustomMetadatas(); + GenerateUnitImplementationFooter(); FSrcMngr.Merge(GetDestUnitName() + '.pas',[FDecStream,FImpStream,FImpTempStream]); FDecStream := nil; diff --git a/wst/trunk/ws_helper/parserdefs.pas b/wst/trunk/ws_helper/parserdefs.pas index eca1a402f..d92052bdf 100644 --- a/wst/trunk/ws_helper/parserdefs.pas +++ b/wst/trunk/ws_helper/parserdefs.pas @@ -133,6 +133,7 @@ Type TArrayDefinition = class(TTypeDefinition) private + FItemExternalName: string; FItemName: string; FItemType: TTypeDefinition; protected @@ -142,13 +143,15 @@ Type );override; public constructor Create( - const AName : string; - AItemType : TTypeDefinition; - ItemName : string + const AName : string; + AItemType : TTypeDefinition; + const AItemName, + AItemExternalName : string ); function NeedFinalization():Boolean;override; property ItemName : string read FItemName; property ItemType : TTypeDefinition read FItemType; + property ItemExternalName : string read FItemExternalName; end; TEnumTypeDefinition = class; @@ -296,6 +299,7 @@ Type FMethodType: TMethodType; FParameterList : TObjectList; private + FProperties: TStrings; function GetParameter(Index: Integer): TParameterDefinition; function GetParameterCount: Integer; protected @@ -317,6 +321,7 @@ Type property MethodType : TMethodType Read FMethodType; property ParameterCount : Integer Read GetParameterCount; property Parameter[Index:Integer] : TParameterDefinition Read GetParameter; + property Properties : TStrings read FProperties; End; { TInterfaceDefinition } @@ -326,6 +331,7 @@ Type FInterfaceGUID: string; FMethodList : TObjectList; private + FAddress: string; function GetMethod(Index: Integer): TMethodDefinition; function GetMethodCount: Integer; protected @@ -346,6 +352,7 @@ Type Property MethodCount : Integer Read GetMethodCount; Property Method[Index:Integer] : TMethodDefinition Read GetMethod; property InterfaceGUID : string read FInterfaceGUID write FInterfaceGUID; + property Address : string read FAddress write FAddress; End; { TSymbolTable } @@ -525,10 +532,12 @@ begin Inherited Create(AName); FMethodType := AMethodType; FParameterList := TObjectList.create(True); + FProperties := TStringList.Create(); end; destructor TMethodDefinition.Destroy(); begin + FreeAndNil(FProperties); FreeAndNil(FParameterList); inherited Destroy(); end; @@ -1176,6 +1185,7 @@ begin AddClassDef(Result,'TAbstractSimpleRemotable','TBaseRemotable'); AddClassDef(Result,'TDateRemotable','TAbstractSimpleRemotable').RegisterExternalAlias('dateTime'); AddClassDef(Result,'TDurationRemotable','TAbstractSimpleRemotable').RegisterExternalAlias('duration'); + AddClassDef(Result,'TTimeRemotable','TAbstractSimpleRemotable').RegisterExternalAlias('time'); AddClassDef(Result,'TAbstractComplexRemotable','TBaseRemotable'); loc_TBaseComplexSimpleContentRemotable := AddClassDef(Result,'TBaseComplexSimpleContentRemotable','TAbstractComplexRemotable'); @@ -1267,14 +1277,19 @@ begin end; constructor TArrayDefinition.Create( - const AName : string; - AItemType : TTypeDefinition; - ItemName : string + const AName : string; + AItemType : TTypeDefinition; + const AItemName, + AItemExternalName : string ); begin Assert(Assigned(AItemType)); inherited Create(AName); FItemType := AItemType; + FItemName := AItemName; + FItemExternalName := AItemExternalName; + if IsStrEmpty(FItemExternalName) then + FItemExternalName := FItemName; end; function TArrayDefinition.NeedFinalization(): Boolean; diff --git a/wst/trunk/ws_helper/ws_helper.lpi b/wst/trunk/ws_helper/ws_helper.lpi index 4a0c2d34c..42db46c37 100644 --- a/wst/trunk/ws_helper/ws_helper.lpi +++ b/wst/trunk/ws_helper/ws_helper.lpi @@ -24,7 +24,7 @@ - + @@ -38,8 +38,8 @@ - - + + @@ -48,9 +48,9 @@ - - - + + + @@ -58,14 +58,15 @@ - - + + - + + @@ -73,9 +74,9 @@ - - - + + + @@ -85,7 +86,7 @@ - + @@ -93,7 +94,7 @@ - + @@ -101,42 +102,42 @@ - + - + - + - + - + - + @@ -151,26 +152,26 @@ - + - + - + - + @@ -184,80 +185,82 @@ - - - + + + + + - - - + + + - + - + - + - + - + - + - + - + - + - + @@ -265,45 +268,45 @@ - + - + - + - + - + - + - + @@ -311,193 +314,204 @@ - + - + - + - - + + - + - - - - + + + + - + - - - + + + - + - + - + - - - - + + + + + + + - + - + - + - + - + - + - + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - + - + - + - - + + - - + + - - + + + + + + + + + + diff --git a/wst/trunk/ws_helper/ws_parser.pas b/wst/trunk/ws_helper/ws_parser.pas index f711563c8..8bbfa09d7 100644 --- a/wst/trunk/ws_helper/ws_parser.pas +++ b/wst/trunk/ws_helper/ws_parser.pas @@ -257,13 +257,10 @@ Var sbl : TInterfaceDefinition; procedure ReadIntfHeader(); - Var - tmpStr : String; begin NextToken(); Repeat Tokenizer.CheckToken(toSymbol); - tmpStr := Tokenizer.TokenString; NextToken(); If AnsiSameText(Tokenizer.TokenString,GetPascalTokenStr(ptRigthParenthesis)) Then Begin NextToken(); @@ -437,7 +434,6 @@ end; procedure TPascalParser.ParseClassType(const AName: String); Var sbl : TClassTypeDefinition; - tmpStr : String; begin sbl := TClassTypeDefinition.Create(AName); FSymbolTable.Add(sbl); diff --git a/wst/trunk/ws_helper/wsdl2pas_imp.pas b/wst/trunk/ws_helper/wsdl2pas_imp.pas index 5d00f9b48..021c93d45 100644 --- a/wst/trunk/ws_helper/wsdl2pas_imp.pas +++ b/wst/trunk/ws_helper/wsdl2pas_imp.pas @@ -91,6 +91,7 @@ type FWsdlShortNames : TStringList; FSoapShortNames : TStringList; FXSShortNames : TStringList; + FChildCursor : IObjectCursor; FServiceCursor : IObjectCursor; FBindingCursor : IObjectCursor; FPortTypeCursor : IObjectCursor; @@ -112,14 +113,14 @@ type procedure Prepare(); procedure ParseService(ANode : TDOMNode); procedure ParsePort(ANode : TDOMNode); - procedure ParsePortType( + function ParsePortType( ANode, ABindingNode : TDOMNode - ); - procedure ParseOperation( + ) : TInterfaceDefinition; + function ParseOperation( AOwner : TInterfaceDefinition; ANode : TDOMNode; const ASoapBindingStyle : string - ); + ) : TMethodDefinition; function ParseType(const AName, ATypeOrElement : string) : TTypeDefinition; public constructor Create(ADoc : TXMLDocument; ASymbols : TSymbolTable); @@ -133,8 +134,9 @@ implementation uses dom_cursors, parserutils, StrUtils, Contnrs; const + s_address : WideString = 'address'; s_all : WideString = 'all'; - s_any : WideString = 'any'; + //s_any : WideString = 'any'; s_array : WideString = 'array'; s_arrayType : WideString = 'arrayType'; s_attribute : WideString = 'attribute'; @@ -148,6 +150,7 @@ const s_extension : WideString = 'extension'; s_input : WideString = 'input'; s_item : WideString = 'item'; + s_location : WideString = 'location'; s_message : WideString = 'message'; s_maxOccurs : WideString = 'maxOccurs'; s_minOccurs : WideString = 'minOccurs'; @@ -161,7 +164,7 @@ const s_prohibited : WideString = 'prohibited'; s_required : WideString = 'required'; s_restriction : WideString = 'restriction'; - s_return : WideString = 'return'; + //s_return : WideString = 'return'; s_rpc : WideString = 'rpc'; s_schema : WideString = 'schema'; s_xs : WideString = 'http://www.w3.org/2001/XMLSchema'; @@ -170,7 +173,9 @@ const s_simpleContent : WideString = 'simpleContent'; s_simpleType : WideString = 'simpleType'; s_soap : WideString = 'http://schemas.xmlsoap.org/wsdl/soap/'; + s_soapAction : WideString = 'soapAction'; s_style : WideString = 'style'; + s_targetNamespace : WideString = 'targetNamespace'; s_type : WideString = 'type'; s_types : WideString = 'types'; s_unbounded : WideString = 'unbounded'; @@ -187,7 +192,7 @@ type TCursorExposedType = ( cetRttiNode, cetDomNode ); function CreateAttributesCursor(ANode : TDOMNode; const AExposedType : TCursorExposedType):IObjectCursor; begin Result := nil; - if ( ANode <> nil ) and ( ANode.Attributes <> nil ) then begin + if ( ANode <> nil ) and ( ANode.Attributes <> nil ) and ( ANode.Attributes.Length > 0 ) then begin Result := TDOMNamedNodeMapCursor.Create(ANode.Attributes,faNone) ; if ( AExposedType = cetRttiNode ) then Result := TDOMNodeRttiExposerCursor.Create(Result); @@ -272,23 +277,8 @@ begin end; function TWsdlParser.CreateWsdlNameFilter(const AName: WideString): IObjectFilter; -var - k : Integer; - locStr : string; - locWStr : WideString; begin - locStr := ''; - for k := 0 to Pred(FWsdlShortNames.Count) do begin - if IsStrEmpty(FWsdlShortNames[k]) then - locWStr := '' - else - locWStr := FWsdlShortNames[k] + ':'; - locWStr := locWStr + AName; - locStr := locStr + ' or ' + s_NODE_NAME + '=' + QuotedStr(locWStr) ; - end; - if ( Length(locStr) > 0 ) then - Delete(locStr,1,Length(' or ')); - Result := ParseFilter(locStr,TDOMNodeRttiExposer); + Result := ParseFilter(CreateQualifiedNameFilterStr(AName,FWsdlShortNames),TDOMNodeRttiExposer); end; function TWsdlParser.FindNamedNode( @@ -298,20 +288,17 @@ function TWsdlParser.FindNamedNode( var attCrs, crs : IObjectCursor; curObj : TDOMNodeRttiExposer; - fltrCreator : TRttiFilterCreator; - s : string; + fltr : IObjectFilter; begin Result := nil; - fltrCreator := TRttiFilterCreator.Create(TDOMNodeRttiExposer); - try - s := s_NODE_NAME; - fltrCreator.AddCondition(s,sfoEqualCaseInsensitive,s_name,fcNone); + if Assigned(AList) then begin + fltr := ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer); AList.Reset(); while AList.MoveNext() do begin curObj := AList.GetCurrent() as TDOMNodeRttiExposer; attCrs := CreateAttributesCursor(curObj.InnerObject,cetRttiNode); if Assigned(attCrs) then begin - crs := CreateCursorOn(attCrs,TRttiObjectFilter.Create(fltrCreator.Root,clrNone)); + crs := CreateCursorOn(attCrs,fltr); crs.Reset(); if crs.MoveNext() and WideSameText(AName,TDOMNodeRttiExposer(crs.GetCurrent()).NodeValue) then begin Result := curObj.InnerObject; @@ -319,9 +306,6 @@ begin end; end; end; - finally - fltrCreator.Clear(clrFreeObjects); - FreeAndNil(fltrCreator); end; end; @@ -386,95 +370,79 @@ end; procedure TWsdlParser.Prepare(); var locAttCursor : IObjectCursor; - locChildCursor : IObjectCursor; - locFltrCreator : TRttiFilterCreator; locObj : TDOMNodeRttiExposer; - locSrvcCrs : IObjectCursor; begin FPortTypeCursor := nil; FWsdlShortNames.Clear(); locAttCursor := CreateAttributesCursor(FDoc.DocumentElement,cetRttiNode); - locChildCursor := TDOMNodeListCursor.Create(FDoc.DocumentElement.GetChildNodes,faFreeOnDestroy) ; - locChildCursor := TDOMNodeRttiExposerCursor.Create(locChildCursor); + FChildCursor := TDOMNodeListCursor.Create(FDoc.DocumentElement.GetChildNodes,faFreeOnDestroy) ; + FChildCursor := TDOMNodeRttiExposerCursor.Create(FChildCursor); - locFltrCreator := TRttiFilterCreator.Create(TDOMNodeRttiExposer); - try - ExtractNameSpaceShortNames(locAttCursor,FWsdlShortNames,s_wsdl,nfaRaiseException,True); - ExtractNameSpaceShortNames(locAttCursor,FSoapShortNames,s_soap,nfaRaiseException,False); - ExtractNameSpaceShortNames(locAttCursor,FXSShortNames,s_xs,nfaRaiseException,True); + ExtractNameSpaceShortNames(locAttCursor,FWsdlShortNames,s_wsdl,nfaRaiseException,True); + ExtractNameSpaceShortNames(locAttCursor,FSoapShortNames,s_soap,nfaRaiseException,False); + ExtractNameSpaceShortNames(locAttCursor,FXSShortNames,s_xs,nfaRaiseException,True); - locFltrCreator.Clear(clrFreeObjects); - CreateWsdlNameFilter(locFltrCreator,s_service); - FServiceCursor := CreateCursorOn(locChildCursor.Clone() as IObjectCursor,TRttiObjectFilter.Create(locFltrCreator.Root,clrFreeObjects)); - FServiceCursor.Reset(); - - locFltrCreator.Clear(clrNone); - CreateWsdlNameFilter(locFltrCreator,s_binding); - FBindingCursor := CreateCursorOn(locChildCursor.Clone() as IObjectCursor,TRttiObjectFilter.Create(locFltrCreator.Root,clrFreeObjects)); - FBindingCursor.Reset(); + FServiceCursor := CreateCursorOn( + FChildCursor.Clone() as IObjectCursor, + ParseFilter(CreateQualifiedNameFilterStr(s_service,FWsdlShortNames),TDOMNodeRttiExposer) + ); + FServiceCursor.Reset(); + + FBindingCursor := CreateCursorOn( + FChildCursor.Clone() as IObjectCursor, + ParseFilter(CreateQualifiedNameFilterStr(s_binding,FWsdlShortNames),TDOMNodeRttiExposer) + ); + FBindingCursor.Reset(); - locFltrCreator.Clear(clrNone); - CreateWsdlNameFilter(locFltrCreator,s_portType); - FPortTypeCursor := CreateCursorOn(locChildCursor.Clone() as IObjectCursor,TRttiObjectFilter.Create(locFltrCreator.Root,clrFreeObjects)); - FPortTypeCursor.Reset(); + FPortTypeCursor := CreateCursorOn( + FChildCursor.Clone() as IObjectCursor, + ParseFilter(CreateQualifiedNameFilterStr(s_portType,FWsdlShortNames),TDOMNodeRttiExposer) + ); + FPortTypeCursor.Reset(); - FSchemaCursor := nil; - locFltrCreator.Clear(clrNone); - CreateWsdlNameFilter(locFltrCreator,s_types); - FTypesCursor := CreateCursorOn(locChildCursor.Clone() as IObjectCursor,TRttiObjectFilter.Create(locFltrCreator.Root,clrFreeObjects)); - FTypesCursor.Reset(); - if FTypesCursor.MoveNext() then begin - locObj := FTypesCursor.GetCurrent() as TDOMNodeRttiExposer; - if locObj.InnerObject.HasChildNodes() then begin - FSchemaCursor := CreateChildrenCursor(locObj.InnerObject,cetRttiNode); - FSchemaCursor.Reset(); - locFltrCreator.Clear(clrNone); - CreateXsNameFilter(locFltrCreator,s_schema); - FSchemaCursor := CreateCursorOn( - FSchemaCursor,//.Clone() as IObjectCursor, - TRttiObjectFilter.Create(locFltrCreator.Root,clrFreeObjects) - ); - FSchemaCursor.Reset(); - end; + FSchemaCursor := nil; + FTypesCursor := CreateCursorOn( + FChildCursor.Clone() as IObjectCursor, + ParseFilter(CreateQualifiedNameFilterStr(s_types,FWsdlShortNames),TDOMNodeRttiExposer) + ); + FTypesCursor.Reset(); + if FTypesCursor.MoveNext() then begin + locObj := FTypesCursor.GetCurrent() as TDOMNodeRttiExposer; + if locObj.InnerObject.HasChildNodes() then begin + FSchemaCursor := CreateChildrenCursor(locObj.InnerObject,cetRttiNode); + FSchemaCursor.Reset(); + FSchemaCursor := CreateCursorOn( + FSchemaCursor,//.Clone() as IObjectCursor, + ParseFilter(CreateQualifiedNameFilterStr(s_schema,FXSShortNames),TDOMNodeRttiExposer) + ); + FSchemaCursor.Reset(); end; - - locFltrCreator.Clear(clrNone); - CreateWsdlNameFilter(locFltrCreator,s_message); - FMessageCursor := CreateCursorOn(locChildCursor.Clone() as IObjectCursor,TRttiObjectFilter.Create(locFltrCreator.Root,clrFreeObjects)); - FMessageCursor.Reset(); - - locSrvcCrs := FServiceCursor.Clone() as IObjectCursor; - while locSrvcCrs.MoveNext() do begin - locObj := locSrvcCrs.GetCurrent() as TDOMNodeRttiExposer; - ParseService(locObj.InnerObject); - end; - finally - locFltrCreator.Free(); end; + + FMessageCursor := CreateCursorOn( + FChildCursor.Clone() as IObjectCursor, + ParseFilter(CreateQualifiedNameFilterStr(s_message,FWsdlShortNames),TDOMNodeRttiExposer) + ); + FMessageCursor.Reset(); end; procedure TWsdlParser.ParseService(ANode: TDOMNode); var - locFltrCreator : TRttiFilterCreator; locCursor, locPortCursor : IObjectCursor; locObj : TDOMNodeRttiExposer; begin - locFltrCreator := TRttiFilterCreator.Create(TDOMNodeRttiExposer); - try - CreateWsdlNameFilter(locFltrCreator,s_port); - locCursor := CreateChildrenCursor(ANode,cetRttiNode); - if Assigned(locCursor) then begin - locPortCursor := CreateCursorOn(locCursor,TRttiObjectFilter.Create(locFltrCreator.Root,clrFreeObjects)); - locFltrCreator.Clear(clrNone); - locPortCursor.Reset(); - while locPortCursor.MoveNext() do begin - locObj := locPortCursor.GetCurrent() as TDOMNodeRttiExposer; - ParsePort(locObj.InnerObject); - end; + locCursor := CreateChildrenCursor(ANode,cetRttiNode); + if Assigned(locCursor) then begin + locPortCursor := CreateCursorOn( + locCursor, + ParseFilter(CreateQualifiedNameFilterStr(s_port,FWsdlShortNames),TDOMNodeRttiExposer) + ); + locPortCursor.Reset(); + while locPortCursor.MoveNext() do begin + locObj := locPortCursor.GetCurrent() as TDOMNodeRttiExposer; + ParsePort(locObj.InnerObject); end; - finally - locFltrCreator.Free(); end; end; @@ -488,26 +456,16 @@ procedure TWsdlParser.ParsePort(ANode: TDOMNode); function ExtractBindingQName(out AName : WideString):Boolean ; var attCrs, crs : IObjectCursor; - fltrCreator : TRttiFilterCreator; - s : string; begin Result := False; attCrs := CreateAttributesCursor(ANode,cetRttiNode); if Assigned(attCrs) then begin - fltrCreator := TRttiFilterCreator.Create(TDOMNodeRttiExposer); - try - s := s_NODE_NAME; - fltrCreator.AddCondition(s,sfoEqualCaseInsensitive,s_binding,fcNone); - crs := CreateCursorOn(attCrs,TRttiObjectFilter.Create(fltrCreator.Root,clrNone)); - crs.Reset(); - if crs.MoveNext() then begin - AName := TDOMNodeRttiExposer(crs.GetCurrent()).NodeValue; - Result := True; - exit; - end; - finally - fltrCreator.Clear(clrFreeObjects); - FreeAndNil(fltrCreator); + crs := CreateCursorOn(attCrs,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_binding)]),TDOMNodeRttiExposer)); + crs.Reset(); + if crs.MoveNext() then begin + AName := TDOMNodeRttiExposer(crs.GetCurrent()).NodeValue; + Result := True; + exit; end; end; end; @@ -515,26 +473,16 @@ procedure TWsdlParser.ParsePort(ANode: TDOMNode); function ExtractTypeQName(ABndgNode : TDOMNode; out AName : WideString):Boolean ; var attCrs, crs : IObjectCursor; - fltrCreator : TRttiFilterCreator; - s : string; begin Result := False; attCrs := CreateAttributesCursor(ABndgNode,cetRttiNode); if Assigned(attCrs) then begin - fltrCreator := TRttiFilterCreator.Create(TDOMNodeRttiExposer); - try - s := s_NODE_NAME; - fltrCreator.AddCondition(s,sfoEqualCaseInsensitive,s_type,fcNone); - crs := CreateCursorOn(attCrs,TRttiObjectFilter.Create(fltrCreator.Root,clrNone)); - crs.Reset(); - if crs.MoveNext() then begin - AName := TDOMNodeRttiExposer(crs.GetCurrent()).NodeValue; - Result := True; - exit; - end; - finally - fltrCreator.Clear(clrFreeObjects); - FreeAndNil(fltrCreator); + crs := CreateCursorOn(attCrs,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_type)]),TDOMNodeRttiExposer)); + crs.Reset(); + if crs.MoveNext() then begin + AName := TDOMNodeRttiExposer(crs.GetCurrent()).NodeValue; + Result := True; + exit; end; end; end; @@ -544,10 +492,36 @@ procedure TWsdlParser.ParsePort(ANode: TDOMNode); Result := FindNamedNode(FPortTypeCursor,AName); end; + function ExtractAddress() : string; + var + tmpCrs : IObjectCursor; + nd : TDOMNode; + begin + Result := ''; + if ANode.HasChildNodes() then begin + tmpCrs := CreateCursorOn( + CreateChildrenCursor(ANode,cetRttiNode), + ParseFilter(CreateQualifiedNameFilterStr(s_address,FSoapShortNames),TDOMNodeRttiExposer) + ); + tmpCrs.Reset(); + if tmpCrs.MoveNext() then begin + nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + tmpCrs := CreateCursorOn( + CreateAttributesCursor(nd,cetRttiNode), + ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_location)]),TDOMNodeRttiExposer) + ); + if Assigned(tmpCrs) and tmpCrs.MoveNext() then begin + Result := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue; + end; + end; + end; + end; + var bindingName, typeName : WideString; i : Integer; bindingNode, typeNode : TDOMNode; + intfDef : TInterfaceDefinition; begin if ExtractBindingQName(bindingName) then begin i := Pos(':',bindingName); @@ -559,14 +533,15 @@ begin typeName := Copy(typeName,( i + 1 ), MaxInt); typeNode := FindTypeNode(typeName); if Assigned(typeNode) then begin - ParsePortType(typeNode,bindingNode); + intfDef := ParsePortType(typeNode,bindingNode); + intfDef.Address := ExtractAddress(); end; end; end; end; end; -procedure TWsdlParser.ParsePortType(ANode, ABindingNode : TDOMNode); +function TWsdlParser.ParsePortType(ANode, ABindingNode : TDOMNode) : TInterfaceDefinition; function ExtractSoapBindingStyle(out AName : WideString):Boolean ; var @@ -596,56 +571,83 @@ procedure TWsdlParser.ParsePortType(ANode, ABindingNode : TDOMNode); end; end; + function ExtractBindingOperationCursor() : IObjectCursor ; + begin + Result := nil; + if ABindingNode.HasChildNodes() then begin + Result := CreateCursorOn( + CreateChildrenCursor(ABindingNode,cetRttiNode), + ParseFilter(CreateQualifiedNameFilterStr(s_operation,FWsdlShortNames),TDOMNodeRttiExposer) + ); + end; + end; + + procedure ParseOperationAtt_SoapAction(ABndngOpCurs : IObjectCursor; AOp : TMethodDefinition); + var + nd : TDOMNode; + tmpCrs : IObjectCursor; + begin + nd := FindNamedNode(ABndngOpCurs,AOp.ExternalName); + if Assigned(nd) and nd.HasChildNodes() then begin + tmpCrs := CreateCursorOn( + CreateChildrenCursor(nd,cetRttiNode), + ParseFilter(CreateQualifiedNameFilterStr(s_operation,FSoapShortNames),TDOMNodeRttiExposer) + ); + tmpCrs.Reset(); + if tmpCrs.MoveNext() then begin + nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + if Assigned(nd.Attributes) and ( nd.Attributes.Length > 0 ) then begin + tmpCrs := CreateCursorOn( + CreateAttributesCursor(nd,cetRttiNode), + ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_soapAction)]),TDOMNodeRttiExposer) + ); + tmpCrs.Reset(); + if tmpCrs.MoveNext() then begin + nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + AOp.Properties.Values[s_soapAction] := nd.NodeValue; + end; + end; + end; + end; + end; + var locIntf : TInterfaceDefinition; locAttCursor : IObjectCursor; - locFltrCreator : TRttiFilterCreator; - locCursor, locOpCursor : IObjectCursor; + locCursor, locOpCursor, locBindingOperationCursor : IObjectCursor; locObj : TDOMNodeRttiExposer; - i : Integer; - locStrBuffer, locSoapBindingStyle : string; + locSoapBindingStyle : string; locWStrBuffer : WideString; + locMthd : TMethodDefinition; begin locAttCursor := CreateAttributesCursor(ANode,cetRttiNode); - locFltrCreator := TRttiFilterCreator.Create(TDOMNodeRttiExposer); + locCursor := CreateCursorOn(locAttCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer)); + locCursor.Reset(); + if not locCursor.MoveNext() then + raise EWslParserException.CreateFmt('PortType Attribute not found : "%s"',[s_name]); + locObj := locCursor.GetCurrent() as TDOMNodeRttiExposer; + locIntf := TInterfaceDefinition.Create(locObj.NodeValue); try - locStrBuffer := s_NODE_NAME; - locFltrCreator.AddCondition(locStrBuffer,sfoEqualCaseInsensitive,s_name,fcNone); - locCursor := CreateCursorOn(locAttCursor,TRttiObjectFilter.Create(locFltrCreator.Root,clrNone)); - locCursor.Reset(); - if not locCursor.MoveNext() then - raise EWslParserException.CreateFmt('PortType Attribute not found : "%s"',[s_name]); - locObj := locCursor.GetCurrent() as TDOMNodeRttiExposer; - locIntf := TInterfaceDefinition.Create(locObj.NodeValue); - try - FSymbols.Add(locIntf); - except - FreeAndNil(locIntf); - raise; - end; - locCursor := CreateChildrenCursor(ANode,cetRttiNode); - if Assigned(locCursor) then begin - locFltrCreator.Clear(clrFreeObjects); - for i := 0 to Pred(FWsdlShortNames.Count) do begin - if IsStrEmpty(FWsdlShortNames[i]) then - locWStrBuffer := '' - else - locWStrBuffer := FWsdlShortNames[i] + ':'; - locWStrBuffer := locWStrBuffer + s_operation; - locStrBuffer := s_NODE_NAME; - locFltrCreator.AddCondition(locStrBuffer,sfoEqualCaseInsensitive,locWStrBuffer,fcOr); - end; - locOpCursor := CreateCursorOn(locCursor,TRttiObjectFilter.Create(locFltrCreator.Root,clrNone)); - locOpCursor.Reset(); - ExtractSoapBindingStyle(locWStrBuffer); - locSoapBindingStyle := locWStrBuffer; - while locOpCursor.MoveNext() do begin - locObj := locOpCursor.GetCurrent() as TDOMNodeRttiExposer; - ParseOperation(locIntf,locObj.InnerObject,locSoapBindingStyle); + FSymbols.Add(locIntf); + except + FreeAndNil(locIntf); + raise; + end; + Result := locIntf; + locCursor := CreateChildrenCursor(ANode,cetRttiNode); + if Assigned(locCursor) then begin + locOpCursor := CreateCursorOn(locCursor,ParseFilter(CreateQualifiedNameFilterStr(s_operation,FWsdlShortNames),TDOMNodeRttiExposer)); + locOpCursor.Reset(); + ExtractSoapBindingStyle(locWStrBuffer); + locSoapBindingStyle := locWStrBuffer; + locBindingOperationCursor := ExtractBindingOperationCursor(); + while locOpCursor.MoveNext() do begin + locObj := locOpCursor.GetCurrent() as TDOMNodeRttiExposer; + locMthd := ParseOperation(locIntf,locObj.InnerObject,locSoapBindingStyle); + if Assigned(locMthd) then begin + ParseOperationAtt_SoapAction(locBindingOperationCursor,locMthd); end; end; - finally - locFltrCreator.Free(); end; end; @@ -679,11 +681,11 @@ begin inherited; end; -procedure TWsdlParser.ParseOperation( +function TWsdlParser.ParseOperation( AOwner : TInterfaceDefinition; ANode : TDOMNode; const ASoapBindingStyle : string -); +) : TMethodDefinition; function ExtractOperationName(out AName : string):Boolean; var @@ -875,7 +877,7 @@ procedure TWsdlParser.ParseOperation( end; end; if ( SameText(ASoapBindingStyle,s_rpc) and - ( prmDef <> nil ) and SameText(prmDef.Name,s_return) and + ( prmDef <> nil ) and ( prmDef.Modifier = pmOut ) and//and SameText(prmDef.Name,s_return) and ( prmDef = tmpMthd.Parameter[Pred(tmpMthd.ParameterCount)] ) ) or ( SameText(ASoapBindingStyle,s_document) and @@ -909,6 +911,8 @@ var locMthd : TMethodDefinition; mthdName : string; begin + Result := nil; + locMthd := nil; if not ExtractOperationName(mthdName) then raise EWslParserException.CreateFmt('Operation Attribute not found : "%s"',[s_name]); if SameText(s_document,ASoapBindingStyle) then begin @@ -920,6 +924,7 @@ begin if ( locMthd <> nil ) then AOwner.AddMethod(locMthd); end; + Result := locMthd; end; function TWsdlParser.ParseType(const AName, ATypeOrElement: string): TTypeDefinition; @@ -1083,10 +1088,44 @@ procedure TWsdlParser.Parse(); end; end; end; + + procedure ExtractNameSpace(); + var + tmpCrs : IObjectCursor; + nd : TDOMNode; + s : string; + begin + nd := FDoc.DocumentElement; + if Assigned(nd.Attributes) and ( nd.Attributes.Length > 0 ) then begin + tmpCrs := CreateCursorOn( + CreateAttributesCursor(nd,cetRttiNode), + ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_targetNamespace)]),TDOMNodeRttiExposer) + ); + tmpCrs.Reset(); + if tmpCrs.MoveNext() then begin + s := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue; + if not IsStrEmpty(s) then begin + FSymbols.RegisterExternalAlias(s); + end; + end; + end; + end; +var + locSrvcCrs : IObjectCursor; + locObj : TDOMNodeRttiExposer; begin Prepare(); + + locSrvcCrs := FServiceCursor.Clone() as IObjectCursor; + locSrvcCrs.Reset(); + while locSrvcCrs.MoveNext() do begin + locObj := locSrvcCrs.GetCurrent() as TDOMNodeRttiExposer; + ParseService(locObj.InnerObject); + end; + ParseForwardDeclarations(); + ExtractNameSpace(); end; { TAbstractTypeParser } @@ -1375,7 +1414,8 @@ var TArrayDefinition.Create( Format('%s_%sArray',[AClassName,locPropTyp.Name]), locPropTyp.DataType, - locPropTyp.Name + locPropTyp.Name, + locPropTyp.ExternalName ) ); end; @@ -1440,7 +1480,7 @@ var end; if not locSym.InheritsFrom(TTypeDefinition) then raise EWslParserException.CreateFmt('Invalid array type definition, invalid item type definition : "%s".',[FTypeName]); - Result := TArrayDefinition.Create(AInternalName,locSym as TTypeDefinition,s_item); + Result := TArrayDefinition.Create(AInternalName,locSym as TTypeDefinition,s_item,s_item); if AHasInternalName then Result.RegisterExternalAlias(ATypeName); end; @@ -1493,7 +1533,7 @@ begin Result := nil; propTyp := arrayItems[0] as TPropertyDefinition; //arrayDef := TArrayDefinition.Create(internalName,(arrayItemType as TTypeDefinition),arrayItemName); - arrayDef := TArrayDefinition.Create(internalName,propTyp.DataType,propTyp.Name); + arrayDef := TArrayDefinition.Create(internalName,propTyp.DataType,propTyp.Name,propTyp.ExternalName); FreeAndNil(classDef); Result := arrayDef; if hasInternalName then @@ -1748,74 +1788,60 @@ end; procedure TSimpleTypeParser.ExtractContentType(); var locCrs, locAttCrs : IObjectCursor; - fltrCtr : TRttiFilterCreator; tmpNode : TDOMNode; begin - fltrCtr := TRttiFilterCreator.Create(TDOMNodeRttiExposer); - try - CreateQualifiedNameFilter(fltrCtr,s_restriction,FOwner.FXSShortNames); - locCrs := CreateCursorOn( - FChildCursor.Clone() as IObjectCursor,TRttiObjectFilter.Create(fltrCtr.Root,clrFreeObjects) - ); - locCrs.Reset(); - if locCrs.MoveNext() then begin - FRestrictionNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; - tmpNode := nil; - locAttCrs := CreateAttributesCursor(FRestrictionNode,cetRttiNode); - if Assigned(locAttCrs) then begin - locAttCrs := CreateCursorOn(locAttCrs,ParseFilter(Format('%s=%s',[s_NODE_NAME,QuotedStr(s_base)]),TDOMNodeRttiExposer)); - locAttCrs.Reset(); - if locAttCrs.MoveNext() then begin - tmpNode := (locAttCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; - end; + locCrs := CreateCursorOn( + FChildCursor.Clone() as IObjectCursor, + ParseFilter(CreateQualifiedNameFilterStr(s_restriction,FOwner.FXSShortNames),TDOMNodeRttiExposer) + ); + locCrs.Reset(); + if locCrs.MoveNext() then begin + FRestrictionNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + tmpNode := nil; + locAttCrs := CreateAttributesCursor(FRestrictionNode,cetRttiNode); + if Assigned(locAttCrs) then begin + locAttCrs := CreateCursorOn(locAttCrs,ParseFilter(Format('%s=%s',[s_NODE_NAME,QuotedStr(s_base)]),TDOMNodeRttiExposer)); + locAttCrs.Reset(); + if locAttCrs.MoveNext() then begin + tmpNode := (locAttCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; end; - FBaseName := ''; - if Assigned(tmpNode) then begin - FBaseName := ExtractNameFromQName(tmpNode.NodeValue); - end; - fltrCtr.Clear(clrNone); - CreateQualifiedNameFilter(fltrCtr,s_enumeration,FOwner.FXSShortNames); - locCrs := CreateChildrenCursor(FRestrictionNode,cetRttiNode) as IObjectCursor; - if Assigned(locCrs) then begin - locCrs.Reset(); - if locCrs.MoveNext() then begin - FIsEnum := True; - end else begin - if IsStrEmpty(FBaseName) then - raise EWslParserException.CreateFmt('Base type is not specified for the simple type, parsing : "%s".',[FTypeName]); - FIsEnum := False - end; + end; + FBaseName := ''; + if Assigned(tmpNode) then begin + FBaseName := ExtractNameFromQName(tmpNode.NodeValue); + end; + locCrs := CreateChildrenCursor(FRestrictionNode,cetRttiNode) as IObjectCursor; + if Assigned(locCrs) then begin + locCrs := CreateCursorOn( + locCrs, + ParseFilter(CreateQualifiedNameFilterStr(s_enumeration,FOwner.FXSShortNames),TDOMNodeRttiExposer) + ); + locCrs.Reset(); + if locCrs.MoveNext() then begin + FIsEnum := True; end else begin if IsStrEmpty(FBaseName) then raise EWslParserException.CreateFmt('Base type is not specified for the simple type, parsing : "%s".',[FTypeName]); FIsEnum := False end; end else begin - raise EWslParserException.CreateFmt('The parser only support "Restriction" mode simple type derivation, parsing : "%s".',[FTypeName]); + if IsStrEmpty(FBaseName) then + raise EWslParserException.CreateFmt('Base type is not specified for the simple type, parsing : "%s".',[FTypeName]); + FIsEnum := False end; - finally - fltrCtr.Clear(clrNone); - FreeAndNil(fltrCtr); + end else begin + raise EWslParserException.CreateFmt('The parser only support "Restriction" mode simple type derivation, parsing : "%s".',[FTypeName]); end; end; function TSimpleTypeParser.ParseEnumContent(): TTypeDefinition; function ExtractEnumCursor():IObjectCursor ; - var - fltrCtr : TRttiFilterCreator; begin - fltrCtr := TRttiFilterCreator.Create(TDOMNodeRttiExposer); - try - CreateQualifiedNameFilter(fltrCtr,s_enumeration,FOwner.FXSShortNames); - Result := CreateCursorOn( - CreateChildrenCursor(FRestrictionNode,cetRttiNode), - TRttiObjectFilter.Create(fltrCtr.Root,clrFreeObjects) - ); - finally - fltrCtr.Clear(clrNone); - FreeAndNil(fltrCtr); - end; + Result := CreateCursorOn( + CreateChildrenCursor(FRestrictionNode,cetRttiNode), + ParseFilter(CreateQualifiedNameFilterStr(s_enumeration,FOwner.FXSShortNames),TDOMNodeRttiExposer) + ); end; var