unit Aurelius.Schema.MSSQL;

{$I Aurelius.Inc}

interface

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

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

  TMSSQLSchemaRetriever = class(TSchemaRetriever)
  strict private
    procedure GetTables;
    procedure GetColumns;
    procedure GetPrimaryKeys;
    procedure GetUniqueKeys;
    procedure GetDBIndexes;
    procedure GetForeignKeys;
    procedure GetFieldDefinition(Column: TColumnMetadata; ADataType: String;
      ASize, APrecision, AScale: Integer);
  public
    procedure RetrieveDatabase; override;
  end;

implementation

uses
  SysUtils,
  Aurelius.Schema.Register;

const
  {$IFDEF MSWINDOWS}
  sqlLineBreak = #13#10;
  {$ELSE}
  sqlLineBreak = ' ';
  {$ENDIF}

{ TMSSQLSchemaImporter }

procedure TMSSQLSchemaImporter.GetDatabaseMetadata(Connection: IDBConnection;
  Database: TDatabaseMetadata);
var
  Retriever: TSchemaRetriever;
begin
  Retriever := TMSSQLSchemaRetriever.Create(Connection, Database);
  try
    Retriever.UseSchema := True;
    Retriever.RetrieveDatabase;
  finally
    Retriever.Free;
  end;
end;

{ TMSSQLSchemaRetriever }

procedure TMSSQLSchemaRetriever.GetColumns;
begin
  RetrieveColumns(
    'select t.name as TABLE_NAME, ' + sqlLineBreak +
    'SCHEMA_NAME(t.schema_id) as TABLE_SCHEMA, ' + sqlLineBreak +
    'c.name as COLUMN_NAME, ' + sqlLineBreak +
    'd.name as DATA_TYPE, ' + sqlLineBreak +
    'c.max_length as CHAR_LENGTH, ' + sqlLineBreak +
    'convert(int, OdbcPrec(c.system_type_id, c.max_length, c.precision)) as NUMERIC_PRECISION, ' + sqlLineBreak +
    'c.scale as NUMERIC_SCALE, ' + sqlLineBreak +
    'c.is_nullable as IS_NULLABLE, ' + sqlLineBreak +
    'c.is_identity as IS_IDENTITY ' + sqlLineBreak +
    'from sys.columns c, sys.types d, sys.tables t ' + sqlLineBreak +
    'where c.user_type_id = d.user_type_id and c.object_id = t.object_id ' + sqlLineBreak +
    'order by SCHEMA_NAME(t.schema_id), t.name, c.column_id',
    procedure (Column: TColumnMetadata; ResultSet: IDBResultSet)
    begin
      Column.NotNull := not AsBoolean(ResultSet.GetFieldValue('IS_NULLABLE'));
      Column.AutoGenerated := AsBoolean(ResultSet.GetFieldValue('IS_IDENTITY'));
      GetFieldDefinition(Column,
        ResultSet.GetFieldValue('DATA_TYPE'),
        AsInteger(ResultSet.GetFieldValue('CHAR_LENGTH')),
        AsInteger(ResultSet.GetFieldValue('NUMERIC_PRECISION')),
        AsInteger(ResultSet.GetFieldValue('NUMERIC_SCALE'))
      );
    end);
end;

procedure TMSSQLSchemaRetriever.GetDBIndexes;
begin
  RetrieveDBIndexes(
    'SELECT SCHEMA_NAME(t.schema_id) as TABLE_SCHEMA, t.name as TABLE_NAME, '+
    'i.name as INDEX_NAME, f.name as COLUMN_NAME '+
    'FROM ((sys.indexes i inner join sys.objects t ON i.object_id = t.object_id) '+
    'INNER JOIN sys.index_columns ik ON i.index_id = ik.index_id) '+
    'INNER JOIN sys.columns f ON ik.column_id = f.column_id '+
    'WHERE (t.is_ms_shipped = 0) AND (i.is_primary_key = 0) '+
    'AND (f.object_id = t.object_id) AND (ik.object_id = t.object_id) '+
    'AND (i.is_unique = 0) '+
    'ORDER BY t.name, i.name, ik.key_ordinal'
  );
end;

procedure TMSSQLSchemaRetriever.GetFieldDefinition(Column: TColumnMetadata;
  ADataType: String; ASize, APrecision, AScale: Integer);
const
  vNoSizeTypes : array[0..22] of string =
    ('bigint', 'bit', 'date', 'datetime', 'float', 'image', 'int', 'money', 'ntext',
    'real', 'smalldatetime', 'smallint', 'smallmoney', 'sql_variant',
    'sysname', 'text', 'timestamp', 'tinyint', 'uniqueidentifier', 'xml',
    'geometry', 'hierarchyid', 'geography');

  function NeedSize: Boolean;
  var
    I: Integer;
  begin
    for i := 0 to high(vNoSizeTypes) do
      if vNoSizeTypes[I] = ADataType then
        Exit(false);
    Result := true;
  end;

