unit TMS.ServerWizard.Creation;

{$I bcl.inc}

interface

{$IFDEF DELPHIXE2_LVL}

uses
  ToolsAPI, TMS.ServerWizard.Types;

type
  TProjectCreationSettings = class
  private
    FServerPort,
    FServerHostname,
    FServerPath,
    FDatabaseDriver,
    FDatabaseDriverType,
    FDatabaseDriverUses,
    FSQLDialect : string;
    function AddError(var Errors: string; const NewError : string): Boolean;
    function GetServerPortNumeric: Integer;
    function GetServerPath: string;
  public
    constructor Create(const ForDefault : TServerKind);

    function Valid(const ServerKind : TServerKind; var Errors : string) : Boolean;

    function GetConnectionModuleComponentType : string;

    property ServerHostname : string read FServerHostname write FServerHostname;
    property ServerPort : string read FServerPort write FServerPort;
    property ServerPortNumeric : Integer read GetServerPortNumeric;
    property ServerPath : string read GetServerPath write FServerPath;
    property DatabaseDriver : string read FDatabaseDriver write FDatabaseDriver;
    property DatabaseDriverType : string read FDatabaseDriverType write FDatabaseDriverType;
    property DatabaseDriverUses : string read FDatabaseDriverUses write FDatabaseDriverUses;
    property SQLDialect : string read FSQLDialect write FSQLDialect;
  end;

  TServerCreator = class
  private
    FServerKind : TServerKind;
    FSettings : TProjectCreationSettings;
    FKinds : TProjectKinds;
    FIdentiferMap : TIdentifierMap;
    function SettingsValid(var Errors: string): Boolean;
    function InternalCreateProject(const Kind: TProjectKind; const ServerUnit : IOTAFile) : IOTAProject;
    function InternalCreateServer: IOTAFile;
    procedure InitIdentifierMap;
    function GetModuleTypeName: string;
    function GetModuleCreationParameters: string;
    function GetServerUses: string;
  public
    constructor Create(const AServerKind : TServerKind; const Settings : TProjectCreationSettings;
      const Kinds : TProjectKinds);
    destructor Destroy; override;

    function CreateServers : Boolean;
  end;

resourcestring
  SPARKLEMODULECREATIONPARAMS =
    'procedure(const C: THttpServerContext) '#13#10 +
    '    begin '#13#10 +
    '      C.Response.StatusCode := 200; '#13#10 +
    '      C.Response.ContentType := ''text/html''; '#13#10 +
    '      C.Response.Close(TEncoding.UTF8.GetBytes(''<h1>Hello, World!</h1><br/>Implement your server response here.'')); '#13#10 +
    '    end';
  XDATAMODULECREATIONPARAMS = '{CONNMODULE_CLASSNAME}.CreatePool(20)';
  REMOTEDBMODULECREATIONPARAMS = '{CONNMODULE_CLASSNAME}.CreateFactory';
  SPARKLEUSES = '';
  XDATAUSES =
    ' '#13#10 +
    '  ConnectionModule, '#13#10 +
    '  XData.Server.Module,';
  REMOTEDBUSES =
    ' '#13#10 +
    '  ConnectionModule, '#13#10 +
    '  RemoteDB.Server.Module,';
  FIREDACUSES =
    ' '#13#10 +
    '  FireDAC.Dapt,';
  XDATAIMPLEMENTATIONUSES =
    ' '#13#10 +
    '  XData.Aurelius.ConnectionPool,';
  XDATAPOOLDECLARATION =
    ' '#13#10 +
    '    class function CreatePool(APoolSize: Integer): IDBConnectionPool;';
  XDATAPOOLIMPLEMENTATION =
    'class function {CONNMODULE_CLASSNAME}.CreatePool(APoolSize: Integer): IDBConnectionPool;'#13#10 +
    'begin'#13#10 +
    '  Result := TDBConnectionPool.Create(APoolSize, CreateFactory);'#13#10 +
    'end;';
//  CREATECONNECTION_NORMAL =
//    'var '#13#10 +
//    '  DataModule: {CONNMODULE_CLASSNAME}; '#13#10 +
//    'begin '#13#10 +
//    '  DataModule := {CONNMODULE_CLASSNAME}.Create(nil); '#13#10 +
//    '  Result := {TDATABASEDRIVERTYPE}.Create(DataModule.Connection, ''{SQLDIALECT}'', DataModule); '#13#10 +
//    'end;';
  CREATECONNECTION_NORMAL =
    'begin '#13#10 +
    '  Result := {CONNMODULE_VARNAME}.AureliusConnection1.CreateConnection; '#13#10 +
    'end;';
