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

{$IFNDEF CLR}
{$I Odac.inc}
{$IFDEF VER10P}
{$I OracleUniProvider.inc} 
{$ENDIF}
unit OracleUniProvider;
{$ENDIF}

interface

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

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}
  TOracleUniProvider = class(TUniProvider)
  public
    class function GetProviderName: string; override;

    function NeedRecreateProcCall: boolean; override;
    function NeedComplexUpdateFieldDefList: 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;
  end;

  TOraConnectDialogService = class (TConnectDialogService)
  private
    FDirect: boolean;
  public
    function SetProp(Prop: integer; const Value: variant): boolean; override;
    function GetConnectMode: integer; override;
  end;

  TOraSqlFormatter = class(TUniSqlFormatter)
  protected
    function GetFunction(const FunctionName: string; const Params: TStringArray): string; override;
    function GetDateAdd(const Params: TStringArray): string;
    function GetDateDiff(const Params: TStringArray): string;
  public
    constructor Create; override;
  end;

  TUniOraScriptProcessor = class (TCustomOraScriptProcessor)
  protected
    procedure SetConnectMode(Connection: TCustomDAConnection; ConnectMode: TConnectMode); override;
  end;

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

implementation

uses
  TypInfo, CRFunctions, CRVio, DAConsts, UniConsts,
{$IFNDEF UNIDACPRO}
  OraCall, OraParser, OraConnectionPool, OraServices, OraSQLGenerator,
  OraNumber, OraDateTime, OraInterval, OraDataTypeMap;
{$ELSE}
  OraCallUni, OraParserUni, OraConnectionPoolUni, OraServicesUni, OraSQLGeneratorUni,
  OraNumberUni, OraDateTimeUni, OraIntervalUni, OraDataTypeMapUni;
{$ENDIF}

var
  OraFunctions, OraMacros: TStrValueStringList;

{ TOracleUniProvider }

class function TOracleUniProvider.GetProviderName: string;
begin
  Result := 'Oracle';
end;

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

function TOracleUniProvider.NeedComplexUpdateFieldDefList: boolean;
begin
  Result := True;
end;

function TOracleUniProvider.GetParserClass: TSQLParserClass;
begin
  Result := TOraParser;
end;

function TOracleUniProvider.GetConnectionParametersClass: TCRConnectionParametersClass;
begin
  Result := TOraConnectionParameters;
end;

function TOracleUniProvider.GetConnectionPoolingManagerClass: TCRConnectionPoolManagerClass;
begin
  Result := TOraConnectionPoolManager;
end;

function TOracleUniProvider.GetConnectionClass: TCRConnectionClass;
begin
  Result := TOCIConnection;
end;

function TOracleUniProvider.GetServerEnumeratorClass: TCRServerEnumeratorClass;
begin
  Result := TOraServerEnumerator;
end;

function TOracleUniProvider.GetTransactionClass: TCRTransactionClass;
begin
  Result := TOCITransaction;
end;

function TOracleUniProvider.GetCommandClass: TCRCommandClass;
begin
  Result := TOCICommand;
end;

function TOracleUniProvider.GetRecordSetClass: TCRRecordSetClass;
begin
  Result := TOCIRecordSet;
end;

function TOracleUniProvider.GetDataSetServiceClass: TDADataSetServiceClass;
begin
  Result := TCustomOraDataSetService;
end;

function TOracleUniProvider.GetScriptProcessorClass: TDAScriptProcessorClass;
begin
  Result := TUniOraScriptProcessor;
end;

function TOracleUniProvider.GetLoaderClass: TCRLoaderClass;
begin
  Result := TOCILoader;
end;

function TOracleUniProvider.GetAlerterClass: TCRAlerterClass;
begin
  Result := TOCIAlerter;
end;

function TOracleUniProvider.GetDumpProcessorClass: TDADumpProcessorClass;
begin
  Result := TCustomOraDumpProcessor;
end;

function TOracleUniProvider.GetFieldTypeMapClass: TDAFieldTypeMapClass;
begin
  Result := TCustomOraFieldTypeMap;
end;

function TOracleUniProvider.GetMetaDataClass: TCRMetaDataClass;
begin
  Result := TOCIMetaData;
