unit uRODLGenTools;

{----------------------------------------------------------------------------}
{ 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.                        }
{----------------------------------------------------------------------------}

{$IFDEF LINUX}
{$I ../RemObjects.inc}
{$ELSE}
{$I ..\RemObjects.inc}
{$ENDIF LINUX}


interface

uses Classes, uRODL, uRORemoteDataModule;

const IntfInvkNotice =
         '{----------------------------------------------------------------------------}'+#13#10+
         '{ This unit was automatically generated by the RemObjects SDK after reading  }'+#13#10+
         '{ the RODL file associated with this project .                               }'+#13#10+
         '{                                                                            }'+#13#10+
         '{ Do not modify this unit manually, or your changes will be lost when this   }'+#13#10+
         '{ unit is regenerated the next time you compile the project.                 }'+#13#10+
         '{----------------------------------------------------------------------------}';

      ImplNotice =
        '{----------------------------------------------------------------------------}'+#13#10+
        '{ This unit was automatically generated by the RemObjects SDK after reading  }'+#13#10+
        '{ the RODL file associated with this project .                               }'+#13#10+
        '{                                                                            }'+#13#10+
        '{ This is where you are supposed to code the implementation of your objects. }'+#13#10+
        '{----------------------------------------------------------------------------}';

      IntfInvkNoticeCSharp =
         '//---------------------------------------------------------------------------'+#13+
         '// This source file was automatically generated by the RemObjects SDK after  '+#13+
         '// reading the RODL file associated with this project.                       '+#13+
         '//                                                                           '+#13+
         '// Do not modify this file manually, or your changes will be lost when this  '+#13+
         '// source file is regenerated the next time you compile the project.         '+#13+
         '//---------------------------------------------------------------------------';

      ImplNoticeCSharp =
         '//---------------------------------------------------------------------------'+#13+
         '// This source file was automatically generated by the RemObjects SDK after  '+#13+
         '// reading the RODL file associated with this project.                       '+#13+
         '//                                                                           '+#13+
         '// This is where you are supposed to code the implementation of your objects.'+#13+
         '//---------------------------------------------------------------------------';

      DelphiFlagNames : array[TRODLParamFlag] of string = (
        'const', 'out', 'var', 'result');

      CSharpFlagNames : array[TRODLParamFlag] of string = (
        '', 'out ', 'ref ', 'result');

      DelphiAsyncInvokeFlagNames : array[TRODLParamFlag] of string = (
        'const', '[out]', 'const', '[result]');

      DelphiAsyncRetrieveFlagNames : array[TRODLParamFlag] of string = (
        '[const]', 'out', 'out', 'result');

type
  PRODataModuleClass = ^TRODataModuleClass;
  TRODataModuleClass = record
    ClassType : TRORemoteDataModuleClass;
    Alias,
    Description,
    RequiredUnits : string;
  end;

// Code generation helpers
function GetOperationDefinition(
   const anOperation : TRODLOperation;
   const aClassName : string = '';
   const aSuffix : string = '';
   AddSenderGUID : boolean = FALSE) : string;

function DataTypeToCSharpType(const iType:string; iLibrary:TRODLLibrary=nil; iForNew:boolean=false):string;
function DataTypeToDelphiDotNetType(const iType:string; iLibrary:TRODLLibrary=nil; iForNew:boolean=false):string;


function GetOperationDefinitionCSharp(
   const anOperation : TRODLOperation;
   aForInterface:boolean;
   const aSuffix : string = ''; aLibrary: TRODLLibrary= nil) : string;

function GetOperationDefinitionDelphiForDotNet(const anOperation : TRODLOperation; aLibrary:TRODLLibrary; const aClassName : string = ''; const aSuffix : string = '') : string;

function GetAsyncInvokeOperationDefinition(
   const anOperation : TRODLOperation;
   const aClassName : string = '';
   const aSuffix : string = '') : string;

function GetAsyncRetrieveOperationDefinition(
   const anOperation : TRODLOperation;
   const aClassName : string = '';
   const aSuffix : string = '') : string;
function NeedsAsyncRetrieveOperationDefinition(anOperation:TRODLOperation):boolean;

function MessageWrite(const iType, iRodlType, iName, iVariable:string):string;
function MessageRead(const iType, iRodlType, iName:string):string;
function TypeToReadWriteFn(const iType:string):string;

procedure GetTypeNames(const aLibrary : TRODLLibrary; aResult : TStrings);
function TypeByName(const aLibrary : TRODLLibrary; const aTypeName : string) : TRODLEntity;

