diff --git a/wst/trunk/base_binary_formatter.pas b/wst/trunk/base_binary_formatter.pas index 12d767f2a..1bab9b465 100644 --- a/wst/trunk/base_binary_formatter.pas +++ b/wst/trunk/base_binary_formatter.pas @@ -266,20 +266,25 @@ type Const ATypeInfo : PTypeInfo ); procedure BeginArray( - Const AName : string; - Const ATypeInfo : PTypeInfo; - Const AItemTypeInfo : PTypeInfo; - Const ABounds : Array Of Integer + const AName : string; + const ATypeInfo : PTypeInfo; + const AItemTypeInfo : PTypeInfo; + const ABounds : Array Of Integer; + const AStyle : TArrayStyle ); procedure NilCurrentScope(); function IsCurrentScopeNil():Boolean; procedure EndScope(); procedure AddScopeAttribute(Const AName,AValue : string); - //If the scope is an array the return value must be the array' length; - function BeginScopeRead( + function BeginObjectRead( + var AScopeName : string; + const ATypeInfo : PTypeInfo + ) : Integer; + function BeginArrayRead( var AScopeName : string; const ATypeInfo : PTypeInfo; - const AScopeType : TScopeType = stObject + const AStyle : TArrayStyle; + const AItemName : string ):Integer; procedure EndScopeRead(); @@ -1001,12 +1006,13 @@ begin end; procedure TBaseBinaryFormatter.BeginArray( - Const AName : string; - Const ATypeInfo : PTypeInfo; - Const AItemTypeInfo : PTypeInfo; - Const ABounds : Array Of Integer + const AName : string; + const ATypeInfo : PTypeInfo; + const AItemTypeInfo : PTypeInfo; + const ABounds : Array Of Integer; + const AStyle : TArrayStyle ); -Var +var i, j, k : Integer; begin If ( Length(ABounds) < 2 ) Then @@ -1044,20 +1050,39 @@ procedure TBaseBinaryFormatter.AddScopeAttribute(const AName, AValue: string); begin end; -function TBaseBinaryFormatter.BeginScopeRead( +function TBaseBinaryFormatter.BeginObjectRead( var AScopeName : string; - const ATypeInfo : PTypeInfo; - const AScopeType : TScopeType = stObject + const ATypeInfo : PTypeInfo ): Integer; -Var +var locNode : PDataBuffer; stk : TStackItem; begin stk := StackTop(); locNode := stk.Find(AScopeName); - If Not Assigned(locNode) Then + if not Assigned(locNode) then begin Error('Scope not found : "%s"',[AScopeName]); - PushStack(locNode,AScopeType); + end; + PushStack(locNode,stObject); + Result := StackTop().GetItemCount(); +end; + +function TBaseBinaryFormatter.BeginArrayRead( + var AScopeName : string; + const ATypeInfo : PTypeInfo; + const AStyle : TArrayStyle; + const AItemName : string +): Integer; +var + locNode : PDataBuffer; + stk : TStackItem; +begin + stk := StackTop(); + locNode := stk.Find(AScopeName); + if not Assigned(locNode) then begin + Error('Scope not found : "%s"',[AScopeName]); + end; + PushStack(locNode,stArray); Result := StackTop().GetItemCount(); end; diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas index f26306bee..afad25b07 100644 --- a/wst/trunk/base_service_intf.pas +++ b/wst/trunk/base_service_intf.pas @@ -23,6 +23,13 @@ const stBase = 0; stObject = stBase + 1; stArray = stBase + 2; + + sARRAY_ITEM = 'item'; + sARRAY_STYLE = 'style'; + + // array style string + sScoped = 'scoped'; + sEmbedded = 'embedded'; type { standart data types defines } @@ -31,6 +38,7 @@ type float = Single; TScopeType = Integer; + TArrayStyle = ( asScoped, asEmbeded, asNone ); THeaderDirection = ( hdOut, hdIn ); THeaderDirections = set of THeaderDirection; const @@ -120,20 +128,25 @@ type Const ATypeInfo : PTypeInfo ); procedure BeginArray( - Const AName : string; - Const ATypeInfo : PTypeInfo; - Const AItemTypeInfo : PTypeInfo; - Const ABounds : Array Of Integer + const AName : string; + const ATypeInfo : PTypeInfo; + const AItemTypeInfo : PTypeInfo; + const ABounds : Array Of Integer; + const AStyle : TArrayStyle ); procedure NilCurrentScope(); function IsCurrentScopeNil():Boolean; procedure EndScope(); procedure AddScopeAttribute(Const AName,AValue : string); - //If the scope is an array the return value must be the array' length; - function BeginScopeRead( - Var AScopeName : string; - Const ATypeInfo : PTypeInfo; - Const AScopeType : TScopeType = stObject + function BeginObjectRead( + var AScopeName : string; + const ATypeInfo : PTypeInfo + ) : Integer; + function BeginArrayRead( + var AScopeName : string; + const ATypeInfo : PTypeInfo; + const AStyle : TArrayStyle; + const AItemName : string ):Integer; procedure EndScopeRead(); property CurrentScope : String Read GetCurrentScope; @@ -509,6 +522,7 @@ type TBaseArrayRemotable = class(TAbstractComplexRemotable) protected class function GetItemName():string;virtual; + class function GetStyle():TArrayStyle;virtual; procedure CheckIndex(const AIndex : Integer); function GetLength():Integer;virtual;abstract; public @@ -517,7 +531,7 @@ type procedure SetLength(const ANewSize : Integer);virtual;abstract; property Length : Integer Read GetLength; - End; + end; { TBaseObjectArrayRemotable An implementation for array handling. The array items are "owned" by @@ -1550,7 +1564,7 @@ Var typRegItem : TTypeRegistryItem; begin oldSS := AStore.GetSerializationStyle(); - AStore.BeginScopeRead(AName,ATypeInfo); + AStore.BeginObjectRead(AName,ATypeInfo); try if AStore.IsCurrentScopeNil() then Exit; // ???? FreeAndNil(AObject); @@ -1706,7 +1720,6 @@ begin Result := System.Length(FArray); end; -const sARRAY_ITEM = 'item'; class procedure TBaseObjectArrayRemotable.Save( AObject : TBaseRemotable; AStore : IFormatterBase; @@ -1719,24 +1732,31 @@ Var nativObj : TBaseObjectArrayRemotable; itm : TObject; itmName : string; + styl : TArrayStyle; begin - If Assigned(AObject) Then Begin + if Assigned(AObject) then begin Assert(AObject.InheritsFrom(TBaseObjectArrayRemotable)); nativObj := AObject as TBaseObjectArrayRemotable; j := nativObj.Length; - End Else + end else begin j := 0; + end; itmTypInfo := PTypeInfo(GetItemClass().ClassInfo); - AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),itmTypInfo,[0,Pred(j)]); - Try - itmName := GetItemName(); - For i := 0 To Pred(j) Do Begin + styl := GetStyle(); + AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),itmTypInfo,[0,Pred(j)],styl); + try + if ( styl = asScoped ) then begin + itmName := GetItemName(); + end else begin + itmName := AName; + end; + for i := 0 to Pred(j) do begin itm := nativObj.Item[i]; AStore.Put(itmName,itmTypInfo,itm); - End; - Finally + end; + finally AStore.EndScope(); - End; + end; end; class procedure TBaseObjectArrayRemotable.Load( @@ -1751,8 +1771,16 @@ Var s : string; itmTypInfo : PTypeInfo; itm : TBaseRemotable; + itmName : string; + styl : TArrayStyle; begin - len := AStore.BeginScopeRead(AName,ATypeInfo, stArray); + styl := GetStyle(); + if ( styl = asScoped ) then begin + itmName := GetItemName(); + end else begin + itmName := AName; + end; + len := AStore.BeginArrayRead(AName,ATypeInfo, GetStyle(),itmName); Try If Not Assigned(AObject) Then AObject := Create(); @@ -2233,6 +2261,7 @@ var i,j : Integer; nativObj : TBaseSimpleTypeArrayRemotable; itmName : string; + styl : TArrayStyle; begin if Assigned(AObject) then begin Assert(AObject.InheritsFrom(TBaseSimpleTypeArrayRemotable)); @@ -2241,9 +2270,14 @@ begin end else begin j := 0; end; - AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),GetItemTypeInfo(),[0,Pred(j)]); + styl := GetStyle(); + AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),GetItemTypeInfo(),[0,Pred(j)],styl); try - itmName := GetItemName(); + if ( styl = asScoped ) then begin + itmName := GetItemName(); + end else begin + itmName := AName; + end; for i := 0 to Pred(j) do begin nativObj.SaveItem(AStore,itmName,i); end; @@ -2261,8 +2295,16 @@ class procedure TBaseSimpleTypeArrayRemotable.Load( Var i, len : Integer; nativObj : TBaseSimpleTypeArrayRemotable; -begin ; - len := AStore.BeginScopeRead(AName,ATypeInfo, stArray); + itmName : string; + styl : TArrayStyle; +begin + styl := GetStyle(); + if ( styl = asScoped ) then begin + itmName := GetItemName(); + end else begin + itmName := AName; + end; + len := AStore.BeginArrayRead(AName,ATypeInfo, GetStyle(),itmName); try if not Assigned(AObject) then AObject := Create(); @@ -2347,6 +2389,18 @@ begin Result := sARRAY_ITEM; end; +class function TBaseArrayRemotable.GetStyle(): TArrayStyle; +var + tri : TTypeRegistryItem; +begin + tri := GetTypeRegistry().Find(PTypeInfo(Self.ClassInfo),False); + if Assigned(tri) and AnsiSameText(sEmbedded,Trim(tri.GetExternalPropertyName(sARRAY_STYLE))) then begin + Result := asEmbeded; + end else begin + Result := asScoped; + end; +end; + procedure TBaseArrayRemotable.CheckIndex(const AIndex : Integer); begin if ( AIndex < 0 ) or ( AIndex >= Length ) then @@ -3354,7 +3408,7 @@ Var tr : TTypeRegistry; begin oldSS := AStore.GetSerializationStyle(); - AStore.BeginScopeRead(AName,ATypeInfo); + AStore.BeginObjectRead(AName,ATypeInfo); try if AStore.IsCurrentScopeNil() then Exit; // ???? FreeAndNil(AObject); @@ -3805,7 +3859,7 @@ procedure TBaseDateRemotable.Load( var strBuffer : string; begin - AStore.BeginScopeRead(AName,ATypeInfo, stObject); + AStore.BeginObjectRead(AName,ATypeInfo); try strBuffer := ''; AStore.GetScopeInnerValue(TypeInfo(string),strBuffer); diff --git a/wst/trunk/base_soap_formatter.pas b/wst/trunk/base_soap_formatter.pas index 021bac5f6..bdeb254fb 100644 --- a/wst/trunk/base_soap_formatter.pas +++ b/wst/trunk/base_soap_formatter.pas @@ -56,7 +56,8 @@ Type FNameSpace: string; FScopeObject: TDOMNode; FScopeType: TScopeType; - function GetItemsCount: Integer; + protected + function GetItemsCount() : Integer;virtual; Public constructor Create(AScopeObject : TDOMNode;AScopeType : TScopeType); function FindNode(var ANodeName : string):TDOMNode;virtual;abstract; @@ -74,14 +75,40 @@ Type function FindNode(var ANodeName : string):TDOMNode;override; End; - { TArrayStackItem } + { TAbstractArrayStackItem } - TArrayStackItem = class(TStackItem) - Private + TAbstractArrayStackItem = class(TStackItem) + private + FItemList : TDOMNodeList; FIndex : Integer; - Public + FItemName : string; + protected + procedure EnsureListCreated(); + function GetItemsCount() : Integer;override; + function CreateList(const ANodeName : string):TDOMNodeList;virtual;abstract; + public + constructor Create( + AScopeObject : TDOMNode; + const AScopeType : TScopeType; + const AItemName : string + ); + destructor Destroy();override; function FindNode(var ANodeName : string):TDOMNode;override; - End; + end; + + { TScopedArrayStackItem } + + TScopedArrayStackItem = class(TAbstractArrayStackItem) + protected + function CreateList(const ANodeName : string):TDOMNodeList;override; + end; + + { TEmbeddedArrayStackItem } + + TEmbeddedArrayStackItem = class(TAbstractArrayStackItem) + protected + function CreateList(const ANodeName : string):TDOMNodeList;override; + end; TSOAPEncodingStyle = ( Encoded, Litteral ); TSOAPDocumentStyle = ( RPC, Document ); @@ -185,7 +212,12 @@ Type ); protected function GetXmlDoc():TXMLDocument; - function PushStack(AScopeObject : TDOMNode;Const AScopeType : TScopeType = stObject):TStackItem; + function PushStack(AScopeObject : TDOMNode):TStackItem;overload; + function PushStack( + AScopeObject : TDOMNode; + const AStyle : TArrayStyle; + const AItemName : string + ):TStackItem;overload; function FindAttributeByValueInNode( Const AAttValue : String; Const ANode : TDOMNode; @@ -210,9 +242,17 @@ Type procedure ClearStack(); procedure BeginScope( Const AScopeName,ANameSpace : string; - Const ANameSpaceShortName : string = ''; - Const AScopeType : TScopeType = stObject + Const ANameSpaceShortName : string ; + Const AScopeType : TScopeType; + const AStyle : TArrayStyle ); + function InternalBeginScopeRead( + var AScopeName : string; + const ATypeInfo : PTypeInfo; + const AScopeType : TScopeType; + const AStyle : TArrayStyle; + const AItemName : string + ):Integer; procedure SetSerializationStyle(const ASerializationStyle : TSerializationStyle); function GetSerializationStyle():TSerializationStyle; @@ -234,20 +274,26 @@ Type Const ATypeInfo : PTypeInfo ); procedure BeginArray( - Const AName : string; - Const ATypeInfo : PTypeInfo; - Const AItemTypeInfo : PTypeInfo; - Const ABounds : Array Of Integer + const AName : string; + const ATypeInfo : PTypeInfo; + const AItemTypeInfo : PTypeInfo; + const ABounds : Array Of Integer; + const AStyle : TArrayStyle ); procedure NilCurrentScope(); function IsCurrentScopeNil():Boolean; procedure EndScope(); procedure AddScopeAttribute(Const AName,AValue : string); - function BeginScopeRead( - Var AScopeName : string; - Const ATypeInfo : PTypeInfo; - Const AScopeType : TScopeType = stObject + function BeginObjectRead( + var AScopeName : string; + const ATypeInfo : PTypeInfo + ) : Integer; + function BeginArrayRead( + var AScopeName : string; + const ATypeInfo : PTypeInfo; + const AStyle : TArrayStyle; + const AItemName : string ):Integer; procedure EndScopeRead(); @@ -330,26 +376,52 @@ begin Result:= ScopeObject.FindNode(ANodeName); end; -{ TArrayStackItem } +{ TAbstractArrayStackItem } -function TArrayStackItem.FindNode(var ANodeName: string): TDOMNode; -var - chdLst : TDOMNodeList; +procedure TAbstractArrayStackItem.EnsureListCreated(); begin - if not ScopeObject.HasChildNodes then - raise ESOAPException.Create('This node has no children.'); - chdLst := ScopeObject.ChildNodes; - try - if ( FIndex >= chdLst.Count ) then - raise ESOAPException.CreateFmt('Index out of bound : %d',[FIndex]); - Result:= chdLst.Item[FIndex]; - Inc(FIndex); - ANodeName := Result.NodeName; - finally - chdLst.Release(); + if ( FItemList = nil ) then begin + FItemList := CreateList(FItemName); end; end; +function TAbstractArrayStackItem.GetItemsCount(): Integer; +begin + EnsureListCreated(); + if Assigned(FItemList) then begin + Result := FItemList.Count; + end else begin + Result := 0; + end; +end; + +constructor TAbstractArrayStackItem.Create( + AScopeObject : TDOMNode; + const AScopeType : TScopeType; + const AItemName : string +); +begin + inherited Create(AScopeObject,AScopeType); + FItemName := AItemName; +end; + +destructor TAbstractArrayStackItem.Destroy(); +begin + if Assigned(FItemList) then + FItemList.Release(); + inherited Destroy(); +end; + +function TAbstractArrayStackItem.FindNode(var ANodeName: string): TDOMNode; +begin + EnsureListCreated(); + if ( FIndex >= FItemList.Count ) then + raise ESOAPException.CreateFmt('Index out of bound : %d; Node Name = "%s"',[FIndex,ANodeName]); + Result:= FItemList.Item[FIndex]; + Inc(FIndex); + ANodeName := Result.NodeName; +end; + { TSOAPBaseFormatter } procedure TSOAPBaseFormatter.ClearStack(); @@ -361,68 +433,41 @@ begin FStack.Pop().Free(); end; -function TSOAPBaseFormatter.PushStack( - AScopeObject : TDOMNode; - Const AScopeType : TScopeType -) : TStackItem; +function TSOAPBaseFormatter.PushStack(AScopeObject : TDOMNode) : TStackItem; begin - if ( AScopeType = stArray ) then - Result := FStack.Push(TArrayStackItem.Create(AScopeObject,AScopeType)) as TStackItem - else - Result := FStack.Push(TObjectStackItem.Create(AScopeObject,AScopeType)) as TStackItem; + Result := FStack.Push(TObjectStackItem.Create(AScopeObject,stObject)) as TStackItem; end; -function TSOAPBaseFormatter.BeginScopeRead( - Var AScopeName : string; - Const ATypeInfo : PTypeInfo; - Const AScopeType : TScopeType = stObject -):Integer; -Var - locNode : TDOMNode; - stk : TStackItem; - - typData : TTypeRegistryItem; - nmspc,nmspcSH : string; - strNodeName : string; +function TSOAPBaseFormatter.PushStack( + AScopeObject : TDOMNode; + const AStyle : TArrayStyle; + const AItemName : string +): TStackItem; begin - if ( Style = Document ) then begin - typData := GetTypeRegistry().Find(ATypeInfo,False); - if not Assigned(typData) then - Error('Object type not registered : %s',[IfThen(Assigned(ATypeInfo),ATypeInfo^.Name,'')]); - nmspc := typData.NameSpace; - if IsStrEmpty(nmspc) then - nmspcSH := '' - else begin - nmspcSH := FindAttributeByValueInScope(nmspc); - if not IsStrEmpty(nmspcSH) then begin - nmspcSH := Copy(nmspcSH,Length('xmlns:')+1,MaxInt); - end; - End; - if IsStrEmpty(nmspcSH) then begin - strNodeName := AScopeName - end else begin - if ( Pos(':',AScopeName) < 1 ) then - strNodeName := nmspcSH + ':' + AScopeName - else - strNodeName := AScopeName; - end; - end else begin - nmspcSH := ''; - strNodeName := AScopeName; + case AStyle of + asScoped : Result := FStack.Push(TScopedArrayStackItem.Create(AScopeObject,stArray,AItemName)) as TStackItem; + asEmbeded : Result := FStack.Push(TEmbeddedArrayStackItem.Create(AScopeObject,stArray,AItemName)) as TStackItem; + else + Assert(False); end; +end; - stk := StackTop(); - locNode := stk.FindNode(strNodeName);//(AScopeName); - If Not Assigned(locNode) Then - Error('Scope not found : "%s"',[strNodeName]);//[AScopeName]); - PushStack(locNode,AScopeType); - if ( Style = Document ) then begin - StackTop().SetNameSpace(nmspc); - end; - if locNode.HasChildNodes then - Result := GetNodeItemsCount(locNode) - else - Result := 0; +function TSOAPBaseFormatter.BeginObjectRead( + var AScopeName : string; + const ATypeInfo : PTypeInfo +): Integer; +begin + Result := InternalBeginScopeRead(AScopeName,ATypeInfo,stObject,asNone,''); +end; + +function TSOAPBaseFormatter.BeginArrayRead( + var AScopeName : string; + const ATypeInfo : PTypeInfo; + const AStyle : TArrayStyle; + const AItemName : string +): Integer; +begin + Result := InternalBeginScopeRead(AScopeName,ATypeInfo,stArray,AStyle,AItemName); end; procedure TSOAPBaseFormatter.EndScopeRead(); @@ -435,7 +480,7 @@ begin if ( FHeaderEnterCount <= 0 ) then begin Inc(FHeaderEnterCount); Prepare(); - BeginScope(sHEADER,sSOAP_ENV,sSOAP_ENV_ABR); + BeginScope(sHEADER,sSOAP_ENV,sSOAP_ENV_ABR,stObject,asNone); SetStyleAndEncoding(Document,Litteral); end; end; @@ -891,7 +936,7 @@ begin strNodeName := AName; end; - BeginScope(strNodeName,''); + BeginScope(strNodeName,'','',stObject,asNone); If mustAddAtt Then AddScopeAttribute('xmlns:'+nmspcSH, nmspc); if ( EncodingStyle = Encoded ) then begin @@ -904,10 +949,11 @@ begin end; procedure TSOAPBaseFormatter.BeginArray( - Const AName : string; - Const ATypeInfo : PTypeInfo; - Const AItemTypeInfo : PTypeInfo; - Const ABounds : Array Of Integer + const AName : string; + const ATypeInfo : PTypeInfo; + const AItemTypeInfo : PTypeInfo; + const ABounds : Array Of Integer; + const AStyle : TArrayStyle ); Var typData : TTypeRegistryItem; @@ -916,21 +962,23 @@ Var strNodeName : string; xsiNmspcSH : string; begin - If ( Length(ABounds) < 2 ) Then + if ( Length(ABounds) < 2 ) then begin Error('Invalid array bounds.'); + end; i := ABounds[0]; j := ABounds[1]; k := j - i + 1; - If ( k < 0 ) Then + if ( k < 0 ) then begin Error('Invalid array bounds.'); - k := j - i + 1; + end; typData := GetTypeRegistry().Find(ATypeInfo,False); - If Not Assigned(typData) Then + if not Assigned(typData) then begin Error('Array type not registered.'); + end; nmspc := typData.NameSpace; - If IsStrEmpty(nmspc) Then + if IsStrEmpty(nmspc) then begin nmspcSH := 'tns' - Else Begin + end else begin nmspcSH := FindAttributeByValueInScope(nmspc); if IsStrEmpty(nmspcSH) then begin nmspcSH := 'ns' + IntToStr(NextNameSpaceCounter()); @@ -938,7 +986,7 @@ begin end else begin nmspcSH := Copy(nmspcSH,Length('xmlns:')+1,MaxInt); end; - End; + end; if ( Style = Document ) then begin strNodeName := nmspcSH + ':' + AName; @@ -946,7 +994,9 @@ begin strNodeName := AName; end; - BeginScope(strNodeName,''); + if ( AStyle = asScoped ) then begin + BeginScope(strNodeName,'','',stArray,AStyle); + end; if ( EncodingStyle = Encoded ) then begin //AddScopeAttribute(sXSI_TYPE,nmspc); @@ -1002,7 +1052,8 @@ end; procedure TSOAPBaseFormatter.BeginScope( Const AScopeName,ANameSpace : string; Const ANameSpaceShortName : string; - Const AScopeType : TScopeType + Const AScopeType : TScopeType; + const AStyle : TArrayStyle ); Var nsStr, scpStr : String; @@ -1030,13 +1081,81 @@ begin GetCurrentScopeObject().AppendChild(e) Else FDoc.AppendChild(e); - PushStack(e,AScopeType); + if ( AScopeType = stObject ) then begin + PushStack(e); + end else begin + PushStack(e,AStyle,''); + end; if hasNmspc and addAtt then begin e.SetAttribute('xmlns:'+nsStr,ANameSpace); StackTop().SetNameSpace(ANameSpace); end; end; +function TSOAPBaseFormatter.InternalBeginScopeRead( + var AScopeName : string; + const ATypeInfo : PTypeInfo; + const AScopeType : TScopeType; + const AStyle : TArrayStyle; + const AItemName : string +): Integer; +var + locNode : TDOMNode; + stk : TStackItem; + typData : TTypeRegistryItem; + nmspc,nmspcSH : string; + strNodeName : string; +begin + if ( Style = Document ) then begin + typData := GetTypeRegistry().Find(ATypeInfo,False); + if not Assigned(typData) then begin + Error('Object type not registered : %s',[IfThen(Assigned(ATypeInfo),ATypeInfo^.Name,'')]); + end; + nmspc := typData.NameSpace; + if IsStrEmpty(nmspc) then begin + nmspcSH := '' + end else begin + nmspcSH := FindAttributeByValueInScope(nmspc); + if not IsStrEmpty(nmspcSH) then begin + nmspcSH := Copy(nmspcSH,Length('xmlns:')+1,MaxInt); + end; + end; + if IsStrEmpty(nmspcSH) then begin + strNodeName := AScopeName + end else begin + if ( Pos(':',AScopeName) < 1 ) then begin + strNodeName := nmspcSH + ':' + AScopeName + end else begin + strNodeName := AScopeName; + end; + end; + end else begin + nmspcSH := ''; + strNodeName := AScopeName; + end; + + stk := StackTop(); + if ( AScopeType = stObject ) or + ( ( AScopeType = stArray ) and ( AStyle = asScoped ) ) + then begin + locNode := stk.FindNode(strNodeName); + end else begin + locNode := stk.ScopeObject; + end; + if not Assigned(locNode) then begin + Error('Scope not found : "%s"',[strNodeName]); + end; + if ( AScopeType = stObject ) then begin + PushStack(locNode); + end else begin + PushStack(locNode,AStyle,AItemName); + end; + if ( Style = Document ) then begin + StackTop().SetNameSpace(nmspc); + end; + Result := StackTop().GetItemsCount(); +end; + procedure TSOAPBaseFormatter.SetSerializationStyle(const ASerializationStyle: TSerializationStyle); begin FSerializationStyle := ASerializationStyle; @@ -1073,9 +1192,9 @@ begin AnsiSameText(locDoc.DocumentElement.NodeName,( sSOAP_ENV_ABR + ':' + sENVELOPE )) then begin ClearStack(); - PushStack(locDoc.DocumentElement,stObject); + PushStack(locDoc.DocumentElement); end else begin - BeginScope(sENVELOPE,sSOAP_ENV,sSOAP_ENV_ABR); + BeginScope(sENVELOPE,sSOAP_ENV,sSOAP_ENV_ABR,stObject,asNone); AddScopeAttribute('xmlns:xsi',sXSI_NS); AddScopeAttribute('xmlns:'+sXSD, sXSD_NS); AddScopeAttribute('xmlns:'+sSOAP_ENC_ABR, sSOAP_ENC); @@ -1506,4 +1625,27 @@ begin Raise ESOAPException.CreateFmt(AMsg,AArgs); end; +{ TScopedArrayStackItem } + +function TScopedArrayStackItem.CreateList(const ANodeName : string): TDOMNodeList; +begin + if ScopeObject.HasChildNodes() then begin + Result := ScopeObject.GetChildNodes(); + end else begin + Result := nil; + end; +end; + +{ TEmbeddedArrayStackItem } + +function TEmbeddedArrayStackItem.CreateList(const ANodeName: string): TDOMNodeList; +begin + if ScopeObject.HasChildNodes() then begin + Result := TDOMNodeList.Create(ScopeObject,ANodeName); + end else begin + Result := nil; + end; +end; + + end. diff --git a/wst/trunk/binary_formatter.pas b/wst/trunk/binary_formatter.pas index 100d22d18..b95a59494 100644 --- a/wst/trunk/binary_formatter.pas +++ b/wst/trunk/binary_formatter.pas @@ -107,10 +107,10 @@ begin ClearStack(); PushStack(GetRootData(),stObject); s := 'Body'; - BeginScopeRead(s,nil); + BeginObjectRead(s,nil); s := StackTop().GetByIndex(0)^.Name; If AnsiSameText(s,'Fault') Then Begin - BeginScopeRead(s,nil,stObject); + BeginObjectRead(s,nil); e := EBaseRemoteException.Create(''); Try nme := 'faultcode'; @@ -127,9 +127,9 @@ begin Raise e; End; FCallTarget := s; - BeginScopeRead(FCallTarget,nil); + BeginObjectRead(FCallTarget,nil); FCallProcedureName := StackTop().GetByIndex(0)^.Name; - BeginScopeRead(FCallProcedureName,nil); + BeginObjectRead(FCallProcedureName,nil); end; function TBinaryFormatter.GetCallProcedureName(): String; diff --git a/wst/trunk/metadata_repository.pas b/wst/trunk/metadata_repository.pas index 972ec63fa..fc513ec4f 100644 --- a/wst/trunk/metadata_repository.pas +++ b/wst/trunk/metadata_repository.pas @@ -108,6 +108,8 @@ type ):LongInt; procedure ClearRepositoryData(var ARepository : PServiceRepository); + function Find(const AProps : PPropertyData; const APropName : string) : PPropertyData; + implementation uses wst_resources_imp, binary_streamer; diff --git a/wst/trunk/server_binary_formatter.pas b/wst/trunk/server_binary_formatter.pas index f6536502a..4b576f406 100644 --- a/wst/trunk/server_binary_formatter.pas +++ b/wst/trunk/server_binary_formatter.pas @@ -93,11 +93,11 @@ begin ClearStack(); PushStack(GetRootData(),stObject); s := 'Body'; - BeginScopeRead(s,nil); + BeginObjectRead(s,nil); FCallTarget := StackTop().GetByIndex(0)^.Name; - BeginScopeRead(FCallTarget,nil); + BeginObjectRead(FCallTarget,nil); FCallProcedureName := StackTop().GetByIndex(0)^.Name; - BeginScopeRead(FCallProcedureName,nil); + BeginObjectRead(FCallProcedureName,nil); end; function TBinaryFormatter.GetCallProcedureName(): String; diff --git a/wst/trunk/server_service_soap.pas b/wst/trunk/server_service_soap.pas index 4491194fd..31017cdda 100644 --- a/wst/trunk/server_service_soap.pas +++ b/wst/trunk/server_service_soap.pas @@ -77,19 +77,11 @@ end; procedure TSOAPFormatter.BeginCallResponse(Const AProcName,ATarget:string); begin -{ Clear(); - BeginScope('Envelope',sSOAP_ENV,'SOAP-ENV'); - AddScopeAttribute('xmlns:xsi',sXSI_NS); - AddScopeAttribute('xmlns:'+sXSD, sXSD_NS); - AddScopeAttribute('xmlns:'+sSOAP_ENC_ABR, sSOAP_ENC); - BeginScope('Body',sSOAP_ENV); - BeginScope(AProcName + 'Response',ATarget); -} Clear(); Prepare(); WriteHeaders(FCallContext); - BeginScope('Body',sSOAP_ENV); - BeginScope(AProcName + 'Response',ATarget); + BeginScope('Body',sSOAP_ENV,'',stObject,asNone); + BeginScope(AProcName + 'Response',ATarget,'',stObject,asNone); end; procedure TSOAPFormatter.EndCallResponse(); @@ -131,7 +123,7 @@ begin hdrNd := bdyNd; bdyNd := hdrNd.NextSibling; if SameText(hdrNd.NodeName,eltName) then begin - PushStack(hdrNd,stArray).SetNameSpace(sSOAP_ENV); + PushStack(hdrNd,asScoped,'').SetNameSpace(sSOAP_ENV); ReadHeaders(FCallContext); PopStack().Free(); end; @@ -184,11 +176,11 @@ begin Else m := AErrorMsg; Clear(); - BeginScope('Envelope',sSOAP_ENV,'SOAP-ENV'); + BeginScope('Envelope',sSOAP_ENV,'SOAP-ENV',stObject,asNone); AddScopeAttribute('xmlns:xsi',sXSI_NS); AddScopeAttribute('xmlns:'+sXSD, sXSD_NS); - BeginScope('Body',sSOAP_ENV); - BeginScope('Fault',sSOAP_ENV); + BeginScope('Body',sSOAP_ENV,'',stObject,asNone); + BeginScope('Fault',sSOAP_ENV,'',stObject,asNone); Put('faultcode',TypeInfo(string),c); Put('faultstring',TypeInfo(string),m); end; diff --git a/wst/trunk/service_intf.pas b/wst/trunk/service_intf.pas index 09f756c44..14e5c6ad8 100644 --- a/wst/trunk/service_intf.pas +++ b/wst/trunk/service_intf.pas @@ -105,9 +105,7 @@ Type // ---- END >> ICallContext implementation ---- procedure ClearHeaders(const ADirection : THeaderDirection); public - (* This is the primary constructor! - Objects passed by the parameter "AProtocol" will be freed by - this instance( the new one create by this constructor call ). *) + (* This is the primary constructor! *) constructor Create( Const ATarget : String; // the target service Const AProtocol : IServiceProtocol diff --git a/wst/trunk/soap_formatter.pas b/wst/trunk/soap_formatter.pas index fc628d84d..3426e5c52 100644 --- a/wst/trunk/soap_formatter.pas +++ b/wst/trunk/soap_formatter.pas @@ -90,15 +90,11 @@ procedure TSOAPFormatter.BeginCall( ACallContext : ICallContext ); begin - //BeginScope('Envelope',sSOAP_ENV,sSOAP_ENV_ABR); - //AddScopeAttribute('xmlns:xsi',sXSI_NS); - //AddScopeAttribute('xmlns:'+sXSD, sXSD_NS); - //AddScopeAttribute('xmlns:'+sSOAP_ENC_ABR, sSOAP_ENC); - Prepare(); - WriteHeaders(ACallContext); - BeginScope('Body',sSOAP_ENV); - if ( Style = RPC ) then - BeginScope(AProcName,ATarget); + Prepare(); + WriteHeaders(ACallContext); + BeginScope('Body',sSOAP_ENV,'',stObject,asNone); + if ( Style = RPC ) then + BeginScope(AProcName,ATarget,'',stObject,asNone); FCallTarget := ATarget; FCallProcedureName := AProcName; @@ -146,7 +142,7 @@ begin hdrNd := bdyNd; bdyNd := hdrNd.NextSibling; if SameText(hdrNd.NodeName,eltName) then begin - PushStack(hdrNd,stArray).SetNameSpace(sSOAP_ENV); + PushStack(hdrNd,asScoped,'').SetNameSpace(sSOAP_ENV); ReadHeaders(ACallContext); PopStack().Free(); end; diff --git a/wst/trunk/synapse_http_protocol.pas b/wst/trunk/synapse_http_protocol.pas index c1db5524d..1a30b73c6 100644 --- a/wst/trunk/synapse_http_protocol.pas +++ b/wst/trunk/synapse_http_protocol.pas @@ -13,7 +13,7 @@ unit synapse_http_protocol; {$mode objfpc}{$H+} -//{$DEFINE WST_DBG} +{$DEFINE WST_DBG} interface diff --git a/wst/trunk/tests/ebay/test_ebay_gui.lpi b/wst/trunk/tests/ebay/test_ebay_gui.lpi index 237794e0a..79cd031a1 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,59 +41,59 @@ - - + + - + - - - + + + - - - - + + + + - - - - + + + + - - - + + + - - - + + + - - - - + + + + @@ -111,10 +111,10 @@ - - - - + + + + @@ -127,10 +127,10 @@ - - - - + + + + @@ -140,10 +140,10 @@ - - - - + + + + @@ -253,17 +253,17 @@ - - + + - - - - + + + + @@ -285,45 +285,53 @@ - - - - + - - - + + + + + + + + + + + + + + - + - - + + - - + + - - + + - - + + @@ -331,68 +339,8 @@ - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -418,7 +366,7 @@ - + @@ -457,8 +405,12 @@ - + + + + + diff --git a/wst/trunk/tests/ebay/umain.pas b/wst/trunk/tests/ebay/umain.pas index e05af0c78..c0b0e983e 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; + Buttons, StdCtrls, ComCtrls, eBayWSDL; type @@ -85,7 +85,7 @@ begin end; except on e : ESOAPException do begin - ShowMessageFmt('SOAP EXCEPTION Code : "%s"; String = "%s"',[e.FaultCode,e.FaultString]); + ShowMessageFmt('SOAP EXCEPTION Code : "%s"; String = "%s"; Msg : '#13'%s',[e.FaultCode,e.FaultString,e.Message]); end; end; end; @@ -166,7 +166,7 @@ begin end; except on e : ESOAPException do begin - ShowMessageFmt('SOAP EXCEPTION Code : "%s"; String = "%s"',[e.FaultCode,e.FaultString]); + ShowMessageFmt('SOAP EXCEPTION Code : "%s"; String = "%s"; Msg : '#13'%s',[e.FaultCode,e.FaultString,e.Message]); end; end; end; diff --git a/wst/trunk/tests/google_api/test_google_api.lpi b/wst/trunk/tests/google_api/test_google_api.lpi index 49b7d121c..f5df8c6a4 100644 --- a/wst/trunk/tests/google_api/test_google_api.lpi +++ b/wst/trunk/tests/google_api/test_google_api.lpi @@ -12,7 +12,7 @@ - + @@ -180,9 +180,11 @@ - - + + + + @@ -230,7 +232,7 @@ - + @@ -239,16 +241,16 @@ - + - - - + + + @@ -276,9 +278,11 @@ - - + + + + @@ -354,7 +358,7 @@ - + @@ -364,7 +368,7 @@ - + @@ -372,16 +376,21 @@ - + + - + - - + + + + + + diff --git a/wst/trunk/tests/http_server/wst_http_server.lpi b/wst/trunk/tests/http_server/wst_http_server.lpi index f5e331308..8cc370289 100644 --- a/wst/trunk/tests/http_server/wst_http_server.lpi +++ b/wst/trunk/tests/http_server/wst_http_server.lpi @@ -12,6 +12,7 @@ + @@ -43,9 +44,11 @@ - - + + + + @@ -244,9 +247,11 @@ - - + + + + @@ -431,9 +436,11 @@ - - + + + + @@ -464,9 +471,11 @@ - - + + + + @@ -545,7 +554,64 @@ - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -572,31 +638,27 @@ - + - - + + - + - + - + - - - - - + diff --git a/wst/trunk/tests/metadata_browser/metadata_browser.lpi b/wst/trunk/tests/metadata_browser/metadata_browser.lpi index 09f721d46..223139469 100644 --- a/wst/trunk/tests/metadata_browser/metadata_browser.lpi +++ b/wst/trunk/tests/metadata_browser/metadata_browser.lpi @@ -7,6 +7,7 @@ + @@ -40,9 +41,11 @@ - + + + diff --git a/wst/trunk/tests/test_suite/testformatter_unit.pas b/wst/trunk/tests/test_suite/testformatter_unit.pas index 2cf342c44..2c589b04c 100644 --- a/wst/trunk/tests/test_suite/testformatter_unit.pas +++ b/wst/trunk/tests/test_suite/testformatter_unit.pas @@ -277,6 +277,8 @@ type property Val_Currency : Currency Read FVal_Currency Write FVal_Currency; End; + TEmbeddedArrayOfStringRemotable = class(TArrayOfStringRemotable); + { TTestFormatterSimpleType } TTestFormatterSimpleType= class(TTestCase) @@ -320,6 +322,7 @@ type procedure Test_Object(); procedure Test_Object_Nil(); procedure Test_StringArray(); + procedure Test_StringArray_Embedded(); procedure Test_StringArrayZeroLength(); procedure Test_BooleanArray(); @@ -458,7 +461,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'intVal_U'; f.Get(TypeInfo(Byte),x,intVal_U); x := 'intVal_S'; @@ -496,7 +499,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(Byte),intVal_U); f.EndScopeRead(); AssertEquals(VAL_1,intVal_U); @@ -515,7 +518,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(ShortInt),intVal_S); f.EndScopeRead(); AssertEquals(VAL_2,intVal_S); @@ -552,7 +555,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'intVal_U'; f.Get(TypeInfo(Word),x,intVal_U); x := 'intVal_S'; @@ -594,7 +597,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'intVal_U'; f.Get(TypeInfo(LongWord),x,intVal_U); x := 'intVal_S'; @@ -636,7 +639,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'intVal_U'; f.Get(TypeInfo(QWord),x,intVal_U); x := 'intVal_S'; @@ -675,7 +678,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Float),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Float)); x := 'tmpVal'; f.Get(TypeInfo(Single),x,tmpVal); f.EndScopeRead(); @@ -711,7 +714,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Float),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Float)); x := 'tmpVal'; f.Get(TypeInfo(Double),x,tmpVal); f.EndScopeRead(); @@ -747,7 +750,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Float),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Float)); x := 'tmpVal'; f.Get(TypeInfo(Currency),x,tmpVal); f.EndScopeRead(); @@ -783,7 +786,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Float),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Float)); x := 'tmpVal'; f.Get(TypeInfo(Extended),x,tmpVal); f.EndScopeRead(); @@ -822,7 +825,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'intVal_1'; f.Get(TypeInfo(string),x,intVal_1); x := 'intVal_3'; @@ -864,7 +867,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'intVal_1'; f.Get(TypeInfo(Boolean),x,intVal_1); x := 'intVal_3'; @@ -906,7 +909,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'intVal_1'; f.Get(TypeInfo(TTestEnum),x,intVal_1); x := 'intVal_3'; @@ -954,7 +957,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'o1'; f.Get(TypeInfo(TClass_Int),x,a); f.EndScopeRead(); @@ -1003,7 +1006,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Float),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Float)); x := 'o1'; f.Get(TypeInfo(TClass_Float),x,a); f.EndScopeRead(); @@ -1046,7 +1049,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Enum),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Enum)); x := 'o1'; f.Get(TypeInfo(TClass_Enum),x,a); f.EndScopeRead(); @@ -1106,7 +1109,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'o1'; f.Get(TypeInfo(TClass_CplxSimpleContent),x,a); x := 'ns'; @@ -1179,7 +1182,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'o1'; f.Get(TypeInfo(TClass_CplxSimpleContent),x,a); x := 'ns'; @@ -1252,7 +1255,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'o1'; f.Get(TypeInfo(TClass_CplxSimpleContent),x,a); x := 'ns'; @@ -1325,7 +1328,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'o1'; f.Get(TypeInfo(TClass_CplxSimpleContent),x,a); x := 'ns'; @@ -1404,7 +1407,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'o1'; f.Get(TypeInfo(TClass_CplxSimpleContent),x,a); x := 'ns'; @@ -1471,7 +1474,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'o1'; f.Get(TypeInfo(TClass_CplxSimpleContent),x,a); x := 'ns'; @@ -1521,7 +1524,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'o1'; f.Get(TypeInfo(TClass_B),x,a); f.EndScopeRead(); @@ -1567,7 +1570,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'o1'; f.Get(TypeInfo(TClass_B),x,a); f.EndScopeRead(); @@ -1614,7 +1617,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfStringRemotable),x,a); f.EndScopeRead(); @@ -1629,6 +1632,82 @@ begin end; end; +procedure TTestFormatter.Test_StringArray_Embedded(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of string = ('AzErTy','QwErTy','123456','','1'); +var + a : TArrayOfStringRemotable; + b : TEmbeddedArrayOfStringRemotable; + i, intVal : Integer; + f : IFormatterBase; + s : TMemoryStream; + x : string; +begin + b := nil; + a := TArrayOfStringRemotable.Create(); + try + b := TEmbeddedArrayOfStringRemotable.Create(); + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals('Length 1', 0,a.Length); + + a.SetLength(AR_LEN); + AssertEquals(AR_LEN,a.Length); + + b.SetLength(AR_LEN); + AssertEquals(AR_LEN,b.Length); + + for i := 0 to Pred(AR_LEN) do begin + a[i] := VAL_AR[i]; + b[i] := VAL_AR[Pred(AR_LEN)-i]; + end; + + intVal := 1210; + + f := CreateFormatter(TypeInfo(TClass_B)); + f.BeginObject('Root',TypeInfo(TClass_B)); + f.Put('a',TypeInfo(TArrayOfStringRemotable),a); + f.Put('x',TypeInfo(Integer),intVal); + f.Put('b',TypeInfo(TEmbeddedArrayOfStringRemotable),b); + f.EndScope(); + s := TMemoryStream.Create(); + f.SaveToStream(s); s.SaveToFile(ClassName + '.XML'); + FreeAndNil(a); + FreeAndNil(b); + intVal := 0; + a := TArrayOfStringRemotable.Create(); + b := TEmbeddedArrayOfStringRemotable.Create(); + a.SetLength(0); + a.SetLength(0); + a.SetLength(0); + b.SetLength(0); + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginObjectRead(x,TypeInfo(TClass_B)); + x := 'a'; + f.Get(TypeInfo(TArrayOfStringRemotable),x,a); + x := 'x'; + f.Get(TypeInfo(Integer),x,intVal); + x := 'b'; + f.Get(TypeInfo(TEmbeddedArrayOfStringRemotable),x,b); + f.EndScopeRead(); + AssertEquals('IntVal', 1210,intVal); + AssertEquals('Length 2', AR_LEN,a.Length); + AssertEquals('Length 2', AR_LEN,b.Length); + + for i := 0 to Pred(AR_LEN) do begin + AssertEquals(VAL_AR[i],a[i]); + AssertEquals(VAL_AR[Pred(AR_LEN)-i],b[i]); + end; + + finally + b.Free(); + a.Free(); + s.Free(); + end; +end; + procedure TTestFormatter.Test_StringArrayZeroLength(); var a : TArrayOfStringRemotable; @@ -1652,7 +1731,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfStringRemotable),x,a); f.EndScopeRead(); @@ -1700,7 +1779,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfBooleanRemotable),x,a); f.EndScopeRead(); @@ -1750,7 +1829,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfInt8URemotable),x,a); f.EndScopeRead(); @@ -1800,7 +1879,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfInt8SRemotable),x,a); f.EndScopeRead(); @@ -1850,7 +1929,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfInt16SRemotable),x,a); f.EndScopeRead(); @@ -1900,7 +1979,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfInt16URemotable),x,a); f.EndScopeRead(); @@ -1950,7 +2029,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfInt32URemotable),x,a); f.EndScopeRead(); @@ -2000,7 +2079,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfInt32SRemotable),x,a); f.EndScopeRead(); @@ -2050,7 +2129,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfInt64SRemotable),x,a); f.EndScopeRead(); @@ -2100,7 +2179,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfInt64URemotable),x,a); f.EndScopeRead(); @@ -2150,7 +2229,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfFloatSingleRemotable),x,a); f.EndScopeRead(); @@ -2200,7 +2279,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfFloatDoubleRemotable),x,a); f.EndScopeRead(); @@ -2250,7 +2329,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfFloatExtendedRemotable),x,a); f.EndScopeRead(); @@ -2300,7 +2379,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfFloatCurrencyRemotable),x,a); f.EndScopeRead(); @@ -2347,7 +2426,7 @@ begin s.Position := 0; f.LoadFromStream(s); x := 'Root'; - f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'a'; f.Get(TypeInfo(TComplexInt32SContentRemotable),x,a); x := 'b'; @@ -3008,6 +3087,10 @@ initialization TClass_CplxSimpleContent.RegisterAttributeProperty('Elt_Exemple'); GetTypeRegistry().Register(sXSD_NS,TypeInfo(TClass_CplxSimpleContent),'TClass_CplxSimpleContent').RegisterExternalPropertyName('Elt_Exemple', 'published'); + with GetTypeRegistry().Register(sWST_BASE_NS,TypeInfo(TEmbeddedArrayOfStringRemotable),'TEmbeddedArrayOfStringRemotable') do begin + RegisterExternalPropertyName(sARRAY_ITEM,'abc'); + RegisterExternalPropertyName(sARRAY_STYLE,sEmbedded); + end; RegisterTest(TTestArray); RegisterTest(TTestSOAPFormatter); diff --git a/wst/trunk/tests/test_suite/wst_test_suite.lpi b/wst/trunk/tests/test_suite/wst_test_suite.lpi index a79a6e53f..dd8751355 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite.lpi +++ b/wst/trunk/tests/test_suite/wst_test_suite.lpi @@ -7,7 +7,7 @@ - + @@ -40,9 +40,9 @@ - - - + + + @@ -50,24 +50,28 @@ - - + + + + - - + + + + - - + + @@ -76,12 +80,12 @@ - - + + - + @@ -89,8 +93,8 @@ - - + + @@ -99,9 +103,11 @@ - - + + + + @@ -115,26 +121,26 @@ - - + + + + - - + - - + @@ -142,9 +148,7 @@ - - @@ -160,21 +164,19 @@ - - - - - + + + @@ -183,13 +185,13 @@ - + - + @@ -197,45 +199,45 @@ - + - + - + - + - + - + - + @@ -244,60 +246,60 @@ - + - + - + - + - - - + + + - + - + - + - + @@ -305,152 +307,34 @@ - - - + - + - + - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/wst/trunk/ws_helper/command_line_parser.pas b/wst/trunk/ws_helper/command_line_parser.pas index 1f4a0bfbb..957735b08 100644 --- a/wst/trunk/ws_helper/command_line_parser.pas +++ b/wst/trunk/ws_helper/command_line_parser.pas @@ -49,16 +49,19 @@ begin end; function ParseCmdLineOptions(out AAppOptions : TComandLineOptions):Integer; -Var +var c : Char; - begin AAppOptions := []; c := #0; - Repeat - c := GetOpt('upibo:a:'); + repeat + c := GetOpt('u:pibo:a:'); case c of - 'u' : Include(AAppOptions,cloInterface); + 'u' : + begin + Include(AAppOptions,cloInterface); + OptionsArgsMAP[cloInterface] := OptArg; + end; 'p' : Include(AAppOptions,cloProxy); 'i' : Include(AAppOptions,cloImp); 'b' : Include(AAppOptions,cloBinder); @@ -73,7 +76,7 @@ begin OptionsArgsMAP[cloOutPutDirAbsolute] := OptArg; End; end; - Until ( c = EndOfOptions ); + until ( c = EndOfOptions ); Result := OptInd; end; diff --git a/wst/trunk/ws_helper/generator.pas b/wst/trunk/ws_helper/generator.pas index 2c7c87b61..1f0037fd0 100644 --- a/wst/trunk/ws_helper/generator.pas +++ b/wst/trunk/ws_helper/generator.pas @@ -401,8 +401,7 @@ Var Indent();WriteLn('%s : %s;',[sLOC_SERIALIZER,sSERIALIZER_CLASS]); Indent();WriteLn('%s : %s;',[sPRM_NAME,'string']); - //If ( AMthd.MethodType = mtFunction ) Then - //Indent();WriteLn('%s : %s;',[sRES_TYPE_INFO,'PTypeInfo']); + WriteLn('Begin'); Indent();WriteLn('%s := GetSerializer();',[sLOC_SERIALIZER]); @@ -1302,6 +1301,9 @@ procedure TInftGenerator.GenerateIntf(AIntf: TInterfaceDefinition); begin Indent(); WriteLn('%s = interface',[GenerateIntfName(AIntf)]); + if not IsStrEmpty(AIntf.InterfaceGUID) then begin + Indent();Indent();WriteLn('[%s]',[QuotedStr(AIntf.InterfaceGUID)]); + end; end; procedure WriteMethod(AMthd : TMethodDefinition); @@ -1759,8 +1761,16 @@ 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.Indent(); FImpTempStream.WriteLn( - 'GetTypeRegistry().ItemByTypeInfo[%s].RegisterExternalPropertyName(''item'',%s);', + 'GetTypeRegistry().ItemByTypeInfo[TypeInfo(%s)].RegisterExternalPropertyName(sARRAY_ITEM,%s);', + [ASymbol.Name,QuotedStr(ASymbol.ItemExternalName)] + ); + end; + if ( ASymbol.Style = asEmbeded ) then begin + FImpTempStream.Indent(); + FImpTempStream.WriteLn( + 'GetTypeRegistry().ItemByTypeInfo[TypeInfo(%s)].RegisterExternalPropertyName(sARRAY_STYLE,sEmbedded);', [ASymbol.Name,QuotedStr(ASymbol.ItemExternalName)] ); end; diff --git a/wst/trunk/ws_helper/parserdefs.pas b/wst/trunk/ws_helper/parserdefs.pas index d92052bdf..1e73f748b 100644 --- a/wst/trunk/ws_helper/parserdefs.pas +++ b/wst/trunk/ws_helper/parserdefs.pas @@ -43,6 +43,7 @@ Type FName: String; FExternalAlias : string; protected + procedure SetName(const AName : string);virtual; procedure FixForwardTypeDefinitions( AFrw : TForwardTypeDefinition; Atype : TTypeDefinition @@ -129,6 +130,8 @@ Type TForwardTypeDefinition = class(TTypeDefinition) end; + TArrayStyle = ( asScoped, asEmbeded ); + { TArrayDefinition } TArrayDefinition = class(TTypeDefinition) @@ -136,6 +139,7 @@ Type FItemExternalName: string; FItemName: string; FItemType: TTypeDefinition; + FStyle: TArrayStyle; protected procedure FixForwardTypeDefinitions( AFrw : TForwardTypeDefinition; @@ -146,12 +150,14 @@ Type const AName : string; AItemType : TTypeDefinition; const AItemName, - AItemExternalName : string + AItemExternalName : string; + const AStyle : TArrayStyle ); function NeedFinalization():Boolean;override; property ItemName : string read FItemName; property ItemType : TTypeDefinition read FItemType; property ItemExternalName : string read FItemExternalName; + property Style : TArrayStyle read FStyle; end; TEnumTypeDefinition = class; @@ -298,8 +304,8 @@ Type private FMethodType: TMethodType; FParameterList : TObjectList; - private FProperties: TStrings; + private function GetParameter(Index: Integer): TParameterDefinition; function GetParameterCount: Integer; protected @@ -460,6 +466,11 @@ begin Result := AnsiSameText(AName,Self.Name) or AnsiSameText(AName,Self.ExternalName); end; +procedure TAbstractSymbolDefinition.SetName(const AName: string); +begin + FName := AName; +end; + procedure TAbstractSymbolDefinition.FixForwardTypeDefinitions( AFrw : TForwardTypeDefinition; Atype : TTypeDefinition @@ -1280,11 +1291,13 @@ constructor TArrayDefinition.Create( const AName : string; AItemType : TTypeDefinition; const AItemName, - AItemExternalName : string + AItemExternalName : string; + const AStyle : TArrayStyle ); begin Assert(Assigned(AItemType)); inherited Create(AName); + FStyle := AStyle; FItemType := AItemType; FItemName := AItemName; FItemExternalName := AItemExternalName; diff --git a/wst/trunk/ws_helper/test_ebay.bat b/wst/trunk/ws_helper/test_ebay.bat index bfc3dc979..e65bc8622 100644 --- a/wst/trunk/ws_helper/test_ebay.bat +++ b/wst/trunk/ws_helper/test_ebay.bat @@ -1 +1 @@ -C:\Programmes\lazarus\wst\ws_helper\ws_helper -u -i -p -b -a"C:\Programmes\lazarus\wst\tests\files" "C:\Programmes\lazarus\utils\eBayLast\eBayWSDL.WSDL" >test_res_eBayWSDL.txt \ No newline at end of file +C:\Programmes\lazarus\wst\ws_helper\ws_helper -uA -i -p -b -a"C:\Programmes\lazarus\wst\tests\files" "C:\Programmes\lazarus\utils\eBayLast\eBayWSDL.WSDL" >test_res_eBayWSDL.txt \ No newline at end of file diff --git a/wst/trunk/ws_helper/ws_helper.lpi b/wst/trunk/ws_helper/ws_helper.lpi index 42db46c37..778cc2591 100644 --- a/wst/trunk/ws_helper/ws_helper.lpi +++ b/wst/trunk/ws_helper/ws_helper.lpi @@ -33,13 +33,13 @@ - + - - + + @@ -50,7 +50,7 @@ - + @@ -58,15 +58,15 @@ - - + + - - + + - + @@ -74,9 +74,9 @@ - - - + + + @@ -86,7 +86,7 @@ - + @@ -177,9 +177,11 @@ - - + + + + @@ -187,8 +189,8 @@ - - + + @@ -197,7 +199,7 @@ - + @@ -268,7 +270,7 @@ - + @@ -286,9 +288,9 @@ - - - + + + @@ -314,7 +316,7 @@ - + @@ -334,17 +336,17 @@ - - + + - - - - + + + + @@ -381,137 +383,31 @@ - - - - + + + + - + + + + + + + - + - - + + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -550,7 +446,7 @@ - + @@ -563,10 +459,6 @@ - - - - diff --git a/wst/trunk/ws_helper/ws_helper.pas b/wst/trunk/ws_helper/ws_helper.pas index 6a7c62fcf..c55996d79 100644 --- a/wst/trunk/ws_helper/ws_helper.pas +++ b/wst/trunk/ws_helper/ws_helper.pas @@ -29,8 +29,9 @@ uses DOM, xmlread, wsdl2pas_imp; resourcestring - sUSAGE = 'ws_helper [-u] [-p] [-b] [-i] [-oPATH] inputFilename' + sNEW_LINE + - ' -u Generate the pascal translation of the WSDL input file ' + sNEW_LINE + + sUSAGE = 'ws_helper [-uMODE] [-p] [-b] [-i] [-oPATH] inputFilename' + sNEW_LINE + + ' -u MODE Generate the pascal translation of the WSDL input file ' + sNEW_LINE + + ' MODE value may be U for used types or A for all types' + sNEW_LINE + ' -p Generate service proxy' + sNEW_LINE + ' -b Generate service binder' + sNEW_LINE + ' -i Generate service minimal implementation' + sNEW_LINE + @@ -51,12 +52,14 @@ Var NextParam : Integer; sourceType : TSourceFileType; symtable : TSymbolTable; + parserMode : TParserMode; function ProcessCmdLine():boolean; begin NextParam := ParseCmdLineOptions(AppOptions); - If ( NextParam <= Paramcount ) Then + if ( NextParam <= Paramcount ) then begin inFileName := ParamStr(NextParam); + end; Result := FileExists(ExpandFileName(inFileName)); if AnsiSameText(ExtractFileExt(inFileName),'.PAS') or AnsiSameText(ExtractFileExt(inFileName),'.PP') @@ -65,11 +68,13 @@ Var end else if AnsiSameText(ExtractFileExt(inFileName),'.WSDL') then begin sourceType := sftWSDL; end; - If Result Then Begin - If ( AppOptions = [] ) Then + if Result then begin + if ( AppOptions = [] ) then begin Include(AppOptions,cloProxy); - End Else + end; + end else begin errStr := Format('File not Found : "%s"',[inFileName]); + end; if ( cloOutPutDirAbsolute in AppOptions ) then begin outPath := Trim(GetOptionArg(cloOutPutDirAbsolute)); end else begin @@ -79,6 +84,10 @@ Var end; end; outPath := IncludeTrailingPathDelimiter(outPath); + parserMode := pmUsedTypes; + if AnsiSameText('A',Trim(GetOptionArg(cloInterface))) then begin + parserMode := pmAllTypes; + end; end; function GenerateSymbolTable() : Boolean ; @@ -110,7 +119,7 @@ Var ReadXMLFile(locDoc,inFileName); try prsr := TWsdlParser.Create(locDoc,symtable); - prsr.Parse(); + prsr.Parse(parserMode); finally FreeAndNil(prsr); FreeAndNil(locDoc); diff --git a/wst/trunk/ws_helper/wsdl2pas_imp.pas b/wst/trunk/ws_helper/wsdl2pas_imp.pas index 021c93d45..a8f20fea6 100644 --- a/wst/trunk/ws_helper/wsdl2pas_imp.pas +++ b/wst/trunk/ws_helper/wsdl2pas_imp.pas @@ -81,6 +81,8 @@ type function Parse():TTypeDefinition;override; end; + TParserMode = ( pmUsedTypes, pmAllTypes ); + { TWsdlParser } TWsdlParser = class @@ -122,10 +124,11 @@ type const ASoapBindingStyle : string ) : TMethodDefinition; function ParseType(const AName, ATypeOrElement : string) : TTypeDefinition; + procedure ParseTypes(); public constructor Create(ADoc : TXMLDocument; ASymbols : TSymbolTable); destructor Destroy();override; - procedure Parse(); + procedure Parse(const AMode : TParserMode); property SymbolTable : TSymbolTable read FSymbols; end; @@ -449,8 +452,22 @@ end; procedure TWsdlParser.ParsePort(ANode: TDOMNode); function FindBindingNode(const AName : WideString):TDOMNode; + var + crs : IObjectCursor; begin Result := FindNamedNode(FBindingCursor,AName); + if Assigned(Result) then begin + crs := CreateChildrenCursor(Result,cetRttiNode); + if Assigned(crs) then begin + crs := CreateCursorOn(crs,ParseFilter(CreateQualifiedNameFilterStr(s_binding,FSoapShortNames),TDOMNodeRttiExposer)); + crs.Reset(); + if not crs.MoveNext() then begin + Result := nil; + end; + end else begin + Result := nil; + end; + end; end; function ExtractBindingQName(out AName : WideString):Boolean ; @@ -619,6 +636,7 @@ var locSoapBindingStyle : string; locWStrBuffer : WideString; locMthd : TMethodDefinition; + inft_guid : TGuid; begin locAttCursor := CreateAttributesCursor(ANode,cetRttiNode); locCursor := CreateCursorOn(locAttCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer)); @@ -634,6 +652,8 @@ begin raise; end; Result := locIntf; + if ( CreateGUID(inft_guid) = 0 ) then + locIntf.InterfaceGUID := GUIDToString(inft_guid); locCursor := CreateChildrenCursor(ANode,cetRttiNode); if Assigned(locCursor) then begin locOpCursor := CreateCursorOn(locCursor,ParseFilter(CreateQualifiedNameFilterStr(s_operation,FWsdlShortNames),TDOMNodeRttiExposer)); @@ -653,34 +673,12 @@ end; type - { TParamDefCrack } + TParamDefCrack = class(TParameterDefinition); - TParamDefCrack = class(TParameterDefinition) - public - procedure SetModifier(const AModifier : TParameterModifier); - end; - - { TMethodDefinitionCrack } - - TMethodDefinitionCrack = class(TMethodDefinition) - public - procedure SetMethodType( AMethodType : TMethodType ); - end; - -{ TMethodDefinitionCrack } - -procedure TMethodDefinitionCrack.SetMethodType(AMethodType: TMethodType); -begin - inherited; -end; - -{ TParamDefCrack } - -procedure TParamDefCrack.SetModifier(const AModifier: TParameterModifier); -begin - inherited; -end; + TMethodDefinitionCrack = class(TMethodDefinition); + TTypeDefinitionCrack = class(TTypeDefinition); + function TWsdlParser.ParseOperation( AOwner : TInterfaceDefinition; ANode : TDOMNode; @@ -764,10 +762,11 @@ function TWsdlParser.ParseOperation( inMsg, strBuffer : string; inMsgNode, tmpNode : TDOMNode; crs, tmpCrs : IObjectCursor; - prmName, prmTypeName, prmTypeType : string; + prmName, prmTypeName, prmTypeType, prmTypeInternalName : string; prmInternameName : string; prmHasInternameName : Boolean; prmDef : TParameterDefinition; + prmTypeDef : TTypeDefinition; begin if ExtractMsgName(s_input,inMsg) then begin inMsgNode := FindMessageNode(inMsg); @@ -775,18 +774,20 @@ function TWsdlParser.ParseOperation( crs := CreatePartCursor(inMsgNode); if ( crs <> nil ) then begin crs.Reset(); - While crs.MoveNext() do begin + while crs.MoveNext() do begin tmpNode := (crs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; - if ( tmpNode.Attributes = nil ) or ( tmpNode.Attributes.Length < 1 ) then + if ( tmpNode.Attributes = nil ) or ( tmpNode.Attributes.Length < 1 ) then begin raise EWslParserException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]); + end; strBuffer := s_NODE_NAME + '=' + QuotedStr(s_name); tmpCrs := CreateCursorOn( CreateAttributesCursor(tmpNode,cetRttiNode), ParseFilter(strBuffer,TDOMNodeRttiExposer) ); tmpCrs.Reset(); - if not tmpCrs.MoveNext() then + if not tmpCrs.MoveNext() then begin raise EWslParserException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]); + end; prmName := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue; strBuffer := s_NODE_NAME + '=' + QuotedStr(s_element) + ' or ' + s_NODE_NAME + ' = ' + QuotedStr(s_type); tmpCrs := CreateCursorOn( @@ -794,20 +795,31 @@ function TWsdlParser.ParseOperation( ParseFilter(strBuffer,TDOMNodeRttiExposer) ); tmpCrs.Reset(); - if not tmpCrs.MoveNext() then + if not tmpCrs.MoveNext() then begin raise EWslParserException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]); + end; prmTypeName := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue; prmTypeType := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeName; - if IsStrEmpty(prmName) or IsStrEmpty(prmTypeName) or IsStrEmpty(prmTypeType) then + if IsStrEmpty(prmName) or IsStrEmpty(prmTypeName) or IsStrEmpty(prmTypeType) then begin raise EWslParserException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]); + end; prmInternameName := Trim(prmName); prmHasInternameName := IsReservedKeyWord(prmInternameName) or ( not IsValidIdent(prmInternameName) ); - if prmHasInternameName then + if prmHasInternameName then begin prmInternameName := '_' + prmInternameName; - prmDef := tmpMthd.AddParameter(prmInternameName,pmConst,GetDataType(prmTypeName,prmTypeType)); + end; + prmTypeDef := GetDataType(prmTypeName,prmTypeType); + prmDef := tmpMthd.AddParameter(prmInternameName,pmConst,prmTypeDef); if prmHasInternameName then begin prmDef.RegisterExternalAlias(prmName); end; + if AnsiSameText(tmpMthd.Name,prmTypeDef.Name) then begin + prmTypeInternalName := prmTypeDef.Name + 'Type'; + while ( FSymbols.IndexOf(prmTypeInternalName) >= 0 ) do begin + prmTypeInternalName := '_' + prmTypeInternalName; + end; + TTypeDefinitionCrack(prmTypeDef).SetName(prmTypeInternalName); + end; end; end; end; @@ -1010,7 +1022,7 @@ var begin embededType := False; Result := FSymbols.Find(ExtractNameFromQName(AName),TTypeDefinition) as TTypeDefinition; - if ( not Assigned(Result) )or ( Result is TForwardTypeDefinition ) then begin + if ( not Assigned(Result) ) or ( Result is TForwardTypeDefinition ) then begin Result := nil; Init(); FindTypeNode(); @@ -1024,6 +1036,51 @@ begin end; end; +procedure TWsdlParser.ParseTypes(); +var + locTypeCrs : IObjectCursor; + locObj : TDOMNodeRttiExposer; + nd : TDOMNodeRttiExposer; + schmCrsr, crsSchemaChild, typTmpCrs : IObjectCursor; + typFilterStr : string; + typNode : TDOMNode; +begin + if Assigned(FSchemaCursor) then begin + schmCrsr := FSchemaCursor.Clone() as IObjectCursor; + schmCrsr.Reset(); + while schmCrsr.MoveNext() do begin + nd := schmCrsr.GetCurrent() as TDOMNodeRttiExposer; + crsSchemaChild := CreateChildrenCursor(nd.InnerObject,cetRttiNode); + if Assigned(crsSchemaChild) then begin + typFilterStr := Format( + '%s or %s or %s', + [ CreateQualifiedNameFilterStr(s_complexType,FXSShortNames), + CreateQualifiedNameFilterStr(s_simpleType,FXSShortNames), + CreateQualifiedNameFilterStr(s_element,FXSShortNames) + ] + ); + crsSchemaChild := CreateCursorOn(crsSchemaChild,ParseFilter(typFilterStr,TDOMNodeRttiExposer)); + crsSchemaChild.Reset(); + while crsSchemaChild.MoveNext() do begin + typNode := (crsSchemaChild.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + typTmpCrs := CreateAttributesCursor(typNode,cetRttiNode); + if Assigned(typTmpCrs) then begin + typTmpCrs.Reset(); + typTmpCrs := CreateCursorOn(typTmpCrs,ParseFilter(Format('%s=%s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer)); + typTmpCrs.Reset(); + if typTmpCrs.MoveNext() then begin + ParseType( + (typTmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue, + ExtractNameFromQName(typNode.NodeName) + ); + end; + end; + end; + end; + end; + end; +end; + constructor TWsdlParser.Create(ADoc: TXMLDocument; ASymbols : TSymbolTable); begin Assert(Assigned(ADoc)); @@ -1044,7 +1101,7 @@ begin inherited Destroy(); end; -procedure TWsdlParser.Parse(); +procedure TWsdlParser.Parse(const AMode : TParserMode); procedure ParseForwardDeclarations(); var @@ -1124,6 +1181,9 @@ begin ParseService(locObj.InnerObject); end; + if ( AMode = pmAllTypes ) then begin + ParseTypes(); + end; ParseForwardDeclarations(); ExtractNameSpace(); end; @@ -1415,7 +1475,8 @@ var Format('%s_%sArray',[AClassName,locPropTyp.Name]), locPropTyp.DataType, locPropTyp.Name, - locPropTyp.ExternalName + locPropTyp.ExternalName, + asEmbeded ) ); end; @@ -1480,7 +1541,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,s_item); + Result := TArrayDefinition.Create(AInternalName,locSym as TTypeDefinition,s_item,s_item,asScoped); if AHasInternalName then Result.RegisterExternalAlias(ATypeName); end; @@ -1533,7 +1594,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,propTyp.ExternalName); + arrayDef := TArrayDefinition.Create(internalName,propTyp.DataType,propTyp.Name,propTyp.ExternalName,asScoped); FreeAndNil(classDef); Result := arrayDef; if hasInternalName then