end;

function TOracleUniProvider.GetConnectDialogServiceClass: TConnectDialogServiceClass;
begin
  Result := TOraConnectDialogService;
end;

function TOracleUniProvider.GetSqlFormatterClass: TUniSqlFormatterClass;
begin
  Result := TOraSqlFormatter;
end;

function TOracleUniProvider.GetConverterManagerClass: TConverterManagerClass;
begin
  Result := TOraConverterManager;
end;

function TOracleUniProvider.GetParamObjectClass(Param: TDAParam): TClass;
begin
  case Param.DataType of
    ftOraClob, ftOraBlob:
      Result := TOraLob;
    ftCursor:
      Result := TOraCursor;
  else
    Result := inherited GetParamObjectClass(Param);
  end;
end;

function TOracleUniProvider.CreateParamObject(Param: TDAParam): TSharedObject;

  function GetOCISvcCtx: TOCISvcCtx;
  var
    ICommand: TCRCommand;
  begin
    ICommand := TDBAccessUtils.GetICommand(Param.Collection.Owner as TComponent);
    Result := TOCICommand(ICommand).OCISvcCtx;
    if Result = nil then
      Result := TOCIConnection(ICommand.GetConnection).OCISvcCtx;
  end;

begin
  case Param.DataType of
    ftOraClob, ftOraBlob: begin
      Result := TOraLob.Create(nil);
      if Param.DataType = ftOraClob then begin
        if TDBAccessUtils.GetNational(Param) then
          TOraLob(Result).LobType := ltNClob
        else
          TOraLob(Result).LobType := ltClob;
        if GetOCISvcCtx.UnicodeEnv then
          TOraLob(Result).IsUnicode := True;
      end
      else
        TOraLob(Result).LobType := ltBlob;
    end;
    ftCursor:
      Result := TOraCursor.Create;
  else
    Result := inherited CreateParamObject(Param);
  end;
end;

procedure TOracleUniProvider.SetObjectProps(Obj: TObject; Options: TStrings; SetAllProps: boolean);
begin
  if Obj.ClassType = TOCIConnection then begin
  {$IFNDEF FPC}
    TOCIConnection(Obj).SetProp(prEnableSQLTimeStamp, True);
  {$ELSE}
    TOCIConnection(Obj).SetProp(prTimeStampAsString, True);
  {$ENDIF}
    TOCIConnection(Obj).SetProp(prIntervalAsString, True);
  end
  else
  if Obj.ClassType = TOCICommand then begin
    TOCICommand(Obj).SetProp(prCheckParamHasDefault, False);
  end;

  inherited;
end;

