unit uRODLToPascalInvk;

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

type { TRODLToInvk }
     TRODLToInvk = class(TRODLConverter)
     private
       fIntfUnitName : string;

       procedure WriteInvokerDeclaration(const aService: TRODLService; aLibrary : TRODLLibrary);
       procedure WriteOperationImplementation(const aService : TRODLService;
            const anOperation : TRODLOperation;
            aLibrary : TRODLLibrary);

     protected
       procedure IntConvert(const aLibrary : TRODLLibrary; const aTargetEntity : string = ''); override;

     public
       class function GetTargetFileName(const aLibrary : TRODLLibrary; const aTargetEntity : string = ''): string; override;

     end;


implementation

uses SysUtils, uRODLGenTools, uROTypes, uRODLToPascalImpl, uRODLToPascalIntf, Dialogs, uRODLToPascal;

{ TRODLToInvk }

procedure TRODLToInvk.IntConvert(const aLibrary: TRODLLIbrary; const aTargetEntity : string = '');
var i, k : integer;
    s,t,actualname : string;
begin
  fIntfUnitName := ChangeFileExt(TRODLToIntf.GetTargetFileName(aLibrary), '');

  Write(Format('unit %s;', [ChangeFileExt(GetTargetFileName(aLibrary), '')]));
  WriteEmptyLine;

  WriteLines(IntfInvkNotice);
  WriteEmptyLine;

  Write('{$I Remobjects.inc}');
  WriteEmptyLine;

  Write('interface');
  WriteEmptyLine;

  Write('uses');
  Write('{vcl:} Classes,' ,PASCAL_INDENTATION_LEVEL_1);
  Write('{RemObjects:} uROXMLIntf, uROServer, uROServerIntf, uROTypes, uROClientIntf,' ,PASCAL_INDENTATION_LEVEL_1);

  if aLibrary.UseCount > 0 then begin

    s := '';
    t := '';
    for i := 0 to aLibrary.UseCount-1 do begin

      if aLibrary.Use[i].LoadedRodlLibraryName <> '' then
        actualname := aLibrary.Use[i].LoadedRodlLibraryName
      else
        actualname := ChangeFileExt(ExtractFilename(aLibrary.Use[i].RodlFile),'');

      if (Pos(actualname+'_Intf', s)<=0) then begin
        if s <> '' then s := s+', ';
        s := s+actualname+'_Intf';
      end;

      if (Pos(actualname+'_Invk', t)<=0) then begin
        if t <> '' then t := t+', ';
        t := t+actualname+'_Invk';
      end;
    end; { for }

    if (s<>'') then begin
      s := s+',';
      Write('{Used RODL Intf''s:} '+s,PASCAL_INDENTATION_LEVEL_1);
    end;

    if (t<>'') then begin
      t := t+',';
      Write('{Used RODL Invk''s:} '+t,PASCAL_INDENTATION_LEVEL_1);
    end;
  end;

  Write(Format('{Generated:} %s_Intf;', [aLibrary.Info.Name]),PASCAL_INDENTATION_LEVEL_1);
  WriteEmptyLine;

  if aLibrary.ServiceCount > 0 then Write('type');

  with aLibrary.CalcServiceOrder() do begin
    for i := 0 to (Count-1) do //if (not aLibrary.Services[i].IsFromUsedRodl) then
      WriteInvokerDeclaration(Objects[i] as TRODLService, aLibrary);
  end;

  {for i := 0 to (aLibrary.ServiceCount-1) do if (not aLibrary.Services[i].IsFromUsedRodl) then
    WriteInvokerDeclaration(aLibrary.Services[i], aLibrary); }

  Write('implementation');
  WriteEmptyLine;

  //s := '';
  {for i := 0 to (aLibrary.ServiceCount-1) do begin
    //s := s+ChangeFileExt(TRODLToImpl.GetTargetFileName(aLibrary, aLibrary.Services[i].Info.Name),'');
    s := s+aLibrary.Services[i].Info.Name+'_Impl';
    if (i<aLibrary.ServiceCount-1) then s := s+', ';
  end;}

  Write('uses');
  (*if (Trim(s)<>'')
    then Write(Format('{RemObjects:} uRORes, %s;', [s]),PASCAL_INDENTATION_LEVEL_1)
    else *)Write(Format('{RemObjects:} uRORes, uROClient;', []),PASCAL_INDENTATION_LEVEL_1);
  WriteEmptyLine;

  for i := 0 to (aLibrary.ServiceCount-1) do if (not aLibrary.Services[i].IsFromUsedRodl) then begin
    //WriteInvokerHandleMessage(aLibrary.Services[i]);

    if not Assigned(aLibrary.Services[i].Default) then Continue;

    if aLibrary.Services[i].Default.Count > 0 then begin
      Write('{ T'+aLibrary.Services[i].Info.Name+'_Invoker }');
      WriteEmptyLine;
    end;

    for k := 0 to (aLibrary.Services[i].Default.Count-1) do
      {s := Format('aaa %s ', ['mmm']);
      Buffer.Add(s);
      //}   WriteOperationImplementation(aLibrary.Services[i], aLibrary.Services[i].Default.Items[k], aLibrary);

  end;

  for i := 0 to (aLibrary.ServiceCount-1) do ;

  Write('end.');
end;

procedure TRODLToInvk.WriteInvokerDeclaration(const aService : TRODLService; aLibrary : TRODLLibrary);
var i : integer;
begin
  Write('{$M+}', PASCAL_INDENTATION_LEVEL_1);
  if aService.Ancestor <> '' then begin
    Write(Format('T%s_Invoker = class(T%s_Invoker)', [aService.Info.Name,aService.Ancestor]), PASCAL_INDENTATION_LEVEL_1);
  end
  else begin
    Write(Format('T%s_Invoker = class(TROInvoker)', [aService.Info.Name]), PASCAL_INDENTATION_LEVEL_1);
  end;
  Write('private', PASCAL_INDENTATION_LEVEL_1);
  Write('protected', PASCAL_INDENTATION_LEVEL_1);
  Write('published', PASCAL_INDENTATION_LEVEL_1);

  for i := 0 to (aService.Default.Count-1) do begin
    Write(Format('procedure Invoke_%s(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);', [aService.Default.Items[i].Info.Name]), PASCAL_INDENTATION_LEVEL_2);
  end;

  Write('end;', PASCAL_INDENTATION_LEVEL_1);
  Write('{$M-}', PASCAL_INDENTATION_LEVEL_1);
  WriteEmptyLine();
end;

procedure TRODLToInvk.WriteOperationImplementation(
  const aService : TRODLService;
  const anOperation: TRODLOperation; aLibrary : TRODLLibrary);
  const resultname = 'return';
var i : integer;
    lHasObjectDisposer: Boolean;
    pars, s, sa : string;
    typname : string;
begin
  Write(Format('procedure T%s_Invoker.Invoke_%s(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);',
               [aService.Info.Name, anOperation.Info.Name]));

  Write(Format('{ %s }', [GetOperationDefinition(anOperation)]));

  with anOperation do begin

    { Determine if we need an ObjectDisposer }
    lHasObjectDisposer := False;
    for i := 0 to (Count-1) do with Items[i] do begin
      if IsImplementedAsClass(DataType, aLibrary) then begin
        lHasObjectDisposer := true;
        break;
      end;
    end;
    if Assigned(Result) and IsImplementedAsClass(Result.DataType, aLibrary) then
      lHasObjectDisposer := true;

    //ShowMessage('1');

    { Write local variables }
    if (Count>0) or Assigned(Result) or lHasObjectDisposer then Write('var');
    for i := 0 to (Count-1) do begin

      typname := GetDataType(Items[i].DataType);
      if IsUserDefinedType(typname,aLibrary) then begin
        typname := GetFullyQualifiedTypeName(typname,aLibrary,fIntfUnitName);
      end;

      Write(Format('%s: %s;', [Items[i].Name, typname]),PASCAL_INDENTATION_LEVEL_1);
      if (Items[i].Flag = fInOut) and IsImplementedAsClass(Items[i].DataType, aLibrary) then
        Write(Format('__in_%s: %s;', [Items[i].Name, typname]),PASCAL_INDENTATION_LEVEL_1);
    end;

    //ShowMessage('2');

    if Assigned(Result) then begin
      typname := GetDataType(Result.DataType);
      if IsUserDefinedType(typname,aLibrary) then begin
        typname := GetFullyQualifiedTypeName(typname,aLibrary,fIntfUnitName);
      end;
      Write(Format('lResult: %s;', [ typname]),PASCAL_INDENTATION_LEVEL_1);
    end;
      

    if lHasObjectDisposer then
      Write('__lObjectDisposer: TROObjectDisposer;',PASCAL_INDENTATION_LEVEL_1);

{    if Assigned(Result)
      then Write('    %s: %s;', [resultname, Result.DataType]);}

    //ShowMessage('3');

    Write('begin');
    sa := GetAttributes(anOperation.Info.Attributes, aService.Info.Attributes, aLibrary.Info.Attributes, 4);
    if sa <> '' then
      Write('  __Message.SetAttributes(__Transport, '+sa +');');
    
    if (Count>0) then begin
      for i := 0 to (Count-1) do begin
        with Items[i] do begin
          if IsImplementedAsClass(DataType, aLibrary) then begin
            Write(Format('%s := nil;', [Items[i].Name]),PASCAL_INDENTATION_LEVEL_1);
            if (Flag = fInOut) then
              Write(Format('__in_%s := nil;', [Items[i].Name]),PASCAL_INDENTATION_LEVEL_1);
          end;
        end;
      end;
    end;
    if Assigned(Result) then
      if IsImplementedAsClass(Result.DataType, aLibrary) then
        Write('lResult := nil;',PASCAL_INDENTATION_LEVEL_1);

    Write('  try');

    //ShowMessage('4');

    for i := 0 to (Count-1) do
      if IsInputFlag(Items[i].Flag) then begin

        if (StrToDataType(Items[i].DataType)=rtDateTime)
          then sa := '[paIsDateTime]'
          else sa := '[]';

        typname := GetDataType(Items[i].DataType);
        if IsUserDefinedType(typname,aLibrary) then begin
          typname := GetFullyQualifiedTypeName(typname,aLibrary,fIntfUnitName);
        end;

        Write(Format('__Message.Read(''%s'', TypeInfo(%s), %s, %s);',[Items[i].Name, typname, Items[i].Name, sa]),PASCAL_INDENTATION_LEVEL_2);
        if (Items[i].Flag = fInOut) and IsImplementedAsClass(Items[i].DataType, aLibrary) then begin
          Write(Format('__in_%s := %s;',[Items[i].Name, Items[i].Name]),PASCAL_INDENTATION_LEVEL_2)
        end;
      end;

    if (Count>0) then WriteEmptyLine;
    s := '    ';
    if Assigned(Result) then s := s+'lResult := ';
    s := s+Format('(__Instance as I%s).%s', [aService.Name, anOperation.Name]);

    //ShowMessage('5');

    if (Count>0) then begin
      pars := '';
      for i := 0 to (Count-1) do begin
        if (Items[i].Flag=fResult) then Continue;
        pars := pars+Items[i].Name+', ';
      end;

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

    s := s+';';
    Write(s);

    WriteEmptyLine;
(*    if anOperation.Info.Attributes.Values['OutputMessageName'] <> '' then
      Write(Format('    __Message.InitializeResponseMessage(__Transport, ''%s'', ''%s'', ''%s'');',[aLibrary.Name, aService.Name, anOperation.Info.Attributes.Values['OutputMessageName']]))
    else *)

    Write(Format('    __Message.InitializeResponseMessage(__Transport, ''%s'', ''%s'', ''%sResponse'');',[aLibrary.Name, aService.Name, Name]));


    //ShowMessage('6');

    if Assigned(Result) then begin
      if (StrToDataType(Result.DataType)=rtDateTime) then
        sa := '[paIsDateTime]'
      else
        sa := '[]';

      typname := GetDataType(Result.DataType);
      if IsUserDefinedType(typname,aLibrary) then begin
        typname := GetFullyQualifiedTypeName(typname,aLibrary,fIntfUnitName);
      end;

      Write(Format('    __Message.Write(''%s'', TypeInfo(%s), lResult, %s);',
        [Result.Name, typname, sa]));
    end;

    //ShowMessage('7');

    for i := 0 to (Count-1) do
      if IsOutputFlag(Items[i].Flag) then begin

        if (StrToDataType(Items[i].DataType)=rtDateTime)
          then sa := '[paIsDateTime]'
          else sa := '[]';

        typname := GetDataType(Items[i].DataType);
        if IsUserDefinedType(typname,aLibrary) then begin
          typname := GetFullyQualifiedTypeName(typname,aLibrary,fIntfUnitName);
        end;

        Write(Format('    __Message.Write(''%s'', TypeInfo(%s), %s, %s);',
          [Items[i].Name, typname, Items[i].Name, sa]));
      end;

    {if Assigned(Result) then begin
      Write(Format('  __Message.Write(''%s'', TypeInfo(%s), @%s);', [resultname, Result.DataType, resultname]))
    end;}
    Write('    __Message.Finalize;');
    if sa <> '' then
      Write('    __Message.UnsetAttributes(__Transport);');
    WriteEmptyLine;

    if not NeedsAsyncRetrieveOperationDefinition(anOperation) then begin
      Write('    __oResponseOptions := [roNoResponse];');
      WriteEmptyLine;
    end;

    Write('  finally');

    //ShowMessage('8');

    if lHasObjectDisposer then begin
      Write('    __lObjectDisposer := TROObjectDisposer.Create(__Instance);');
      Write('    try');

      for i := 0 to (Count-1) do with Items[i] do begin
        if IsImplementedAsClass(DataType, aLibrary) then begin
          if Items[i].Flag = fInOut then begin
            Write(Format('      __lObjectDisposer.Add(__in_%s);', [Items[i].Name]));
          end;
          Write(Format('      __lObjectDisposer.Add(%s);', [Items[i].Name]));
        end;
      end;
      if Assigned(Result) then begin
        if IsImplementedAsClass(Result.DataType, aLibrary) then begin
          Write('      __lObjectDisposer.Add(lResult);');
        end;
      end;

      Write('    finally');
      Write('      __lObjectDisposer.Free();');
      Write('    end;');
    end;
    Write('  end;');
    Write('end;');


    { ToDo: passing an incomig reference to an out param will blow, as both will
            be freed (so the same object si freed twice. we need to add better
            logic to catch this:

            currently

              finally
                if (Param1 <> Result) then Param1.Free;
                Result.Free;
              end;

            better:

              finally
                if (Param1 <> Result) then Param1.Free;
                Result.Free;
              end;
    }

  {finally
    if (Param1 <> Result) then Param1.Free;
    Result.Free;
  end;}



  end;
  WriteEmptyLine;
end;

class function TRODLToInvk.GetTargetFileName(const aLibrary: TRODLLIbrary; const aTargetEntity: string): string;
begin
  result := aLibrary.Name+'_Invk.pas';
end;

end.