unit Aurelius.Schema.DB2;

{$I Aurelius.Inc}

interface

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

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

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

implementation

uses
  SysUtils,
  Aurelius.Schema.Register;

{ TDB2SchemaImporter }

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

{ TDB2SchemaRetriever }

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

procedure TDB2SchemaRetriever.GetColumns;
begin
  RetrieveColumns(
    'SELECT TABNAME AS TABLE_NAME, TABSCHEMA AS TABLE_SCHEMA, COLNAME AS COLUMN_NAME, '+
    'TYPENAME AS DATA_TYPE, LENGTH AS FIELD_SIZE, SCALE AS NUMERIC_SCALE, IDENTITY, '+
    'NULLS AS NULLABLE '+
    'FROM SYSCAT.COLUMNS '+
    'ORDER BY TABNAME, COLNO',
    procedure (Column: TColumnMetadata; ResultSet: IDBResultSet)
    begin
      Column.NotNull := (AsString(ResultSet.GetFieldValue('NULLABLE')) = 'N');
      GetFieldDefinition(Column,
        AsString(ResultSet.GetFieldValue('DATA_TYPE')),
        AsInteger(ResultSet.GetFieldValue('FIELD_SIZE')),
        AsInteger(ResultSet.GetFieldValue('NUMERIC_SCALE'))
      );
      Column.AutoGenerated := (AsString(ResultSet.GetFieldValue('IDENTITY')) = 'Y');
    end
  );
end;

procedure TDB2SchemaRetriever.GetDBIndexes;
begin
  RetrieveDBIndexes(
    'SELECT I.TABNAME AS TABLE_NAME, I.TABSCHEMA AS TABLE_SCHEMA, I.INDNAME AS INDEX_NAME, IC.COLNAME AS COLUMN_NAME '+
    'FROM SYSCAT.INDEXES I, SYSCAT.INDEXCOLUSE IC ' +
    'WHERE I.INDSCHEMA = IC.INDSCHEMA AND I.INDNAME = IC.INDNAME '+
    'AND I.OWNERTYPE=''U'' AND I.UNIQUERULE = ''D'' AND USER_DEFINED = 1 '+
    'ORDER BY I.TABNAME, I.INDNAME, IC.COLSEQ'
  );
end;

procedure TDB2SchemaRetriever.GetFieldDefinition(Column: TColumnMetadata;
  ADataType: string; ASize, AScale: integer);

const
  vSizeTypes: array[0..3] of string =
    ('character', 'varchar', 'vargraphic', 'graphic');
  vPrecisionTypes: array[0..1] of string =
    ('decimal', 'numeric');

  function FindType(ATypes: array of string): boolean;
  var
    I: integer;
  begin
    for I := Low(ATypes) to high(ATypes) do
      if SameText(ADataType, ATypes[I]) then
        Exit(true);
    Result := False;
  end;

begin
  Column.DataType := ADataType;
  if FindType(vSizeTypes) then
    Column.Length := ASize
  else
  if FindType(vPrecisionTypes) then
  begin
    Column.Precision := ASize;
    Column.Scale := AScale;
  end;

  ADataType := Lowercase(ADataType);
  if ADataType = 'character' then
    Column.DataType := 'CHAR'
  else
  if ADataType = 'decimal' then
    Column.DataType := 'NUMERIC'
  else
  if ADataType = 'double' then
    Column.DataType := 'DOUBLE PRECISION';
end;

procedure TDB2SchemaRetriever.GetForeignKeys;
begin
  RetrieveForeignKeys(
    'SELECT TC.TABNAME AS FK_TABLE_NAME, TC.CONSTNAME AS CONSTRAINT_NAME, KC.COLNAME AS FK_COLUMN_NAME, '+
    'TC.TABSCHEMA AS FK_TABLE_SCHEMA, TC.REFTABSCHEMA AS PK_TABLE_SCHEMA, ' +
    'TC.REFTABNAME AS PK_TABLE_NAME, KP.COLNAME AS PK_COLUMN_NAME '+
    'FROM SYSCAT.REFERENCES TC, SYSCAT.KEYCOLUSE KC, SYSCAT.KEYCOLUSE KP '+
    'WHERE TC.TABSCHEMA = KC.TABSCHEMA AND TC.TABNAME = KC.TABNAME AND TC.CONSTNAME = KC.CONSTNAME '+
    'AND TC.REFTABSCHEMA = KP.TABSCHEMA AND TC.REFTABNAME = KP.TABNAME AND TC.REFKEYNAME = KP.CONSTNAME '+
    'AND KC.COLSEQ = KP.COLSEQ '+
    'ORDER BY TC.TABNAME, TC.CONSTNAME, KC.COLSEQ'
  );
end;

procedure TDB2SchemaRetriever.GetPrimaryKeys;
begin
  RetrievePrimaryKeys(
    'SELECT TC.TABNAME AS TABLE_NAME, TC.TABSCHEMA AS TABLE_SCHEMA, ' +
    'TC.CONSTNAME AS CONSTRAINT_NAME, KC.COLNAME AS COLUMN_NAME '+
    'FROM SYSCAT.TABCONST TC, SYSCAT.KEYCOLUSE KC ' +
    'WHERE TC.TABSCHEMA = KC.TABSCHEMA AND TC.TABNAME = KC.TABNAME AND TC.CONSTNAME = KC.CONSTNAME '+
    'AND TC.TYPE=''P'' '+
    'ORDER BY TC.TABNAME, TC.CONSTNAME, KC.COLSEQ'
  );
end;

procedure TDB2SchemaRetriever.GetSequences;
begin
  RetrieveSequences(
    'SELECT SEQNAME AS SEQUENCE_NAME '+
    'FROM SYSCAT.SEQUENCES '+
    'WHERE OWNER = USER AND NOT SEQSCHEMA LIKE ''SYS%'' '+
    'AND SEQTYPE = ''S'' '+
    'ORDER BY SEQNAME'
  );
end;

procedure TDB2SchemaRetriever.GetTables;
begin
  RetrieveTables(
    'SELECT TABNAME AS TABLE_NAME, TABSCHEMA AS TABLE_SCHEMA '+
    'FROM SYSCAT.TABLES '+
    'WHERE TYPE = ''T'' AND OWNER = USER '+
    'AND NOT TABSCHEMA LIKE ''SYS%'' '+
    'ORDER BY TABNAME'
  );
end;

procedure TDB2SchemaRetriever.GetUniqueKeys;
begin
  RetrieveUniqueKeys(
    'SELECT TC.TABNAME AS TABLE_NAME, TC.TABSCHEMA AS TABLE_SCHEMA, ' +
    'TC.CONSTNAME AS CONSTRAINT_NAME, KC.COLNAME AS COLUMN_NAME '+
    'FROM SYSCAT.TABCONST TC, SYSCAT.KEYCOLUSE KC ' +
    'WHERE TC.TABSCHEMA = KC.TABSCHEMA AND TC.TABNAME = KC.TABNAME AND TC.CONSTNAME = KC.CONSTNAME '+
    'AND TC.TYPE=''U'' '+
    'ORDER BY TC.TABNAME, TC.CONSTNAME, KC.COLSEQ'
  );
end;

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

initialization
  TSchemaImporterRegister.GetInstance.RegisterImporter('DB2', TDB2SchemaImporter.Create);

end.

