unit uDAPostgresInterfaces;

{----------------------------------------------------------------------------}
{ 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
  SysUtils,
  uDAInterfaces, uDAEngine, uROClasses;

type
  { IDAPostgresConnection
      For identification purposes Implemented by all Postgres connections }
  IDAPostgresConnection = interface(IDAConnection)
    ['{D8EADB7E-7AA0-48FF-9E7D-34853F999BFC}']
  end;

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

  TDAEPostgresConnection = class(TDAEConnection, IDAPostgresConnection, IDACanQueryDatabaseNames, IDAUseGenerators)
  protected
    function DoGetLastAutoInc(const GeneratorName: string): integer; override;
    procedure DoGetTableFields(const aTableName: string; out Fields: TDAFieldCollection); override;
    procedure DoGetTableNames(out List: IROStrings); override;
    procedure DoGetViewNames(out List: IROStrings); override;
    procedure DoGetStoredProcedureNames(out List: IROStrings); override;
    procedure DoGetForeignKeys(out ForeignKeys: TDADriverForeignKeyCollection); override;
    function GetSPSelectSyntax(HasArguments: Boolean): string; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} 
    procedure DoGetStoredProcedureParams(const aStoredProcedureName: string; out Params: TDAParamCollection); override;
    function IdentifierNeedsQuoting(const iIdentifier: string): boolean; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    // IDACanQueryDatabaseNames
    function GetDatabaseNames: IROStrings;
    // IDAUseGenerators
    function GetNextAutoinc(const GeneratorName: string): integer; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
  end;

function Postgres_GetDatabaseNames(aConnection: TDAEConnection): IROStrings;
function Postgres_DoGetLastAutoInc(const GeneratorName: string; Query: IDADataset): integer;
function Postgres_GetNextAutoInc(const GeneratorName: string; Query: IDADataset): integer;
procedure Postgres_DoGetTableFields(const aTableName: string; Query: IDADataset; out Fields: TDAFieldCollection);
procedure Postgres_DoGetNames(Query: IDADataset; AList: IROStrings; AObjectType: TDAObjecttype);
function PostgresDataTypeToDA(aDataType: string; Unicode: Boolean=False): TDADataType;
procedure Postgres_DoGetForeignKeys(Query: IDADataset;ForeignKeys: TDADriverForeignKeyCollection);
function Postgres_GetSPSelectSyntax(HasArguments: Boolean): String;
procedure Postgres_DoGetStoredProcedureParams(const aStoredProcedureName: string; Query: IDADataset; out Params: TDAParamCollection);
function Postgres_IdentifierNeedsQuoting(const iIdentifier: string): boolean;

const
  PostgreSQL_DriverType = 'PostgreSQL';
  
implementation

const
  Postgres_MasterDatabase     = 'template1';
  Postgres_GetDatabaseNames_SQL = 'SELECT datname FROM pg_database ORDER BY datname';

