unit uRODLToPascalImpl;

{----------------------------------------------------------------------------}
{ 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 { TRODLToImpl }
     TRODLToImpl = class(TRODLConverter)
     private
       fService : TRODLService;
       fAncestorService:TRODLService;
       fServerClassName: string;
       fRequiredUnits: string;

       procedure WriteServiceDeclaration(const aService: TRODLService);
       procedure WriteOperationImplementation(const anOperation : TRODLOperation);
       procedure SetServerClassName(const Value: string);
       function GetWriteDataModule: boolean;

     protected
       procedure IntConvert(const aLibrary : TRODLLIbrary; const aTargetEntity : string = ''); override;
       function ValidateTargetEntity(const aLibrary : TRODLLIbrary; const aTargetEntity : string) : boolean; override;

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

       property WriteDataModule : boolean read GetWriteDataModule;
       procedure WriteDFM(const aLibrary: TRODLLIbrary; const aTargetEntity: string; const aFilename: string);

       property ServerClassName : string read fServerClassName write SetServerClassName;
       property RequiredUnits : string read fRequiredUnits write fRequiredUnits;
     end;

implementation

uses SysUtils, Dialogs, Classes,
     {$IFDEF HYDRA_DESIGNTIME}
     uROIDETools, uEWOTAHelpers,
     {$ENDIF HYDRA_DESIGNTIME}
     uRODLGenTools, uRODLToPascalInvk, uRODLToPascal, uROServer;

function IsHydraModule : boolean;
{$IFDEF HYDRA_DESIGNTIME}
var
  lSource: string;
{$ENDIF HYDRA_DESIGNTIME}
begin
  result := FALSE;
  {$IFDEF HYDRA_DESIGNTIME}
  if (CurrentProject<>NIL) then begin
    lSource := UpperCase(ReadModuleSource(CurrentProject));
    result := Pos('{#HYDRAMODULE}', lSource)>0;
  end;
  {$ENDIF HYDRA_DESIGNTIME}
end;

{ TRODLToImpl }
procedure TRODLToImpl.WriteDFM(const aLibrary: TRODLLIbrary; const aTargetEntity: string; const aFilename: string);
var svc : TRODLService;
begin
  with TStringList.Create do try
    svc := aLibrary.ItemByName(aTargetEntity) as TRODLService;

    if (Trim(svc.Ancestor)='') then Add(Format('object %s: T%s', [aTargetEntity, aTargetEntity]))
                               else Add(Format('inherited %s: T%s', [aTargetEntity, aTargetEntity]));
    Add('  OldCreateOrder = True');
    Add('  Left = 200');
    Add('  Top = 200');
    Add('  Height = 300');
    Add('  Width = 300');
    Add('end');
  finally
    SaveToFile(aFilename);
    Free;
  end;
end;

procedure TRODLToImpl.IntConvert(const aLibrary: TRODLLIbrary; const aTargetEntity : string = '');
var i : integer;
    s, s2 : string;
    lIsHydraModule : boolean;
begin
  if not Assigned(fService) or not Assigned(fService.Default) then exit;
  if ServerClassName = '' then begin
    ServerClassName := 'TRORemoteDataModule';
     if (copy(RequiredUnits, Length(RequiredUnits), 1) <> ',') and (RequiredUnits <> '') then
      RequiredUnits := RequiredUnits + ',';
    RequiredUnits := RequiredUnits + 'uRORemoteDataModule';
  end;

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

  WriteLines(ImplNotice);
  WriteEmptyLine;

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

  Write('interface');
  WriteEmptyLine;

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

  {
    handled via RequiredUnits
  if WriteDataModule then begin
    s := Copy(ServerClassName,2,MaxInt);
    if (s<>'') // For inherited ones...
      then Write(Format('              u%s,', [s]),PASCAL_INDENTATION_LEVEL_1);
  end;}

  if (RequiredUnits<>'') then begin
    s := Trim(RequiredUnits);
    if (s[Length(s)]<>',') then s := s+',';
    Write('{Required:} '+s ,PASCAL_INDENTATION_LEVEL_1);
  end;

  {TODO: -cRO3 RequiredUnits, and UsedRODLs might overlap if (for example) using the DARemoteService
              ancestor was chosen not in SB but from the IDE. Check these and create a unique list
              for RO3. }

  if fService.Ancestor <> '' then begin
    fAncestorService := aLibrary.FindService(fService.Ancestor);
    if Assigned(fAncestorService) and (fAncestorService.ImplUnit <> '') then
      Write('{Ancestor Implementation:} '+fAncestorService.ImplUnit+',',PASCAL_INDENTATION_LEVEL_1)
    else
      Write('{Ancestor Implementation:} '+fService.Ancestor+'_Impl,',PASCAL_INDENTATION_LEVEL_1);
  end;

  if aLibrary.UseCount > 0 then begin
    s := '';
    for i := 0 to aLibrary.UseCount-1 do begin
      if aLibrary.Use[i].LoadedRodlLibraryName <> '' then
        s2 := aLibrary.Use[i].LoadedRodlLibraryName + '_Intf'
      else
        s2 := ChangeFileExt(ExtractFilename(aLibrary.Use[i].RodlFile),'')+'_Intf';
      if Pos(s2, s) <= 0 then begin
        if s <> '' then
          s := s+', ';
        s := s+s2;
      end;
    end; { for }
    s := s+',';

    Write('{Used RODLs:} '+s,PASCAL_INDENTATION_LEVEL_1);
  end;

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

  Write('type');

  WriteServiceDeclaration(fService);

  {WriteEmptyLine;
  Write(Format('// Returns an I%s instance in case you need direct access to it from inside your server application',
               [fService.Info.Name]));
  Write(Format('function New%s(const aClientID : TGUID; UseClassFactory : boolean = TRUE) : I%s;', [fService.Info.Name, fService.Info.Name]));}

  WriteEmptyLine;

  Write('implementation');
  WriteEmptyLine;
  if WriteDataModule
    then Write('{$R *.dfm}');

  Write('uses');

  (*)if aLibrary.UseCount > 0 then begin
    s := '';
    for i := 0 to aLibrary.UseCount-1 do begin
      if s <> '' then s := s+', ';
      s := s+ChangeFileExt(ExtractFilename(aLibrary.Use[i].RodlFile),'')+'_Invk';
    end; { for }
    s := s+',';

    Write('{Ansestor Invokers:} '+s,PASCAL_INDENTATION_LEVEL_1);
  end; *)
  if fService.IsFromUsedRodl then begin
    s := ChangeFileExt(ExtractFilename(fService.LocatedInRodlUse.RodlFile),'')+'_Invk';
  end
  else begin
    s := ChangeFileExt(TRODLToInvk.GetTargetFileName(aLibrary),'');
  end;

  lIsHydraModule := IsHydraModule;
  if lIsHydraModule then begin
    Write(Format('{Hydra:} uHYRes, uHYIntf, uHYROFactory,', [s]),PASCAL_INDENTATION_LEVEL_1);
  end;

  Write(Format('{Generated:} %s;', [s]),PASCAL_INDENTATION_LEVEL_1);

  WriteEmptyLine;

  Write(Format('procedure Create_%s(out anInstance : IUnknown);', [fService.Info.Name]));
  Write('begin');
  if WriteDataModule
    then Write(Format('  anInstance := T%s.Create(nil);', [fService.Info.Name]))
    else Write(Format('  anInstance := T%s.Create;', [fService.Info.Name]));
  Write('end;');
  WriteEmptyLine;

  Write(Format('{ %s }', [fService.Info.Name]));
{  Write(Format('function New%s(const aClientID : TGUID; UseClassFactory : boolean = TRUE) : I%s;', [fService.Info.Name, fService.Info.Name]));
  Write('var');
  Write('  lUnknown: IUnknown;');
  Write('  lClassFactorty: IROClassFactory;');
  Write('begin');
  Write('  result := nil;');
  Write('  if UseClassFactory then begin');
  Write(Format('    lClassFactorty := FindClassFactory(''%s'');', [fService.Info.Name]));
  Write('    lClassFactorty.CreateInstance(aClientID, lUnknown);');
  Write('  end');
  Write(Format('  else Create_%s(lUnknown);', [fService.Info.Name]));
  WriteEmptyLine;
  Write(Format('  result := lUnknown as I%s;', [fService.Info.Name]));
  Write('end;');

  WriteEmptyLine;}

  if Assigned(fService.Default) then begin
    for i := 0 to fService.Default.Count-1 do
      WriteOperationImplementation(fService.Default.Items[i]);
  end;

  Write('initialization');
  s := fService.Info.Name;

  if lIsHydraModule then begin
    Write('  THYROFactory.Create(HInstance,');
  end;

  s := Format('  TROClassFactory.Create(''%s'', Create_%s, T%s_Invoker)', [s,s,s]);
  if lIsHydraModule then s := s+'  ' else s := s+';';
  Write(s);

  if lIsHydraModule then
    Write('  );');

  WriteEmptyLine;

  Write('finalization');
  WriteEmptyLine;

  Write('end.');
  s := buffer.Text;
