+ runtime WSDL generation : SOAP Header blocks should not derive from THeaderBlock

+ test case

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@862 8e941d3f-bd1b-0410-a28a-d453659cc2b4

wst/trunk/base_service_intf.pas

@@ -1594,6 +1594,7 @@ const
   sXSD = 'xsd';
   sSOAP_ENV = 'http://schemas.xmlsoap.org/soap/envelope/';
   sSOAP_ENV_ABR = 'SOAP-ENV';
+  sWST_BASE_NS_ABR = 'wst';
   sWST_BASE_NS = 'urn:wst_base';
 
   PROP_LIST_DELIMITER = ';';

wst/trunk/metadata_wsdl.pas

@@ -171,6 +171,8 @@ const
   sWSDL_TARGET_NS          = 'targetNamespace';
   sWSDL_TYPE               = sTYPE;
   sWSDL_TYPES              = 'types';
+
+  sWST_HEADER_BLOCK        = 'wst_headerBlock';
   
   sFORMAT_Input_EncodingStyle = 'FORMAT_Input_EncodingStyle';
   sFORMAT_Input_EncodingStyleURI = 'FORMAT_Input_EncodingStyleURI';
@@ -332,20 +334,29 @@ end;
 
 function GetNameSpaceShortName(
   const ANameSpace    : string;
-        AWsdlDocument : TXMLDocument;
+        ANode : TDOMElement;
   const APreferedShortName : string = ''
-):string;//inline;
+) : string; overload;
 begin
-  if FindAttributeByValueInNode(ANameSpace,AWsdlDocument.DocumentElement,Result,0,sXMLNS) then begin
+  if FindAttributeByValueInNode(ANameSpace,ANode,Result,0,sXMLNS) then begin
     Result := Copy(Result,Length(sXMLNS+':')+1,MaxInt);
   end else begin
     Result := Trim(APreferedShortName);
     if ( Length(Result) = 0 ) then
-      Result := Format('ns%d',[GetNodeListCount(AWsdlDocument.DocumentElement.Attributes)]) ;
-    AWsdlDocument.DocumentElement.SetAttribute(Format('%s:%s',[sXMLNS,Result]),ANameSpace);
+      Result := Format('ns%d',[GetNodeListCount(ANode.Attributes)]) ;
+    ANode.SetAttribute(Format('%s:%s',[sXMLNS,Result]),ANameSpace);
   end;
 end;
 
+function GetNameSpaceShortName(
+  const ANameSpace    : string;
+        AWsdlDocument : TXMLDocument;
+  const APreferedShortName : string = ''
+) : string; overload;
+begin
+  Result := GetNameSpaceShortName(ANameSpace,AWsdlDocument.DocumentElement,APreferedShortName);
+end;
+
 type TServiceElementType = ( setPortType, setBinding, setPort, setService,setAddress );
 function GetServicePartName(AService : PService; const AServicePart : TServiceElementType):string;
 const PART_NAME_MAP : array[TServiceElementType] of shortstring = ('', 'Binding', 'Port', '','');
