abaae03afa
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4233 8e941d3f-bd1b-0410-a28a-d453659cc2b4
1095 lines
37 KiB
ObjectPascal
1095 lines
37 KiB
ObjectPascal
{
|
|
This file is part of the Web Service Toolkit
|
|
Copyright (c) 2006 by Inoussa OUEDRAOGO
|
|
|
|
This file is provide under modified LGPL licence
|
|
( the files COPYING.modifiedLGPL and COPYING.LGPL).
|
|
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
}
|
|
{$INCLUDE wst_global.inc}
|
|
unit metadata_wsdl;
|
|
|
|
{$RANGECHECKS OFF}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, TypInfo,
|
|
{$IFNDEF FPC}xmldom, wst_delphi_xml{$ELSE}DOM{$ENDIF},
|
|
base_service_intf, metadata_repository;
|
|
|
|
type
|
|
|
|
IWsdlTypeHandler = interface
|
|
['{DA9AF8B1-392B-49A8-91CC-6B5C5131E6FA}']
|
|
procedure Generate(
|
|
const APascalTypeName : string;
|
|
AWsdlDocument : TXMLDocument;
|
|
ATypeRegistry : TTypeRegistry
|
|
);
|
|
end;
|
|
|
|
IWsdlTypeHandlerRegistry = Interface
|
|
['{A2FA2FE4-933D-44CC-B266-BF48674DECE9}']
|
|
function Find(const APascalTypeName : string):IWsdlTypeHandler;
|
|
procedure Register(
|
|
const APascalTypeName : string;
|
|
AFactory : IItemFactory
|
|
);
|
|
procedure RegisterDefaultHandler(
|
|
const ATypeKind : TTypeKind;
|
|
AFactory : IItemFactory
|
|
);
|
|
End;
|
|
|
|
{ TEnumTypeHandler }
|
|
|
|
TEnumTypeHandler = class(TSimpleFactoryItem,IWsdlTypeHandler)
|
|
protected
|
|
procedure Generate(
|
|
const APascalTypeName : string;
|
|
AWsdlDocument : TXMLDocument;
|
|
ATypeRegistry : TTypeRegistry
|
|
);
|
|
end;
|
|
|
|
{ TBaseComplexRemotable_TypeHandler }
|
|
|
|
TBaseComplexRemotable_TypeHandler = class(TSimpleFactoryItem,IWsdlTypeHandler)
|
|
protected
|
|
procedure Generate(
|
|
const APascalTypeName : string;
|
|
AWsdlDocument : TXMLDocument;
|
|
ATypeRegistry : TTypeRegistry
|
|
);
|
|
end;
|
|
|
|
{ TBaseObjectArrayRemotable_TypeHandler }
|
|
|
|
TBaseArrayRemotable_TypeHandler = class(TSimpleFactoryItem,IWsdlTypeHandler)
|
|
protected
|
|
procedure Generate(
|
|
const APascalTypeName : string;
|
|
AWsdlDocument : TXMLDocument;
|
|
ATypeRegistry : TTypeRegistry
|
|
);
|
|
end;
|
|
|
|
{ TRecord_TypeHandler }
|
|
|
|
TRecord_TypeHandler = class(TSimpleFactoryItem,IWsdlTypeHandler)
|
|
protected
|
|
procedure Generate(
|
|
const APascalTypeName : string;
|
|
AWsdlDocument : TXMLDocument;
|
|
ATypeRegistry : TTypeRegistry
|
|
);
|
|
end;
|
|
|
|
|
|
procedure GenerateWSDL(
|
|
AMdtdRep : PServiceRepository;
|
|
ADoc : TXMLDocument;
|
|
ATypeRegistry : TTypeRegistry;
|
|
AHandlerRegistry : IWsdlTypeHandlerRegistry
|
|
);overload;
|
|
procedure GenerateWSDL(AMdtdRep : PServiceRepository; ADoc : TXMLDocument);overload;
|
|
function GenerateWSDL(const ARepName, ARootAddress : string):string;overload;
|
|
|
|
function GetWsdlTypeHandlerRegistry():IWsdlTypeHandlerRegistry;
|
|
function CreateWsdlTypeHandlerRegistry(ATypeRegistry : TTypeRegistry):IWsdlTypeHandlerRegistry;
|
|
procedure RegisterFondamentalTypesHandler(ARegistry : IWsdlTypeHandlerRegistry);
|
|
|
|
implementation
|
|
uses
|
|
wst_types
|
|
{$IFDEF WST_DELPHI}
|
|
, wst_delphi_rtti_utils
|
|
{$ENDIF}
|
|
{$IFDEF FPC}
|
|
, wst_fpc_xml, XmlWrite
|
|
{$ENDIF}
|
|
, record_rtti;
|
|
|
|
const
|
|
sWSDL_NS = 'http://schemas.xmlsoap.org/wsdl/';
|
|
sSOAP_NS = 'http://schemas.xmlsoap.org/wsdl/soap/';
|
|
sSOAP = 'soap';
|
|
sXMLNS = 'xmlns';
|
|
sXSD_NS = 'http://www.w3.org/2001/XMLSchema';
|
|
sXSD = 'xsd';
|
|
sTNS = 'tns';
|
|
|
|
sSOAP_ACTION = 'soapAction';
|
|
sSOAP_ENCODING_STYLE = 'encodingStyle';
|
|
sSOAP_RPC = 'rpc';
|
|
sSOAP_TRANSPORT = 'http://schemas.xmlsoap.org/soap/http';
|
|
sSOAP_USE = 'use';
|
|
|
|
sADDRESS = 'address';
|
|
sATTRIBUTE = 'attribute';
|
|
sBASE = 'base';
|
|
sBINDING = 'binding';
|
|
sBODY = 'body';
|
|
sCOMPLEX_CONTENT = 'complexContent';
|
|
sCOMPLEX_TYPE = 'complexType';
|
|
sELEMENT = 'element';
|
|
sENUMERATION = 'enumeration';
|
|
sEXTENSION = 'extension';
|
|
sITEM = 'item';
|
|
sLOCATION = 'location';
|
|
sMIN_OCCURS = 'minOccurs';
|
|
sMAX_OCCURS = 'maxOccurs';
|
|
sNAME = 'name';
|
|
sNAME_SPACE = 'namespace';
|
|
sPORT_TYPE = 'portType';
|
|
sRESTRICTION = 'restriction';
|
|
sSEQUENCE = 'sequence';
|
|
sSERVICE = 'service';
|
|
sSIMPLE_TYPE = 'simpleType';
|
|
sSTYLE = 'style';
|
|
sTRANSPORT = 'transport';
|
|
sTRUE_LOWERCASE = 'true';
|
|
sTYPE = 'type';
|
|
sUNBOUNDED = 'unbounded';
|
|
sUSE = 'use';
|
|
sVALUE = 'value';
|
|
|
|
sWSDL_DEFINITIONS = 'definitions';
|
|
sWSDL_INPUT = 'input';
|
|
sWSDL_MESSAGE = 'message';
|
|
sWSDL_NAME = 'name';
|
|
sWSDL_OPERATION = 'operation';
|
|
sWSDL_OUTPUT = 'output';
|
|
sWSDL_PART = 'part';
|
|
sWSDL_PORT = 'port';
|
|
sWSDL_PORT_TYPE = sPORT_TYPE;
|
|
sWSDL_SCHEMA = 'schema';
|
|
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';
|
|
|
|
sFORM_attributeFormDefault = 'attributeFormDefault';
|
|
sFORM_elementFormDefault = 'elementFormDefault';
|
|
|
|
var
|
|
WsdlTypeHandlerRegistryInst : IWsdlTypeHandlerRegistry;
|
|
|
|
type
|
|
|
|
{ TWsdlTypeHandlerRegistry }
|
|
|
|
TWsdlTypeHandlerRegistry = class(TBaseFactoryRegistry,IWsdlTypeHandlerRegistry)
|
|
private
|
|
FTypeRegistry : TTypeRegistry;
|
|
FDefaultHandlerTable : Array[TTypeKind] of IItemFactory;
|
|
private
|
|
function FindNearestClass(const AClassType : TClass):IItemFactory;
|
|
protected
|
|
function Find(const APascalTypeName : string):IWsdlTypeHandler;
|
|
procedure RegisterDefaultHandler(
|
|
const ATypeKind : TTypeKind;
|
|
AFactory : IItemFactory
|
|
);
|
|
public
|
|
constructor Create(ATypeRegistry : TTypeRegistry);
|
|
destructor Destroy();override;
|
|
End;
|
|
|
|
{ TWsdlTypeHandlerRegistry }
|
|
|
|
function DistanceFromChildToParent(AChildClass,AParentClass : TClass):Integer;
|
|
var
|
|
ch : TClass;
|
|
begin
|
|
if Assigned(AChildClass) and Assigned(AParentClass) then begin
|
|
Result := 0;
|
|
ch := AChildClass;
|
|
while Assigned(ch) do begin
|
|
if ( ch = AParentClass ) then
|
|
Exit;
|
|
Inc(Result);
|
|
ch := ch.ClassParent;
|
|
end;
|
|
end;
|
|
Result := MaxInt;
|
|
end;
|
|
|
|
function TWsdlTypeHandlerRegistry.FindNearestClass(const AClassType : TClass):IItemFactory;
|
|
var
|
|
i,c, foundIndex,tmpScore, score : Integer;
|
|
itm : TBaseFactoryRegistryItem;
|
|
typData : PTypeData;
|
|
r : TTypeRegistry;
|
|
ri : TTypeRegistryItem;
|
|
begin
|
|
Result := nil;
|
|
foundIndex := -1;
|
|
score := MaxInt;
|
|
r := FTypeRegistry;
|
|
c := Count;
|
|
for i := 0 to Pred(c) do begin
|
|
itm := Item[i];
|
|
ri := r.Find(itm.Name);
|
|
if Assigned(ri) and ( ri.DataType^.Kind = tkClass ) then begin
|
|
typData := GetTypeData(ri.DataType);
|
|
tmpScore := DistanceFromChildToParent(AClassType,typData^.ClassType);
|
|
if ( tmpScore < score ) then begin
|
|
foundIndex := i;
|
|
score := tmpScore;
|
|
end;
|
|
end;
|
|
end;
|
|
if ( foundIndex >= 0 ) then begin
|
|
Result := Item[foundIndex].Factory;
|
|
end;
|
|
end;
|
|
|
|
function TWsdlTypeHandlerRegistry.Find(const APascalTypeName: string): IWsdlTypeHandler;
|
|
Var
|
|
fct : IItemFactory;
|
|
ri : TTypeRegistryItem;
|
|
begin
|
|
Result := nil;
|
|
fct := FindFactory(APascalTypeName);
|
|
if not Assigned(fct) then begin
|
|
ri := FTypeRegistry.Find(APascalTypeName);
|
|
if Assigned(ri) then begin
|
|
if ( ri.DataType^.Kind = tkClass ) then
|
|
fct := FindNearestClass(GetTypeData(ri.DataType)^.ClassType);
|
|
if not Assigned(fct) then
|
|
fct := FDefaultHandlerTable[ri.DataType^.Kind];
|
|
end;
|
|
end;
|
|
if Assigned(fct) then
|
|
Result := fct.CreateInstance() as IWsdlTypeHandler;
|
|
end;
|
|
|
|
procedure TWsdlTypeHandlerRegistry.RegisterDefaultHandler(
|
|
const ATypeKind: TTypeKind;
|
|
AFactory: IItemFactory
|
|
);
|
|
begin
|
|
FDefaultHandlerTable[ATypeKind] := AFactory;
|
|
end;
|
|
|
|
constructor TWsdlTypeHandlerRegistry.Create(ATypeRegistry : TTypeRegistry);
|
|
begin
|
|
Assert(ATypeRegistry <> nil);
|
|
inherited Create();
|
|
FTypeRegistry := ATypeRegistry;
|
|
end;
|
|
|
|
destructor TWsdlTypeHandlerRegistry.Destroy();
|
|
var
|
|
i : TTypeKind;
|
|
begin
|
|
for i := Low(TTypeKind) to High(TTypeKind) do
|
|
FDefaultHandlerTable[i] := nil;
|
|
inherited Destroy();
|
|
end;
|
|
|
|
function CreateElement(const ANodeName : DOMString; AParent : TDOMNode; ADoc : TXMLDocument):TDOMElement;//inline;
|
|
begin
|
|
Result := ADoc.CreateElement(ANodeName);
|
|
AParent.AppendChild(Result);
|
|
end;
|
|
|
|
function FindAttributeByValueInNode(
|
|
const AAttValue : string;
|
|
const ANode : TDOMNode;
|
|
out AResAtt : string;
|
|
const AStartIndex : Integer = 0;
|
|
const AStartingWith : string = ''
|
|
):boolean;
|
|
var
|
|
i,c : Integer;
|
|
b : Boolean;
|
|
begin
|
|
AResAtt := '';
|
|
if Assigned(ANode) and Assigned(ANode.Attributes) then begin
|
|
b := ( Length(AStartingWith) = 0);
|
|
c := Pred(ANode.Attributes.Length);
|
|
if ( AStartIndex >= 0 ) then
|
|
i := AStartIndex
|
|
else
|
|
i := 0;
|
|
for i := i to c do begin
|
|
if AnsiSameText(AAttValue,ANode.Attributes.Item[i].NodeValue) and
|
|
( b or ( Pos(AStartingWith,ANode.Attributes.Item[i].NodeName) = 1 ))
|
|
then begin
|
|
AResAtt := ANode.Attributes.Item[i].NodeName;
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
Result := False;
|
|
end;
|
|
|
|
function GetNameSpaceShortName(
|
|
const ANameSpace : string;
|
|
ANode : TDOMElement;
|
|
const APreferedShortName : string = ''
|
|
) : string; overload;
|
|
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(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', '','');
|
|
begin
|
|
Result := AService^.Name + PART_NAME_MAP[AServicePart];
|
|
end;
|
|
|
|
procedure GenerateWSDL(AMdtdRep : PServiceRepository; ADoc : TXMLDocument);
|
|
begin
|
|
GenerateWSDL(AMdtdRep,ADoc,GetTypeRegistry(),GetWsdlTypeHandlerRegistry());
|
|
end;
|
|
|
|
procedure GenerateWSDL(
|
|
AMdtdRep : PServiceRepository;
|
|
ADoc : TXMLDocument;
|
|
ATypeRegistry : TTypeRegistry;
|
|
AHandlerRegistry : IWsdlTypeHandlerRegistry
|
|
);
|
|
procedure GenerateServiceMessages(
|
|
AService : PService;
|
|
ARootNode : TDOMElement
|
|
);
|
|
|
|
procedure GenerateOperationMessage(AOperation : PServiceOperation);
|
|
|
|
procedure GenerateParam(APrm : POperationParam; AMsgNode : TDOMElement);
|
|
var
|
|
tmpNode : TDOMElement;
|
|
typItm : TTypeRegistryItem;
|
|
ns_shortName, s : string;
|
|
begin
|
|
tmpNode := CreateElement(sWSDL_PART,AMsgNode,ADoc);
|
|
tmpNode.SetAttribute(sWSDL_NAME,APrm^.Name);
|
|
typItm := ATypeRegistry.Find(APrm^.TypeName);
|
|
if not Assigned(typItm) then
|
|
raise EMetadataException.CreateFmt('Type not registered : "%s".',[APrm^.TypeName]);
|
|
//Assert(Assigned(typItm),APrm^.TypeName);
|
|
ns_shortName := GetNameSpaceShortName(typItm.NameSpace,ADoc);
|
|
s := Format('%s:%s',[ns_shortName,typItm.DeclaredName]);
|
|
tmpNode.SetAttribute(sWSDL_TYPE,s);
|
|
end;
|
|
|
|
var
|
|
qryNode, rspNode : TDOMElement;
|
|
ii, cc : Integer;
|
|
pp : POperationParam;
|
|
begin
|
|
qryNode := CreateElement(sWSDL_MESSAGE,ARootNode,ADoc);
|
|
qryNode.SetAttribute(sWSDL_NAME,Format('%s',[AOperation^.Name]));
|
|
rspNode := CreateElement(sWSDL_MESSAGE,ARootNode,ADoc);
|
|
rspNode.SetAttribute(sWSDL_NAME,Format('%sResponse',[AOperation^.Name]));
|
|
cc := AOperation^.ParamsCount;
|
|
if ( cc > 0 ) then begin
|
|
pp := AOperation^.Params;
|
|
for ii := 0 to Pred(cc) do begin
|
|
if ( pp^.Modifier in [opfNone, opfIn] ) then
|
|
GenerateParam(pp,qryNode)
|
|
else if ( pp^.Modifier in [opfVar, opfOut] ) then
|
|
GenerateParam(pp,rspNode);
|
|
Inc(pp);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
Var
|
|
j, k : Integer;
|
|
po : PServiceOperation;
|
|
begin
|
|
k := AService^.OperationsCount;
|
|
if ( k > 0 ) then begin
|
|
po := AService^.Operations;
|
|
for j := 0 to pred(k) do begin
|
|
GenerateOperationMessage(po);
|
|
Inc(po);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure GenerateServicePortType(AService : PService; ARootNode : TDOMElement);
|
|
|
|
procedure GenerateOperation(AOperation : PServiceOperation; APrtTypeNode : TDOMElement);
|
|
var
|
|
opNode, inNode, outNode : TDOMElement;
|
|
begin
|
|
opNode := CreateElement(sWSDL_OPERATION,APrtTypeNode,ADoc);
|
|
opNode.SetAttribute(sWSDL_NAME,AOperation^.Name);
|
|
inNode := CreateElement(sWSDL_INPUT,opNode,ADoc);
|
|
inNode.SetAttribute(sWSDL_MESSAGE,Format('%s:%s',[sTNS,AOperation^.Name]));
|
|
outNode := CreateElement(sWSDL_OUTPUT,opNode,ADoc);
|
|
outNode.SetAttribute(sWSDL_MESSAGE,Format('%s:%sResponse',[sTNS,AOperation^.Name]));
|
|
end;
|
|
|
|
var
|
|
prtTypeNode : TDOMElement;
|
|
j, k : Integer;
|
|
po : PServiceOperation;
|
|
begin
|
|
prtTypeNode := CreateElement(sWSDL_PORT_TYPE,ARootNode,ADoc);
|
|
prtTypeNode.SetAttribute(sWSDL_NAME,GetServicePartName(AService,setPortType));
|
|
k := AService^.OperationsCount;
|
|
if ( k > 0 ) then begin
|
|
po := AService^.Operations;
|
|
for j := 0 to pred(k) do begin
|
|
GenerateOperation(po,prtTypeNode);
|
|
Inc(po);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure GenerateServiceBinding(AService : PService; ARootNode : TDOMElement);
|
|
|
|
procedure GenerateOperation(AOperation : PServiceOperation; ABndngNode : TDOMElement);
|
|
var
|
|
opNode, inNode, outNode, bdyNode : TDOMElement;
|
|
strBuff : string;
|
|
propData : PPropertyData;
|
|
encdStyl,encdStylURI : string;
|
|
begin
|
|
strBuff := Format('%s:%s',[sSOAP,sWSDL_OPERATION]);
|
|
//CreateElement(strBuff,ABndngNode,ADoc).SetAttribute(sSOAP_ACTION,Format('%s/%s%s',[AMdtdRep^.NameSpace,AService^.Name,AOperation^.Name]));
|
|
opNode := CreateElement(sWSDL_OPERATION,ABndngNode,ADoc);
|
|
opNode.SetAttribute(sWSDL_NAME,AOperation^.Name);
|
|
CreateElement(strBuff,opNode,ADoc).SetAttribute(sSOAP_ACTION,Format('%s/%s%s',[AMdtdRep^.NameSpace,AService^.Name,AOperation^.Name]));
|
|
inNode := CreateElement(sWSDL_INPUT,opNode,ADoc);
|
|
strBuff := Format('%s:%s',[sSOAP,sBODY]);
|
|
bdyNode := CreateElement(strBuff,inNode,ADoc);
|
|
encdStyl := 'literal';
|
|
encdStylURI := '';
|
|
propData := Find(AOperation^.Properties,sFORMAT_Input_EncodingStyle);
|
|
if Assigned(propData) and ( Length(Trim(propData^.Data)) > 0 ) then begin
|
|
encdStyl := Trim(propData^.Data);
|
|
end;
|
|
bdyNode.SetAttribute(sSOAP_USE,encdStyl);
|
|
bdyNode.SetAttribute(sNAME_SPACE,Format('%s',[AMdtdRep^.NameSpace]));
|
|
propData := Find(AOperation^.Properties,sFORMAT_Input_EncodingStyleURI);
|
|
if Assigned(propData) and ( Length(Trim(propData^.Data)) > 0 ) then begin
|
|
encdStylURI := Trim(propData^.Data);
|
|
end;
|
|
if ( Length(encdStylURI) > 0 ) then
|
|
bdyNode.SetAttribute(sSOAP_ENCODING_STYLE,encdStylURI);
|
|
|
|
outNode := CreateElement(sWSDL_OUTPUT,opNode,ADoc);
|
|
strBuff := Format('%s:%s',[sSOAP,sBODY]);
|
|
bdyNode := CreateElement(strBuff,outNode,ADoc);
|
|
bdyNode.SetAttribute(sSOAP_USE,encdStyl);
|
|
bdyNode.SetAttribute(sNAME_SPACE,Format('%s',[AMdtdRep^.NameSpace]));
|
|
if ( Length(encdStylURI) > 0 ) then
|
|
bdyNode.SetAttribute(sSOAP_ENCODING_STYLE,encdStylURI);
|
|
end;
|
|
|
|
var
|
|
bndgNode, soapbndgNode : TDOMElement;
|
|
j, k : Integer;
|
|
po : PServiceOperation;
|
|
strBuf : string;
|
|
begin
|
|
bndgNode := CreateElement(sBINDING,ARootNode,ADoc);
|
|
bndgNode.SetAttribute(sWSDL_NAME,GetServicePartName(AService,setBinding));
|
|
bndgNode.SetAttribute(sWSDL_TYPE,Format('%s:%s',[sTNS,GetServicePartName(AService,setPortType)]));
|
|
|
|
strBuf := Format('%s:%s',[sSOAP,sBINDING]);
|
|
soapbndgNode := CreateElement(strBuf,bndgNode,ADoc);
|
|
soapbndgNode.SetAttribute(sSTYLE,sSOAP_RPC);
|
|
soapbndgNode.SetAttribute(sTRANSPORT,sSOAP_TRANSPORT);
|
|
|
|
k := AService^.OperationsCount;
|
|
if ( k > 0 ) then begin
|
|
po := AService^.Operations;
|
|
for j := 0 to pred(k) do begin
|
|
GenerateOperation(po,bndgNode);
|
|
Inc(po);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure GenerateServicePublication(AService : PService; ARootNode : TDOMElement);
|
|
var
|
|
srvcNode, portNode, soapAdrNode : TDOMElement;
|
|
strBuf : string;
|
|
begin
|
|
srvcNode := CreateElement(sSERVICE,ARootNode,ADoc);
|
|
srvcNode.SetAttribute(sWSDL_NAME,GetServicePartName(AService,setService));
|
|
|
|
strBuf := Format('%s',[sWSDL_PORT]);
|
|
portNode := CreateElement(strBuf,srvcNode,ADoc);
|
|
portNode.SetAttribute(sWSDL_NAME,GetServicePartName(AService,setPort));
|
|
portNode.SetAttribute(sBINDING,Format('%s:%s',[sTNS,GetServicePartName(AService,setBinding)]));
|
|
|
|
strBuf := Format('%s:%s',[sSOAP,sADDRESS]);
|
|
soapAdrNode := CreateElement(strBuf,portNode,ADoc);
|
|
soapAdrNode.SetAttribute(sLOCATION,Format('%s%s',[AMdtdRep^.RootAddress,GetServicePartName(AService,setAddress)]));
|
|
end;
|
|
|
|
procedure GenerateServiceTypes();
|
|
var
|
|
j, k : Integer;
|
|
tr : TTypeRegistry;
|
|
tri : TTypeRegistryItem;
|
|
g : IWsdlTypeHandler;
|
|
gr : IWsdlTypeHandlerRegistry;
|
|
begin
|
|
tr := ATypeRegistry;
|
|
gr := AHandlerRegistry;
|
|
k := tr.Count;
|
|
for j := 0 to Pred(k) do begin
|
|
tri := tr[j];
|
|
if ( not ( trioNonVisibleToMetadataService in tri.Options ) ) and
|
|
AnsiSameText(AMdtdRep^.NameSpace,tri.NameSpace)
|
|
then begin
|
|
g := gr.Find(tri.DataType^.Name);
|
|
if assigned(g) then
|
|
g.Generate(tri.DataType^.Name,ADoc,tr);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function CreateRootNode():TDOMElement;
|
|
begin
|
|
Result := CreateElement(sWSDL_DEFINITIONS,ADoc,ADoc);
|
|
Result.SetAttribute(sWSDL_NAME,AMdtdRep^.Name);
|
|
|
|
Result.SetAttribute(sWSDL_TARGET_NS,AMdtdRep^.NameSpace);
|
|
Result.SetAttribute(Format('%s:%s',[sXMLNS,sSOAP]),sSOAP_NS);
|
|
Result.SetAttribute(Format('%s:%s',[sXMLNS,sXSD]),sXSD_NS);
|
|
Result.SetAttribute(Format('%s:%s',[sXMLNS,sTNS]),AMdtdRep^.NameSpace);
|
|
Result.SetAttribute(sXMLNS,sWSDL_NS);
|
|
end;
|
|
|
|
function CreateTypesRootNode(ARootNode : TDOMNode):TDOMElement;
|
|
begin
|
|
Result := CreateElement(sWSDL_TYPES,ARootNode,ADoc);
|
|
//Result.SetAttribute(sWSDL_TARGET_NS,AMdtdRep^.NameSpace);
|
|
end;
|
|
|
|
var
|
|
defNode, typesNode, schNode : TDOMElement;
|
|
i, c : Integer;
|
|
ps : PService;
|
|
propData : PPropertyData;
|
|
begin
|
|
if not ( Assigned(AMdtdRep) and Assigned(ADoc)) then
|
|
Exit;
|
|
|
|
defNode := CreateRootNode();
|
|
typesNode := CreateTypesRootNode(defNode);
|
|
schNode := CreateElement(sXSD + ':' + sWSDL_SCHEMA,typesNode,ADoc);
|
|
schNode.SetAttribute(sXMLNS,sXSD_NS);
|
|
schNode.SetAttribute(sWSDL_TARGET_NS,AMdtdRep^.NameSpace);
|
|
propData := Find(AMdtdRep^.Properties,sFORM_elementFormDefault);
|
|
if (propData <> nil) and (propData^.Data <> '') then
|
|
schNode.SetAttribute(sFORM_elementFormDefault,Trim(propData^.Data));
|
|
propData := Find(AMdtdRep^.Properties,sFORM_attributeFormDefault);
|
|
if (propData <> nil) and (propData^.Data <> '') then
|
|
schNode.SetAttribute(sFORM_attributeFormDefault,Trim(propData^.Data));
|
|
|
|
GenerateServiceTypes();
|
|
|
|
c := AMdtdRep^.ServicesCount;
|
|
if ( c > 0 ) then begin
|
|
ps := AMdtdRep^.Services;
|
|
for i := 0 to Pred(c) do begin
|
|
GenerateServiceMessages(ps,defNode);
|
|
Inc(ps);
|
|
end;
|
|
ps := AMdtdRep^.Services;
|
|
for i := 0 to Pred(c) do begin
|
|
GenerateServicePortType(ps,defNode);
|
|
Inc(ps);
|
|
end;
|
|
ps := AMdtdRep^.Services;
|
|
for i := 0 to Pred(c) do begin
|
|
GenerateServiceBinding(ps,defNode);
|
|
Inc(ps);
|
|
end;
|
|
ps := AMdtdRep^.Services;
|
|
for i := 0 to Pred(c) do begin
|
|
GenerateServicePublication(ps,defNode);
|
|
Inc(ps);
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
function GenerateWSDL(const ARepName, ARootAddress : string):string;overload;
|
|
var
|
|
strm : TMemoryStream;
|
|
rep : PServiceRepository;
|
|
doc :TXMLDocument;
|
|
i : SizeInt;
|
|
s : string;
|
|
begin
|
|
Result := '';
|
|
rep := nil;
|
|
doc := Nil;
|
|
i := GetModuleMetadataMngr().IndexOfName(ARepName);
|
|
if ( i < 0 ) then
|
|
Exit;
|
|
strm := TMemoryStream.Create();
|
|
try
|
|
s := GetModuleMetadataMngr().GetRepositoryName(i);
|
|
GetModuleMetadataMngr().LoadRepositoryName(s,ARootAddress,rep);
|
|
strm.Clear();
|
|
doc := CreateDoc();
|
|
GenerateWSDL(rep,doc);
|
|
WriteXMLFile(doc,strm);
|
|
i := strm.Size;
|
|
if ( i > 0 ) then begin
|
|
SetLength(Result,i);
|
|
Move(strm.memory^,Result[1],i);
|
|
end;
|
|
finally
|
|
ReleaseDomNode(doc);
|
|
strm.Free();
|
|
GetModuleMetadataMngr().ClearRepository(rep);
|
|
end;
|
|
end;
|
|
|
|
function GetWsdlTypeHandlerRegistry():IWsdlTypeHandlerRegistry;
|
|
begin
|
|
Result := WsdlTypeHandlerRegistryInst;
|
|
end;
|
|
|
|
type
|
|
|
|
{ TFakeTypeHandler }
|
|
|
|
TFakeTypeHandler = class(TSimpleFactoryItem,IWsdlTypeHandler)
|
|
protected
|
|
procedure Generate(
|
|
const APascalTypeName : string;
|
|
AWsdlDocument : TXMLDocument;
|
|
ATypeRegistry : TTypeRegistry
|
|
);
|
|
end;
|
|
|
|
{ TBaseComplexRemotable_TypeHandler }
|
|
|
|
procedure TBaseComplexRemotable_TypeHandler.Generate(
|
|
const APascalTypeName : string;
|
|
AWsdlDocument : TXMLDocument;
|
|
ATypeRegistry : TTypeRegistry
|
|
);
|
|
|
|
function FindHighestRegisteredParent(AClass : TClass) : TTypeRegistryItem;
|
|
var
|
|
locRes : TTypeRegistryItem;
|
|
begin
|
|
locRes := nil;
|
|
if ( AClass <> nil ) and ( AClass.ClassParent <> nil ) then begin
|
|
locRes := ATypeRegistry.Find(PTypeInfo(AClass.ClassParent.ClassInfo),False);
|
|
end;
|
|
{if ( locRes <> nil ) then begin
|
|
if ( locRes.NameSpace = sSOAP_ENV ) or
|
|
( GetTypeData(locRes.DataType)^.ClassType = TBaseComplexRemotable )
|
|
then
|
|
locRes := nil;
|
|
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;
|
|
defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode, cplxContentNode, extNode : TDOMElement;
|
|
i : Integer;
|
|
propList : PPropList;
|
|
propCount, propListLen : Integer;
|
|
p : PPropInfo;
|
|
persistType : TPropStoreType;
|
|
objTypeData : PTypeData;
|
|
clsTyp : TBaseComplexRemotableClass;
|
|
attProp : Boolean;
|
|
parentRegItem : TTypeRegistryItem;
|
|
parentClss : TClass;
|
|
begin
|
|
typItm := ATypeRegistry.Find(APascalTypeName);
|
|
if Assigned(typItm) and
|
|
( typItm.DataType^.Kind = tkClass )
|
|
then begin
|
|
GetNameSpaceShortName(typItm.NameSpace,AWsdlDocument);
|
|
defTypesNode := FindNode(AWsdlDocument.DocumentElement,sWSDL_TYPES) as TDOMElement;
|
|
Assert(Assigned(defTypesNode));
|
|
defSchemaNode := defTypesNode.FirstChild as TDOMElement;
|
|
|
|
objTypeData := GetTypeData(typItm.DataType);
|
|
clsTyp := TBaseComplexRemotableClass(objTypeData^.ClassType);
|
|
parentRegItem := FindHighestRegisteredParent(clsTyp);
|
|
if ( parentRegItem <> nil ) then
|
|
parentClss := GetTypeData(parentRegItem.DataType)^.ClassType
|
|
else
|
|
parentClss := nil;
|
|
|
|
s := Format('%s:%s',[sXSD,sCOMPLEX_TYPE]);
|
|
cplxNode := CreateElement(s,defSchemaNode,AWsdlDocument);
|
|
cplxNode.SetAttribute(sNAME, typItm.DeclaredName);
|
|
extNode := cplxNode;
|
|
if ( parentClss <> nil ) then begin
|
|
if ( parentClss = THeaderBlock ) then begin
|
|
s := Format('%s:%s',[GetNameSpaceShortName(sWST_BASE_NS,defSchemaNode,sWST_BASE_NS_ABR),sWST_HEADER_BLOCK]);
|
|
cplxNode.SetAttribute(s, sTRUE_LOWERCASE);
|
|
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;
|
|
end;
|
|
|
|
sqcNode := CreateElement(Format('%s:%s',[sXSD,sSEQUENCE]),extNode,AWsdlDocument);
|
|
propCount := objTypeData^.PropCount;
|
|
if ( propCount > 0 ) then begin
|
|
propListLen := GetPropList(typItm.DataType,propList);
|
|
try
|
|
for i := 0 to Pred(propCount) do begin
|
|
p := propList^[i];
|
|
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);
|
|
if attProp then begin
|
|
s := Format('%s:%s',[sXSD,sATTRIBUTE]);
|
|
propNode := CreateElement(s,extNode,AWsdlDocument)
|
|
end else begin
|
|
s := Format('%s:%s',[sXSD,sELEMENT]);
|
|
propNode := CreateElement(s,sqcNode,AWsdlDocument);
|
|
end;
|
|
propNode.SetAttribute(sNAME,typItm.GetExternalPropertyName(p^.Name));
|
|
propTypItm := ATypeRegistry.Find(p^.PropType^.Name);
|
|
if Assigned(propTypItm) then begin
|
|
prop_ns_shortName := GetNameSpaceShortName(propTypItm.NameSpace,AWsdlDocument);
|
|
propNode.SetAttribute(sTYPE,Format('%s:%s',[prop_ns_shortName,propTypItm.DeclaredName]));
|
|
if attProp then begin
|
|
if ( persistType = pstOptional ) then
|
|
propNode.SetAttribute(sUSE,'optional')
|
|
else
|
|
propNode.SetAttribute(sUSE,'required');
|
|
end else begin
|
|
if ( persistType = pstOptional ) then
|
|
propNode.SetAttribute(sMIN_OCCURS,'0')
|
|
else
|
|
propNode.SetAttribute(sMIN_OCCURS,'1');
|
|
propNode.SetAttribute(sMAX_OCCURS,'1');
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
Freemem(propList,propListLen*SizeOf(Pointer));
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TEnumTypeHandler }
|
|
|
|
procedure TEnumTypeHandler.Generate(
|
|
const APascalTypeName: string;
|
|
AWsdlDocument: TXMLDocument;
|
|
ATypeRegistry : TTypeRegistry
|
|
);
|
|
var
|
|
typItm : TTypeRegistryItem;
|
|
ns_shortName, s : string;
|
|
defTypesNode, defSchemaNode, resNode, restrictNode : TDOMElement;
|
|
i, c : Integer;
|
|
begin
|
|
typItm := ATypeRegistry.Find(APascalTypeName);
|
|
if Assigned(typItm) and
|
|
( typItm.DataType^.Kind = tkEnumeration )
|
|
then begin
|
|
if FindAttributeByValueInNode(typItm.NameSpace,AWsdlDocument.DocumentElement,ns_shortName) then begin
|
|
ns_shortName := Copy(ns_shortName,Length(sXMLNS+':')+1,MaxInt);
|
|
end else begin
|
|
ns_shortName := Format('ns%d',[GetNodeListCount(AWsdlDocument.DocumentElement.Attributes)]) ;
|
|
AWsdlDocument.DocumentElement.SetAttribute(Format('%s:%s',[sXMLNS,ns_shortName]),typItm.NameSpace);
|
|
end;
|
|
defTypesNode := FindNode(AWsdlDocument.DocumentElement,sWSDL_TYPES) as TDOMElement;
|
|
Assert(Assigned(defTypesNode));
|
|
defSchemaNode := defTypesNode.FirstChild as TDOMElement;
|
|
|
|
//s := Format('%s:%s',[sXSD,sELEMENT]);
|
|
//eltNode := CreateElement(s,defSchemaNode,AWsdlDocument);
|
|
//eltNode.SetAttribute(sNAME, typItm.DeclaredName) ;
|
|
s := Format('%s:%s',[sXSD,sSIMPLE_TYPE]);
|
|
resNode := CreateElement(s,defSchemaNode,AWsdlDocument);
|
|
resNode.SetAttribute(sNAME, typItm.DeclaredName) ;
|
|
s := Format('%s:%s',[sXSD,sRESTRICTION]);
|
|
restrictNode := CreateElement(s,resNode,AWsdlDocument);
|
|
restrictNode.SetAttribute(sBASE,Format('%s:%s',[sXSD,'string'])) ;
|
|
c := GetEnumNameCount(typItm.DataType);
|
|
for i := 0 to pred(c) do begin
|
|
s := Format('%s:%s',[sXSD,sENUMERATION]);
|
|
//CreateElement(s,restrictNode,AWsdlDocument).SetAttribute(sVALUE,GetEnumName(typItm.DataType,i));
|
|
CreateElement(s,restrictNode,AWsdlDocument).SetAttribute(
|
|
sVALUE,
|
|
typItm.GetExternalPropertyName(GetEnumName(typItm.DataType,i))
|
|
);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TFakeTypeHandler }
|
|
|
|
procedure TFakeTypeHandler.Generate(
|
|
const APascalTypeName: string;
|
|
AWsdlDocument: TXMLDocument;
|
|
ATypeRegistry : TTypeRegistry
|
|
);
|
|
begin
|
|
end;
|
|
|
|
function CreateWsdlTypeHandlerRegistry(ATypeRegistry : TTypeRegistry):IWsdlTypeHandlerRegistry;
|
|
begin
|
|
Result := TWsdlTypeHandlerRegistry.Create(ATypeRegistry);
|
|
end;
|
|
|
|
procedure RegisterFondamentalTypesHandler(ARegistry : IWsdlTypeHandlerRegistry);
|
|
var
|
|
r : IWsdlTypeHandlerRegistry;
|
|
begin
|
|
r := ARegistry;
|
|
r.RegisterDefaultHandler(tkInteger,TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
r.RegisterDefaultHandler(tkInt64,TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
|
|
{$IFDEF FPC}
|
|
r.RegisterDefaultHandler(tkQWord,TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
r.RegisterDefaultHandler(tkSString,TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
r.RegisterDefaultHandler(tkAString,TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
r.RegisterDefaultHandler(tkBool,TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
{$ENDIF}
|
|
|
|
r.RegisterDefaultHandler(tkLString,TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
r.RegisterDefaultHandler(tkWString,TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
|
|
r.RegisterDefaultHandler(tkWString,TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
|
|
r.RegisterDefaultHandler(tkEnumeration,TSimpleItemFactory.Create(TEnumTypeHandler));
|
|
|
|
r.RegisterDefaultHandler(tkClass,TSimpleItemFactory.Create(TBaseComplexRemotable_TypeHandler));
|
|
|
|
r.Register('TBaseArrayRemotable',TSimpleItemFactory.Create(TBaseArrayRemotable_TypeHandler));
|
|
|
|
r.RegisterDefaultHandler(tkRecord,TSimpleItemFactory.Create(TRecord_TypeHandler));
|
|
|
|
{ r.Register('Integer',TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
r.Register('LongWord',TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
|
|
r.Register('string',TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
r.Register('shortstring',TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
r.Register('ansistring',TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
r.Register('boolean',TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
|
|
r.Register('Byte',TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
r.Register('ShortInt',TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
r.Register('Word',TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
r.Register('SmallInt',TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
r.Register('Int64',TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
r.Register('QWord',TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
|
|
r.Register('Single',TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
r.Register('Currency',TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
r.Register('Comp',TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
r.Register('Double',TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
r.Register('Extended',TSimpleItemFactory.Create(TFakeTypeHandler));
|
|
}
|
|
end;
|
|
|
|
|
|
{ TBaseArrayRemotable_TypeHandler }
|
|
|
|
procedure TBaseArrayRemotable_TypeHandler.Generate(
|
|
const APascalTypeName: string;
|
|
AWsdlDocument: TXMLDocument;
|
|
ATypeRegistry : TTypeRegistry
|
|
);
|
|
var
|
|
typItm, propTypItm : TTypeRegistryItem;
|
|
s, prop_ns_shortName : string;
|
|
defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode : TDOMElement;
|
|
arrayTypeData : PTypeData;
|
|
arrayTypeClass : TBaseArrayRemotableClass;
|
|
begin
|
|
typItm := ATypeRegistry.Find(APascalTypeName);
|
|
if not Assigned(typItm) then
|
|
Exit;
|
|
arrayTypeData := GetTypeData(typItm.DataType);
|
|
if Assigned(typItm) and
|
|
( typItm.DataType^.Kind = tkClass ) and
|
|
( arrayTypeData^.ClassType.InheritsFrom(TBaseArrayRemotable) )
|
|
then begin
|
|
GetNameSpaceShortName(typItm.NameSpace,AWsdlDocument);
|
|
defTypesNode := FindNode(AWsdlDocument.DocumentElement,sWSDL_TYPES) as TDOMElement;
|
|
Assert(Assigned(defTypesNode));
|
|
defSchemaNode := defTypesNode.FirstChild as TDOMElement;
|
|
|
|
s := Format('%s:%s',[sXSD,sCOMPLEX_TYPE]);
|
|
cplxNode := CreateElement(s,defSchemaNode,AWsdlDocument);
|
|
cplxNode.SetAttribute(sNAME, typItm.DeclaredName) ;
|
|
|
|
s := Format('%s:%s',[sXSD,sSEQUENCE]);
|
|
sqcNode := CreateElement(s,cplxNode,AWsdlDocument);
|
|
arrayTypeClass := TBaseArrayRemotableClass(arrayTypeData^.ClassType);
|
|
propTypItm := ATypeRegistry.Find(arrayTypeClass.GetItemTypeInfo()^.Name);
|
|
s := Format('%s:%s',[sXSD,sELEMENT]);
|
|
propNode := CreateElement(s,sqcNode,AWsdlDocument);
|
|
s := Trim(typItm.GetExternalPropertyName(sARRAY_ITEM));
|
|
if ( s = '' ) then
|
|
s := sITEM;
|
|
propNode.SetAttribute(sNAME,s);
|
|
if Assigned(propTypItm) then begin
|
|
prop_ns_shortName := GetNameSpaceShortName(propTypItm.NameSpace,AWsdlDocument);
|
|
propNode.SetAttribute(sTYPE,Format('%s:%s',[prop_ns_shortName,propTypItm.DeclaredName]));
|
|
propNode.SetAttribute(sMIN_OCCURS,'0');
|
|
propNode.SetAttribute(sMAX_OCCURS,sUNBOUNDED);
|
|
if arrayTypeClass.InheritsFrom(TObjectCollectionRemotable) then begin
|
|
propNode.SetAttribute(
|
|
Format('%s:wst_collection',[GetNameSpaceShortName(sWST_BASE_NS,defSchemaNode,sWST_BASE_NS_ABR)]),
|
|
sTRUE_LOWERCASE
|
|
);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TRecord_TypeHandler }
|
|
|
|
procedure TRecord_TypeHandler.Generate(
|
|
const APascalTypeName : string;
|
|
AWsdlDocument : TXMLDocument;
|
|
ATypeRegistry : TTypeRegistry
|
|
);
|
|
var
|
|
typItm, propTypItm : TTypeRegistryItem;
|
|
s, prop_ns_shortName : string;
|
|
defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode : TDOMElement;
|
|
i : PtrUInt;
|
|
p : TRecordFieldInfo;
|
|
objTypeData : PRecordTypeData;
|
|
persistType : TPropStoreType;
|
|
begin
|
|
typItm := ATypeRegistry.Find(APascalTypeName);
|
|
if Assigned(typItm) and
|
|
( typItm.DataType^.Kind = tkRecord )
|
|
then begin
|
|
GetNameSpaceShortName(typItm.NameSpace,AWsdlDocument);
|
|
defTypesNode := FindNode(AWsdlDocument.DocumentElement,sWSDL_TYPES) as TDOMElement;
|
|
Assert(Assigned(defTypesNode));
|
|
defSchemaNode := defTypesNode.FirstChild as TDOMElement;
|
|
|
|
objTypeData := TRecordRttiDataObject(typItm.GetObject(FIELDS_STRING)).GetRecordTypeData();
|
|
persistType := pstOptional;
|
|
|
|
s := Format('%s:%s',[sXSD,sCOMPLEX_TYPE]);
|
|
cplxNode := CreateElement(s,defSchemaNode,AWsdlDocument);
|
|
cplxNode.SetAttribute(sNAME, typItm.DeclaredName);
|
|
cplxNode.SetAttribute(Format('%s:wst_record',[GetNameSpaceShortName(sWST_BASE_NS,defSchemaNode,'wst')]),sTRUE_LOWERCASE);
|
|
|
|
sqcNode := CreateElement(Format('%s:%s',[sXSD,sSEQUENCE]),cplxNode,AWsdlDocument);
|
|
if ( objTypeData^.FieldCount > 0 ) then begin
|
|
for i := 0 to Pred(objTypeData^.FieldCount) do begin
|
|
p := objTypeData^.Fields[i];
|
|
if p.Visible then begin
|
|
if p.IsAttribute then begin
|
|
s := Format('%s:%s',[sXSD,sATTRIBUTE]);
|
|
propNode := CreateElement(s,cplxNode,AWsdlDocument)
|
|
end else begin
|
|
s := Format('%s:%s',[sXSD,sELEMENT]);
|
|
propNode := CreateElement(s,sqcNode,AWsdlDocument);
|
|
end;
|
|
propNode.SetAttribute(sNAME,typItm.GetExternalPropertyName(p.Name));
|
|
propTypItm := ATypeRegistry.Find(p.TypeInfo^^.Name);
|
|
if Assigned(propTypItm) then begin
|
|
prop_ns_shortName := GetNameSpaceShortName(propTypItm.NameSpace,AWsdlDocument);
|
|
propNode.SetAttribute(sTYPE,Format('%s:%s',[prop_ns_shortName,propTypItm.DeclaredName]));
|
|
if p.IsAttribute then begin
|
|
if ( persistType = pstOptional ) then
|
|
propNode.SetAttribute(sUSE,'optional')
|
|
else
|
|
propNode.SetAttribute(sUSE,'required');
|
|
end else begin
|
|
if ( persistType = pstOptional ) then
|
|
propNode.SetAttribute(sMIN_OCCURS,'0')
|
|
else
|
|
propNode.SetAttribute(sMIN_OCCURS,'1');
|
|
propNode.SetAttribute(sMAX_OCCURS,'1');
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
WsdlTypeHandlerRegistryInst := CreateWsdlTypeHandlerRegistry(GetTypeRegistry());
|
|
RegisterFondamentalTypesHandler(WsdlTypeHandlerRegistryInst);
|
|
|
|
finalization
|
|
WsdlTypeHandlerRegistryInst := nil;
|
|
|
|
end.
|