unit Aurelius.Sql.AbsoluteDB;

{$I Aurelius.inc}

interface

uses
  DB,
  Aurelius.Sql.AnsiSqlGenerator,
  Aurelius.Sql.BaseTypes,
  Aurelius.Sql.Commands,
  Aurelius.Sql.Interfaces,
  Aurelius.Sql.Metadata,
  Aurelius.Sql.Register,
  Aurelius.Global.Utils,
  Variants,
  SysUtils,
  Generics.Collections;

type
  TAbsoluteDBSQLGenerator = class(TAnsiSQLGenerator)
  protected
    function GetMaxConstraintNameLength: Integer; override;
    procedure DefineColumnType(Column: TColumnMetadata); override;
    function GetGeneratorName: string; override;
    function GetSqlDialect: string; override;
    function GenerateCreateColumn(Column: TColumnMetadata): string; override;
    function GenerateCreateTable(Table: TTableMetadata; CreateForeignKeys: boolean): string; override;
    function GenerateGetLastInsertId(SQLField: TSQLField): string; override;
    function GenerateLimitedSelect(SelectSql: TSelectSql; Command: TSelectCommand): string;
      override;
    // Disable/Enable foreign keys (even if Absolute Database has no foreign keys!)
    function GenerateEnableForeignKeys(AEnable: boolean): string; override;
    function GeneratePrimaryKey(APkName: string; AColumns: TList<TColumnMetadata>): string; override;
    function GenerateUniqueKeyDefinition(UniqueKey: TUniqueKeyMetadata): string; override;
    function GenerateDropUniqueKey(UniqueKey: TUniqueKeyMetadata): string; override;
    function GetSupportedFeatures: TDBFeatures; override;
    function GetSupportedFieldTypes: TFieldTypeSet; override;
  public
    constructor Create;
  end;

implementation

uses
  Aurelius.Sql.Functions;

const
  NULL_SQL_COMMAND = 'DROP TABLE IF EXISTS MEMORY "";'; // a placeholder NULL command (see explanations below)

{ TABSSQLGenerator }

constructor TAbsoluteDBSQLGenerator.Create;
begin
  inherited Create;
  RegisterFunction('length', TSimpleSQLFunction.Create('length', TypeInfo(integer)));
  UnregisterFunction('bytelength');
end;

procedure TAbsoluteDBSQLGenerator.DefineColumnType(Column: TColumnMetadata);
begin
  case Column.FieldType of
    ftBlob, ftDBaseOle, ftParadoxOle, ftTypedBinary:
      Column.DataType := 'BLOB';
    ftBoolean:
      Column.DataType := 'LOGICAL';
    ftCurrency:
      Column.DataType := 'CURRENCY';
    ftDateTime:
      Column.DataType := 'DATETIME';
    ftFloat, ftSingle, ftExtended:
      Column.DataType := 'FLOAT';
    ftGuid:
      Column.DataType := 'GUID';
    ftLargeint:
      Column.DataType := 'LARGEINT';
    ftMemo:
      Column.DataType := 'MEMO';
    ftWideMemo:
      Column.DataType := 'WIDEMEMO';
    ftWideString, ftFixedWideChar:
      Column.DataType := 'WIDESTRING($len)';
  else
    inherited DefineColumnType(Column);
  end;

  // Absolute DB does not use precision/scale
  Column.Precision := 0;
  Column.Scale := 0;

  if Column.AutoGenerated then
    Column.DataType := 'AUTOINC(' + Column.DataType + ')';
end;

function TAbsoluteDBSQLGenerator.GenerateCreateColumn(
  Column: TColumnMetadata): string;
begin
  Result := 'ALTER TABLE ';

  Result := Result + IdName(Column.Table.Name) + sqlLineBreak + '  ADD (' +
    IdName(Column.Name) + ' ' + GetColumnSQLType(Column);

  Result := Result + GetNullableConstraint(Column.NotNull);

  Result := Result + ');';
end;

function TAbsoluteDBSQLGenerator.GenerateCreateTable(Table: TTableMetadata; CreateForeignKeys: boolean): string;
var
  I: Integer;
  PkName: string;
begin
  Result := 'CREATE TABLE ';

  Result := Result + IdName(Table.Name) + ' (' + sqlLineBreak + '  ';

  for I := 0 to Table.Columns.Count - 1 do
  begin
    if I > 0 then
      Result := Result + ',' + sqlLineBreak + '  ';
    Result := Result + GenerateFieldDefinition(Table.Columns[I]);
  end;

  // Primary Key
  if Table.IdColumns.Count > 0 then
  begin
    PkName := 'PK_';
    PkName := PkName + Table.Name;
    PkName := IdName(Copy(PkName, 1, GetMaxConstraintNameLength));
    Result := Result + ',' + sqlLineBreak + '  ' + GeneratePrimaryKey(PkName, Table.IdColumns);
  end;

  // Unique Constraints
  for I := 0 to Table.UniqueKeys.Count - 1 do
  begin
    Result := Result + ',' + sqlLineBreak + '  ' + GenerateUniqueKeyDefinition(Table.UniqueKeys[I]);
  end;

  Result := Result + ');';