function TOracleUniProvider.GetConnectionOptions: TOptionsList;
begin
  if FConnectionOptions = nil then begin
    FConnectionOptions := TOptionsList.Create(GetProviderName);
    FConnectionOptions.Add(TIntegerOption.Create('CharLength', prCharLength, [TOCIConnection], 0));
    FConnectionOptions.Add(TStringOption.Create('Charset', prCharset, [TOCIConnection], '', True));
    FConnectionOptions.Add(TBooleanOption.Create('UseUnicode', prUseUnicode, [TOCIConnection, TOraConnectionParameters], False, True));
    FConnectionOptions.Add(TBooleanOption.Create('UnicodeEnvironment', prUnicodeEnvironment, [TOCIConnection, TOraConnectionParameters], False, True));
    FConnectionOptions.Add(TStringOption.Create('DateFormat', prDateFormat, [TOCIConnection], ''));
    FConnectionOptions.Add(TStringOption.Create('DateLanguage', prDateLanguage, [TOCIConnection], ''));
    FConnectionOptions.Add(TBooleanOption.Create('UseOCI7', prUseOCI7, [TOCIConnection, TOraConnectionParameters], False));
    FConnectionOptions.Add(TEnumeratorOption.Create('OptimizerMode', prOptimizerMode, [TOCIConnection, TOraConnectionParameters], Variant(omDefault), TypeInfo(TOptimizerMode)));
    FConnectionOptions.Add(TIntegerOption.Create('ConnectionTimeout', prConnectionTimeOut, [TOCIConnection, TOraConnectionParameters], 0, True));
    FConnectionOptions.Add(TBooleanOption.Create('StatementCache', prStatementCache, [TOCIConnection, TOraConnectionParameters], False));
    FConnectionOptions.Add(TIntegerOption.Create('StatementCacheSize', prStatementCacheSize, [TOCIConnection, TOraConnectionParameters], 20));
    FConnectionOptions.Add(TStringOption.Create('ClientIdentifier', prClientIdentifier, [TOCIConnection, TOraConnectionParameters], ''));
    FConnectionOptions.Add(TBooleanOption.Create('Direct', prDirect, [TOCIConnection, TOraConnectionParameters, TOraServerEnumerator, TOraConnectDialogService], False, True));
  {$IFNDEF CLR}
    FConnectionOptions.Add(TEnumeratorOption.Create('IPVersion', prIPVersion, [TOCIConnection, TOraConnectionParameters], Variant(ivIPv4), TypeInfo(TIPVersion), True));
  {$ENDIF}
    FConnectionOptions.Add(TEnumeratorOption.Create('ConnectMode', prConnectMode, [TOCIConnection, TOraConnectionParameters], Variant(cmNormal), TypeInfo(TConnectMode), True));
    FConnectionOptions.Add(TBooleanOption.Create('ThreadSafety', prThreadSafety, [TOCIConnection], True));
    FConnectionOptions.Add(TStringOption.Create('HomeName', prHomeName, [TOCIConnection, TOraConnectionParameters, TOraServerEnumerator], '', True));
    FConnectionOptions.Add(TStringOption.Create('Schema', prSchema, [TOCIConnection, TOraConnectionParameters], '', True));
    FConnectionOptions.Add(TEnumeratorOption.Create('PoolingType', prPoolingType, [TOraConnectionParameters], Variant(optLocal), TypeInfo(TOraPoolingType)));
    FConnectionOptions.Add(TIntegerOption.Create('PrecisionSmallint', prSmallintPrecision, [TOCIConnection], 4));
    FConnectionOptions.Add(TIntegerOption.Create('PrecisionInteger', prIntegerPrecision, [TOCIConnection], 9));
    FConnectionOptions.Add(TIntegerOption.Create('PrecisionLargeint', prLargeintPrecision, [TOCIConnection], 18));
    FConnectionOptions.Add(TIntegerOption.Create('PrecisionFloat', prFloatPrecision, [TOCIConnection], 0));
    FConnectionOptions.Add(TStringOption.Create('PrecisionBCD', prBCDPrecision, [TOCIConnection], '14,4'));
  {$IFNDEF FPC}
    FConnectionOptions.Add(TStringOption.Create('PrecisionFMTBCD', prFMTBCDPrecision, [TOCIConnection], '38,38'));
  {$ENDIF}
  end;
  Result := FConnectionOptions;
end;

function TOracleUniProvider.GetSQLOptions: TOptionsList;
begin
  if FSQLOptions = nil then begin
    FSQLOptions := ToptionsList.Create(GetProviderName);
    FSQLOptions.Add(TBooleanOption.Create('StatementCache', prStatementCache, [TOCICommand], False));
    FSQLOptions.Add(TBooleanOption.Create('TemporaryLobUpdate', prTemporaryLobUpdate, [TOCICommand], True));
    FSQLOptions.Add(TBooleanOption.Create('NonBlocking', prNonBlocking, [TOCICommand], False));
  end;
  Result := FSQLOptions;
end;

