unit uRODLToWSDL;

{----------------------------------------------------------------------------}
{ RemObjects SDK Library - CodeGen                                           }
{                                                                            }
{ compiler: Delphi 5 and up, Kylix 2 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Using this code requires a valid license of the RemObjects SDK             }
{ which can be obtained at http://www.remobjects.com.                        }
{----------------------------------------------------------------------------}

{$IFNDEF MSWINDOWS}
{$I ../RemObjects.inc}
{$ELSE}
{$I ..\RemObjects.inc}
{$ENDIF}

interface

uses
  Classes, uRODL, uROTypes, uROClasses, uROXMLSerializer;

const

  SOAPDataTypes : array[TRODataType] of string = (
        'int',
        'dateTime',
        'double',
        'double',
        'string',
        'string',
        'long',
        'boolean',
        'anyType',
        dts_base64Binary,
        'any',
        'string',
        'decimal',
        'string',
        'dateTime',
        '???');


type
  { TRODLToWSDL }
  TRODLToWSDL = class(TRODLConverter)
  private
    fLocation: string;
    fShowClientId: Boolean;
    fUseLiteral: Boolean;
    fUseDocument: Boolean;
    fTargetEntity, fTargetNamespace: string;
    fExternalTypesAsReferences: Boolean;
    fHasXsdData: Boolean;
    fExternalRefs, // namespace
    fExternalUrls: TStrings; // uri
    fXsdTns,
    fTargetXSD: string;
    procedure SetLocation(const Value: string);
    function GetPrefix(const aType, aNs: string): String;

    procedure WriteEnum(anEnum : TRODLEnum);
    procedure WriteStruct(const aLibrary: TRODLLibrary; aStruct : TRODLStruct);
    procedure WriteArray(anArray : TRODLArray);
    procedure WriteExceptionElement(anException : TRODLException);

    procedure WriteMessages(aLibrary: TRODLLibrary; aService : TRODLService);
    procedure WriteExceptionMessage(anException: TRODLException);
    procedure WriteLiteralParameters(aLibrary: TRODLLibrary; aService : TRODLService);
    procedure WriteBindings(aLibrary: TRODLLibrary; aService : TRODLService);
    procedure WritePorts(aLibrary: TRODLLibrary; aService : TRODLService);
    procedure WriteExceptionParts(aMeth: TRODLOperation);
    procedure WriteService(aLibrary: TRODLLibrary; aService : TRODLService);
    function GetAnchestor(aLibrary: TRODLLibrary;
      aService: TRODLService): TRODLService;
    procedure WriteAnnotation(aDocString: string; aIndentation: Integer = 0; aNs:
        string = 'xs:');
    procedure WriteDocumentation(aDocString: string; aIndentation: Integer = 0;
        aNs: string = 'xs:');
    function ExtSOAPDataType(aLibrary: TRODLLibrary; const aDataTypeName : string) : string;
    procedure ResolveExternalReferences(aLibrary: TRODLLibrary);
    function ReplaceSpecialChars(aText: String): String;
  protected
    procedure IntConvert(const aLibrary : TRODLLibrary; const aTargetEntity : string = ''); override;
    procedure AddExternal(aNode: TRODLEntity); overload;
    procedure AddExternal(const aNs,aUrl: string); overload;

  public
    constructor Create(const aLibraryFile: string; const aTargetEntity: string = ''); overload; override;
    constructor Create(const aLibrary: TRODLLibrary; const aTargetEntity: string = ''); overload; override;
    destructor Destroy; override;
    property TargetXsd: string read fTargetXSD write fTargetXSD;
    property Location : string read fLocation write SetLocation;
    property TargetNamespace: string read fTargetNamespace write fTargetNamespace;
    property ShowClientId : Boolean read fShowClientId write fShowClientId;
    property UseLiteral : Boolean read fUseLiteral write fUseLiteral;
    property UseDocument : Boolean read fUseDocument write fUseDocument;
    property ExternalTypesAsReferences : Boolean read fExternalTypesAsReferences write fExternalTypesAsReferences;
  end;

function SOAPDataType(const aDataTypeName : string; IncludeNamespace : boolean = TRUE) : string;

implementation

uses SysUtils;

function SOAPDataType(const aDataTypeName : string; IncludeNamespace : boolean = TRUE) : string;
var dt : TRODataType;
begin
  dt := StrToDataType(aDataTypeName);
  if (dt=rtUserDefined)
    then result := aDataTypeName
    else result := SOAPDataTypes[dt];

  if IncludeNamespace then begin
    if (dt=rtUserDefined) then result := 'tns:'+result
                          else result := ns_Standard+':'+result;
  end;
end;

{ TRODLToWSDL }

const
  definitions_ns : array[0..5] of string = ('xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/" ',
                                            'xmlns:xs="http://www.w3.org/2001/XMLSchema" ',
                                            'name="%s" ',
                                            'xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/" ',
                                            'xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" ',
                                            'xmlns:mime="http://schemas.xmlsoap.org/wsdl/mime/"');

procedure TRODLToWSDL.IntConvert(const aLibrary: TRODLLibrary; const aTargetEntity: string);
var
  s, i: integer;
  lService: TRODLService;
begin
  if pos(':', fTargetNamespace) = 0 then fTargetNamespace := 'urn:'+fTargetNamespace;
  fTargetEntity := aTargetEntity;
  with aLibrary do begin
    if (aTargetEntity<>'') then begin
        lService := aLibrary.FindService(aTargetEntity);
        if (lService <> nil) then
          if lService.isPrivate then Exit;
      end else
        lService := NIL;
    fExternalRefs.Clear;
	fExternalUrls.Clear;
    fXsdTns := '';
    if fExternalTypesAsReferences then begin
      ResolveExternalReferences(aLibrary);
    end;
    if fXsdTns = '' then
      fXsdTns := fTargetNamespace;



    Write('<?xml version="1.0" encoding="UTF-8" ?>');
    if fTargetXSD <> '' then begin
      if not fHasXsdData then raise Exception.Create('No xsd by that name');
      Write('<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema" xmlns="'+ fXsdTns +'"');
      Write('targetNamespace="'+fXsdTns+'" elementFormDefault="qualified"', 3);
      Write('xmlns:tns="'+ fXsdTns +'" ', 3);
      for i := 0 to fExternalRefs.Count -1 do begin
        if fExternalRefs[i] <> fXsdTns then
          write('xmlns:ns'+IntToStr(i)+'="'+fExternalRefs[i]+'" ', 3);
      end;
      Write('>');


    end else begin
      Write('<wsdl:definitions ');

      for i := 0 to High(definitions_ns) do
          Write(Format(definitions_ns[i], [Name]), 3);

      Write('targetNamespace="'+ fTargetNamespace +'" ', 3);
      Write('xmlns:tns="'+ fTargetNamespace +'" ', 3);

      for i := 0 to fExternalRefs.Count -1 do begin
        write('xmlns:ns'+IntToStr(i)+'="'+fExternalRefs[i]+'" ', 3);
      end;

      Write('>');
      WriteAnnotation(aLibrary.Documentation); {Giovanni}


      // Write types

      Write('<wsdl:types>', 3);
      Write(Format('<xs:schema targetNamespace="%s" elementFormDefault="qualified">', [fTargetNamespace]), 6);
    end;

    for i := 0 to fExternalRefs.Count -1 do begin
      if ((fTargetXSD ='') and (fExternalRefs[i] = fTargetNamespace)) or
        ((fTargetXSD <> '') and (fExternalRefs[i] = fXsdTns)) then
        Write(Format('<xs:include schemaLocation="%s?xsd=%s" />',[flocation, fExternalUrls[i]] ), 3)
      else
        Write(Format('<xs:import namespace="%s" schemaLocation="%s?xsd=%s" />',[fExternalRefs[i], fLocation, fExternalUrls[i]] ), 3);
    end;

    for i := 0 to (EnumCount-1) do WriteEnum(Enums[i]);
    for i := 0 to (StructCount-1) do WriteStruct(aLibrary, Structs[i]);
    for i := 0 to (ArrayCount-1) do WriteArray(Arrays[i]);
    for i := 0 to (ExceptionCount-1) do WriteExceptionElement(Exceptions[i]);
    if fUseLiteral and fUseDocument then begin
      if (aTargetEntity<>'') then WriteLiteralParameters(aLibrary, lService)
      else for s := 0 to (ServiceCount-1) do begin
        lService := Services[s];
        WriteLiteralParameters(aLibrary, lService);
      end;
      if fShowClientId then begin
        Write('<xs:element name="ROClientIDHeader">', 3);
        Write('<xs:complexType>', 6);
        Write('<xs:sequence>', 9);
        Write('<xs:element name="ID" minOccurs="0" maxOccurs="1" type="xs:string" />', 6);
        Write('</xs:sequence>', 9);
        Write('</xs:complexType>', 6);
        Write('</xs:element>', 3);
      end;
    end;
    Write('</xs:schema>', 6);
    if fTargetXSD = '' then begin
      Write('</wsdl:types>', 3);

      // Writes messages
      if (aTargetEntity<>'') then WriteMessages(aLibrary, lService)
      else for s := 0 to (ServiceCount-1) do begin
        lService := Services[s];
        WriteMessages(aLibrary, lService);
      end;
      for s := 0 to aLibrary.ExceptionCount -1 do begin
        WriteExceptionMessage(aLibrary.Exceptions[s]);
      end;
      if fShowClientId and fUseLiteral and fUseDocument then begin
        Write('<wsdl:message name="ROClientIDHeaderMessage">', 3);
        Write('<wsdl:part name="ROClientID" element="tns:ROClientIDHeader" />', 3);
        Write('</wsdl:message>', 3);
      end;

      // Writes port and operations
      if (aTargetEntity<>'') then WritePorts(aLibrary, lService)
      else for s := 0 to (ServiceCount-1) do begin
        lService := Services[s];
        WritePorts(aLibrary, lService);
      end;

      // Write bindings
      if (aTargetEntity<>'') then WriteBindings(aLibrary, lService)
      else for s := 0 to (ServiceCount-1) do begin
        lService := Services[s];
        WriteBindings(aLibrary, lService);
      end;

      // Writes services
      if (aTargetEntity<>'') then WriteService(aLibrary, lService)
      else for s := 0 to (ServiceCount-1) do begin
        lService := Services[s];
        WriteService(aLibrary, lService);
      end;

      Write('</wsdl:definitions>');
    end;
  end;
end;

procedure TRODLToWSDL.SetLocation(const Value: string);
begin
  fLocation := Value;
end;

procedure TRODLToWSDL.WriteArray(anArray: TRODLArray);
var
  lMin,
  lMax: Integer;
begin
  if fExternalTypesAsReferences and (anArray.Attributes.Values['ImportedFromUrl'] <> fTargetXSD) then exit;
  Write(Format('<xs:complexType name="%s">', [anArray.Name]), 9);
  WriteAnnotation(anArray.Documentation, 9);

  if fUseDocument then begin
    Write('<xs:sequence>', 12);

    lMax := StrToIntDef(anArray.Attributes.Values['MaxOccurs'], -1);
    lMin := StrToIntDef(anArray.Attributes.Values['MinOccurs'], 0);

    if lMax = -1 then begin
      Write(Format('<xs:element name="%s" minOccurs="%d" maxOccurs="unbounded" type="%s" />', [Unprefix(SOAPDataType(anArray.ElementType, false)),
        lMin,
        ExtSOAPDataType(anArray.OwnerLibrary, anArray.ElementType)]), 15);
    end else begin
    Write(Format('<xs:element name="%s" minOccurs="%d" maxOccurs="%d" type="%s" />', [Unprefix(SOAPDataType(anArray.ElementType, false)),
      lMin,
      lMax,
      ExtSOAPDataType(anArray.OwnerLibrary, anArray.ElementType)]), 15);
    end;
    Write('</xs:sequence>', 12);
  end else begin
    Write('<xs:complexContent>', 12);
    Write('<xs:restriction base="soapenc:Array">', 15);
    Write('<xs:sequence />', 18);
    Write(Format('<xs:attribute ref="soapenc:arrayType" n1:arrayType="%s[]" xmlns:n1="http://schemas.xmlsoap.org/wsdl/" />',
            [Unprefix(ExtSOAPDataType(anArray.OwnerLibrary, anArray.ElementType))]), 18);
    Write('</xs:restriction>', 15);

    Write('</xs:complexContent>', 12);

  end;
  Write('</xs:complexType>', 9);
end;

procedure TRODLToWSDL.WriteEnum(anEnum: TRODLEnum);
var i : integer;
begin
  if fExternalTypesAsReferences and (anEnum.Attributes.Values['ImportedFromUrl'] <> fTargetXSD) then exit;
  Write(Format('<xs:simpleType name="%s">', [anEnum.Name]), 9);
  WriteAnnotation(anEnum.Documentation, 12); {Giovanni}
  Write('<xs:restriction base="xs:string">', 12);
  for i := 0 to anEnum.Count-1 do
  begin
    //WriteDocumentation(anEnum.Items[i].Documentation, 12); {Giovanni}
    Write(Format('<xs:enumeration value="%s" />', [Unprefix(anEnum.Items[i].Name)]), 15);
  end;
  Write('</xs:restriction>', 12);
  Write('</xs:simpleType>', 9);
end;

function TRODLToWSDL.GetAnchestor(aLibrary: TRODLLibrary; aService: TRODLService): TRODLService;
begin
  result := NIL;
  if (aService.Ancestor<>'') and not aService.isPrivate
    then result := aLibrary.FindService(aService.Ancestor)
end;

procedure TRODLToWSDL.WriteMessages(aLibrary: TRODLLibrary; aService: TRODLService);
var o, p : integer;
    dups : TStringList;
    lRet: TRODLStruct;
    lType, s, svcname, mtdname : string;
    op : TRODLOperation;
begin
  // Writes all the methods of this service and its anchestors.
  // If more than one service descend from the same base one, the WSDL has to be generated
  // using a format like this: http://localhost:8099/SOAP?Service=ServiceOne

  svcname := aService.Name;
  dups := TStringList.Create;
  dups.Duplicates := dupIgnore;
  dups.Sorted := TRUE;
  try
    while Assigned(aService) and not aService.isPrivate do begin

      with aService.Default do begin
        for o := 0 to (Count-1) do begin
          op := Items[o];

          // If a method with this name is present, it skips it
          mtdname := UpperCase(op.Name);
          if (dups.IndexOf(mtdname)>=0) then Continue else dups.Add(mtdname);

          if fUseLiteral and fUseDocument then begin
               Write(Format('<wsdl:message name="%s___%sRequest">', [Unprefix(svcname), Unprefix(op.Name)]), 3);
               s := op.Attributes.Values['SOAPInputNameOverride'];
               if s = '' then s := Format('%s___%s', [svcname, op.Name]);
               Write(Format('<wsdl:part name="parameters" element="tns:%s" />', [s]), 6);
               Write('</wsdl:message>', 3);
               Write(Format('<wsdl:message name="%s___%sResponse">', [Unprefix(svcname), Unprefix(op.Name)]), 3);
               s := op.Attributes.Values['SOAPOutputNameOverride'];
               if s = '' then s := Format('%s___%sResponse', [svcname, op.Name]);
               Write(Format('<wsdl:part name="parameters" element="tns:%s" />', [s]), 6);
               Write('</wsdl:message>', 3);
          end 
          else begin
          // Continues
          with Items[o] do begin
             // Request
             Write(Format('<wsdl:message name="%s___%sRequest">', [Unprefix(svcname), Unprefix(op.Name)]), 3);
             for p := 0 to (Count-1) do
               if IsInputFlag(Items[p].Flag) then begin
                 lType := Items[p].DataType;
                 lRet := aLibrary.FindStruct(lType);
                 if (lRet <> nil) and (lRet.Count = 1) and (lRet.Attributes.Values['Anonymous'] = '1') then
                   lType := lRet.Items[0].DataType;

                 Write(Format('<wsdl:part name="%s" type="%s" />', [Unprefix(Items[p].Name), ExtSOAPDataType(aLibrary, lType)]), 6);
               end;
             Write('</wsdl:message>', 3);

             // Response
             Write(Format('<wsdl:message name="%s___%sResponse">', [Unprefix(svcname), Unprefix(op.Name)]), 3);

             if Assigned(aService.Default.Items[o].Result) then begin
                lType := op.Result.DataType;
                 lRet := aLibrary.FindStruct(lType);
                 if (lRet <> nil) and (lRet.Count = 1) and (lRet.Attributes.Values['Anonymous'] = '1') then
                   lType := lRet.Items[0].DataType;
                 Write(Format('<wsdl:part name="%s" type="%s" />', [Unprefix(op.Result.Name), ExtSOAPDataType(aLibrary, lType)]), 6);
             end;
                 //Write(Format('<part name="return" type="%s" />', [SOAPDataType(aService.Default.Items[o].Result.DataType)]), 6);

             for p := 0 to (Count-1) do begin
               if Items[p].Flag in [fOut, fInOut] then begin
                 lType := Items[p].DataType;
                                  lRet := aLibrary.FindStruct(lType);
                 if (lRet <> nil) and (lRet.Count = 1) and (lRet.Attributes.Values['Anonymous'] = '1') then
                   lType := lRet.Items[0].DataType;

                 Write(Format('<wsdl:part name="%s" type="%s" />', [Unprefix(Items[p].Name), ExtSOAPDataType(aLibrary, lType)]), 6);
               end;
             end;
             Write('</wsdl:message>', 3);
          end;
      end;
        end;
      end;
      aService := GetAnchestor(aLibrary, aService);
    end;
  finally
    dups.Free;
  end;
end;

procedure TRODLToWSDL.WritePorts(aLibrary: TRODLLibrary; aService: TRODLService);
var o : integer;
svcname: string;
begin
  // Writes a port for each method of this service and its anchestors.
  // Refer to the comment in TRODLToWSDL.WriteMessages
  if aService.isPrivate then Exit;
  svcname := aService.Name;
  Write(Format('<wsdl:portType name="%s">', [Unprefix(svcname)]), 3);
  WriteDocumentation(aService.Documentation, 6, 'wsdl:');
  while Assigned(aService) and not aService.isPrivate  do begin

    for o := 0 to (aService.Default.Count-1) do begin
      with aService.Default.Items[o] do begin
        Write(Format('<wsdl:operation name="%s">', [Unprefix(Name)]), 6);
        WriteDocumentation(Documentation, 6, 'wsdl:'); {Giovanni}
        Write(Format('<wsdl:input message="tns:%s___%sRequest" />', [Unprefix(svcname), Unprefix(Name)]), 9);
        Write(Format('<wsdl:output message="tns:%s___%sResponse" />', [Unprefix(svcname), Unprefix(Name)]), 9);
        WriteExceptionParts(aService.Default.Items[o]);
        Write(Format('</wsdl:operation>', [Name]), 6)
      end;
    end;

    aService := GetAnchestor(aLibrary, aService);
  end;
  Write('</wsdl:portType>', 3);
end;

procedure TRODLToWSDL.WriteBindings(aLibrary: TRODLLibrary; aService: TRODLService);
var o : integer;
    lAct, svcname : string;
begin
  // Write all the bindings for this service and its anchestors using the method names.
  // It's important to notice that we NEVER use the anchestor name when composing the SOAPAction, but
  // always use the final service name
  if aService.isPrivate then Exit;
  svcname := aService.Name;

  Write(Format('<wsdl:binding name="%sBinding" type="tns:%s">', [Unprefix(svcname), Unprefix(svcname)]), 3);
  WriteAnnotation(aService.Documentation, 6); {Giovanni}
  if fUseDocument then
    Write('<soap:binding transport="http://schemas.xmlsoap.org/soap/http" />', 6)
  else
    Write('<soap:binding style="rpc" transport="http://schemas.xmlsoap.org/soap/http" />', 6);

  while Assigned(aService) and not aService.isPrivate do begin

    for o := 0 to (aService.Default.Count-1) do begin
      with aService.Default.Items[o] do begin
        lAct := Attributes.Values['Action'];
        Write(Format('<wsdl:operation name="%s">', [Unprefix(Name)]), 9);
        if lAct <> '' then begin
          if pos(':', lAct) = 0 then lAct := 'urn:'+lAct;
          if fUseDocument then
            Write(Format('<soap:operation soapAction="%s" style="document" />', [lAct]),12)
          else
            Write(Format('<soap:operation soapAction="%s" style="rpc" />', [lAct]),12);
        end else begin
          if fUseDocument then
            Write(Format('<soap:operation soapAction="urn:%s-%s#%s" style="document" />', [aLibrary.Name, Unprefix(svcname), Unprefix(Name)]),12)
          else
            Write(Format('<soap:operation soapAction="urn:%s-%s#%s" style="rpc" />', [aLibrary.Name, Unprefix(svcname), Unprefix(Name)]),12);
        end;
        if fUseLiteral then begin
          Write('<wsdl:input>', 12);
          Write('<soap:body use="literal" />', 15);
          if fShowClientId and fUseDocument then
            write('<soap:header message="tns:ROClientIDHeaderMessage" use="literal" part="ROClientID" />', 15);
          Write('</wsdl:input>', 12);

          Write('<wsdl:output>', 12);
          Write('<soap:body use="literal" />', 15);
          if fShowClientId and fUseDocument then
            write('<soap:header message="tns:ROClientIDHeaderMessage" use="literal" part="ROClientID" />', 15);
          Write('</wsdl:output>', 12);
        end
        else begin
        Write('<wsdl:input>', 12);
        Write(Format('<soap:body use="encoded" '+
                     'encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" '+
                     'namespace="urn:%s-%s" />',
              [Unprefix(aLibrary.Name), Unprefix(svcname)]), 15);
        Write('</wsdl:input>', 12);

        Write('<wsdl:output>', 12);
        Write(Format('<soap:body use="encoded" '+
                     'encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" '+
                     'namespace="urn:%s-%s" />',
              [Unprefix(aLibrary.Name), Unprefix(svcname)]), 15);
        Write('</wsdl:output>', 12);
        end;

        Write('</wsdl:operation>', 9);
      end;
    end;

    aService := GetAnchestor(aLibrary, aService);
  end;

  Write('</wsdl:binding>', 3);
end;


procedure TRODLToWSDL.WriteAnnotation(aDocString: string; aIndentation: Integer
    = 0; aNs: string = 'xs:');
begin
  if Trim(aDocString) = '' then exit;
  Write(Format('<%sannotation>',[aNs]), aIndentation);
  WriteDocumentation(aDocString,aIndentation+3, aNs);
  Write(Format('</%sannotation>',[aNs]), aIndentation);
end;


procedure TRODLToWSDL.WriteDocumentation(aDocString: string; aIndentation:
    Integer = 0; aNs: string = 'xs:');
var lDocString: String;
begin
  lDocString := ReplaceSpecialChars(aDocString);
  if Trim(aDocString) = '' then exit;
  Write(Format('<%sdocumentation>',[aNs]), aIndentation);
  Write(Format('%s', [lDocString]),aIndentation);
  Write(Format('</%sdocumentation>',[aNs]), aIndentation);
end;

procedure TRODLToWSDL.WriteService(aLibrary: TRODLLibrary; aService: TRODLService);
begin
  // We only write the service itself, ignoring the anchestors
  if aService.isPrivate then Exit;
  Write(Format('<wsdl:service name="%s">', [Unprefix(aService.Name)]), 3);
  WriteAnnotation(aService.Default.Documentation, 6);

  while Assigned(aService) and not aService.isPrivate  do begin
    Write(Format('<wsdl:port name="%sPort" binding="tns:%sBinding">',
                 [Unprefix(aService.Name), Unprefix(aService.Name)]), 6);
    Write(Format('<soap:address location="%s" />', [fLocation+'?service='+StringReplace(aService.Name,' ', '+', [rfReplaceAll])]), 9);
    Write('</wsdl:port>', 6);

    aService := NIL;//GetAnchestor(aLibrary, aService);
  end;

  Write('</wsdl:service>',3);
end;

procedure TRODLToWSDL.WriteStruct(const aLibrary: TRODLLibrary; aStruct: TRODLStruct);
var
  i : integer;
  lLax: Boolean;
  lRet: TRODLStruct;
begin
  if fExternalTypesAsReferences and (aStruct.Attributes.Values['ImportedFromUrl'] <> fTargetXSD) then exit;
  if  aStruct.Attributes.Values['Anonymous'] = '1' then exit;
  Write(Format('<xs:complexType name="%s">', [Unprefix(aStruct.Name)]), 9);
  WriteAnnotation(aStruct.Documentation, 9); {Giovanni}
  if fUseDocument then begin
    if aStruct.Ancestor <> '' then begin
      write(Format('<xs:complexContent><xs:extension base="%s">', [ExtSOAPDataType(aLibrary, aStruct.Ancestor)]), 9);
    end;
  end;
  Write('<xs:sequence>', 12);
  lLax := aStruct.Attributes.Values['lax'] = '1';
  while Assigned(aStruct) do begin
    for i := 0 to aStruct.Count-1 do
      with aStruct.Items[i] do begin
        lRet := aLibrary.FindStruct(DataType);
        if (lRet <> nil) and (lRet.Count = 1) and (lRet.Attributes.Values['Anonymous'] = '1') then begin
          if lRet.Attributes.Values['Nillable'] = '1' then
            Write(Format('<xs:element name="%s" type="%s" nillable="1">', [Unprefix(Name), ExtSOAPDataType(aLibrary, lRet.Items[0].DataType)]), 15)
          else
            Write(Format('<xs:element name="%s" type="%s" minOccurs="0" maxOccurs="1">', [Unprefix(Name), ExtSOAPDataType(aLibrary, lRet.Items[0].DataType)]), 15);
        end else begin
          Write(Format('<xs:element name="%s" type="%s">', [Unprefix(Name), ExtSOAPDataType(aLibrary, DataType)]), 15);
        end;
        WriteAnnotation(Documentation, 15); {Giovanni}
        Write('</xs:element>',15);
      end;

    if fUseDocument then break;
    if aStruct.Ancestor <> '' then begin
      aStruct := aLibrary.FindStruct(aStruct.Ancestor)
    end
    else begin
      aStruct := nil;
    end;
  end;
  if lLax then
    Write('<xs:any namespace="##any" processContents="lax"/>', 15);
  Write('</xs:sequence>', 12);
  if fUseDocument then begin
    if aStruct.Ancestor <> '' then
      write('</xs:extension></xs:complexContent>', 9);
  end;

  Write('</xs:complexType>', 9);
end;

procedure TRODLToWSDL.WriteLiteralParameters(aLibrary: TRODLLibrary;
  aService: TRODLService);
var o, p, i : integer;
    dups : TStringList;
    s, svcname, mtdname : string;
    op : TRODLOperation;
    lRet: TRODLStruct;
begin
  // Writes all the methods of this service and its anchestors.
  // If more than one service descend from the same base one, the WSDL has to be generated
  // using a format like this: http://localhost:8099/SOAP?Service=ServiceOne

  svcname := aService.Name;
  dups := TStringList.Create;
  dups.Duplicates := dupIgnore;
  dups.Sorted := TRUE;
  try
    while Assigned(aService) and not aService.isPrivate do begin

      for o := 0 to (aService.Default.Count-1) do begin
        op := aService.Default.Items[o];

        // If a method with this name is present, it skips it
        mtdname := UpperCase(op.Name);
        if (dups.IndexOf(mtdname)>=0) then Continue else dups.Add(mtdname);

        s := op.Attributes.Values['SOAPInputNameOverride'];
        if s = '' then s := Format('%s___%s', [Unprefix(svcname), Unprefix(op.Name)]);

        if not ((fExternalTypesAsReferences) and (op.Attributes.Values['InputImportedFromUrl'] <> fTargetXSD)) then begin
          p := 0;
          for i := 0 to op.Count -1 do begin
            if op[i].Flag in [fIn, fInOut] then
              inc(p);
          end;
          write(Format('<xs:element name="%s">', [Unprefix(s)]), 3);
          if p = 0 then begin
            write('<xs:complexType />', 6);
          end
          else begin
            write('<xs:complexType>', 6);
            write('<xs:sequence>', 9);
            for i := 0 to op.Count -1 do begin
              if op[i].Flag in [fIn, fInOut] then begin
                lRet := aLibrary.FindStruct(op[i].DataType);
                if (lRet <> nil) and (lRet.Count = 1) and (lRet.Attributes.Values['Anonymous'] = '1') then begin
                  if lRet.Attributes.Values['Nillable'] = '1' then
                    write(Format('<xs:element name="%s" nillable="1" type="%s" />', [Unprefix(op[i].Name), ExtSOAPDataType(aLibrary, lRet[0].DataType)]), 12)
                  else
                    write(Format('<xs:element name="%s" minOccurs="0" maxOccurs="1" type="%s" />', [Unprefix(op[i].Name), ExtSOAPDataType(aLibrary, lRet[0].DataType)]), 12);
                end else

                write(Format('<xs:element name="%s" minOccurs="1" maxOccurs="1" type="%s" />', [Unprefix(op[i].Name), ExtSOAPDataType(aLibrary, op[i].DataType)]), 12);
              end;
            end;
          if op.Attributes.VAlues['InputLax'] = '1' then
            Write('<xs:any namespace="##any" processContents="lax"/>', 12);
            write('</xs:sequence>', 9);
            write('</xs:complexType>', 6);
          end;

          write('</xs:element>', 3);
        end;

        s := op.Attributes.Values['SOAPOutputNameOverride'];
        if s = '' then s := Format('%s___%sResponse', [Unprefix(svcname), Unprefix(op.Name)]);
        if not ((fExternalTypesAsReferences) and (op.Attributes.Values['OutputImportedFromUrl'] <> fTargetXSD)) then begin
          p := 0;
          for i := 0 to op.Count -1 do begin
            if op[i].Flag in [fOut, fInOut, fResult] then
              inc(p);
          end;
          if op.Result <> nil then begin
            inc(p);
          end;
          write(Format('<xs:element name="%s">', [Unprefix(s)]), 3);
          if p = 0 then begin
            write('<xs:complexType />', 6);
          end
          else begin
            write('<xs:complexType>', 6);
            write('<xs:sequence>', 9);
            if op.Result <> nil then begin
                lRet := aLibrary.FindStruct(op.Result.DataType);
                if (lRet <> nil) and (lRet.Count = 1) and (lRet.Attributes.Values['Anonymous'] = '1') then begin
                  if lRet.Attributes.Values['Nillable'] = '1' then
                    write(Format('<xs:element name="%s" nillable="1" type="%s" />', [Unprefix(op.Result.Name), ExtSOAPDataType(aLibrary, lRet[0].DataType)]), 12)
                  else
                    write(Format('<xs:element name="%s" minOccurs="0" maxOccurs="1" type="%s" />', [Unprefix(op.Result.Name), ExtSOAPDataType(aLibrary, lRet[0].DataType)]), 12);
                end else
                  write(Format('<xs:element name="%s" minOccurs="1" maxOccurs="1" type="%s" />', [Unprefix(op.Result.Name), ExtSOAPDataType(aLibrary, op.Result.DataType)]), 12);
            end;
            for i := 0 to op.Count -1 do begin
              if op[i].Flag in [fOut, fInOut, fResult] then begin
                lRet := aLibrary.FindStruct(op[i].DataType);
                if (lRet <> nil) and (lRet.Count = 1) and (lRet.Attributes.Values['Anonymous'] = '1') then begin
                  if lRet.Attributes.Values['Nillable'] = '1' then
                    write(Format('<xs:element name="%s" nillable="1" type="%s" />', [Unprefix(op[i].Name), ExtSOAPDataType(aLibrary, lRet[0].DataType)]), 12)
                  else
                    write(Format('<xs:element name="%s" minOccurs="0" maxOccurs="1" type="%s" />', [Unprefix(op[i].Name), ExtSOAPDataType(aLibrary, lRet[0].DataType)]), 12);
                end else
                  write(Format('<xs:element name="%s" minOccurs="1" maxOccurs="1" type="%s" />', [Unprefix(op[i].Name), ExtSOAPDataType(aLibrary, op[i].DataType)]), 12);
              end;
            end;
          if op.Attributes.VAlues['OutputLax'] = '1' then
            Write('<xs:any namespace="##any" processContents="lax"/>', 12);
            write('</xs:sequence>', 9);
            write('</xs:complexType>', 6);
          end;
          write('</xs:element>', 3);
        end;
      end;
      aService := GetAnchestor(aLibrary, aService);
    end;
  finally
    dups.Free;
  end;
end;

constructor TRODLToWSDL.Create(const aLibraryFile, aTargetEntity: string);
begin
  fTargetNamespace := 'http://tempuri.org/';
  fExternalRefs := TStringList.Create;
  fExternalUrls := TStringList.Create;
  inherited;
end;

constructor TRODLToWSDL.Create(const aLibrary: TRODLLibrary;
  const aTargetEntity: string);
begin
  fTargetNamespace := 'http://tempuri.org/';
  fExternalRefs := TStringList.Create;
  fExternalUrls := TStringList.Create;
  inherited;
end;

destructor TRODLToWSDL.Destroy;
begin
  fExternalRefs.Free;
  fExternalUrls.Free;
  inherited;
end;

procedure TRODLToWSDL.AddExternal(aNode: TRODLEntity);
var
  lEx: TRODLException;
begin
  if Anode = nil then exit;
  if aNode is TRODLException then begin
    lEx := TRODLException(aNode);
    if (fTargetXSD = '') or (fTargetXSD <> lEx.Attributes.Values['ElementUrl']) then
      AddExternal(lEx.Attributes.Values['ElementNamespace'], lEx.Attributes.Values['ElementUrl']);
    exit;
  end;
  if aNode.Attributes.Values['ImportedFromUrl'] = '' then exit;
  AddExternal(aNode.Attributes.Values['ImportedFromNamespace'], aNode.Attributes.Values['ImportedFromUrl']);
end;

procedure TRODLToWSDL.AddExternal(const aNs,aUrl: string);
var
  i: Integer;
begin
  for i := 0 to fExternalRefs.Count -1 do begin
    if (fExternalRefs[i] = aNs) and (fExternalUrls[i] = aUrl) then exit;
  end;
  fExternalRefs.Add(aNs);
  fExternalUrls.ADd(aUrl);
end;


function TRODLToWSDL.ExtSOAPDataType(aLibrary: TRODLLibrary; const aDataTypeName: string): string;
var
  el: TRODLEntity;
begin
  if fExternalTypesAsReferences then begin
    el := aLibrary.FindStruct(aDataTypeName);
    if el = nil then
      el := aLibrary.FindException(aDataTypeName);
    if el = nil then
      el := aLibrary.FindEnum(aDataTypeName);
    if el = nil then
      el := aLibrary.FindArray(aDataTypeName);
    if el <> nil then begin
      if (el.Attributes.values['ElementNamespace'] <> '') and (fXsdTns <> el.Attributes.values['ElementNamespace']) then begin
        result := 'ns'+IntToStr(fExternalRefs.IndexOf(el.Attributes.values['ElementNamespace']))+':'+Unprefix(aDataTypeName);
        exit;
      end;
      if (el.Attributes.values['ImportedFromNamespace'] <> '') and (fXsdTns <> el.Attributes.values['ImportedFromNamespace']) then begin
        result := 'ns'+IntToStr(fExternalRefs.IndexOf(el.Attributes.values['ImportedFromNamespace']))+':'+Unprefix(aDataTypeName);
        exit;
      end;
    end;
  end;

  result := SOAPDataType(Unprefix(aDataTypeName), True);
end;

procedure TRODLToWSDL.ResolveExternalReferences(aLibrary: TRODLLibrary);
var
  i, j, k: Integer;
  lIsTarget: Boolean;
  lServ: TRODLService;
  lStr: TRODLStruct;
  lEx: TRODLException;
  lEl: TRODLEntity;

  lOp: TRODLOperation;
  lList: TList;

begin
  lList := TList.Create;
  try
    // assume only 1 of fTargetEntity/fTargetXsd is set
    for i := 0 to aLibrary.ExceptionCount  -1 do begin
      lEx := aLibrary.Exceptions[i];
      if (lEx.Attributes.Values['ElementUrl'] = fTargetXSD) and (lEx.Count = 1) then begin
        fHasXsdData := true;
        if (fXsdTns = '') and (lEx.Attributes.Values['ElementNamespace'] <> '') then
          fXsdTns := lEx.Attributes.Values['ElementNamespace'];
        lEl := aLibrary.ItemByName(lEx.Items[0].DataType);
        if (lEl <> nil) and (lEl.Attributes.Values['ImportedFromUrl'] <> fTargetXSD) then
        AddExternal(lEl);
        lEl := aLibrary.ItemByName(lex.Ancestor);
        if (lEl <> nil) and (lEl.Attributes.Values['ElementUrl'] <> fTargetXSD) then
          AddExternal(lEl);
      end;
    end;
    for i := 0 to aLibrary.ArrayCount  -1 do begin
      if aLibrary.Arrays[i].Attributes.Values['ImportedFromUrl'] = fTargetXSD then begin
        fHasXsdData := true;
        if (fXsdTns = '') and (aLibrary.Arrays[i].Attributes.Values['ImportedFromNamespace'] <> '') then
          fXsdTns := aLibrary.Arrays[i].Attributes.Values['ImportedFromNamespace'];
        lEl := aLibrary.ItemByName(aLibrary.Arrays[i].ElementType);
        if (lEl <> nil) and (lEl.Attributes.Values['ImportedFromUrl'] <> fTargetXSD) then
          AddExternal(lEl);
      end else if fTargetXSD = '' then AddExternal(aLibrary.Arrays[i]);
    end;
    for i := 0 to aLibrary.StructCount  -1 do begin
      lStr := aLibrary.Structs[i];
      if lStr.Attributes.Values['ImportedFromUrl'] = fTargetXSD then begin
        while lStr <> nil do begin
          fHasXsdData := true;
          if (fXsdTns = '') and (lStr.Attributes.Values['ImportedFromNamespace'] <> '') then
            fXsdTns := lStr.Attributes.Values['ImportedFromNamespace'];
          for j := 0 to lStr.Count -1 do begin
            lEl := aLibrary.ItemByName(lStr[j].DataType);
            if (lEl <> nil) and (lEl.Attributes.Values['ImportedFromUrl'] <> fTargetXSD) then
              AddExternal(lEl);
          end;
          lEl := aLibrary.ItemByName(lStr.Ancestor);
          if (lEl <> nil) and (lEl.Attributes.Values['ImportedFromUrl'] <> fTargetXSD) then
            AddExternal(lEl);
          if lEl is TRODLStruct then
            lStr := TRodlStruct(lEl)
          else
            break;
        end;
      end else if fTargetXSD = '' then AddExternal(lStr);
    end;
    for i := 0 to aLibrary.EnumCount  -1 do begin
      if aLibrary.Enums[i].Attributes.Values['ImportedFromUrl'] = fTargetXSD then begin
        fHasXsdData := true;
        if (fXsdTns = '') and (aLibrary.Enums[i].Attributes.Values['ImportedFromNamespace'] <> '') then
          fXsdTns := aLibrary.Enums[i].Attributes.Values['ImportedFromNamespace'];

       end else if fTargetXSD = '' then
         AddExternal(aLibrary.Enums[i]);
    end;
    for i := 0 to aLibrary.ServiceCount -1 do begin
      lServ := aLibrary.Services[i];
      lIsTarget := ((fTargetEntity = '') or (lServ.Name = fTargetEntity)) and (fTargetXsd = '');
      if lIsTarget or (fTargetXSD <> '') then begin
        for j := 0 to lServ[0].Count -1 do begin
          lOp := lServ[0][j];
          if lIsTarget then
          for k := 0 to lOp.Attributes.Count -1 do begin
            if copy(lOp.Attributes[k], 1, 6) = 'fault_' then begin
              AddExternal(aLibrary.FindException(lOp.Attributes.Values[lOp.Attributes.Names[k]]));
            end;
          end;
          if lOp.Attributes.Values['InputImportedFromUrl'] = fTargetXSD then begin
            for k := 0 to lOp.Count -1 do begin
              if lOp[k].Flag in [fIn, fInOut] then begin
                lEl := aLibrary.ItemByName(lOp[k].DataType);
                if (lEl <> nil) and (lEl.Attributes.Values['ImportedFromUrl'] <> fTargetXSD) then
                  AddExternal(lEl);
              end;
            end;
          end else if lIsTarget and (lOp.Attributes.Values['InputImportedFromUrl'] <> '') then begin
            AddExternal(fTargetNamespace, lOp.Attributes.Values['InputImportedFromUrl']);
          end;
          if lOp.Attributes.Values['OutputImportedFromUrl'] = fTargetXSD then begin
            for k := 0 to lOp.Count -1 do begin
              if lOp[k].Flag in [fInOut] then begin
                lEl := aLibrary.ItemByName(lOp[k].DataType);
                if (lEl <> nil) and (lEl.Attributes.Values['ImportedFromUrl'] <> fTargetXSD) then
                  AddExternal(lEl);
              end;
            end;
            if lOp.Result <> nil then begin
              lEl := aLibrary.ItemByName(lOp.Result.DataType);
              if (lEl <> nil) and (lEl.Attributes.Values['ImportedFromUrl'] <> fTargetXSD) then
                AddExternal(lEl);
            end;
          end else if lIsTarget and (lOp.Attributes.Values['OutputImportedFromUrl'] <> '') then begin
            AddExternal(fTargetNamespace, lOp.Attributes.Values['OutputImportedFromUrl']);
          end;
        end;
      end;
    end;

  finally
    lList.Free;
  end;
end;

procedure TRODLToWSDL.WriteExceptionMessage(AnException: TRODLException);
var
  i: Integer;
  lItem: TRODLTypedEntity;
begin
  if not fUseDocument then exit; // only supported for document
  Write(Format('<wsdl:message name="%s">', [anException.Name]), 3);
  for i := 0 to anException.Count -1 do begin
    lItem := anException[i];
    if AnException.Attributes.Values['ElementName'] <> '' then
      Write(Format('<wsdl:part name="%s" element="%s" />', [lItem.Name, GetPrefix(AnException.Attributes.Values['ElementName'], AnException.Attributes.Values['ElementNamespace'])]), 6)
    else
      Write(Format('<wsdl:part name="%s" type="%s" />', [lItem.Name, ExtSOAPDataType(anException.OwnerLibrary, lItem.DataType)]), 6);
  end;
  Write('</wsdl:message>', 3);

end;

procedure TRODLToWSDL.WriteExceptionParts(aMeth: TRODLOperation);
var
  i: Integer;
  s, lVal: string;
begin
  if not UseDocument then exit;
  for i := 0 to aMeth.Attributes.Count -1 do begin
    s := aMeth.Attributes.Names[i];
    if copy(s,1,6)= 'fault_' then begin
      lVal := aMeth.Attributes.Values[s];
      if aMeth.OwnerLibrary.FindException(lVal) <> nil then begin
        Write(Format('<wsdl:fault name="%s" message="tns:%s" />', [copy(s,7,MaxInt), lVal]), 9);
      end;
    end;
  end;
end;

procedure TRODLToWSDL.WriteExceptionElement(anException: TRODLException);
var
  lRet: TRODLStruct;
  i: Integer;
begin
  if fExternalTypesAsReferences and (anException.Attributes.Values['ElementUrl'] <> fTargetXSD) then exit;

  if (anException.Attributes.Values['ElementType'] = '') and (anException.Attributes.Values['ElementName'] <> '') then begin
    Write(Format('<xs:element name="%s">', [anException.Attributes.Values['ElementName']]), 9);
    WriteAnnotation(anException.Documentation, 9); {Giovanni}
    Write('<xs:complexType>', 9);
  end else begin
    if anException.Attributes.Values['ElementType'] = '' then
      Write(Format('<xs:complexType name="%s">', [anException.Name]), 9)
    else
      Write(Format('<xs:complexType name="%s">', [anException.Attributes.Values['ElementType']]), 9);
    WriteAnnotation(anException.Documentation, 9); {Giovanni}
  end;
  if anException.Ancestor <> '' then begin
    write('<xs:complexContent>', 9);
    write(Format('<xs:extension base="%s">', [ExtSOAPDataType(anException.OwnerLibrary, anException.Ancestor)]), 9);
  end;
  Write('<xs:sequence>', 12);

  for i := 0 to anException.Count-1 do begin
    with anException.Items[i] do begin
      lRet := anException.OwnerLibrary.FindStruct(DataType);
      if (lRet <> nil) and (lRet.Count = 1) and (lRet.Attributes.Values['Anonymous'] = '1') then begin
        if lRet.Attributes.Values['Nillable'] = '1' then
          Write(Format('<xs:element name="%s" type="%s" nillable="1">', [Unprefix(Name), ExtSOAPDataType(anException.OwnerLibrary, lRet.Items[0].DataType)]), 15)
        else
          Write(Format('<xs:element name="%s" type="%s" minOccurs="0" maxOccurs="1">', [Unprefix(Name), ExtSOAPDataType(anException.OwnerLibrary, lRet.Items[0].DataType)]), 15);
      end else begin
        Write(Format('<xs:element name="%s" type="%s">', [Unprefix(Name), ExtSOAPDataType(anException.OwnerLibrary, DataType)]), 15);
      end;
      WriteAnnotation(Documentation, 15); {Giovanni}
      Write('</xs:element>',15);
    end;
  end;
  Write('</xs:sequence>', 12);
  if anException.Ancestor <> '' then begin
    write('</xs:extension>', 9);
    write('</xs:complexContent>', 9);
  end;
  Write('</xs:complexType>', 9);
  if (anException.Attributes.Values['ElementType'] = '') and (anException.Attributes.Values['ElementName'] <> '') then
    Write('</xs:element>', 9);
  if anException.Attributes.Values['ElementType'] <> '' then begin
    Write(Format('<xs:element name="%s" type="%s" />', [anException.Attributes.Values['ElementName'], anException.Attributes.Values['ElementType']]), 9);
  end;
end;

function TRODLToWSDL.GetPrefix(const aType, aNs: string): String;
begin
  if (fTargetXSD = '') and (aNs = fTargetNamespace) then begin
     result := 'tns:'+aType;
     exit;
  end;

  if aNs <> '' then begin
    result := 'ns'+IntToStr(fExternalRefs.IndexOf(aNs))+':'+Unprefix(aType);
    exit;
  end;
  Result := 'tns:'+ aType;
end;

function TRODLToWSDL.ReplaceSpecialChars(aText: String): String;
begin
  result := StringReplace(aText, '&', '&amp;', [rfReplaceAll, rfIgnoreCase]);
  result := StringReplace(result, '"', '&quot;', [rfReplaceAll, rfIgnoreCase]);
  result := StringReplace(result, '''', '&apos;', [rfReplaceAll, rfIgnoreCase]);
  result := StringReplace(result, '<', '&lt;', [rfReplaceAll, rfIgnoreCase]);
  result := StringReplace(result, '>', '&gt;', [rfReplaceAll, rfIgnoreCase]);
end;

end.