unit Aurelius.Schema.NexusDB;

{$I Aurelius.Inc}

interface

uses
  Aurelius.Drivers.Interfaces,
  Aurelius.Schema.AbstractImporter,
  Aurelius.Sql.Metadata;

type
  TNexusDBSchemaImporter = class(TAbstractSchemaImporter)
  strict protected
    procedure GetDatabaseMetadata(Connection: IDBConnection; Database: TDatabaseMetadata); override;
  end;

  TNexusDBSchemaRetriever = class(TSchemaRetriever)
  strict private
    procedure GetTables;
    procedure GetColumns;
    procedure GetPrimaryKeys;
    procedure GetUniqueKeys;
    procedure GetDBIndexes;
    procedure GetForeignKeys;
    procedure GetFieldDefinition(Column: TColumnMetadata; const ADataType: string; AUnits, ADecimals: integer);
  public
    constructor Create(AConnection: IDBConnection; ADatabase: TDatabaseMetadata); override;
    procedure RetrieveDatabase; override;
  end;

implementation

uses
  SysUtils,
  Aurelius.Schema.Register;

{ TNexusDBSchemaImporter }

procedure TNexusDBSchemaImporter.GetDatabaseMetadata(Connection: IDBConnection;
  Database: TDatabaseMetadata);
var
  Retriever: TSchemaRetriever;
begin
  Retriever := TNexusDBSchemaRetriever.Create(Connection, Database);
  try
    Retriever.RetrieveDatabase;
  finally
    Retriever.Free;
  end;
end;

{ TNexusDBSchemaRetriever }

constructor TNexusDBSchemaRetriever.Create(AConnection: IDBConnection;
  ADatabase: TDatabaseMetadata);
begin
  inherited Create(AConnection, ADatabase);
end;

procedure TNexusDBSchemaRetriever.GetColumns;
begin
  RetrieveColumns(
      'select '+
      'F.TABLE_NAME as TABLE_NAME, '+
      'F.FIELD_NAME as COLUMN_NAME, '+
      'F.FIELD_TYPE_NEXUS AS DATA_TYPE, '+
      'F.FIELD_UNITS AS FIELD_UNITS, '+
      'F.FIELD_DECIMALS AS FIELD_DECIMALS, '+
      'F.FIELD_REQUIRED as IS_REQUIRED, '+
      'T.AUTOINC_STARTING_VALUE as IDENTITY_SEED, '+
      'T.AUTOINC_INCREMENT_VALUE as IDENTITY_INCREMENT '+
      'From '+
      '  #Fields F LEFT JOIN #Tables T ON F.TABLE_INDEX = T.TABLE_INDEX '+
      'Order by T.TABLE_NAME, F.FIELD_INDEX',
    procedure (Column: TColumnMetadata; ResultSet: IDBResultSet)
    begin
      Column.NotNull := AsBoolean(ResultSet.GetFieldValue('IS_REQUIRED'));
      GetFieldDefinition(Column,
        AsString(ResultSet.GetFieldValue('DATA_TYPE')),
        AsInteger(ResultSet.GetFieldValue('FIELD_UNITS')),
        AsInteger(ResultSet.GetFieldValue('FIELD_DECIMALS'))
      );
      Column.AutoGenerated := SameText(Column.DataType, 'AUTOINC');

      // For some reasons, IS_REQUIRED column is "false" for AutoInc fields,
      // even when such fields were created as NOT NULL
      if Column.AutoGenerated then
        Column.NotNull := true;
    end
  );
end;