function TOracleUniProvider.GetDataSetOptions: TOptionsList;
begin
  if FDataSetOptions = nil then begin
    FDataSetOptions := TOptionsList.Create(GetProviderName);
    FDataSetOptions.Add(TBooleanOption.Create('FetchAll', prFetchAll, [TOCIRecordSet], False));
    FDataSetOptions.Add(TBooleanOption.Create('AutoClose', prAutoClose, [TOCIRecordSet], False));
    FDataSetOptions.Add(TBooleanOption.Create('FieldsAsString', prFieldsAsString, [TOCICommand], False));
    FDataSetOptions.Add(TBooleanOption.Create('DeferredLobRead', prDeferredLobRead, [TOCIRecordSet], False));
    FDataSetOptions.Add(TBooleanOption.Create('CacheLobs', prCacheLobs, [TOCICommand], True));
    FDataSetOptions.Add(TBooleanOption.Create('ScrollableCursor', prScrollableCursor, [TOCICommand], False));
  {$IFNDEF FPC}
    FDataSetOptions.Add(TBooleanOption.Create('RawAsString', prRawAsString, [TOCICommand], False));
  {$ENDIF}
    FDataSetOptions.Add(TBooleanOption.Create('TemporaryLobUpdate', prTemporaryLobUpdate, [TOCICommand], True));
    FDataSetOptions.Add(TBooleanOption.Create('StatementCache', prStatementCache, [TOCICommand], False));
    FDataSetOptions.Add(TBooleanOption.Create('ExtendedFieldsInfo', prExtendedFieldsInfo, [TOCIRecordSet], False));
    FDataSetOptions.Add(TStringOption.Create('KeySequence', prKeySequence, [TCustomOraDataSetService], ''));
    FDataSetOptions.Add(TEnumeratorOption.Create('SequenceMode', prSequenceMode, [TCustomOraDataSetService], Variant(_smPost), TypeInfo(_TSequenceMode)));
    FDataSetOptions.Add(TBooleanOption.Create('NonBlocking', prNonBlocking, [TOCICommand], False));
  end;
  Result := FDataSetOptions;
end;

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

function TOracleUniProvider.GetLoaderOptions: TOptionsList;
begin
  if FLoaderOptions = nil then begin
    FLoaderOptions := TOptionsList.Create(GetProviderName);
    FLoaderOptions.Add(TBooleanOption.Create('DirectPath', prDirectPath, [TOCILoader], True));
    FLoaderOptions.Add(TBooleanOption.Create('QuoteNames', prQuoteNames, [TOCILoader], False));
  end;
  Result := FLoaderOptions;
end;

{ TOraConnectDialogService }

function TOraConnectDialogService.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prDirect:
      FDirect := Value;
  else
    Result := inherited SetProp(Prop, Value);
  end;
end;

function TOraConnectDialogService.GetConnectMode: integer;
begin
  if FDirect then
    Result := 2
  else
    Result := 1;
end;

{ TOraSqlFormatter }

constructor TOraSqlFormatter.Create;
begin
  inherited;

  FFunctions := OraFunctions;
  FPredefinedMacros := OraMacros;
end;

function TOraSqlFormatter.GetFunction(const FunctionName: string; const Params: TStringArray): string;
begin
  if UpperCase(FunctionName) = 'DATEADD' then
    Result := GetDateAdd(Params)
  else
  if UpperCase(FunctionName) = 'DATEDIFF' then
    Result := GetDateDiff(Params)
  else
    Result := inherited GetFunction(FunctionName, Params);
end;

function TOraSqlFormatter.GetDateAdd(const Params: TStringArray): string;
var
  datepart, number, date: string;
begin
  if Length(Params) <> 3 then
    raise Exception.CreateFmt(SWrongArgCnt, ['DATEADD']);
  datepart := LowerCase(Params[0]);
  number := Params[1];
  date := Params[2];
  if datepart = 'year' then
    Result := ' ADD_MONTHS(' + date + ', (' + number + ')*12)'
  else
  if datepart = 'month' then
    Result := ' ADD_MONTHS(' + date + ', ' + number + ')'
  else
  if datepart = 'day' then
    Result := date + ' + ' + number
  else
  if datepart = 'hour' then
    Result := date + ' + (' + number + ')/24'
  else
  if datepart = 'minute' then
    Result := date + ' + (' + number + ')/1440'
  else
  if datepart = 'second' then
    Result := date + ' + (' + number + ')/86400'
  else
  if datepart = 'millisecond' then
    Result := date + ' + (' + number + ')/86400000'
  else
    raise Exception.CreateFmt(SUnknownDatepart, [Datepart]);
end;

function TOraSqlFormatter.GetDateDiff(const Params: TStringArray): string;
const
  monthFmt = '(EXTRACT(YEAR FROM %1:s) - EXTRACT(YEAR FROM %0:s))*12 + EXTRACT(MONTH FROM %1:s) - EXTRACT(MONTH FROM %0:s)';