@@ -690,13 +701,34 @@ procedure TBaseComplexRemotable_TypeHandler.Generate(
     if ( AClass <> nil ) and ( AClass.ClassParent <> nil ) then begin
       locRes := ATypeRegistry.Find(PTypeInfo(AClass.ClassParent.ClassInfo),False);
     end;
-    if ( locRes <> nil ) then begin
-      if ( GetTypeData(locRes.DataType)^.ClassType = TBaseComplexRemotable ) then
+    {if ( locRes <> nil ) then begin
+      if ( locRes.NameSpace = sSOAP_ENV ) or
+         ( GetTypeData(locRes.DataType)^.ClassType = TBaseComplexRemotable )
+      then
         locRes := nil;
-    end;
+    end;}
     Result := locRes;
   end;
-  
+
+  function IsParentVisible(const AParentRegItem : TTypeRegistryItem) : Boolean;
+  begin
+    Result :=
+      ( AParentRegItem <> nil ) and
+      ( ( AParentRegItem.NameSpace <> sSOAP_ENV ) and
+        ( GetTypeData(AParentRegItem.DataType)^.ClassType <> TBaseComplexRemotable )
+      )
+  end;
+
+  function IsInheritedPropertyAlreadyPublished(
+    const AProperty    : PPropInfo;
+    const AParentClass : TClass
+  ) : Boolean;
+  begin
+    Result :=
+      ( AParentClass = THeaderBlock ) and
+      ( SameText('mustUnderstand',AProperty^.Name) );
+  end;
+
 var
   typItm, propTypItm : TTypeRegistryItem;
   s, prop_ns_shortName : string;
@@ -734,14 +766,20 @@ begin
     cplxNode.SetAttribute(sNAME, typItm.DeclaredName);
     extNode := cplxNode;
     if ( parentClss <> nil ) then begin
-      if ( parentRegItem.NameSpace = typItm.NameSpace ) then begin
-        s := Format('%s:%s',[sTNS,parentRegItem.DeclaredName]);
-      end else begin
-        s := Format('%s:%s',[GetNameSpaceShortName(parentRegItem.NameSpace,AWsdlDocument),parentRegItem.DeclaredName]);
+      if ( parentClss = THeaderBlock ) then begin
+        s := Format('%s:%s',[GetNameSpaceShortName(sWST_BASE_NS,defSchemaNode,sWST_BASE_NS_ABR),sWST_HEADER_BLOCK]);
+        cplxNode.SetAttribute(s, 'true');
+      end;
+      if IsParentVisible(parentRegItem) then begin
+        if ( parentRegItem.NameSpace = typItm.NameSpace ) then begin
+          s := Format('%s:%s',[sTNS,parentRegItem.DeclaredName]);
+        end else begin
+          s := Format('%s:%s',[GetNameSpaceShortName(parentRegItem.NameSpace,AWsdlDocument),parentRegItem.DeclaredName]);
+        end;
+        cplxContentNode := CreateElement(Format('%s:%s',[sXSD,sCOMPLEX_CONTENT]),cplxNode,AWsdlDocument);
+        extNode := CreateElement(Format('%s:%s',[sXSD,sEXTENSION]),cplxContentNode,AWsdlDocument);
+        extNode.SetAttribute(sBASE,s);
       end;
-      cplxContentNode := CreateElement(Format('%s:%s',[sXSD,sCOMPLEX_CONTENT]),cplxNode,AWsdlDocument);
-      extNode := CreateElement(Format('%s:%s',[sXSD,sEXTENSION]),cplxContentNode,AWsdlDocument);
-      extNode.SetAttribute(sBASE,s);
     end;
 
       sqcNode := CreateElement(Format('%s:%s',[sXSD,sSEQUENCE]),extNode,AWsdlDocument);
@@ -751,7 +789,11 @@ begin
         try
           for i := 0 to Pred(propCount) do begin
             p := propList^[i];
-            if ( parentClss = nil ) or ( not IsPublishedProp(parentClss,p^.Name) ) then begin
+            if ( parentClss = nil ) or
+               ( not ( IsPublishedProp(parentClss,p^.Name) or IsInheritedPropertyAlreadyPublished(p,parentClss) )
+
+               )
+            then begin
               persistType := IsStoredPropClass(objTypeData^.ClassType,p);
               if ( persistType in [pstOptional,pstAlways] ) then begin
                 attProp := clsTyp.IsAttributeProperty(p^.Name);

wst/trunk/tests/test_suite/files/wsdl_gen_soap_headerblock.wsdl

@@ -0,0 +1,21 @@
+<?xml version="1.0"?>
+<definitions name="runtime_generator" 
+       xmlns="http://schemas.xmlsoap.org/wsdl/" 
+       xmlns:tns="urn:sample-namespace" 
+       xmlns:xsd="http://www.w3.org/2001/XMLSchema" 
+       xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/" 
+       targetNamespace="urn:sample-namespace">
+  <types>
+    <xsd:schema 
+          xmlns="http://www.w3.org/2001/XMLSchema" 
+          xmlns:wst="urn:wst_base"
+          targetNamespace="urn:sample-namespace">
+      <xsd:complexType name="TLoginHeader" wst:wst_headerBlock="true">
+        <xsd:sequence>
+          <xsd:element name="Login" type="xsd:string" maxOccurs="1" minOccurs="1"/>
+          <xsd:element name="Password" type="xsd:string" maxOccurs="1" minOccurs="1"/>
+        </xsd:sequence>
+      </xsd:complexType>
+    </xsd:schema>
+  </types>
+</definitions>

wst/trunk/tests/test_suite/test_generators.pas

@@ -977,7 +977,7 @@ begin
     locDoc := CreateDoc();
     g := CreateGenerator(locDoc);
     g.Execute(tr,mdl.Name);
-    WriteXMLFile(locDoc,wstExpandLocalFileName('type_hint_record_item.xsd'));
+    //WriteXMLFile(locDoc,wstExpandLocalFileName('type_hint_record_item.xsd'));
     locExistDoc := LoadXmlFromFilesList('type_hint_record_item.xsd');
     Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.');
   finally

wst/trunk/tests/test_suite/test_generators_runtime.pas

@@ -70,7 +70,16 @@ type
     fieldWord : Word;
     fieldString : string;
   end;
-  
+
+  TLoginHeader = class(THeaderBlock)
+  private
+    FLogin: string;
+    FPassword: string;
+  published
+    property Login : string read FLogin write FLogin;
+    property Password : string read FPassword write FPassword;
+  end;
+
   { TTestWSDLGenerator }
 
   TTestWSDLGenerator= class(TTestCase)
@@ -81,6 +90,7 @@ type
     procedure generate_enum();
     procedure generate_array();
     procedure generate_record();
+    procedure generate_soap_headerblock();
   end;
 
 implementation
@@ -257,6 +267,36 @@ begin
   end;
 end;
 
+procedure TTestWSDLGenerator.generate_soap_headerblock();
+var
+  locRep : PServiceRepository;
+  locDoc, locExistDoc : TXMLDocument;
+  typeReg : TTypeRegistry;
+  handlerReg : IWsdlTypeHandlerRegistry;
+begin
+  locExistDoc := nil;
+  typeReg := nil;
+  locDoc := nil;
+  locRep := CreateRepository();
+  try
+    typeReg := TTypeRegistry.Create();
+    RegisterStdTypes(typeReg);
+    typeReg.Register(sNAMESPACE_SAMPLE,TypeInfo(TLoginHeader));
+    handlerReg := CreateWsdlTypeHandlerRegistry(typeReg);
+    RegisterFondamentalTypesHandler(handlerReg);
+    locDoc := CreateDoc();
+    GenerateWSDL(locRep,locDoc,typeReg,handlerReg);
+    //WriteXML(locDoc,wstExpandLocalFileName('generate_soap_headerblock.wsdl'));
+    ReadXMLFile(locExistDoc,wstExpandLocalFileName(TestFilesPath + 'wsdl_gen_soap_headerblock.wsdl'));
+    Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.');
+  finally
+    typeReg.Free();
+    ReleaseDomNode(locExistDoc);
+    ReleaseDomNode(locDoc);
+    Dispose(locRep);
+  end;
+end;
+
 initialization
   TClass_ABC.RegisterAttributeProperty('ABC_EnumAttProp');