
//////////////////////////////////////////////////
//  Universal Data Access Components
//  Copyright © 2008-2014 Devart. All right reserved.
//////////////////////////////////////////////////

{$IFNDEF CLR}
{$I PgDac.inc}
{$IFDEF VER10P}
{$I PostgreSQLUniProvider.inc}
{$ENDIF}
unit PostgreSQLUniProvider;
{$ENDIF}

interface

uses
  SysUtils, Classes, Variants, DB, CRAccess, CRConnectionPool, MemData,
  {$IFNDEF FPC}MemDS{$ELSE}MemDataSet{$ENDIF}, DBAccess,
  CRTypes, CRParser, CRDataTypeMap,
  DAScript, DADump, UniProvider;

type

{$IFDEF VER16P}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32 {$IFNDEF STD}{$IFDEF VER18P}or pidiOSSimulator or pidiOSDevice{$IFDEF VER19P} or pidAndroid{$ENDIF}{$ENDIF}{$ENDIF})]
{$ENDIF}
  TPostgreSQLUniProvider = class(TUniProvider)
  public
    class function GetProviderName: string; override;

    function IsDatabaseSupported: boolean; override;
    function IsPortSupported: boolean; override;
    function NeedRecreateProcCall: boolean; override;

    function GetParserClass: TSQLParserClass; override;
    function GetConnectionParametersClass: TCRConnectionParametersClass; override;
    function GetConnectionPoolingManagerClass: TCRConnectionPoolManagerClass; override;
    function GetConnectionClass: TCRConnectionClass; override;
    function GetServerEnumeratorClass: TCRServerEnumeratorClass; override;    
    function GetTransactionClass: TCRTransactionClass; override;
    function GetCommandClass: TCRCommandClass; override;
    function GetRecordSetClass: TCRRecordSetClass; override;
    function GetDataSetServiceClass: TDADataSetServiceClass; override;
    function GetScriptProcessorClass: TDAScriptProcessorClass; override;
    function GetLoaderClass: TCRLoaderClass; override;
    function GetAlerterClass: TCRAlerterClass; override;
    function GetDumpProcessorClass: TDADumpProcessorClass; override;
    function GetMetaDataClass: TCRMetaDataClass; override;
    function GetConnectDialogServiceClass: TConnectDialogServiceClass; override;
    function GetFieldTypeMapClass: TDAFieldTypeMapClass; override;
    function GetSqlFormatterClass: TUniSqlFormatterClass; override;
    function GetConverterManagerClass: TConverterManagerClass; override;
    function GetParamObjectClass(Param: TDAParam): TClass; override;
    function CreateParamObject(Param: TDAParam): TSharedObject; override;

    procedure SetObjectProps(Obj: TObject; Options: TStrings; SetAllProps: boolean); override;

    function GetConnectionOptions: TOptionsList; override;
    function GetSQLOptions: TOptionsList; override;
    function GetDataSetOptions: TOptionsList; override;
    function GetScriptOptions: TOptionsList; override;
    function GetLoaderOptions: TOptionsList; override;

    // for Failover Demo
    class function GetSocket(Connection: TCustomDAConnection): {$IFNDEF CLR}longint{$ELSE}IntPtr{$ENDIF};
  end;

  TPgConnectDialogService = class(TConnectDialogService)
  public
    function GetDefaultDatabase: string; override;
  end;

  TPgSqlFormatter = class(TUniSqlFormatter)
  protected
  public
    constructor Create; override;
  end;

{$IFNDEF FPC}
procedure RegisterComponent;
{$ELSE}
procedure Register;
{$ENDIF}

implementation

uses
  DAConsts, UniConsts, CRVio, CRVioTcp,
{$IFNDEF UNIDACPRO}
  PgParser, PgClasses, PgObjects, PgConnectionPool, PgServices, PgScriptProcessor,
  PgSQLNet, PgDataTypeMap, PgSQLGenerator;
{$ELSE}
  PgParserUni, PgClassesUni, PgObjectsUni, PgConnectionPoolUni, PgServicesUni,
  PgScriptProcessorUni, PgSQLNetUni, PgDataTypeMapUni, PgSQLGeneratorUni;
{$ENDIF}  

var
  PgFunctions, PgMacros: TStrValueStringList;

class function TPostgreSQLUniProvider.GetProviderName: string;
begin
  Result := 'PostgreSQL';
end;

function TPostgreSQLUniProvider.IsDatabaseSupported: boolean;
begin
  Result := True;
end;

function TPostgreSQLUniProvider.IsPortSupported: boolean;
begin
  Result := True;
end;

function TPostgreSQLUniProvider.NeedRecreateProcCall: boolean;
begin
  Result := True;
