unit uDAElevateDBInterfaces;

{----------------------------------------------------------------------------}
{ Data Abstract Library - Core Library                                       }
{                                                                            }
{ compiler: Delphi 6 and up, Kylix 3 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Using this code requires a valid license of the Data Abstract              }
{ which can be obtained at http://www.remobjects.com.                        }
{----------------------------------------------------------------------------}

{$I DataAbstract.inc}

interface

uses uROClasses, uDAInterfaces, uDAEngine;

type
  IDAElevateConnection = interface(IDAConnection)
    ['{30A997EA-0EBE-41D0-AD13-521DEFCDFE0D}']
  end;

  TDAElevateDBDriver = class(TDAEDriver)
  protected
    function GetDefaultConnectionType(const AuxDriver: string): string; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
  end;

  TDAElevateDBConnection = class(TDAEConnection, IDAConnection, IDAElevateConnection, IDADirectoryBasedDatabase)
  protected
    Procedure CheckConnected;
    procedure DoGetTableNames(out List: IROStrings); override;
    procedure DoGetViewNames(out List: IROStrings); override;
    procedure DoGetStoredProcedureNames(out List: IROStrings); override;
    procedure DoGetForeignKeys(out ForeignKeys: TDADriverForeignKeyCollection); override;
    procedure DoGetTableFields(const aTableName: string; out Fields: TDAFieldCollection); override;
    function GetSPSelectSyntax(HasArguments: Boolean): string; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
  end;

const
  ElevateDB_DriverType = 'ElevateDB';
  ElevateDB_ConfigDBName = 'Configuration';

procedure ElevateDB_RegisterDatabase(Query: IDADataset; ADataBaseName: string;aPath: String);
procedure ElevateDB_DoGetNames(Query: IDADataset; AList: IROStrings; AObjectType: TDAObjecttype);
procedure ElevateDB_DoGetForeignKeys(Query: IDADataset; ForeignKeys: TDADriverForeignKeyCollection);
procedure ElevateDB_DoGetTableFields(const aTableName: string; Query: IDADataset; out Fields: TDAFieldCollection);
function ElevateDB_GetSPSelectSyntax(HasArguments: Boolean): String;

implementation

uses Classes,SysUtils;

procedure ElevateDB_RegisterDatabase(Query: IDADataset; ADataBaseName: string;aPath: String);
const
  s_SQL = 'Select Count(*) from Databases Where name = ''%s''';
  s_DropDataBaseSQL = 'DROP DATABASE "%s" KEEP CONTENTS';
  s_CreateDataBaseSQL = 'CREATE DATABASE "%s" PATH ''%s''';
begin
  try
    Query.SQL := Format(s_SQL, [aDataBaseName]);
    Query.Open;
    if Query.Fields[0].AsInteger =0 then begin
      Query.Close;
      Query.SQL := Format(s_CreateDataBaseSQL, [aDataBaseName, aPath]);
      Query.Execute;
    end;
  finally
    Query := nil;
  end;
end;

procedure ElevateDB_DoGetNames(Query: IDADataset; AList: IROStrings; AObjectType: TDAObjecttype);
const
  sDoGetTableNames            =   'SELECT Name FROM Information.Tables';
  sDoGetViewNames             =   'SELECT Name FROM Information.Views';
  sDoGetProcedures            =   'SELECT Name FROM Information.Procedures';
begin
  try
    case AObjectType of
      dotTable: Query.SQL := sDoGetTableNames;
      dotView: Query.SQL := sDoGetViewNames;
      dotProcedure: Query.SQL := sDoGetProcedures;
    end;
    Query.Open;
    while not Query.Eof do begin
      Alist.Add(Query.Fields[0].AsString);
      Query.Next;
    end;
  finally
    Query := nil;
  end;
end;

procedure ElevateDB_DoGetForeignKeys(Query: IDADataset; ForeignKeys: TDADriverForeignKeyCollection);
const
  sFK_SQL = 'Select c.tablename,c.name, c.targettable, cc.columnname '+
            'from Information.Constraints as c '+
            'join Information.ConstraintColumns as cc on ((c.tablename = cc.tablename) and (cc.constraintname = c.EnforcingIndex)) '+
            'where c.type = ''foreign key''';
  sPK_SQL = 'Select c.tablename,c.name, c.targettable, cc.columnname '+
            'from Information.Constraints as c '+
            'join Information.ConstraintColumns as cc on ((c.Targettable = cc.tablename) and (cc.constraintname = c.TargetTableConstraint)) '+
            'where c.type = ''foreign key''';
var
  lCurrConstraint             : string;
  lCurrFK                     : TDADriverForeignKey;
  lList: TStringList;
  i: integer;
begin
  lList:=TstringList.Create;
  try
    Query.SQL := sFK_SQL;
    Query.Open;

    lCurrConstraint := '';
    lCurrFK := nil;
    ForeignKeys.Clear;
    while (not Query.EOF) do begin
      if lCurrConstraint <> Query.Fields[0].AsString + '.' + Query.Fields[1].AsString then begin
        lCurrConstraint := Query.Fields[0].AsString + '.' + Query.Fields[1].AsString;
        lCurrFK := ForeignKeys.Add();
        lList.AddObject(lCurrConstraint,lCurrFK);
        with lCurrFK do begin
          Name:=lCurrConstraint;
          PKTable := TrimRight(Query.Fields[2].AsString);
          FKTable := TrimRight(Query.Fields[0].AsString);
         // PKField := TrimRight(Query.Fields[2].AsString);
          FKField := TrimRight(Query.Fields[3].AsString);
        end;
      end else begin
        with lCurrFK do begin
         // PKField := PKField + ';' + TrimRight(Query.Fields[2].AsString);
          FKField := FKField + ';' + TrimRight(Query.Fields[3].AsString);
        end;
      end;
      Query.Next;
    end;
    Llist.Sorted:=True;
    Query.close;
    Query.SQL := sPK_SQL;
    Query.Open;
    while (not Query.EOF) do begin
      lCurrConstraint := Query.Fields[0].AsString + '.' + Query.Fields[1].AsString;
      i:= lList.IndexOf(lCurrConstraint);
      if i <> -1 then begin
        lCurrFK:= TDADriverForeignKey(lList.Objects[i]);
        if lCurrFK.PKField = '' then
          lCurrFK.PKField := TrimRight(Query.Fields[3].AsString)
        else
          lCurrFK.PKField := lCurrFK.PKField + ';' +TrimRight(Query.Fields[3].AsString);
      end;
      Query.Next;
    end;
  finally
    Query := nil;
    LList.Free;
  end;
end;

procedure ElevateDB_DoGetTableFields(const aTableName: string; Query: IDADataset; out Fields: TDAFieldCollection);
const
  s_sql = 'SELECT tc.Name, tc.Nullable, tc.Identity, cc.ColumnName, tc.scale FROM Information.TableColumns as tc '+
          'LEFT JOIN Information.Constraints AS c ON ((c.TableName = tc.TableName) and (c.Type = ''Primary Key'')) '+
          'LEFT JOIN Information.ConstraintColumns as cc on ((c.tablename = cc.tablename) and (cc.constraintname = c.EnforcingIndex) and (cc.ColumnName = tc.Name)) '+
          'WHERE tc.TableName = ';
var
  fld: TDAField;
begin
  Fields := TDAFieldCollection.Create(nil);
  try
    Query.SQL := 'SELECT * FROM ' + aTableName +' WHERE 1=0';
    Query.Open;
    Fields.Assign(Query.Fields);
    Query.Close;
    Query.SQL := s_SQL+ '''' + aTableName+'''';
    Query.Open;
    While not Query.Eof do begin
      fld := Fields.FindField(Trim(Query.Fields[0].AsString));
      if Fld <> nil then begin
        Fld.Required:=Query.Fields[1].AsBoolean;
        if not Query.Fields[2].IsNull and Query.Fields[2].AsBoolean then begin
          if fld.DataType = datInteger then fld.DataType := datAutoInc;
          if fld.DataType = datLargeInt then fld.DataType := datLargeAutoInc;
        end;
        if not Query.Fields[3].IsNull then fld.InPrimaryKey:=True;
        if fld.DataType = datDecimal then begin
          fld.DecimalPrecision:=20;
          fld.DecimalScale:=Query.Fields[4].AsInteger;
        end;
      end;
      Query.Next;
    end;
  finally
    Query:=nil;
  end;
end;

function ElevateDB_GetSPSelectSyntax(HasArguments: Boolean): String;
begin
  if HasArguments then
    Result:='CALL {0} ({1})'
  else
    Result:='CALL {0} ()';
end;
{ TDAElevateDBDriver }

function TDAElevateDBDriver.GetDefaultConnectionType(
  const AuxDriver: string): string;
begin
  Result:= ElevateDB_DriverType;
end;


{ TDAElevateDBConnection }

procedure TDAElevateDBConnection.CheckConnected;
begin
  if not GetConnected then SetConnected(True);
end;

procedure TDAElevateDBConnection.DoGetForeignKeys(
  out ForeignKeys: TDADriverForeignKeyCollection);
begin
  CheckConnected;
  inherited;
  ElevateDB_DoGetForeignKeys(GetDatasetClass.Create(Self),ForeignKeys);
end;

procedure TDAElevateDBConnection.DoGetStoredProcedureNames(
  out List: IROStrings);
begin
  CheckConnected;
  inherited;
  ElevateDB_DoGetNames(GetDatasetClass.Create(Self),List,dotProcedure);
end;

procedure TDAElevateDBConnection.DoGetTableFields(const aTableName: string;
  out Fields: TDAFieldCollection);
begin
  CheckConnected;
  ElevateDB_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName),GetDatasetClass.Create(Self),Fields);
end;

procedure TDAElevateDBConnection.DoGetTableNames(out List: IROStrings);
begin
  CheckConnected;
  inherited;
  ElevateDB_DoGetNames(GetDatasetClass.Create(Self),List,dotTable);
end;

procedure TDAElevateDBConnection.DoGetViewNames(out List: IROStrings);
begin
  CheckConnected;
  inherited;
  ElevateDB_DoGetNames(GetDatasetClass.Create(Self),List,dotView);
end;

function TDAElevateDBConnection.GetSPSelectSyntax(
  HasArguments: Boolean): string;
begin
  Result := ElevateDB_GetSPSelectSyntax(HasArguments);
end;

end.