function PostgresDataTypeToDA(aDataType: string; Unicode: Boolean): TDADataType;
begin
  aDataType := LowerCase(aDataType);
  if pos(' ', aDataType) <> 0 then Delete(aDataType, Pos(' ', aDataType), MaxInt);
  if (aDAtaType = 'varchar') or (aDataType = 'character varying') or
    (aDataType = 'character') or (aDataType = 'char') or
    (aDataType = '"char"') or (aDataType = 'name') then begin
    if Unicode then
      Result := datWideString
    else
      Result := datString;
  end
  else if aDataType = 'text' then begin
    if Unicode then
      Result := datWideMemo
    else
      Result := datMemo;
  end
  else if (aDataType = 'blob') or (aDataType = 'binary') or
    (aDataType = 'varbinary') or (aDataType = 'bytea') or
    (aDataType = 'binary large object') then
    Result := datBlob
  else if (aDataType = 'date') or (aDataType = 'absdate') or
    (aDataType = 'time') or (aDataType = 'timetz') or
    (aDataType = 'datetime') or
    (aDataType = 'timestamp') or (aDataType = 'timestamptz') or
    (aDataType = 'year') then
    result := datDateTime
  else if (aDataType = 'single') or
    (aDataType = 'real') or (aDataType = 'float4') then
    Result := datSingleFloat
  else if (aDataType = 'double') or
    (aDataType = 'float') or
    (aDataType = 'doubleprecision') or (aDataType = 'float8') then
    Result := datFloat
  else if (aDataType = 'bit') or (aDataType = 'boolean') or (aDataType = 'bool') then
    Result := datBoolean
  else if (aDataType = 'bigint') or (aDataType = 'int8') then
    result := datLargeInt
  else if (aDataType = 'decimal') or (aDataType = 'numeric') then
    result := datDecimal
  else if (aDataType = 'money') then
    result := datCurrency
  else if (aDataType = 'serial') or (aDataType = 'serial4') then
    result := datAutoInc
  else if (aDataType = 'bigserial') or (aDataType = 'serial8') then
    result := datLargeAutoInc
  else if (aDataType = 'smallint') or (aDataType = 'int2') then
    result := datSmallInt
  else if (aDataType = 'shortint') or (aDataType = 'int1') then
    result := datShortInt
  else if (aDataType = 'enum') or
    (aDataType = 'int4') or (adatatype = 'int') or (adatatype = 'integer') or
    (aDataType = 'tinyint') then
    result := datInteger
  else
    result := datUnknown;
end;

function Postgres_GetDatabaseNames(aConnection: TDAEConnection): IROStrings;
begin
  Result := Engine_GetDatabaseNames(aConnection, Postgres_MasterDatabase, Postgres_GetDatabaseNames_SQL);
end;

function Postgres_DoGetLastAutoInc(const GeneratorName: string; Query: IDADataset): integer;
begin
  try
    Query.SQL := 'SELECT currval(''' + GeneratorName + ''')';
    Query.Open;
    result := Query.Fields[0].Value;
  finally
    Query := nil;
  end;
end;

function Postgres_GetNextAutoInc(const GeneratorName: string; Query: IDADataset): integer;
begin
  try
    Query.SQL := 'SELECT nextval(''' + GeneratorName + ''')';
    Query.Open;
    result := Query.Fields[0].Value;
  finally
    Query := nil;
  end;
end;

procedure Postgres_DoGetTableFields(const aTableName: string; Query: IDADataset; out Fields: TDAFieldCollection);
const
  main_sql                    = 'SELECT COLUMN_NAME, DATA_TYPE, IS_NULLABLE, COLUMN_DEFAULT, CHARACTER_MAXIMUM_LENGTH, CHARACTER_SET_NAME, NUMERIC_PRECISION, NUMERIC_SCALE ' +
    'FROM INFORMATION_SCHEMA.COLUMNS ' +
    'WHERE TABLE_NAME=''{tbl}'' and TABLE_SCHEMA=''{schem}'' ' +
    'ORDER BY ORDINAL_POSITION';
  pk_sql                      = 'SELECT COLUMN_NAME ' +
    'FROM INFORMATION_SCHEMA.KEY_COLUMN_USAGE ' +
    'WHERE TABLE_NAME=''{tbl}'' and TABLE_SCHEMA=''{schem}'' AND CONSTRAINT_NAME like ''%_pkey''';
var
  fld                         : TDAField;
  lSchema, lTable             : string;
  p1                          : integer;
  s                           : string;