end;

function TPostgreSQLUniProvider.GetParserClass: TSQLParserClass;
begin
  Result := TPgParser;
end;

function TPostgreSQLUniProvider.GetConnectionParametersClass: TCRConnectionParametersClass;
begin
  Result := TPgConnectionParameters;
end;

function TPostgreSQLUniProvider.GetConnectionPoolingManagerClass: TCRConnectionPoolManagerClass;
begin
  Result := TPgConnectionPoolManager;
end;

function TPostgreSQLUniProvider.GetConnectionClass: TCRConnectionClass;
begin
  Result := TPgSQLConnection;
end;

function TPostgreSQLUniProvider.GetServerEnumeratorClass: TCRServerEnumeratorClass;    
begin
  Result := TPgServerEnumerator;
end;

function TPostgreSQLUniProvider.GetTransactionClass: TCRTransactionClass;
begin
  Result := TPgSQLTransaction;
end;

function TPostgreSQLUniProvider.GetCommandClass: TCRCommandClass;
begin
  Result := TPgSQLCommand;
end;

function TPostgreSQLUniProvider.GetRecordSetClass: TCRRecordSetClass;
begin
  Result := TPgSQLRecordSet;
end;

function TPostgreSQLUniProvider.GetDataSetServiceClass: TDADataSetServiceClass;
begin
  Result := TCustomPgDataSetService;
end;

function TPostgreSQLUniProvider.GetScriptProcessorClass: TDAScriptProcessorClass;
begin
  Result := TPgScriptProcessor;
end;

function TPostgreSQLUniProvider.GetLoaderClass: TCRLoaderClass;
begin
  Result := TPgSQLLoader;
end;

function TPostgreSQLUniProvider.GetAlerterClass: TCRAlerterClass;
begin
  Result := TPgSQLAlerter;
end;

function TPostgreSQLUniProvider.GetDumpProcessorClass: TDADumpProcessorClass;
begin
  Result := TCustomPgDumpProcessor;
end;

function TPostgreSQLUniProvider.GetMetaDataClass: TCRMetaDataClass;
begin
  Result := TPgSQLMetaData;
end;

function TPostgreSQLUniProvider.GetConnectDialogServiceClass: TConnectDialogServiceClass;
begin
  Result := TPgConnectDialogService;
end;

function TPostgreSQLUniProvider.GetFieldTypeMapClass: TDAFieldTypeMapClass;
begin
  Result := TCustomPgFieldTypeMap;
end;

function TPostgreSQLUniProvider.GetSqlFormatterClass: TUniSqlFormatterClass;
begin
  Result := TPgSqlFormatter;
end;

function TPostgreSQLUniProvider.GetConverterManagerClass: TConverterManagerClass;
begin
  Result := TPgConverterManager;
end;

function TPostgreSQLUniProvider.GetParamObjectClass(Param: TDAParam): TClass;
begin
  case Param.DataType of
    ftOraBlob:
      Result := TPgSQLLargeObject;
    ftCursor:
      Result := TPgRefCursor;
  else
    Result := inherited GetParamObjectClass(Param);
  end;
end;

function TPostgreSQLUniProvider.CreateParamObject(Param: TDAParam): TSharedObject;
begin
  case Param.DataType of
    ftOraBlob:
      Result := TPgSQLLargeObject.Create(nil);
    ftCursor:
      Result := TPgRefCursor.Create;
  else
    Result := inherited CreateParamObject(Param);
  end;
end;

procedure TPostgreSQLUniProvider.SetObjectProps(Obj: TObject; Options: TStrings; SetAllProps: boolean);
begin
  if Obj is TPgSQLConnection then begin
    TPgSQLConnection(Obj).SetProp(prEnablePgTimeStamps, False);
    TPgSQLConnection(Obj).SetProp(prEnableGeometrics, False);
    TPgSQLConnection(Obj).SetProp(prEnableComposites, False);
    TPgSQLConnection(Obj).SetProp(prEnableDomains, True);
    TPgSQLConnection(Obj).SetProp(prIntervalAsString, True);
  end;

  inherited;
end;