//  CREATECONNECTION_SQLLITE =
//    'begin '#13#10 +
//    '  Result := {TDATABASEDRIVERTYPE}.Create(ParamStr(0) + ''.db''); '#13#10 +
//    'end;';

{$ENDIF}

implementation

{$IFDEF DELPHIXE2_LVL}


uses
  System.SysUtils, Vcl.Dialogs, TMS.ServerWizard.Creation.Project, TMS.ServerWizard.Files,
  TMS.ServerWizard.Configuration, TMS.ServerWizard.ToolsAPI.Utils;

{ TServerCreator }

constructor TServerCreator.Create(const AServerKind : TServerKind;
  const Settings : TProjectCreationSettings; const Kinds : TProjectKinds);
begin
  inherited Create();
  FServerKind := AServerKind;
  FSettings := Settings;
  FKinds := Kinds;
  FIdentiferMap := TIdentifierMap.Create;
end;

destructor TServerCreator.Destroy;
begin
  FIdentiferMap.Free;
  inherited;
end;

function TServerCreator.SettingsValid(var Errors : string) : Boolean;
begin
  Result := true;

  if FKinds = [] then begin
    Result := false;
    Errors := 'One or more project kinds must be selected (eg, VCL.)';
  end;

  Result := FSettings.Valid(FServerKind, Errors) and Result;
end;

procedure TServerCreator.InitIdentifierMap;
begin
  // This is the list of constants to replace in the files loaded from resources
  FIdentiferMap.Clear;

  FIdentiferMap.Add('{SERVER_HOST_NAME}', FSettings.ServerHostname);
  FIdentiferMap.Add('{SERVER_PORT}', FSettings.ServerPort);
  FIdentiferMap.Add('{SERVER_PATH}', FSettings.ServerPath);

  FIdentiferMap.Add('{TMODULETYPE}', GetModuleTypeName);
  FIdentiferMap.Add('{MODULECREATIONPARAMETERS}', GetModuleCreationParameters);

  // Server.pas, uses clause
  FIdentiferMap.Add('{SERVER_USES}', GetServerUses);

  // ConnectionModule.pas:
  FIdentiferMap.Add('{SQLDIALECT}', FSettings.SQLDialect);
//  FIdentiferMap.Add('{SQLDIALECTUSES}', FSettings.SQLDialect);
  FIdentiferMap.Add('{DATABASEDRIVER}', FSettings.DatabaseDriver);
  FIdentiferMap.Add('{DATABASEDRIVERUSES}', GetDriverNameForDatabaseUIName(FSettings.DatabaseDriver));
  FIdentiferMap.Add('{DATABASEDRIVERNAME}', GetDriverNameForDatabaseUIName(FSettings.DatabaseDriver));
  FIdentiferMap.Add('{TDATABASEDRIVERTYPE}', FSettings.DatabaseDriverType);

  // ConnectionModule.pas:
  // Constants are defined in SparkleResources.rc
  if SameText(FSettings.DatabaseDriver, 'FIREDAC') then
    FIdentiferMap.Add('{DRIVERADDITIONALUSES}', FIREDACUSES)
  else
    FIdentiferMap.Add('{DRIVERADDITIONALUSES}', '');

  // Only define these if it is an XData project:
  if FServerKind = TServerKind.skXData then begin
    FIdentiferMap.Add('{XDATAPOOLDECLARATION}', XDATAPOOLDECLARATION);
    FIdentiferMap.Add('{XDATAPOOLIMPLEMENTATION}', XDATAPOOLIMPLEMENTATION);
    FIdentiferMap.Add('{XDATAIMPLEMENTATIONUSES}', XDATAIMPLEMENTATIONUSES);
  end else begin
    // For other servers, these constants should be expanded to be blank
    FIdentiferMap.Add('{XDATAPOOLDECLARATION}', '');
    FIdentiferMap.Add('{XDATAPOOLIMPLEMENTATION}', '');
    FIdentiferMap.Add('{XDATAIMPLEMENTATIONUSES}', '');
  end;

  // These are for the connection module global var and class name
  FIdentiferMap.Add('{CONNMODULE_VARNAME}', FSettings.DatabaseDriverUses + FSettings.SQLDialect + 'Connection');
  FIdentiferMap.Add('{CONNMODULE_CLASSNAME}', 'T' + FSettings.DatabaseDriverUses + FSettings.SQLDialect + 'Connection');

  // And what kind of connection component should be created?
  FIdentiferMap.Add('{CONNECTIONMODULE_CREATE_COMP_TYPE}', FSettings.GetConnectionModuleComponentType);

  // ! Special case.
  // Normally, connections are created using the data module, except for SQLLite