// TRORemoteDatamodule registration
procedure RegisterRODataModuleClass(aClass : TRORemoteDataModuleClass; const anAlias, aDescription, someRequiredUnits : string);
function GetRODataModuleClass(Index : integer) : TRODataModuleClass;
function GetRODataModuleClassCount : integer;

implementation

uses {$IFNDEF LINUX}Windows,{$ENDIF} SysUtils, uRORes, uROTypes, uRODLToPascalIntf;

var _datamodules : TStringList;

const
  MAX_PARAM_LENGTH = 100;

// Code generation helpers
function GetOperationDefinition(const anOperation : TRODLOperation;
  const aClassName : string = ''; const aSuffix : string = '';
  AddSenderGUID : boolean = FALSE) : string;
var x : integer;
    lPars, lPars2, s : string;
    lFillStr: string;
begin
   if not Assigned(anOperation.Result) then s := 'procedure ' else s := 'function ';

   if aClassName<>''
     then s := s+aClassName+'.'+anOperation.Name
     else s := s+anOperation.Name;

   if aSuffix<>''
     then s := s+aSuffix;

   if aClassName = '' then
     SetLength(lFillStr,Length(s)+4+1) { Interface section }
   else
     SetLength(lFillStr,Length(s)+1);  { Implementation section }
   FillChar(lFillStr[1],Length(lFillStr),#32);

   with anOperation do begin
     lPars := '';
     lPars2 := '';

     if (Count>0) then begin
       for x := 0 to (Count-1) do begin
         with Items[x] do begin
           if (Flag <> fResult) then begin
             if Length(lPars2) > MAX_PARAM_LENGTH then begin
               lPars := lPars+lPars2+#13#10+lFillStr;
               lPars2 := '';
             end;
             lPars2 := lPars2+Format('%s %s: %s; ', [DelphiFlagNames[Flag], Name, GetDataType(DataType)]);
           end;
         end;
       end;
       lPars := lPars+lPars2;
     end;
     
     if AddSenderGUID then begin
       lPars2 := 'const __Sender : TGUID';
       if (lPars<>'') then lPars2 := lPars2+'; ';

       lPars := lPars2+lPars;
     end;

     if (lPars<>'') then begin
       if Count>0
         then s := s+'('+Copy(lPars,1,Length(lPars)-2)+')'
         else s := s+'('+Copy(lPars,1,Length(lPars))+')'
     end;
   end;

   if Assigned(anOperation.Result) then s := s+': '+GetDataType(anOperation.Result.DataType);
   s := s+';';

   result := s;
end;

function DataTypeToCSharpType(const iType:string; iLibrary:TRODLLibrary=nil; iForNew:boolean=false):string;
var
  lType,lElementType:string;
begin
  lType := iType;
  if CompareText(iType,'Integer') = 0 then begin
    Result := 'Int32';
  end
  else if CompareText(iType,'WideString') = 0 then begin
    Result := 'String';
  end
  else if CompareText(iType,'DateTime') = 0 then begin
    Result := 'DateTime'; //make sure casing is good
  end
  else if CompareText(iType,'Xml') = 0 then begin
    Result := 'XmlNode';
  end
  else if Assigned(iLibrary) and IsArray(lType,ilibrary,lElementType) then begin
    if iForNew then
      Result := DataTypeToCSharpType(lElementType,iLibrary)+'[0]'
    else
      Result := DataTypeToCSharpType(lElementType,iLibrary)+'[]';
  end
  else if Assigned(iLibrary) then begin
    if IsUserDefinedType(lType,iLibrary) then begin
      result := lType; // IsUserDefinedType() fixed the casing
    end
    else begin
      Result := LowerCase(iType);
      if Length(Result) > 0 then Result[1] := UpCase(Result[1]);
    end;
  end
  else begin
    Result := iType;
  end;
  if iForNew and (Pos('[0]',result) = 0) then result := result+'()';
end;

function DataTypeToDelphiDotNetType(const iType:string; iLibrary:TRODLLibrary=nil; iForNew:boolean=false):string;
var
  lType:string;
begin
  lType := iType;
  if CompareText(iType, 'Xml') = 0 then
    result := 'XmlNode'
  else
  if CompareText(iType,'WideString') = 0 then begin
    Result := 'String';
  end
  else if Assigned(iLibrary) then begin
    if IsUserDefinedType(lType,iLibrary) then begin
      result := lType; // IsUserDefinedType() fixed the casing
    end
    else begin
      Result := LowerCase(iType);
      if Length(Result) > 0 then Result[1] := UpCase(Result[1]);
    end;
  end
  else begin
    Result := iType;
  end;
  //if iForNew and (Pos('[0]',result) = 0) then result := result+'()';
end;

function GetOperationDefinitionCSharp(const anOperation : TRODLOperation; aForInterface:Boolean; const aSuffix : string = ''; aLibrary: TRODLLibrary = nil) : string;
var x : integer;
    pars, s : string;
begin
   if not Assigned(anOperation.Result) then s := 'void ' else s := DataTypeToCSharpType(anOperation.Result.DataType,aLibrary)+' ';
   if not aForInterface then s := 'public '+s;

   {if aClassName<>''
     then s := s+aClassName+'.'+anOperation.Name
     else}
   s := s+anOperation.Name;

   {if aSuffix<>''
     then s := s+aSuffix;}

   with anOperation do
     if (Count>0) then begin
       pars := '';

       for x := 0 to (Count-1) do begin
         with Items[x] do begin
           if (Flag<>fresult)
             then pars :=pars+Format('%s%s %s, ', [CSharpFlagNames[Flag], DataTypeToCSharpType(DataType,aLibrary), Name]);
         end;
       end;
                    
       if (pars<>'') then
         s := s+'('+Copy(pars,1,Length(pars)-2)+')'
       else
         s := s+'()';
     end
     else
       s := s+'()';

   //if Assigned(anOperation.Result) then s := s+': '+anOperation.Result.DataType;
   //s := s+';';
   if aForInterface then s := s+';';

   result := s;
end;

function GetOperationDefinitionDelphiForDotNet(const anOperation : TRODLOperation; aLibrary:TRODLLibrary; const aClassName : string = ''; const aSuffix : string = '') : string;
var x : integer;
    pars, s : string;
begin
   if not Assigned(anOperation.Result) then s := 'procedure ' else s := 'function ';

   if aClassName<>''
     then s := s+aClassName+'.'+anOperation.Name
     else s := s+anOperation.Name;

   if aSuffix<>''
     then s := s+aSuffix;

   with anOperation do
     if (Count>0) then begin
       pars := '';

       for x := 0 to (Count-1) do begin
         with Items[x] do begin
           if (Flag<>fresult)
             then pars :=pars+Format('%s %s: %s; ', [DelphiFlagNames[Flag], Name, DataTypeToCSharpType(DataType)]);
         end;
       end;

       if (pars<>'') then s := s+'('+Copy(pars,1,Length(pars)-2)+')';
     end;

   if Assigned(anOperation.Result) then s := s+': '+DataTypeToCSharpType(anOperation.Result.DataType);
   s := s+';';

   result := s;
end;


function GetAsyncInvokeOperationDefinition(
   const anOperation : TRODLOperation;
   const aClassName : string = '';
   const aSuffix : string = '') : string;
var x : integer;
    pars, s : string;
begin
   s := 'procedure ';

   if aClassName<>''
     then s := s+aClassName+'.'+'Invoke_'+anOperation.Name
     else s := s+'Invoke_'+anOperation.Name;

   if aSuffix<>''
     then s := s+aSuffix;

   with anOperation do
     if (Count>0) then begin
       pars := '';

       for x := 0 to (Count-1) do begin
         with Items[x] do begin
           if not (Flag in [fOut,fResult]) then
             pars :=pars+Format('%s %s: %s; ', [DelphiAsyncInvokeFlagNames[Flag], Name, GetDataType(DataType)]);
         end;
       end;

       if (pars<>'') then s := s+'('+Copy(pars,1,Length(pars)-2)+')';
     end;

   //if Assigned(anOperation.Result) then s := s+': '+anOperation.Result.DataType;
   s := s+';';

   result := s;
end;

function NeedsAsyncRetrieveOperationDefinition(anOperation:TRODLOperation):boolean;
var
  i:integer;
begin
  result := Assigned(anOperation.Result) or (anOperation.ForceAsyncResponse);
  if not result then
    for i := 0 to anOperation.Count-1 do with anOperation.Items[i] do
      if (Flag <> fIn) then result := true;
end;

function GetAsyncRetrieveOperationDefinition(
   const anOperation : TRODLOperation;
   const aClassName : string = '';
   const aSuffix : string = '') : string;
var x : integer;
    pars, s : string;
begin
   if not Assigned(anOperation.Result) then s := 'procedure ' else s := 'function ';

   if aClassName<>''
     then s := s+aClassName+'.'+'Retrieve_'+anOperation.Name
     else s := s+'Retrieve_'+anOperation.Name;

   if aSuffix<>''
     then s := s+aSuffix;

   with anOperation do
     if (Count>0) then begin
       pars := '';

       for x := 0 to (Count-1) do begin
         with Items[x] do begin
           if not (Flag in [fIn,fResult]) then
             pars :=pars+Format('%s %s: %s; ', [DelphiAsyncRetrieveFlagNames[Flag], Name, GetDataType(DataType)]);
         end;
       end;

       if (pars<>'') then s := s+'('+Copy(pars,1,Length(pars)-2)+')';
     end;

   if Assigned(anOperation.Result) then s := s+': '+GetDataType(anOperation.Result.DataType);
   s := s+';';

   result := s;
end;

function TypeToReadWriteFn(const iType:string):string;
begin
  if SameText(iType,'Integer') then begin
    result := 'Int32';
  end
  else if SameText(iType,'Boolean') then begin
    result := 'Boolean';
  end
  else if SameText(iType,'WideString') then begin
    result := 'WideString';
  end
  else if SameText(iType,'String') then begin
    result := 'AnsiString';
  end
  {else if (iType = 'Binary') or (iType = 'Array') then begin
    Result := 'ISerializable';
  end}
  else begin
    Result := '';
  end;
end;

function MessageWrite(const iType, iRodlType, iName, iVariable:string):string;
var lWriteFn: string;
begin
  lWriteFn := TypeToReadWriteFn(iRodlType);
  if lWriteFn <> '' then begin
    Result := Format('%s("%s", %s);',
                     [lWriteFn, iName, iVariable]);
  end
  else begin
    Result := Format('("%s", %s, typeof(%s));',  //typeof(%s),
                     [iName, iVariable, iType]); //iType,
  end;
end;

function MessageRead(const iType, iRodlType, iName:string):string;
var lWriteFn: string;
begin
  lWriteFn := TypeToReadWriteFn(iRodlType);
  if lWriteFn <> '' then begin
    Result := Format('__Message.Read%s("%s");',
                     [lWriteFn, iName]);
  end
  else begin
    Result := Format('(%s)__Message.Read("%s", typeof(%s));',
                     [iType, iName, iType]);
  end;
end;

procedure GetTypeNames(const aLibrary : TRODLLibrary; aResult : TStrings);
var i : integer;
begin
  with aLibrary do begin
    for i := 0 to StructCount-1 do
      aResult.AddObject(Structs[i].Name, pointer(Structs[i]));

    for i := 0 to EnumCount-1 do
      aResult.AddObject(Enums[i].Name, pointer(Enums[i]));

    for i := 0 to ArrayCount-1 do
      aResult.AddObject(Arrays[i].Name, pointer(Arrays[i]));
  end;
end;

function TypeByName(const aLibrary : TRODLLibrary; const aTypeName : string) : TRODLEntity;
var i : integer;
begin
  result := NIL;

  with aLibrary do begin
    for i := 0 to (Count-1) do
      if (CompareText(Items[i].Name, aTypeName)=0) then begin
        result := Items[i];
        Exit;
      end;
  end;
end;

// TRORemoteDatamodule registration
procedure RegisterRODataModuleClass(aClass : TRORemoteDataModuleClass; const anAlias, aDescription, someRequiredUnits : string);
var idx : integer;
    item : PRODataModuleClass;
begin
  idx := _datamodules.IndexOf(aClass.ClassName);
  if (idx>=0) then begin
    Dispose(PRODataModuleClass(_datamodules.Objects[idx]));
    _datamodules.Delete(idx);
  end;

  New(item);
  item.ClassType := aClass;
  item.Alias := anAlias;
  item.Description := aDescription;
  item.RequiredUnits := someRequiredUnits;

  _datamodules.AddObject(aClass.ClassName, TObject(item));
end;

function GetRODataModuleClass(Index : integer) : TRODataModuleClass;
begin
  result := PRODataModuleClass(_datamodules.Objects[Index])^
end;

function GetRODataModuleClassCount : integer;
begin
  result := _datamodules.Count
end;

procedure DisposeModuleClasses;
var i : integer;
begin
  for i := 0 to (_datamodules.Count-1) do
    Dispose(PRODataModuleClass(_datamodules.Objects[i]));
end;

initialization
  _datamodules := TStringList.Create;
  {_datamodules.Duplicates := dupError;}
  _datamodules.Sorted := TRUE;

finalization
  DisposeModuleClasses();
  FreeAndNIL(_datamodules);

end.