unit uRODLToXML;

{----------------------------------------------------------------------------}
{ 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
  SysUtils,
  Classes,uRODL;

var
  XMLFlagNames: XMLFlagNamesArray deprecated;

type
  { TRODLToXML }
  TRODLToXML = class(TRODLConverter)
  private
    fFlattenUsedRODLs:boolean;
    fStyleSheet: string;
    procedure WriteArrays(xml: TStringList; aLibrary: TRODLLibrary);
    procedure WriteAttributes(xml: TStringList; aEntity: TRODLEntity);
    procedure WriteEnums(xml: TStringList; aLibrary: TRODLLibrary);
    procedure WriteEventSinks(xml: TStringList; aLibrary: TRODLLibrary);
    procedure WriteExceptions(xml: TStringList; aLibrary: TRODLLibrary);
    procedure WriteServices(xml: TStringList; aLibrary: TRODLLibrary);
    procedure WriteStructs(xml: TStringList; aLibrary: TRODLLibrary);
    procedure WriteUses(xml: TStringList; aLibrary: TRODLLibrary);
    function WriteAsCData(aData: string): string;
    function Indent(SpaceCount: byte): string;
  protected
    procedure IntConvert(const aLibrary: TRODLLibrary; const aTargetEntity: string = ''); override;
  public
    constructor Create(const aLibrary: TRODLLibrary; iFlattenUsedRODLs:boolean=false); reintroduce; overload;
    constructor Create(const aLibraryFile: string; iFlattenUsedRODLs:boolean=false); reintroduce; overload;

    property StyleSheet: string read fStyleSheet write fStyleSheet;
  end;

  TXMLToRODL = uRODL.TXMLToRODL;

function XMLFlagNameToFlag(const aName: string): TRODLParamFlag;

function LoadLibraryFromXml(const aFilename: string): TRODLLibrary;

implementation

uses
  {$IFDEF DEBUG_REMOBJECTS_RODLTOXML}eDebugServer, {$ENDIF}
  TypInfo, {$IFDEF DELPHI5}ComObj,{$ENDIF}
  uRORes, uROXMLIntf;

function XMLFlagNameToFlag(const aName: string): TRODLParamFlag;
begin
  result := uRODL.XMLFlagNameToFlag(aName);
end;

function LoadLibraryFromXml(const aFilename: string): TRODLLibrary;
begin
  with uRODL.TXMLToRODL.Create do try
    result := ReadFromFile(aFilename);
  finally
    Free;
  end;
end;

constructor TRODLToXML.Create(const aLibrary: TRODLLibrary; iFlattenUsedRODLs: boolean);
begin
  fFlattenUsedRODLs := iFlattenUsedRODLs;
  inherited Create(aLibrary);
end;

constructor TRODLToXML.Create(const aLibraryFile: string; iFlattenUsedRODLs: boolean);
begin
  fFlattenUsedRODLs := iFlattenUsedRODLs;
  inherited Create(aLibraryFIle);
end;

procedure TRODLToXML.IntConvert(const aLibrary: TRODLLibrary; const aTargetEntity: string = '');
var
  lAdditional: string;
  xml: TStringList;
begin
  xml := TStringList.Create;
  with aLibrary do try
    {$IFDEF FPC}
    if aTargetEntity = '' then lAdditional := '' else //remove FPC warning
    {$ENDIF FPC}
    lAdditional := '';
    if Namespace <> '' then lAdditional := 'Namespace="' + Namespace + '" ';

    xml.Append('<?xml version="1.0" encoding="utf-8"?>');
    if fStyleSheet <> '' then
      xml.Append('<?xml-stylesheet type="text/xsl" href="' + fStyleSheet + '"?>');

    xml.Append(Format('<Library Name="%s" ' + lAdditional + 'UID="%s" Version="3.0">', [Name, GUIDToString(UID)]));

    WriteAttributes(xml, aLibrary);
    WriteServices(xml, aLibrary);
    WriteEventSinks(xml, aLibrary);
    WriteStructs(xml, aLibrary);
    WriteEnums(xml, aLibrary);
    WriteArrays(xml, aLibrary);
    WriteUses(xml, aLibrary);
    WriteExceptions(xml, aLibrary);

    xml.Append('</Library>');
  finally
    Buffer.AddStrings(xml);
    xml.Free;
  end;
end;

procedure TRODLToXML.WriteArrays(xml: TStringList; aLibrary: TRODLLibrary);
var
  i: Integer;
begin
  xml.Append(Indent(3) + '<Arrays>');
  with aLibrary do
    for i := 0 to (ArrayCount - 1) do begin
      if fFlattenUsedRODLs or not Arrays[i].IsFromUsedRodl then
        with Arrays[i] do begin
          xml.Append(Indent(6) + Format('<Array Name="%s" UID="%s">', [Name, GUIDToString(UID)]));
          WriteAttributes(xml, Info);
          xml.Append(Indent(3) + Format('<ElementType DataType="%s" />', [ElementType]));
          xml.Append(Indent(6) + '</Array>');
        end;
    end;
  xml.Append(Indent(3) + '</Arrays>');
end;

function TRODLToXML.WriteAsCData(aData: string): string;

  function CleanCDATA(const aString: string): string;
  var
    lLength: Integer;
  begin
    result := aString;
    lLength := length(aString);
    while (lLength > 0) and
    {$IFDEF UNICODE}
    (CharInSet(result[lLength],[#09,#10,#13,#32]))
    {$ELSE}
    (result[lLength] in [#09,#10,#13,#32])
    {$ENDIF}
    do dec(lLength);
    SetLength(result, lLength);
    for lLength := Length(Result) downto 1 do
      if
      {$IFDEF UNICODE}
        CharInSet(Result[lLength] , [#0..#8,#11,#12,#14..#31])
      {$ELSE}
        (Result[lLength] in [#0..#8,#11,#12,#14..#31])
      {$ENDIF}
      then result[lLength] := #32;
    result := StringReplace(result, ']]>', ']]&gt;', [rfReplaceAll]);
  end;

begin
  result := '<![CDATA['+{$IFDEF UNICODE}StringOf(BytesOf({$ENDIF}(UTF8Encode(CleanCDATA(aData)))+']]>'{$IFDEF UNICODE})){$ENDIF};
end;

function SafeHtmlAttribute(const s: string): string;
begin
  result := StringReplace(s, '&', '&amp;' , [rfReplaceAll]);
end;

procedure TRODLToXML.WriteAttributes(xml: TStringList; aEntity: TRODLEntity);
var
  attr: Integer;
begin
  if aEntity.Documentation <> '' then
    xml.Append(Indent(6) + '<Documentation>' + WriteAsCData(aEntity.Documentation) + '</Documentation>');

  if (aEntity.Attributes.Count > 0) then begin
    with aEntity.Attributes do begin
      xml.Append(Indent(6) + '<CustomAttributes>');

      for attr := 0 to (aEntity.Attributes.Count - 1) do
        xml.Append(Indent(9) + Format('<%s Value="%s" />',
          [Names[attr], SafeHtmlAttribute(Values[Names[attr]])]));

      xml.Append(Indent(6) + '</CustomAttributes>');
    end;
  end;

  if Assigned(aEntity.GroupUnder) then
    xml.Append(Indent(6) + Format('<Group Under="%s" />', [GUIDToString(aEntity.GroupUnder.UID)]));
end;

procedure TRODLToXML.WriteEnums(xml: TStringList; aLibrary: TRODLLibrary);
var
  i, k: Integer;
begin
  xml.Append(Indent(3) + '<Enums>');
  with aLibrary do
    for i := 0 to (EnumCount - 1) do begin

      if fFlattenUsedRODLs or not Enums[i].IsFromUsedRodl then
        with Enums[i] do begin
          if not PrefixEnumValues then
            xml.Append(Indent(6) + Format('<Enum Name="%s" UID="%s" Prefix="0">', [Name, GUIDToString(UID)]))
          else
            xml.Append(Indent(6) + Format('<Enum Name="%s" UID="%s">', [Name, GUIDToString(UID)]));
          WriteAttributes(xml, Info);
          xml.Append(Indent(3) + '<EnumValues>');
          for k := 0 to (Count - 1) do begin
            with Items[k] do begin
              xml.Append(Indent(9) + Format('<EnumValue Name="%s">', [Name]));
              WriteAttributes(xml, Info);
              xml.Append(Indent(9) + '</EnumValue>');
            end;
          end;
          xml.Append(Indent(3) + '</EnumValues>');
          xml.Append(Indent(6) + '</Enum>');
        end;
    end;
  xml.Append(Indent(3) + '</Enums>');
end;

procedure TRODLToXML.WriteEventSinks(xml: TStringList; aLibrary: TRODLLibrary);
var
  i, k, m, p: Integer;
  lAdditional: string;
begin
  with aLibrary do
    if EventSinkCount > 0 then begin
      xml.Append(Indent(3) + '<EventSinks>');
      for i := 0 to (EventSinkCount - 1) do begin
        if fFlattenUsedRODLs or not EventSinks[i].IsFromUsedRodl then
          with EventSinks[i] do begin

            lAdditional := '';
            if ImplUnit <> '' then lAdditional := ' ImplUnit="' + ImplUnit + '"';
            if ImplClass <> '' then lAdditional := lAdditional + ' ImplClass="' + ImplClass + '"';
            if Ancestor <> '' then lAdditional := lAdditional + ' Ancestor="' + Ancestor + '"';
            if Abstract then lAdditional := lAdditional + ' Abstract="1"';
            xml.Append(Indent(6) + Format('<EventSink Name="%s" UID="%s"' + lAdditional + '>', [Name, GUIDToString(UID)]));

            WriteAttributes(xml, Info);

            xml.Append(Indent(6) + '<Interfaces>');

            for k := 0 to (Count - 1) do begin
              with Items[k] do begin
                xml.Append(Indent(9) +
                  Format('<Interface Name="%s" UID="%s">', [Name, GUIDToString(UID)]));

                WriteAttributes(xml, Info);

                xml.Append(Indent(6) + '<Operations>');
                for m := 0 to (Count - 1) do begin
                  with Items[m] do begin
                    xml.Append(Indent(9) +
                      Format('<Operation Name="%s" UID="%s">', [Name, GUIDToString(UID)]));

                    WriteAttributes(xml, Info);

                    xml.Append(Indent(6) + '<Parameters>');

                    { ToDo: cloned from above for now; implement "proper" RODL->XML for 3.0 }
                    if Assigned(Result) then with Result do begin
                      with Result do begin
                        xml.Append(Format('<Parameter Name="%s" DataType="%s" Flag="%s">', [Name, DataType, uRODL.XMLFlagNames[Flag]]));
                        WriteAttributes(xml, Info);
                        xml.Append('</Parameter>');
                      end;
                    end;

                    for p := 0 to (Count - 1) do begin
                      with Items[p] do begin
                        xml.Append(Format('<Parameter Name="%s" DataType="%s" Flag="%s">', [Name, DataType, uRODL.XMLFlagNames[Flag]]));
                        WriteAttributes(xml, Info);
                        xml.Append('</Parameter>');
                      end;
                    end;
                    xml.Append(Indent(6) + '</Parameters>');
                    xml.Append(Indent(9) + '</Operation>');
                  end;
                end;
                xml.Append(Indent(6) + '</Operations>');

                xml.Append(Indent(9) + '</Interface>');
              end;
            end;

            xml.Append(Indent(6) + '</Interfaces>');
            xml.Append(Indent(6) + '</EventSink>');
          end;
      end;
      xml.Append(Indent(3) + '</EventSinks>');
    end;
end;

procedure TRODLToXML.WriteExceptions(xml: TStringList; aLibrary: TRODLLibrary);
var
  i, k: Integer;
  lAdd: string;
begin
  with aLibrary do
    if ExceptionCount > 0 then begin
      xml.Append(Indent(3) + '<Exceptions>');
      for i := 0 to (ExceptionCount - 1) do begin
        if fFlattenUsedRODLs or not Exceptions[i].IsFromUsedRodl then
          with Exceptions[i] do begin

            lAdd := '';
            if AutoCreateParams then
              lAdd := ' AutoCreateParams="1"'
            else
              lAdd := ' AutoCreateParams="0"';

            if Ancestor <> '' then lAdd := lAdd+Format(' Ancestor="%s"',[Ancestor]);
            if Abstract then lAdd := lAdd + ' Abstract="1"';

            xml.Append(Indent(6) + Format('<Exception Name="%s" UID="%s"'+lAdd+'>',[Name, GUIDToString(UID)]));
            WriteAttributes(xml, Info);
            xml.Append(Indent(3) + '<Elements>');
            for k := 0 to (Count - 1) do begin
              with Items[k] do begin
                xml.Append(Indent(9) + Format('<Element Name="%s" DataType="%s">', [Name, DataType]));
                WriteAttributes(xml, Info);
                xml.Append(Indent(9) + Format('</Element>', [Name, DataType]));
              end;
            end;
            xml.Append(Indent(3) + '</Elements>');
            xml.Append(Indent(6) + '</Exception>')
          end;

      end;
      xml.Append(Indent(3) + '</Exceptions>');
    end;
end;

procedure TRODLToXML.WriteServices(xml: TStringList; aLibrary: TRODLLibrary);
var
  i, k, m, p: Integer;
  lAdditional: string;
begin
  with aLibrary do begin
    if GroupCount > 0 then begin
      xml.Append(Indent(3) + '<Groups>');
      for i := 0 to (GroupCount - 1) do begin
        if fFlattenUsedRODLs or not Groups[i].IsFromUsedRodl then begin
          with Groups[i] do begin
            xml.Append(Indent(6) + Format('<Group Name="%s" UID="%s">', [Name, GUIDToString(UID)]));
            WriteAttributes(xml, Info);
            xml.Append(Indent(6) + '</Group>');
          end;
        end;
      end;
      xml.Append(Indent(3) + '</Groups>');
    end;

    xml.Append(Indent(3) + '<Services>');
    for i := 0 to (ServiceCount - 1) do begin
      if fFlattenUsedRODLs or not Services[i].IsFromUsedRodl then
        with Services[i] do begin

          lAdditional := '';
          if ImplUnit <> '' then lAdditional := ' ImplUnit="' + ImplUnit + '"';
          if ImplClass <> '' then lAdditional := lAdditional + ' ImplClass="' + ImplClass + '"';
          if Ancestor <> '' then lAdditional := lAdditional + ' Ancestor="' + Ancestor + '"';
          if Abstract then lAdditional := lAdditional + ' Abstract="1"';
          if isPrivate then lAdditional := lAdditional + ' Private="1"';

          xml.Append(Indent(6) + Format('<Service Name="%s" UID="%s"' + lAdditional + '>', [Name, GUIDToString(UID)]));
          WriteAttributes(xml, Info);

          xml.Append(Indent(6) + '<Interfaces>');

          for k := 0 to (Count - 1) do begin
            with Items[k] do begin
              xml.Append(Indent(9) + Format('<Interface Name="%s" UID="%s">', [Name, GUIDToString(UID)]));
              WriteAttributes(xml, Info);

              xml.Append(Indent(6) + '<Operations>');
              for m := 0 to (Count - 1) do begin
                with Items[m] do begin
                  if ForceAsyncResponse then
                    xml.Append(Indent(9) + Format('<Operation Name="%s" UID="%s" ForceAsyncResponse="1">', [Name, GUIDToString(UID)]))
                  else
                    xml.Append(Indent(9) + Format('<Operation Name="%s" UID="%s">', [Name, GUIDToString(UID)]));

                  WriteAttributes(xml, Info);

                  xml.Append(Indent(6) + '<Parameters>');

                  if Assigned(Result) then with Result do begin
                    with Result do begin
                      xml.Append(Format('<Parameter Name="%s" DataType="%s" Flag="%s">', [Name, DataType, uRODL.XMLFlagNames[Flag]]));
                      WriteAttributes(xml, Info);
                      xml.Append('</Parameter>');
                    end;
                  end;

                  for p := 0 to (Count - 1) do begin
                    with Items[p] do begin
                      xml.Append(Format('<Parameter Name="%s" DataType="%s" Flag="%s" >', [Name, DataType, uRODL.XMLFlagNames[Flag]]));
                      WriteAttributes(xml, Info);
                      xml.Append('</Parameter>');
                    end;
                  end;
                  xml.Append(Indent(6) + '</Parameters>');

                  if CodeBodyCount > 0 then begin
                    xml.Append(Indent(6) + '<Code>');
                    for p := 0 to CodeBodyCount-1 do begin
                      xml.Append(Indent(6) + '<Code Language="'+CodeBodyLanguages[p]+'" >' + WriteAsCData(CodeBodies[CodeBodyLanguages[p]].Text) + '</Code>');
                    end;
                    xml.Append(Indent(6) + '</Code>');
                  end;

                  xml.Append(Indent(9) + '</Operation>');
                end;
              end;
              xml.Append(Indent(6) + '</Operations>');

              xml.Append(Indent(9) + '</Interface>');
            end;
          end;

          xml.Append(Indent(6) + '</Interfaces>');
          xml.Append(Indent(6) + '</Service>');
        end;
    end;
  end;
  xml.Append(Indent(3) + '</Services>');
end;

procedure TRODLToXML.WriteStructs(xml: TStringList; aLibrary: TRODLLibrary);
var
  i, k: Integer;
  lAdditional: string;
begin
  xml.Append(Indent(3) + '<Structs>');
  with aLibrary do
    for i := 0 to (StructCount - 1) do begin

      if fFlattenUsedRODLs or not Structs[i].IsFromUsedRodl then
        with Structs[i] do begin

          lAdditional := '';
          if AutoCreateParams then
            lAdditional := ' AutoCreateParams="1"'
          else
            lAdditional := ' AutoCreateParams="0"';

          if Ancestor <> '' then lAdditional := lAdditional + Format(' Ancestor="%s"', [Ancestor]);
          if Abstract then lAdditional := lAdditional + ' Abstract="1"';

          xml.Append(Indent(6) + Format('<Struct Name="%s" UID="%s"' + lAdditional + '>',
                                          [Name, GUIDToString(UID)]));

          WriteAttributes(xml, Info);
          xml.Append(Indent(3) + '<Elements>');
          for k := 0 to (Count - 1) do begin
            with Items[k] do begin
              xml.Append(Indent(9) + Format('<Element Name="%s" DataType="%s">', [Name, DataType]));
              WriteAttributes(xml, Info);
              xml.Append(Indent(9) + Format('</Element>', [Name, DataType]));
            end;
          end;
          xml.Append(Indent(3) + '</Elements>');
          xml.Append(Indent(6) + '</Struct>');
        end;

    end;
  xml.Append(Indent(3) + '</Structs>');
end;

procedure TRODLToXML.WriteUses(xml: TStringList; aLibrary: TRODLLibrary);
var
  i: Integer;
  lSplitModeAttribute: string;
  lUsedRodlFilename, lUsedRodlFilename_absolute: string;
begin
  with aLibrary do
    if UseCount > 0 then begin
      xml.Append(Indent(3) + '<Uses>');
      for i := 0 to (UseCount - 1) do begin
        if (not fFlattenUsedRODLs) and (not Use[i].IsFromUsedRodl) then
          with Use[i] do begin
            lUsedRodlFilename := RodlFile;
            lUsedRodlFilename_absolute := AbsoluteRodlFile;
            if lUsedRodlFilename_absolute = '' then
              lUsedRodlFilename_absolute := ExpandFileName(ExpandVariables(lUsedRodlFilename));
            {if aLibrary.RodlFilename <> '' then
              lUsedRodlFilename := ExtractRelativePath(ExtractFilePath(aLibrary.RodlFilename),lUsedRodlFilename);}

            lSplitModeAttribute := '';
            if SplitMode <> usmAsParent then
              lSplitModeAttribute := Format(' SplitMode="%s"', [IntToStr(Integer(SplitMode))]);
            if GenerateCode then
              xml.Append(Indent(6) + Format('<Use Name="%s" UID="%s" Rodl="%s" GenerateCode="1" AbsoluteRodl="%s"%s>',
                [Name, GUIDToString(UID), lUsedRodlFilename, lUsedRodlFilename_absolute, lSplitModeAttribute]))
            else
              xml.Append(Indent(6) + Format('<Use Name="%s" UID="%s" Rodl="%s" AbsoluteRodl="%s"%s>',
                [Name, GUIDToString(UID), lUsedRodlFilename, lUsedRodlFilename_absolute, lSplitModeAttribute]));
            WriteAttributes(xml, Info);
            xml.Append(Indent(6) + '</Use>')
          end;

      end;
      xml.Append(Indent(3) + '</Uses>');
    end;
end;

function TRODLToXML.Indent(SpaceCount: byte): string;
{var
  i: integer;}
begin
  {$IFDEF FPC}
  if SpaceCount = 0 then result := '' else // removing FPC warning
  {$ENDIF}
  result := '';
  {for i := 1 to SpaceCount do
    result := result + ' ';}
end;

(*
function StringToGUID(const s: string): TGUID;
begin
  if s = '' then Result := NewGuid else begin
    try
      Result := Sysutils.StringToGUID(s);
    except
      on e: EConvertError do
        Result := NewGuid;
    end;
  end;
end;
*)
initialization
  {$WARN SYMBOL_DEPRECATED OFF}
  XMLFlagNames := uRODL.XMLFlagNames;
  {$WARN SYMBOL_DEPRECATED ON}
end.