//  if SameText(FSettings.DatabaseDriver, 'SQLite') then
//    FIdentiferMap.Add('{CREATE_CONNECTION}', CREATECONNECTION_SQLLITE) // Constants defined in SparkleResources.rc
//  else
    FIdentiferMap.Add('{CREATE_CONNECTION}', CREATECONNECTION_NORMAL)
end;

function TServerCreator.GetServerUses : string;
begin
  case FServerKind of
    TServerKind.skSparkle: Result := SPARKLEUSES;
    TServerKind.skXData: Result := XDATAUSES;
    TServerKind.skRemoteDB: Result := REMOTEDBUSES;
    TServerKind.skStandAloneConnModule: Exit('ERROR');
    else
      raise Exception.Create('Unknown server kind: ' + IntToStr(Integer(FServerKind)));
  end;
end;

function TServerCreator.GetModuleTypeName : string;
begin
  case FServerKind of
    TServerKind.skSparkle: Result := 'TAnonymousServerModule';
    TServerKind.skXData: Result := 'TXDataServerModule';
    TServerKind.skRemoteDB: Result := 'TRemoteDBModule';
    TServerKind.skStandAloneConnModule: Result := 'TConnectionModule';
  end;
end;

function TServerCreator.GetModuleCreationParameters : string;
begin
  case FServerKind of
    TServerKind.skSparkle: Result := SPARKLEMODULECREATIONPARAMS;
    TServerKind.skXData: Result := XDATAMODULECREATIONPARAMS;
    TServerKind.skRemoteDB: Result := REMOTEDBMODULECREATIONPARAMS;
    TServerKind.skStandAloneConnModule: Exit('ERROR');
    else
      raise Exception.Create('Unknown server kind: ' + IntToStr(Integer(FServerKind)));
  end;
end;

function TServerCreator.CreateServers : Boolean;
var
  Errors : string;
  Kind : TProjectKind;
  ServerUnit : IOTAFile;
  Project,
  FirstProject : IOTAProject;
  ConnModule : IOTAModule;
  ProjectGroup : IOTAProjectGroup;