begin
  Column.DataType := ADataType;
  ADataType := LowerCase(ADataType);
  if NeedSize then
  begin
    if (ASize = -1) and (
      (ADatatype = 'nvarchar') or
      (ADatatype = 'varbinary') or
      (ADatatype = 'varchar')
      ) then
    begin
      Column.DataType := Column.DataType + '(MAX)';
    end
    else
    if (ADataType = 'decimal') or (ADataType = 'numeric') then
    begin
      Column.DataType := 'numeric';
      Column.Precision := APrecision;
      Column.Scale := AScale;
    end
    else
    if (ADataType = 'nchar') or (ADataType = 'nvarchar') then
    begin
      Column.Length := APrecision;
    end
    else
    if (ADataType = 'datetime2') or (ADataType = 'datetimeoffset') or
       (ADataType = 'time') then
    begin
      // Just keep the size 0
    end else
      Column.Length := ASize;
  end;
end;

procedure TMSSQLSchemaRetriever.GetForeignKeys;
begin
  RetrieveForeignKeys(
    'SELECT '+
    '  O1.name AS PK_TABLE_NAME, '+
    '  OBJECT_SCHEMA_NAME(O1.object_id) AS PK_TABLE_SCHEMA, '+
    '   C1.name AS PK_COLUMN_NAME, '+
    '   O2.name AS FK_TABLE_NAME, '+
    '   OBJECT_SCHEMA_NAME(O2.object_id) AS FK_TABLE_SCHEMA, '+
    '   C2.name AS FK_COLUMN_NAME, '+
    '   F.name AS CONSTRAINT_NAME '+
    ' FROM   sys.all_objects O1, '+
    '   sys.all_objects O2, '+
    '   sys.all_columns C1, '+
    '   sys.all_columns C2, '+
    '   sys.foreign_keys F '+
    '   INNER JOIN sys.foreign_key_columns K '+
    '     ON (K.constraint_object_id = F.object_id) '+
    ' WHERE  O1.object_id = F.referenced_object_id '+
    '   AND O2.object_id = F.parent_object_id '+
    '   AND C1.object_id = F.referenced_object_id '+
    '   AND C2.object_id = F.parent_object_id '+
    '   AND C1.column_id = K.referenced_column_id '+
    '   AND C2.column_id = K.parent_column_id '+
    '   AND K.constraint_object_id = F.object_id '+
    ' ORDER BY O2.schema_id, O2.name, F.name, K.constraint_column_id');
end;

procedure TMSSQLSchemaRetriever.GetPrimaryKeys;
begin
  RetrievePrimaryKeys(
    'SELECT kcu.TABLE_NAME, kcu.TABLE_SCHEMA, '+
    'kcu.CONSTRAINT_NAME, kcu.COLUMN_NAME, kcu.ORDINAL_POSITION '+
    'FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS as tc '+
    'INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE as kcu '+
    'ON kcu.CONSTRAINT_SCHEMA = tc.CONSTRAINT_SCHEMA '+
    'AND kcu.CONSTRAINT_NAME = tc.CONSTRAINT_NAME '+
    'AND kcu.TABLE_SCHEMA = tc.TABLE_SCHEMA '+
    'AND kcu.TABLE_NAME = tc.TABLE_NAME '+
    'WHERE tc.CONSTRAINT_TYPE = ''PRIMARY KEY'' '+
    'ORDER BY kcu.TABLE_SCHEMA, kcu.TABLE_NAME, tc.CONSTRAINT_TYPE, kcu.CONSTRAINT_NAME, kcu.ORDINAL_POSITION');
end;

procedure TMSSQLSchemaRetriever.GetUniqueKeys;
begin
  RetrieveUniqueKeys(
    'SELECT kcu.TABLE_NAME, kcu.TABLE_SCHEMA, kcu.CONSTRAINT_NAME, kcu.COLUMN_NAME, kcu.ORDINAL_POSITION '+
    'FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS as tc '+
    'INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE as kcu '+
    'ON kcu.CONSTRAINT_SCHEMA = tc.CONSTRAINT_SCHEMA '+
    'AND kcu.CONSTRAINT_NAME = tc.CONSTRAINT_NAME '+
    'AND kcu.TABLE_SCHEMA = tc.TABLE_SCHEMA '+
    'AND kcu.TABLE_NAME = tc.TABLE_NAME '+
    'WHERE tc.CONSTRAINT_TYPE = ''UNIQUE'' '+
    'ORDER BY kcu.TABLE_SCHEMA, kcu.TABLE_NAME, tc.CONSTRAINT_TYPE, kcu.CONSTRAINT_NAME, kcu.ORDINAL_POSITION');
end;

procedure TMSSQLSchemaRetriever.GetTables;
begin
  RetrieveTables(
    'SELECT t.name as TABLE_NAME, SCHEMA_NAME(t.schema_id) as TABLE_SCHEMA '+
    'FROM sys.tables t ' +
    'WHERE t.is_ms_shipped = 0 '+
    'ORDER BY t.schema_id, t.name'
  );
end;

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

initialization
  TSchemaImporterRegister.GetInstance.RegisterImporter('MSSQL', TMSSQLSchemaImporter.Create);

end.