end;

function TAbsoluteDBSQLGenerator.GenerateDropUniqueKey(UniqueKey: TUniqueKeyMetadata): string;
begin
  Result := 'DROP INDEX ' + IdName(UniqueKey.Table.Name) + '.' + IdName(UniqueKey.Name) + ';';
end;

function TAbsoluteDBSQLGenerator.GenerateEnableForeignKeys(AEnable: boolean): string;
begin
  {Absolute Database has no foreign keys.
  Before dropping a table, Aurelius offers the following strategies:
  - create an 'ALTER TABLE ... DROP CONSTRAINT ...' SQL command, to drop foreign keys;
  - disable foreign keys before dropping tables then enable foreign keys again (as in Aurelius.SQL.SQLite).
  We have chosen the second solution so we need a placeholder.
  As there is no 'NULL' SQL command in Absolute Database, we use a SQL command with no effect.}
  Result := NULL_SQL_COMMAND;
end;

function TAbsoluteDBSQLGenerator.GenerateGetLastInsertId(SQLField: TSQLField): string;
begin
  Result := 'SELECT LastAutoinc(' + IdName(SQLField.Table.Name) + ', ' + IdName(SQLField.Field) + ') FROM ' + IdName(SQLField.Table.Name);
end;

function TAbsoluteDBSQLGenerator.GenerateLimitedSelect(SelectSql: TSelectSql;
  Command: TSelectCommand): string;
var
  MaxRows: integer;
  p: integer;
  TopStr: string;
begin
  Result := GenerateRegularSelect(SelectSql);
  p := Pos('SELECT', UpperCase(Result));
  Assert(p > 0, 'SELECT word not found in SQL. Cannot generate limited select');
  p := p + Length('SELECT');

  // MaxRows must be present in SQL statement no matter what
  if not Command.HasMaxRows then
    MaxRows := MaxInt div 2 // for some reason even maxint - 2 cause integer overflow
  else
    MaxRows := Command.MaxRows;

  if Command.HasFirstRow then
    TopStr := TopStr + Format('TOP %d,%d', [MaxRows, Command.FirstRow + 1])
  else
    TopStr := TopStr + Format('TOP %d', [MaxRows]);
  TopStr := ' ' + TopStr;
  Result := 'SELECT ' + TopStr + Copy(Result, p, MaxInt);
end;

function TAbsoluteDBSQLGenerator.GeneratePrimaryKey(APkName: string; AColumns: TList<TColumnMetadata>): string;
begin
  Result := 'PRIMARY KEY ' + IdName(APkName) + ' (';
  Result := Result + ConcatColumnNames(AColumns, ', ');
  Result := Result + ')';
end;

function TAbsoluteDBSQLGenerator.GenerateUniqueKeyDefinition(UniqueKey: TUniqueKeyMetadata): string;
begin
  Result := 'UNIQUE INDEX ' + IdName(UniqueKey.Name) + ' (' +
    ConcatColumnNames(UniqueKey.Columns, ', ') + ')';
end;

function TAbsoluteDBSQLGenerator.GetGeneratorName: string;
begin
  Result := 'AbsoluteDB SQL Generator';
end;

function TAbsoluteDBSQLGenerator.GetMaxConstraintNameLength: Integer;
begin
  Result := 255; // Identifier max length (in characters)
end;

function TAbsoluteDBSQLGenerator.GetSqlDialect: string;
begin
  Result := 'AbsoluteDB';
end;

function TAbsoluteDBSQLGenerator.GetSupportedFeatures: TDBFeatures;
begin
  Result := AllDBFeatures - [TDBFeature.Sequences, TDBFeature.AlterTableForeignKey, TDBFeature.ForeignKeys,
    TDBFeature.RetrieveIdOnInsert, TDBFeature.Schemas];
end;

function TAbsoluteDBSQLGenerator.GetSupportedFieldTypes: TFieldTypeSet;
begin
//  Result := inherited GetSupportedFieldTypes + [ftGuid];
  Result := inherited GetSupportedFieldTypes + [ftBoolean];
end;

initialization
  TSQLGeneratorRegister.GetInstance.RegisterGenerator(TAbsoluteDBSQLGenerator.Create);

end.