end;

procedure TRODLToImpl.WriteServiceDeclaration(const aService : TRODLService);
var i : integer;
begin
  Write(Format('{ T%s }', [aService.Info.Name]), PASCAL_INDENTATION_LEVEL_1);
  if aService.Ancestor <> '' then begin
    if Assigned(fAncestorService) and (fAncestorService.ImplClass <> '') then
      Write(Format('T%s = class(%s, I%s)', [aService.Info.Name, fAncestorService.ImplClass, aService.Info.Name]), PASCAL_INDENTATION_LEVEL_1)
    else
      Write(Format('T%s = class(T%s, I%s)', [aService.Info.Name, aService.Ancestor, aService.Info.Name]), PASCAL_INDENTATION_LEVEL_1);
  end
  else begin
    if WriteDataModule then
      Write(Format('T%s = class(%s, I%s)', [aService.Info.Name, ServerClassName, aService.Info.Name]), PASCAL_INDENTATION_LEVEL_1)
    else
      Write(Format('T%s = class(TRORemotable, I%s)', [aService.Info.Name, aService.Info.Name]), PASCAL_INDENTATION_LEVEL_1);
  end;

  Write('private',PASCAL_INDENTATION_LEVEL_1);
  Write('protected',PASCAL_INDENTATION_LEVEL_1);
  Write(Format('{ I%s methods }', [aService.Info.Name]), PASCAL_INDENTATION_LEVEL_2);
  for i := 0 to (aService.Default.Count-1) do
    Write(Format(GetOperationDefinition(aService.Default.Items[i]), []), PASCAL_INDENTATION_LEVEL_2);

  Write('end;', PASCAL_INDENTATION_LEVEL_1);