procedure TNexusDBSchemaRetriever.GetDBIndexes;
begin
  RetrieveDBIndexes(
    'SELECT I.TABLE_NAME, I.INDEX_NAME, F.SEGMENT_FIELD as COLUMN_NAME '+
    'FROM #INDEXES I, #INDEXFIELDS F '+
    'WHERE I.TABLE_INDEX = F.TABLE_INDEX AND I.INDEX_INDEX = F.INDEX_INDEX '+
    '  AND (I.INDEX_ISDEFAULT = FALSE) AND NOT (I.INDEX_NAME LIKE ''$%'') '+
    '  AND (I.INDEX_ALLOWSDUPS = ''YES'') '+
    'ORDER BY I.TABLE_INDEX, I.INDEX_INDEX, F.SEGMENT_INDEX'
  );
end;

procedure TNexusDBSchemaRetriever.GetFieldDefinition(Column: TColumnMetadata;
  const ADataType: string; AUnits, ADecimals: integer);

const
  mtNexus = 0;
  mtAurelius = 1;

  _MapTypes: array[0..30, mtNexus..mtAurelius] of string = (
  ('nxtBoolean'      , 'Boolean'),
  ('nxtChar'         , 'Singlechar'),
  ('nxtWideChar'     , 'Nsinglechar'),
  ('nxtByte'         , 'Byte'),
  ('nxtWord16'       , 'Word'),
  ('nxtWord32'       , 'Dword'),
  ('nxtInt8'         , 'Shortint'),
  ('nxtInt16'        , 'Smallint'),
  ('nxtInt32'        , 'Integer'),
  ('nxtInt64'        , 'Bigint'),
  ('nxtAutoInc'      , 'Autoinc'),
  ('nxtSingle'       , 'Float'),
  ('nxtDouble'       , 'Real'),
  ('nxtExtended'     , 'Extended'),
  ('nxtCurrency'     , 'Money'),
  ('nxtDate'         , 'Date'),
  ('nxtTime'         , 'Time'),
  ('nxtDateTime'     , 'Timestamp'),
  ('nxtInterval'     , ''), // can't be represented directly
  ('nxtBLOB'         , 'Blob'),
  ('nxtBLOBMemo'     , 'Clob'),
  ('nxtBLOBGraphic'  , 'Image'),
  ('nxtByteArray'    , 'Bytearray'),
  ('nxtShortString'  , 'Shortstring'),
  ('nxtNullString'   , 'Varchar'),
  ('nxtWideString'   , 'Nvarchar'),
  ('nxtRecRev'       , 'Recrev'),
  ('nxtGUID'         , 'Guid'),
  ('nxtBCD'          , 'Numeric'),
  ('nxtBLOBWideMemo' , 'Nclob'),
  ('nxtFmtBCD'       , 'Numeric')
  );

  _NxSizeTypes: array[0..3] of string = ('Bytearray', 'Shortstring', 'Varchar', 'Nvarchar');
  _NxSizePrecisionTypes: array[0..0] of string = ('Numeric');
  _NxPrecisionTypes: array[0..0] of string = ('Float');

  function TypeInSet(const AType: string; ATypes: array of string): boolean;
  var
    I: integer;
  begin
    for I := Low(ATypes) to High(ATypes) do
      if SameText(AType, ATypes[I]) then
        Exit(true);
    Result := false;
  end;

var
  I: integer;
begin
  for I := Low(_MapTypes) to High(_MapTypes) do
    if SameText(ADatatype, _MapTypes[I, mtNexus]) then
    begin
      Column.DataType := _MapTypes[I, mtAurelius];
      break;
    end;

  if Column.DataType = '' then
    Column.DataType := 'UNKNOWN';

  {Check if field needs size}
  if TypeInSet(Column.DataType, _NxSizeTypes) then
  begin
    Column.Length := AUnits;
  end
  else
  if TypeInSet(Column.DataType, _NxSizePrecisionTypes) then
  begin
    Column.Precision := AUnits;
    Column.Scale := ADecimals;
  end
  else
  if TypeInSet(Column.DataType, _NxPrecisionTypes) then
  begin
    Column.Precision := ADecimals;
  end;
end;