begin
  Fields := TDAFieldCollection.Create(nil);
  try
    {
    Query.SQL := 'SELECT * FROM ' + aTableName + ' WHERE 1=0';
    Query.Open;
    Fields.Assign(Query.Fields);
    Query.Close;
    }
    Query.SQL := main_sql;
    lTable := aTableName;
    if pos('.', lTable) = 0 then begin
      lSchema := 'public'
    end else begin
      lSchema := copy(lTable, 1, pos('.', lTable) - 1);
      Delete(lTable, 1, pos('.', lTable));
    end;
    Query.SQL := StringReplace(Query.SQL, '{tbl}', lTable, []);
    Query.SQL := StringReplace(Query.SQL, '{schem}', lSchema, []);
    Query.Open;
    while not Query.Eof do begin
      fld := Fields.Add;
      fld.Name:=Query.Fields[0].AsString;
      fld.Required := Query.Fields[2].AsString <> 'YES';
      fld.DefaultValue := Query.Fields[3].AsString;
      fld.DataType := PostgresDataTypeToDA(Query.Fields[1].asString, sametext(Query.Fields[5].AsString, 'utf8') or sametext(Query.Fields[5].AsString, 'utf16'));
      if fld.DataType = datDecimal then begin
        fld.DecimalPrecision := Query.Fields[6].asInteger;
        fld.DecimalScale := Query.Fields[7].asInteger;
      end;
      if Query.Fields[1].asString = '"char"' then fld.size := 1
      else if Query.Fields[1].asString = 'name' then fld.size := 63
      else fld.Size := Query.Fields[4].AsInteger;

      if fld.DefaultValue <> '' then begin
        if pos('nextval(', fld.DefaultValue) = 1 then begin
          case fld.DataType of
            datInteger: fld.DataType := datAutoInc;
            datLargeInt: fld.DataType := datLargeAutoInc;
          else
            fld.DefaultValue := '';
          end;
          if fld.DefaultValue <> '' then begin
            s := fld.DefaultValue;
            p1 := pos('''', s);
            Delete(s, 1, p1);
            p1 := pos('''', s);
            fld.GeneratorName := Copy(s, 1, p1 - 1);
            fld.DefaultValue := '';
          end;
        end else if not TestDefaultValue(fld.DefaultValue, fld.DataType) then begin
          fld.DefaultValue := '';
        end;
      end;
      Query.Next;
    end;
    Query.Close;
    Query.SQL := pk_sql;
    Query.SQL := StringReplace(Query.SQL, '{tbl}', lTable, []);
    Query.SQL := StringReplace(Query.SQL, '{schem}', lSchema, []);
    Query.Open;
    while not Query.Eof do begin
      fld := Fields.FindField(Query.Fields[0].AsString);
      if fld <> nil then
        fld.InPrimaryKey := true;
      Query.Next;
    end;
  finally
    Query := nil;
  end;
end;

procedure Postgres_DoGetNames(Query: IDADataset; AList: IROStrings; AObjectType: TDAObjecttype);
const
  c_select = 'SELECT pg_namespace.nspname, pg_class.relname FROM pg_class, pg_namespace '+
             'WHERE (pg_class.relkind = ''r'') AND (pg_namespace.oid = pg_class.relnamespace) AND '+
             '(pg_namespace.nspname NOT LIKE ''pg_%'') AND (pg_namespace.nspname NOT LIKE ''information_schema'') ORDER BY 1,2';
  c_stored = 'SELECT pg_namespace.nspname, pg_proc.proname '+
             'FROM pg_namespace, pg_proc '+
             'WHERE pg_namespace.oid = pg_proc.pronamespace and '+
             '(pg_namespace.nspname NOT LIKE ''pg_%'') AND (pg_namespace.nspname NOT LIKE ''information_schema'') ORDER BY 1,2';
  c_view =   'SELECT pg_namespace.nspname, pg_class.relname FROM pg_class, pg_namespace '+
             'WHERE (pg_class.relkind = ''v'') AND (pg_namespace.oid = pg_class.relnamespace) AND '+
             '(pg_namespace.nspname NOT LIKE ''pg_%'') AND (pg_namespace.nspname NOT LIKE ''information_schema'') ORDER BY 1,2';
begin
  try
    case AObjectType of
      dotTable: Query.SQL := c_select;
      dotProcedure: Query.SQL := c_stored;
      dotView: Query.SQL := c_view;
    else
    end;
    Query.Open;
    while not Query.EOF do begin
      if SameText(Query.fields[0].AsString, 'public') then
        AList.Add(Trim(Query.Fields[1].AsString))
      else
        AList.Add(Trim(Query.Fields[0].AsString)+'.'+Trim(Query.Fields[1].AsString));
      Query.Next;
    end;
    Query.Close;
  finally
    Query := nil;
  end;
end;

procedure Postgres_DoGetForeignKeys(Query: IDADataset;ForeignKeys: TDADriverForeignKeyCollection);
const
  s_sql = 'select c.conname,s.seq,fn.nspname,f.relname,fa.attname,pn.nspname,p.relname,pa.attname '+
          'from pg_constraint c join pg_class p ON (c.conrelid = p.oid) join pg_namespace pn ON (p.relnamespace = pn.oid) '+
          'join pg_class f ON (c.confrelid = f.oid) join pg_namespace fn ON (f.relnamespace = fn.oid) '+
          'join (select s.seq from generate_series(0,100) as s(seq)) as s on ( s.seq BETWEEN array_lower(conkey,1) and array_upper(conkey,1)) '+
          'join pg_attribute pa ON ((c.conrelid = pa.attrelid) and (pa.attnum = c.conkey[s.seq])) '+
          'join pg_attribute fa ON ((c.confrelid = fa.attrelid) and (fa.attnum = c.confkey[s.seq])) '+
          'WHERE c.contype=''f'' ORDER by 1,3,4,2';
var
  lCurrConstraint: string;
  lCurrFK: TDADriverForeignKey;
begin
  lCurrConstraint:='';
  lCurrFK := nil;
  ForeignKeys.Clear;
  try
    Query.SQL := s_sql;
    Query.Open;
    while not Query.Eof do begin
      if lCurrConstraint <> Query.Fields[0].AsString then begin
        lCurrConstraint := Query.Fields[0].AsString;
        lCurrFK := ForeignKeys.Add();
        with lCurrFK do begin
          Name := Trim(Query.Fields[0].AsString);
          if not SameText(Query.fields[2].AsString, 'public') then
            PKTable := Format('%s.%s', [Trim(Query.Fields[2].AsString), Trim(Query.Fields[3].AsString)])
          else
            PKTable := Trim(Query.Fields[3].AsString);
          if not SameText(Query.fields[5].AsString, 'public') then
            FKTable := Format('%s.%s', [Trim(Query.fields[5].AsString), Trim(Query.fields[6].AsString)])
          else
            FKTable := Trim(Query.fields[6].AsString);
          PKField := Trim(Query.Fields[4].AsString);
          FKField := Trim(Query.Fields[7].AsString);
        end
      end  
      else
        with lCurrFK do begin
          PKField := PKField + ';' + TrimRight(Query.Fields[4].AsString);
          FKField := FKField + ';' + TrimRight(Query.Fields[7].AsString);
        end;
      Query.Next;
    end;
    Query.Close;
  finally
    Query := nil;
  end;
end;

function Postgres_GetSPSelectSyntax(HasArguments: Boolean): String;
begin
  if HasArguments then
    Result := 'SELECT * FROM {0}({1})'
  else
    Result := 'SELECT * FROM {0}()';
end;

procedure Postgres_DoGetStoredProcedureParams(const aStoredProcedureName: string; Query: IDADataset; out Params: TDAParamCollection);
const
  s_sql= 'select ns.nspname as schema,p.proname as name, ' +
      //   '/*  p.pronargs,p.proretset,p.prorettype,p.proargtypes,p.proallargtypes,p.proargmodes,p.proargnames,*/ ' +
         'COALESCE(s.seq,1) as paramnumber,ipt.typname as paramtype, ' +
         'COALESCE(p.proargmodes[s.seq], case when (p.pronargs < s.seq)  then ''r'' else ''i'' end) as parammode, ' +
         'COALESCE(p.proargnames[s.seq], case when (p.proargmodes[s.seq] is null) and (p.pronargs < s.seq)  then ''result'' else ''$''||s.seq end) as paramname '+
         'from pg_proc p '+
         'join pg_namespace ns on ((p.pronamespace = ns.oid)) '+ // and (ns.nspname not like ''pg_%'') and (ns.nspname <> ''information_schema'')) ' +
         'join (select s.seq from generate_series(0,100) as s(seq)) as s on (s.seq between COALESCE(array_lower(p.proallargtypes,1),1) and COALESCE(array_upper(p.proallargtypes,1),p.pronargs+1)) ' +
         'join pg_type ipt on (COALESCE(p.proargtypes[s.seq-1],p.proallargtypes[s.seq-1],prorettype) =ipt.oid) ';
 s_where='where (ns.nspname = ''%s'') and (p.proname = ''%s'') ';
 s_order='order by schema,name,paramnumber';
var
  schema, proc:string;
  s: string;
begin
  Params := TDAParamCollection.Create(nil);
  if Pos('.', aStoredProcedureName) > 0 then
  begin
    schema := Trim(Copy(aStoredProcedureName, 1, Pos('.', aStoredProcedureName) - 1));
    proc := Trim(Copy(aStoredProcedureName, Pos('.', aStoredProcedureName) + 1, Length(aStoredProcedureName)));
  end else
  begin
    schema := 'public';
    proc := aStoredProcedureName;
  end;
  Query.SQL:= s_sql+ Format(s_where,[schema,proc])+s_order;
  Query.Open;
  while not Query.EOF do begin
    With Params.Add do begin
      s:= Query.Fields[4].AsString;
      if s = 'r' then ParamType:=daptResult
      else if s = 'o' then ParamType:=daptOutput
      else if s = 'b' then ParamType:=daptInputOutput
      else ParamType:=daptInput;
      Name := Query.Fields[5].AsString;
      DataType := PostgresDataTypeToDA(Query.Fields[3].AsString);
    end;
    Query.Next;
  end;
end;

function Postgres_IdentifierNeedsQuoting(const iIdentifier: string): boolean;
begin
  Result:= AnsiLowerCase(iIdentifier) <> iIdentifier;
end;
{ TDAEPostgresConnection }

procedure TDAEPostgresConnection.DoGetForeignKeys(
  out ForeignKeys: TDADriverForeignKeyCollection);
begin
  inherited;
  Postgres_DoGetForeignKeys(GetDatasetClass.Create(Self),ForeignKeys);
end;

function TDAEPostgresConnection.DoGetLastAutoInc(
  const GeneratorName: string): integer;
begin
  Result := Postgres_DoGetLastAutoInc(GeneratorName, GetDatasetClass.Create(Self));
end;

procedure TDAEPostgresConnection.DoGetStoredProcedureNames(
  out List: IROStrings);
begin
  inherited;
  Postgres_DoGetNames(GetDatasetClass.Create(Self),List,dotProcedure);
end;

procedure TDAEPostgresConnection.DoGetStoredProcedureParams(
  const aStoredProcedureName: string; out Params: TDAParamCollection);
begin
inherited;
exit;
  Postgres_DoGetStoredProcedureParams(aStoredProcedureName, GetDatasetClass.Create(Self), Params);
end;

procedure TDAEPostgresConnection.DoGetTableFields(const aTableName: string;
  out Fields: TDAFieldCollection);
begin
  Postgres_DoGetTableFields(aTableName, GetDatasetClass.Create(Self), Fields);
end;

procedure TDAEPostgresConnection.DoGetTableNames(out List: IROStrings);
begin
  inherited;
  Postgres_DoGetNames(GetDatasetClass.Create(Self),List,dotTable);
end;

procedure TDAEPostgresConnection.DoGetViewNames(out List: IROStrings);
begin
  inherited;
  Postgres_DoGetNames(GetDatasetClass.Create(Self), List, dotView);
end;

function TDAEPostgresConnection.GetDatabaseNames: IROStrings;
begin
  Result := Postgres_GetDatabaseNames(Self);
end;

function TDAEPostgresConnection.GetNextAutoinc(
  const GeneratorName: string): integer;
begin
  Result := Postgres_GetNextAutoInc(GeneratorName, GetDatasetClass.Create(Self));
end;

function TDAEPostgresConnection.GetSPSelectSyntax(
  HasArguments: Boolean): string;
begin
  Result:= Postgres_GetSPSelectSyntax(HasArguments);
end;

function TDAEPostgresConnection.IdentifierNeedsQuoting(
  const iIdentifier: string): boolean;
begin
  Result:= inherited IdentifierNeedsQuoting(iIdentifier) or Postgres_IdentifierNeedsQuoting(iIdentifier);
end;

{ TDAPostgresDriver }

function TDAPostgresDriver.GetDefaultConnectionType(
  const AuxDriver: string): string;
begin
  Result:= PostgreSQL_DriverType;
end;

end.