var
  datepart, startDate, endDate: string;
begin
  if Length(Params) <> 3 then
    raise Exception.CreateFmt(SWrongArgCnt, ['DATEDIFF']);
  datepart := LowerCase(Params[0]);
  startDate := Params[1];
  endDate := Params[2];
  if datepart = 'year' then
    Result := Format('FLOOR((' + monthFmt + ')/12)', [startDate, endDate])
  else
  if datepart = 'month' then
    Result := Format(monthFmt, [startDate, endDate])
  else
  if datepart = 'day' then
    Result := 'FLOOR(' + endDate + ' - ' + startDate + ')'
  else
  if datepart = 'hour' then
    Result := '(' + endDate + ' - ' + startDate + ')*24'
  else
  if datepart = 'minute' then
    Result := '(' + endDate + ' - ' + startDate + ')*1440'
  else
  if datepart = 'second' then
    Result := '(' + endDate + ' - ' + startDate + ')*86400'
  else
  if datepart = 'millisecond' then
    Result := '(' + endDate + ' - ' + startDate + ')*86400000'
  else
    raise Exception.CreateFmt(SUnknownDatepart, [Datepart]);
end;

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

{ TUniOraScriptProcessor }

procedure TUniOraScriptProcessor.SetConnectMode(Connection: TCustomDAConnection;
  ConnectMode: TConnectMode);
begin
  SetSpecificOption(Connection, 'Oracle.ConnectMode', GetEnumName(TypeInfo (TConnectMode), Integer(ConnectMode)));
end;

initialization
  UniProviders.RegisterProvider(TOracleUniProvider);

  OraFunctions := TStrValueStringList.Create;
  OraFunctions.Add('USER',        'USER');
  OraFunctions.Add('CHAR_LENGTH', 'LENGTH(%s)');
  OraFunctions.Add('LOCATE',      'INSTR(%1:s, %0:s)');
  OraFunctions.Add('SUBSTRING',   'SUBSTR(%s, %s, %s)');
  OraFunctions.Add('CONCAT',      '%s || %s');
  OraFunctions.Add('CHAR',        'CHR(%s)');
  OraFunctions.Add('TRIM',        'TRIM(%s)');
  OraFunctions.Add('TRUNCATE',    'TRUNC(%s, %s)');
  OraFunctions.Add('CEILING',     'CEIL(%s)');
  // Date-time
  OraFunctions.Add('CURRENT_DATE', 'CURRENT_DATE');
  OraFunctions.Add('YEAR',         'EXTRACT(YEAR FROM %s)');
  OraFunctions.Add('MONTH',        'EXTRACT(MONTH FROM %s)');
  OraFunctions.Add('DAY',          'EXTRACT(DAY FROM %s)');
  // Date-time literals
  OraFunctions.Add('__DATE_TIME_LITERAL', 'TO_DATE(%s, ''yyyy-mm-dd hh:mi:ss'')');
  OraFunctions.Add('__DATE_LITERAL',      'TO_DATE(%s, ''yyyy-mm-dd'')');
  OraFunctions.Add('__TIME_LITERAL',      'TO_DATE(%s, ''hh:mi:ss'')');
  // CONVERT functions
  OraFunctions.Add('TODATE',   'TO_DATE(%s, ''yyyy-mm-dd hh:mi:ss'')');
  OraFunctions.Add('TONUMBER', 'TO_NUMBER(%s)');
  OraFunctions.Add('TOCHAR',   'TO_CHAR(%s)');

  OraMacros := TStrValueStringList.Create;
  OraMacros.Add('PROVIDER', 'Oracle');
  OraMacros.Add('ORACLE',   '');
  // DataType macros
  OraMacros.Add('DATETIME', 'DATE');
  OraMacros.Add('DOUBLE',   'NUMBER');
  OraMacros.Add('VARCHAR',  'VARCHAR2');

finalization
  UniProviders.UnRegisterProvider(TOracleUniProvider);

  OraFunctions.Free;
  OraMacros.Free;

end.