procedure TNexusDBSchemaRetriever.GetForeignKeys;
begin
  RetrieveForeignKeys(
    'SELECT'+
    '  F.FK_CONSTRAINT_REFERENCES_TABLE_NAME as PK_TABLE_NAME, '+
    '  PK.FK_CONSTRAINT_REFERENCED_COLUMNS_NAME as PK_COLUMN_NAME, '+
    '  F.FK_CONSTRAINT_TABLE_NAME as FK_TABLE_NAME, '+
    '  FK.FK_CONSTRAINT_REFERENCING_COLUMNS_NAME as FK_COLUMN_NAME, '+
    '  F.FK_CONSTRAINT_NAME as CONSTRAINT_NAME '+
    'FROM '+
    '  #FOREIGNKEY_CONSTRAINTS F, #FOREIGNKEY_CONSTRAINTS_REFERENCING_COLUMNS FK, '+
    '  #FOREIGNKEY_CONSTRAINTS_REFERENCED_COLUMNS PK '+
    'WHERE '+
    '  F.FK_CONSTRAINT_NAME = FK.FK_CONSTRAINT_NAME AND '+
    '  F.FK_CONSTRAINT_TABLE_NAME = FK.FK_CONSTRAINT_TABLE_NAME AND '+
    '  F.FK_CONSTRAINT_NAME = PK.FK_CONSTRAINT_NAME AND '+
    '  F.FK_CONSTRAINT_TABLE_NAME = PK.FK_CONSTRAINT_TABLE_NAME AND '+
    '  FK.FK_CONSTRAINT_REFERENCING_COLUMNS_INDEX = PK.FK_CONSTRAINT_REFERENCED_COLUMNS_INDEX '+
    'ORDER BY '+
    '  F.FK_CONSTRAINT_TABLE_NAME, F.FK_CONSTRAINT_NAME, FK.FK_CONSTRAINT_REFERENCING_COLUMNS_INDEX'
  );
end;

procedure TNexusDBSchemaRetriever.GetPrimaryKeys;
begin
  RetrievePrimaryKeys(
    'SELECT '+
    'I.TABLE_NAME, '+
    'F.SEGMENT_FIELD as COLUMN_NAME, '+
    'I.CONSTRAINT_NAME '+
    'FROM #INDEXES I, #INDEXFIELDS F '+
    'WHERE I.TABLE_INDEX = F.TABLE_INDEX AND I.INDEX_INDEX = F.INDEX_INDEX '+
    '  AND I.INDEX_ISDEFAULT = TRUE '+
    'ORDER BY I.TABLE_NAME, F.SEGMENT_INDEX'
  );
end;

procedure TNexusDBSchemaRetriever.GetTables;
begin
  RetrieveTables(
    'SELECT TABLE_NAME FROM #TABLES ORDER BY TABLE_NAME'
  );
end;

procedure TNexusDBSchemaRetriever.GetUniqueKeys;
begin
  RetrieveUniqueKeys(
      'SELECT '+
      'I.TABLE_NAME, '+
      'I.CONSTRAINT_NAME, '+
      'F.SEGMENT_FIELD as COLUMN_NAME '+
      'FROM #INDEXES I, #INDEXFIELDS F '+
      'WHERE I.TABLE_INDEX = F.TABLE_INDEX AND I.INDEX_INDEX = F.INDEX_INDEX '+
      '  AND (I.INDEX_ISDEFAULT = FALSE) AND (I.INDEX_NAME LIKE ''%UNIQUE%'') '+
      'ORDER BY I.TABLE_INDEX, I.INDEX_INDEX, F.SEGMENT_INDEX'
  );
end;

procedure TNexusDBSchemaRetriever.RetrieveDatabase;
begin
  Database.Clear;
  GetTables;
  GetColumns;
  GetPrimaryKeys;
  GetUniqueKeys;
  GetDBIndexes;
  GetForeignKeys;
end;

initialization
  TSchemaImporterRegister.GetInstance.RegisterImporter('NexusDB', TNexusDBSchemaImporter.Create);

end.