begin
  Result := true;

  if SettingsValid(Errors) then begin
    InitIdentifierMap;

    // skStandAloneConnModule creates the connection module only
    if FServerKind = TServerKind.skStandAloneConnModule then begin
      InitIdentifierMap;
      CreateConnectionModuleOnly(FIdentiferMap);
    end else begin
      // Settings ok; go ahead and create a server, then each platform start/stop project
      ServerUnit := InternalCreateServer;
      for Kind in FKinds do begin
        try
          InitIdentifierMap;
          Project := InternalCreateProject(Kind, ServerUnit);
          if not Assigned(FirstProject) then
            FirstProject := Project;
        except
          on E : Exception do
            MessageDlg(Format('There was an error creating the %s project.', [ProjectKindToString(Kind)]),
              mtError, [mbOk], 0);
        end;
      end;
    end;

    // For XData and RemoteDB servers, if there was a connection module, open it
    // It's the only module that needs to be edited.
    for Kind in FKinds do begin
      ConnModule := GetExistingModule(FileConfigs[Kind].ConnectionModule.UnitName);
      if Assigned(ConnModule) then
        ConnModule.Show; // Just opens the data module 'form'; use ShowFilename for .pas
    end;
    // Make the first project to be created the active project. The reason is,
    // it contains the connection module (the others just refer to it by uses clause.)
    // So it should be the one to first compile, hopefully - others can then compile
    // without having the file in the project, ie just by uses clause.
    ProjectGroup := (BorlandIDEServices as IOTAModuleServices).MainProjectGroup;
    if Assigned(FirstProject) and Assigned(ProjectGroup) then
      ProjectGroup.ActiveProject := FirstProject;
  end else begin
    MessageDlg('There were one or more errors:' + #10#13 + Errors, mtError, [mbOK], 0);
    Result := false;
  end;
end;

function TServerCreator.InternalCreateServer : IOTAFile;
begin
  Result := TFileFromResource.Create('SERVER', FIdentiferMap);
end;

function TServerCreator.InternalCreateProject(const Kind : TProjectKind; const ServerUnit : IOTAFile) : IOTAProject;
var
  Creator : IOTACreator;
  ModuleServices : IOTAModuleServices;
  Module : IOTAModule;
begin
  Creator := CreateProjectCreator(FServerKind, Kind, ServerUnit, FIdentiferMap, FSettings);
  ModuleServices := (BorlandIDEServices as IOTAModuleServices);
  Module := ModuleServices.CreateModule(Creator);
  Result := Module as IOTAProject;
end;

{ TProjectCreationSettings }

constructor TProjectCreationSettings.Create(const ForDefault : TServerKind);
begin
  inherited Create();
  // Init with default settings
  FServerPort := '2001';
  FServerHostname := '+';

  // Set the initial path based on the kind of server
  case ForDefault of
    TServerKind.skSparkle: FServerPath := 'tms/sparkle';
    TServerKind.skXData: FServerPath := 'tms/xdata';
    TServerKind.skRemoteDB: FServerPath := 'tms/remotedb';
    TServerKind.skStandAloneConnModule: FServerPath := 'tms/unused';
  end;
end;

function TProjectCreationSettings.AddError(var Errors : string; const NewError : string) : Boolean;
begin
  if Errors <> '' then
    Errors := Errors + #10#13;

  Errors := Errors + NewError;

  Result := false; // always indicate an error, allows calling via
  // 'Result := AddError' or 'Exit(AddError())'
end;

function TProjectCreationSettings.GetConnectionModuleComponentType: string;
begin
  // The connection module has a connection component
  Result := GetComponentTypeForDatabaseID(FDatabaseDriver);
end;

function TProjectCreationSettings.GetServerPath: string;
begin
  Result := FServerPath;
  // For replacing the constants in the resources, path mustn't begin with
  // a slash - that's already there
  // But not worth showing the user an error about this, it should work with
  // either '/path' or 'path'
  if (Length(FServerPath) > 0) and (FServerPath[1] = '/') then
    Result := Copy(FServerPath, 2, Length(FServerPath));
end;

function TProjectCreationSettings.GetServerPortNumeric: Integer;
begin
  // Ok if Valid() is true
  Result := StrToInt(FServerPort);
end;

function TProjectCreationSettings.Valid(const ServerKind : TServerKind; var Errors: string): Boolean;
var
  ServerPort : Integer;
begin
  Result := true;

  // Port must be numberic and less than 64K
  ServerPort := 0;
  if not TryStrToInt(FServerPort, ServerPort) then
    Result := AddError(Errors, 'Server port must be numeric');
  if ServerPort >= 65536 then
    Result := AddError(Errors, 'Server port must be less than 65536');

  // Host name must not be empty
  if Trim(FServerHostname) = '' then
    Result := AddError(Errors, 'Hostname must not be empty');

  // Server path must not be empty
  if Trim(FServerPath) = '' then
    Result := AddError(Errors, 'Server path must not be empty');

  // XData and RemoteDB need database and SQL settings
  if ServerKind <> TServerKind.skSparkle then begin
    if Trim(FDatabaseDriver) = '' then
      Result := AddError(Errors, 'Database driver must not be empty');
    if Trim(FDatabaseDriverType) = '' then
      Result := AddError(Errors, 'Database driver type must not be empty');
    if Trim(FDatabaseDriverUses) = '' then
      Result := AddError(Errors, 'Database driver uses clause must not be empty');
    if (Trim(FSQLDialect) = '') and (GetComponentTypeForDatabaseID(FDatabaseDriver) <> '') then
      Result := AddError(Errors, 'SQL dialect must not be empty');
    // The SQL dialect can be typed in freely, and so if it's not a known dialect
    // then it assumes the uses = whatever's typed
    // So, check that the dialect uses clause has no spaces
    if Pos(' ', Trim(FSQLDialect)) > 0 then
      Result := AddError(Errors, 'SQL dialect must not contain spaces');
  end;
end;

{$ENDIF}

end.