end;

function TRODLToImpl.ValidateTargetEntity(
  const aLibrary: TRODLLIbrary; const aTargetEntity: string): boolean;
var i : integer;
begin
  result := FALSE;

  for i := 0 to (aLibrary.ServiceCount-1) do
    if (CompareText(aLibrary.Services[i].Info.Name, aTargetEntity)=0) then begin
      fService := aLibrary.Services[i]; // Will be used later
      result := TRUE;
      Exit;
    end;
end;

procedure TRODLToImpl.WriteOperationImplementation(const anOperation: TRODLOperation);
var
  i : integer;
  lCode:TStrings;
begin
  Write(GetOperationDefinition(anOperation, 'T'+fService.Info.Name));
  lCode := anOperation.CodeBodies['Delphi'];
  if Assigned(lCode) then begin
    WriteLines(lCode.Text);
  end
  else begin
    Write('begin');
    Write('end;');
  end;


  for i := 0 to (anOperation.Count-1) do begin
  end;

  WriteEmptyLine;
end;

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

procedure TRODLToImpl.SetServerClassName(const Value: string);
begin
  fServerClassName := Value;
end;

function TRODLToImpl.GetWriteDataModule: boolean;
begin
  result := (fServerClassName <> TRORemotable.ClassName);
end;

end.