function TPostgreSQLUniProvider.GetConnectionOptions: TOptionsList;
begin
  if FConnectionOptions = nil then begin
    FConnectionOptions := TOptionsList.Create(GetProviderName);
    FConnectionOptions.Add(TStringOption.Create('ApplicationName', prApplicationName, [TPgSQLConnection, TPgConnectionParameters], ''));
    FConnectionOptions.Add(TStringOption.Create('Charset', prCharset, [TPgSQLConnection, TPgConnectionParameters], '', True));
    FConnectionOptions.Add(TIntegerOption.Create('ConnectionTimeout', prConnectionTimeOut, [TPgSQLConnection, TPgConnectionParameters], 15, True));
    FConnectionOptions.Add(TEnumeratorOption.Create('ProtocolVersion', prProtocolVersion, [TPgSQLConnection, TPgConnectionParameters], Variant(pv30), TypeInfo(TProtocolVersion), True));
  {$IFNDEF CLR}
    FConnectionOptions.Add(TEnumeratorOption.Create('IPVersion', prIPVersion, [TPgSQLConnection, TPgConnectionParameters], Variant(ivIPv4), TypeInfo(TIPVersion), True));
  {$ENDIF}
    FConnectionOptions.Add(TStringOption.Create('Schema', prSchema, [TPgSQLConnection, TPgConnectionParameters], '', True));
    FConnectionOptions.Add(TBooleanOption.Create('UseUnicode', prUseUnicode, [TPgSQLConnection, TPgConnectionParameters], False, True));

    // SSL
    FConnectionOptions.Add(TEnumeratorOption.Create('SSLMode', prSSL_Mode, [TPgSQLConnection, TPgConnectionParameters], Variant(smDisable), TypeInfo(TSSLMode), True));
    FConnectionOptions.Add(TStringOption.Create('SSLCACert', prSSL_CACert, [TPgSQLConnection, TPgConnectionParameters], '', True));
    FConnectionOptions.Add(TStringOption.Create('SSLCert', prSSL_Cert, [TPgSQLConnection, TPgConnectionParameters], '', True));
    FConnectionOptions.Add(TStringOption.Create('SSLKey', prSSL_Key, [TPgSQLConnection, TPgConnectionParameters], '', True));
    FConnectionOptions.Add(TStringOption.Create('SSLCipherList', prSSL_CipherList, [TPgSQLConnection, TPgConnectionParameters], '', True));
  end;
  Result := FConnectionOptions;
end;

function TPostgreSQLUniProvider.GetSQLOptions: TOptionsList;
begin
  if FSQLOptions = nil then begin
    FSQLOptions := TOptionsList.Create(GetProviderName);
    FSQLOptions.Add(TIntegerOption.Create('CommandTimeout', prCommandTimeOut, [TPgSQLCommand], 0));
    FSQLOptions.Add(TBooleanOption.Create('UnpreparedExecute', prSimpleQueryExecute, [TPgSQLCommand], False));
    FSQLOptions.Add(TBooleanOption.Create('UseParamTypes', prUseParamTypes, [TPgSQLCommand], False));
  end;
  Result := FSQLOptions;
end;

function TPostgreSQLUniProvider.GetDataSetOptions: TOptionsList;
begin
  if FDataSetOptions = nil then begin
    FDataSetOptions := TOptionsList.Create(GetProviderName);
    FDataSetOptions.Add(TBooleanOption.Create('AutoDeleteBlob', prAutoDeleteBlob, [TCustomPgDataSetService], True));
    FDataSetOptions.Add(TBooleanOption.Create('CacheBlobs', prCacheBlobs, [TPgSQLRecordSet], True));
    FDataSetOptions.Add(TIntegerOption.Create('CommandTimeout', prCommandTimeOut, [TPgSQLRecordSet], 0));
    FDataSetOptions.Add(TBooleanOption.Create('DeferredBlobRead', prDeferredBlobRead, [TPgSQLRecordSet], False));
    FDataSetOptions.Add(TBooleanOption.Create('ExtendedFieldsInfo', prExtendedFieldsInfo, [TPgSQLRecordSet], True));
    FDataSetOptions.Add(TBooleanOption.Create('FetchAll', prFetchAll, [TPgSQLRecordSet], True));
    FDataSetOptions.Add(TStringOption.Create('KeySequence', prKeySequence, [TCustomPgDataSetService], ''));
    FDataSetOptions.Add(TBooleanOption.Create('OIDAsInt', prOIDAsInt, [TPgSQLRecordSet], False));
    FDataSetOptions.Add(TEnumeratorOption.Create('SequenceMode', prSequenceMode, [TCustomPgDataSetService], Variant(_smPost), TypeInfo(_TSequenceMode)));
    FDataSetOptions.Add(TBooleanOption.Create('UnknownAsString', prUnknownAsString, [TPgSQLRecordSet], False));
    FDataSetOptions.Add(TBooleanOption.Create('UnpreparedExecute', prSimpleQueryExecute, [TPgSQLRecordSet], False));
    FDataSetOptions.Add(TBooleanOption.Create('UseParamTypes', prUseParamTypes, [TPgSQLRecordSet], False));
    FDataSetOptions.Add(TBooleanOption.Create('CursorWithHold', prCursorWithHold, [TPgSQLRecordSet], False));
  end;
  Result := FDataSetOptions;
end;

function TPostgreSQLUniProvider.GetScriptOptions: TOptionsList;
begin
  if FScriptOptions = nil then begin
    FScriptOptions := TOptionsList.Create(GetProviderName);
  end;
  Result := FScriptOptions;
end;

function TPostgreSQLUniProvider.GetLoaderOptions: TOptionsList;
begin
  if FLoaderOptions = nil then begin
    FLoaderOptions := TOptionsList.Create(GetProviderName);
    FLoaderOptions.Add(TBooleanOption.Create('TextMode', prTextMode, [TPgSQLLoader], False));
    FLoaderOptions.Add(TIntegerOption.Create('BufferSize', prBufferSize, [TPgSQLLoader], WriteBufferSize));
    FLoaderOptions.Add(TBooleanOption.Create('QuoteNames', prQuoteNames, [TPgSQLLoader], False));
  end;
  Result := FLoaderOptions;
end;

class function TPostgreSQLUniProvider.GetSocket(Connection: TCustomDAConnection): {$IFNDEF CLR}longint{$ELSE}IntPtr{$ENDIF};
var
  ICon: TPgSQLConnection;
begin
  Assert(Connection.Connected);
  ICon := TDBAccessUtils.GetIConnection(Connection) as TPgSQLConnection;
  Result := (ICon.GetProtocol.Net.Vio as TCRVioTcp).GetSocket;
end;

{ TPgConnectDialogService }

function TPgConnectDialogService.GetDefaultDatabase: string;
begin
  Result := 'template1';
end;

{ TPgSqlFormatter }

constructor TPgSqlFormatter.Create;
begin
  inherited;

  FFunctions := PgFunctions;
  FPredefinedMacros := PgMacros;
end;

{$IFNDEF FPC}
procedure RegisterComponent;
{$ELSE}
procedure Register;
{$ENDIF}
begin
  RegisterComponents('UniDAC Providers', [TPostgreSQLUniProvider]);
end;

initialization
  UniProviders.RegisterProvider(TPostgreSQLUniProvider);

  PgFunctions := TStrValueStringList.Create;
  PgFunctions.Add('USER', 'USER()');
  PgFunctions.Add('CHAR_LENGTH', 'CHAR_LENGTH(%s)');
  PgFunctions.Add('LOCATE', 'STRPOS(%1:s, %0:s)');
  PgFunctions.Add('SUBSTRING', 'SUBSTRING(%s, %s, %s)');
  PgFunctions.Add('CONCAT', '%s || %s');
  PgFunctions.Add('CHAR', 'CHR(%s)');
  PgFunctions.Add('TRIM', 'TRIM(%s)');
  PgFunctions.Add('TRUNCATE', 'TRUNC(%s, %s)');
  PgFunctions.Add('CEILING', 'CEILING(%s)');
  // Date-time
  PgFunctions.Add('CURRENT_DATE', 'CURRENT_DATE');
  PgFunctions.Add('YEAR', 'EXTRACT(YEAR FROM %s)');
  PgFunctions.Add('MONTH', 'EXTRACT(MONTH FROM %s)');
  PgFunctions.Add('DAY', 'EXTRACT(DAY FROM %s)');
  PgFunctions.Add('DATEADD', '(%2:s + INTERVAL'' %1:s %0:s'')');
  PgFunctions.Add('DATEDIFF', 'EXTRACT(%s FROM (%2:s - %1:s))');
  // Date-time literals
  PgFunctions.Add('__DATE_TIME_LITERAL', 'TIMESTAMP %s');
  PgFunctions.Add('__DATE_LITERAL', 'DATE %s');
  PgFunctions.Add('__TIME_LITERAL', 'TIME %s');
  // CONVERT functions
  PgFunctions.Add('TODATE', 'CAST(%s AS TIMESTAMP)');
  PgFunctions.Add('TONUMBER', 'CAST(%s AS NUMERIC)');
  PgFunctions.Add('TOCHAR', 'CAST(%s AS VARCHAR)');

  PgMacros := TStrValueStringList.Create;
  PgMacros.Add('PROVIDER', 'PostgreSQL');
  PgMacros.Add('POSTGRESQL', '');
  // DataType macros
  PgMacros.Add('DATETIME', 'TIMESTAMP');
  PgMacros.Add('DOUBLE', 'DOUBLE PRECISION');
  PgMacros.Add('VARCHAR', 'VARCHAR');

finalization
  UniProviders.UnRegisterProvider(TPostgreSQLUniProvider);

  PgFunctions.Free;
  PgMacros.Free;

end.
