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

{$IFNDEF CLR}

{$I PgDac.inc}
unit PgServicesUni;

{$ENDIF}

interface

uses
  Classes, SysUtils, Variants, DB,
{$IFNDEF CLR}
  CLRClasses,
{$ELSE}
  System.Text,  
{$ENDIF}
  CRTypes, CRFunctions, CRAccess,
  MemData, {$IFNDEF FPC}MemDS{$ELSE}MemDataSet{$ENDIF},
  DBAccess, DADump, DASQLGenerator;

const
  prAutoDeleteBlob = 101;
  prSequenceMode   = 102;

type
  TCustomPgDataSetService = class;

  TCustomPgFieldTypeMap = class(TDAFieldTypeMap)
  public
    class function GetFieldType(DataType: Word): TFieldType; override;
    class function GetDataType(FieldType: TFieldType): integer; override;
  end;

  TCustomPgDataSetUpdater = class(TDADataSetUpdater)
  private
    procedure GetSequenceNextVal;
  protected
    FDataSetService: TCustomPgDataSetService;

    function GetUpdateObject: TCustomDAUpdateSQL;
    procedure CheckUpdateQuery(const StatementType: TStatementType); override;

    function BatchUpdate: boolean; override;
    function UseParamType(Param: TDAParam): boolean; override;
    function ReturnParamsAsFields: boolean; override;

    procedure CheckUpdateSQL(const SQL: string; const StatementTypes: TStatementTypes;
      out ParamsInfo: TDAParamsInfo; UseGenerator: boolean = True); override;
    procedure SetUpdateQueryOptions(const StatementType: TStatementType); override;

    procedure PrepareAppend; override;
    function PerformAppend: boolean; override;
  public
    constructor Create(AOwner: TDataSetService); override;

    function PerformSQL(const SQL: string; const StatementTypes: TStatementTypes): boolean; override;
  end;

  TCustomPgDataSetService = class(TDADataSetService)
  private
    FAutoDeleteBlob: boolean;

    function SequenceRequestOnInsert: boolean;
    function SequenceRequestOnPost: boolean;
    function SequenceRequestUseReturning: boolean;

  protected
    FUpdater: TCustomPgDataSetUpdater;

    function GetIRecordSet: TCRRecordSet;
    function UsedConnection: TCustomDAConnection;

    procedure CreateSQLGenerator; override;
    procedure CreateDataSetUpdater; override;
    procedure SetDataSetUpdater(Value: TDataSetUpdater); override;

    procedure InitCursor; override;
    function DetectCanModify: boolean; override;
    function GetCurrentSchema: string; override;
    function GetRecCount: integer; override;

  public
    function OpenNext: boolean; override;

    function SetProp(Prop: integer; const Value: variant): boolean; override;
  end;

  TPgServerEnumerator = class (TCRServerEnumerator)
  public
    procedure GetServerList(List: TStrings); override;
  end;

  TCustomPgDumpProcessor = class(TDADumpProcessor)
  protected
    FCurSchema: string;

    procedure CheckTables(const QueryText: string); override;
    procedure BackupObjects(const QueryText: string); override;
    function CreateQuery: TCustomDADataSet; override;
    procedure BackupData(const Schema, TableName, QueryText: string; TableNum, TableCount: integer); reintroduce;

  public
    constructor Create(Owner: TDADump); override;
    destructor Destroy; override;
  end;

implementation

uses
  CRParser, MemUtils, DAConsts, DASQLMonitor,
{$IFNDEF UNIDACPRO}
  PgConsts, PgParser, PgObjects, PgClasses, PgSQLGenerator;
{$ELSE}
  PgConstsUni, PgParserUni, PgObjectsUni, PgClassesUni, PgSQLGeneratorUni;
{$ENDIF}

{ TCustomPgFieldTypeMap }

class function TCustomPgFieldTypeMap.GetFieldType(DataType: Word): TFieldType;
begin
  case DataType of
    dtPgLargeObject:
      Result := ftOraBlob;
  else
    Result := inherited GetFieldType(DataType);
  end;
end;

class function TCustomPgFieldTypeMap.GetDataType(FieldType: TFieldType): integer;
begin
  case FieldType of
    ftOraBlob:
      Result := dtPgLargeObject;
  else
    Result := inherited GetDataType(FieldType);
  end;
end;

{ TCustomPgDataSetUpdater }

constructor TCustomPgDataSetUpdater.Create(AOwner: TDataSetService);
begin
  inherited Create(AOwner);

  FDataSetService := TCustomPgDataSetService(AOwner);
end;

function TCustomPgDataSetUpdater.GetUpdateObject: TCustomDAUpdateSQL;
begin
  Result := inherited GetUpdateObject;
end;

procedure TCustomPgDataSetUpdater.CheckUpdateQuery(const StatementType: TStatementType);
begin
  inherited;
end;

function TCustomPgDataSetUpdater.PerformSQL(const SQL: string; const StatementTypes: TStatementTypes): boolean;
var
  i: integer;
  FieldDesc: TFieldDesc;
  IsDelete: boolean;
  lo: TPgSQLLargeObject;
begin
  Result := inherited PerformSQL(SQL, StatementTypes);

  IsDelete := stDelete in StatementTypes;

  if IsDelete and FDataSetService.FAutoDeleteBlob then
    for i := 0 to FDataSet.Fields.Count - 1 do begin
      FieldDesc := FDataSet.GetFieldDesc(FDataSet.Fields[i]);
      if FieldDesc.DataType = dtPgLargeObject then begin
        lo := TPgSQLLargeObject(GetIRecordSet.GetObject(FieldDesc, IntPtr(FDataSet.ActiveBuffer)));
        if lo.IsCreated then
          lo.UnlinkObject;
      end;
    end;
end;

function TCustomPgDataSetUpdater.BatchUpdate: boolean;
begin
  Result := False;
end;

function TCustomPgDataSetUpdater.UseParamType(Param: TDAParam): boolean;
begin
  Result := True;
end;

function TCustomPgDataSetUpdater.ReturnParamsAsFields: boolean;
begin
  Result := True;
end;

procedure TCustomPgDataSetUpdater.CheckUpdateSQL(const SQL: string;
  const StatementTypes: TStatementTypes; out ParamsInfo: TDAParamsInfo; UseGenerator: boolean = True);
var
  Offset, i: integer;
  ICommand: TPgSQLCommand;
  ParamInfo: TPgParamInfo;
begin
  inherited;

  if ParamsInfo = nil then
    Exit;

  if UseSQLGeneratorParams(StatementTypes) then begin
    if IsClass(FUpdateQuery, TCustomDADataSet) then
      ICommand := TPgSQLCommand(TDBAccessUtils.GetICommand(TCustomDADataSet(FUpdateQuery)))
    else
    if IsClass(FUpdateQuery, TCustomDASQL) then
      ICommand := TPgSQLCommand(TDBAccessUtils.GetICommand(TCustomDASQL(FUpdateQuery)))
    else begin
      ICommand := nil;
      Assert(False);
    end;

    ICommand.ClearPlaceHolders;
    for i := 0 to ParamsInfo.Count - 1 do begin
      ParamInfo := TPgParamInfo(ParamsInfo.Items[i]);
      Offset := TCustomPgSQLGenerator(FDataSetService.SQLGenerator).GetParamOffset(i);
      ICommand.AddPlaceHolder(Offset + ParamInfo.Position, Offset + ParamInfo.EndPosition, nil);
    end;
  end;
end;

procedure TCustomPgDataSetUpdater.SetUpdateQueryOptions(const StatementType: TStatementType);
var
  DestRecordSet, SourceRecordSet: TCRRecordSet;

  procedure CopyPropR(Prop: integer);
  var
    v: variant;
  begin
    SourceRecordSet.GetProp(Prop, v);
    DestRecordSet.SetProp(Prop, v);
  end;

begin
  CheckIRecordSet; // can be inactive
  SourceRecordSet := GetIRecordSet;
  DestRecordSet := TDBAccessUtils.GetIRecordSet(FUpdateQuery as TCustomDADataSet);

  CopyPropR(prOIDAsInt);
  CopyPropR(prCacheBlobs);
  CopyPropR(prCommandTimeOut);
  CopyPropR(prUnknownAsString);
  CopyPropR(prSimpleQueryExecute);
  CopyPropR(prUseParamTypes);

  DestRecordSet.SetProp(prExtendedFieldsInfo, False);
end;

procedure TCustomPgDataSetUpdater.PrepareAppend;
begin
  if FDataSetService.SequenceRequestOnInsert then
    GetSequenceNextVal;
end;

function TCustomPgDataSetUpdater.PerformAppend: boolean;
var
  OldReturnParams: boolean;
  RequestSeq: boolean;
  RequestSeqInRet: boolean;
begin
  OldReturnParams := FDataSet.Options.ReturnParams;

  RequestSeq := FDataSetService.SequenceRequestOnPost;
  RequestSeqInRet := FDataSetService.SequenceRequestUseReturning;
  TCustomPgSQLGenerator(FDataSetService.SQLGenerator).SequenceRequestUseReturning := RequestSeqInRet;

  if RequestSeqInRet then
    FDataSet.Options.ReturnParams := True; //To retrieve sequence value

  try
    if RequestSeq and not RequestSeqInRet then
      GetSequenceNextVal;

    Result := inherited PerformAppend;
  finally
    if RequestSeqInRet then
      FDataSet.Options.ReturnParams := OldReturnParams;
  end;
end;

procedure TCustomPgDataSetUpdater.GetSequenceNextVal;
var
  Value: variant;
begin
  Value := SelectDBValue('Get sequence value',
    Format('SELECT NEXTVAL(%s)', [PgSQLInfo.ToStringConst(FDataSetService.SQLGenerator.KeySequence)]));
  FDataSetService.SetKeyGeneratorValue(Value);
end;

{ TCustomPgDataSetService }

function TCustomPgDataSetService.OpenNext: boolean;
var
  Cursor: TPgCursor;
begin
  if not FDataSet.Active then begin
    FDataSet.Open;
    Result := True;
  end
  else begin
    Cursor := TPgSQLCommand(GetIRecordSet.GetCommand).GetNextCursor;
    if Cursor <> nil then begin
      FDataSet.Close;
      TDBAccessUtils.SetCursor(FDataSet, Cursor);
      FDataSet.Open;
      Result := True;
    end
    else
      Result := False;
  end;    
end;

function TCustomPgDataSetService.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prAutoDeleteBlob:
      FAutoDeleteBlob := Value;
    prSequenceMode:
      TCustomPgSQLGenerator(SQLGenerator).SequenceMode := _TSequenceMode(Value);
  else
    Result := inherited SetProp(Prop, Value);
  end;
end;

function TCustomPgDataSetService.GetIRecordSet: TCRRecordSet;
begin
  Result := inherited GetIRecordSet;
end;

function TCustomPgDataSetService.UsedConnection: TCustomDAConnection;
begin
  Result := inherited UsedConnection;
end;

procedure TCustomPgDataSetService.CreateSQLGenerator;
begin
  SetSQLGenerator(TCustomPgSQLGenerator.Create(TDASQLGeneratorService));
end;

procedure TCustomPgDataSetService.CreateDataSetUpdater;
begin
  SetDataSetUpdater(TCustomPgDataSetUpdater.Create(Self));
end;

procedure TCustomPgDataSetService.SetDataSetUpdater(Value: TDataSetUpdater);
begin
  inherited;

  FUpdater := TCustomPgDataSetUpdater(Value);
end;

procedure TCustomPgDataSetService.InitCursor;
{$IFNDEF FPC}
var
  i: integer;
  RecordSet: TPgSQLRecordSet;
  FieldDesc: TPgSQLFieldDesc;
  Field: TField;
{$ENDIF}
begin
  inherited;

{$IFNDEF FPC}
  RecordSet := TPgSQLRecordSet(GetIRecordSet);
  for i := 0 to RecordSet.Fields.Count - 1 do begin
    FieldDesc := TPgSQLFieldDesc(RecordSet.Fields[i]);
    if FieldDesc.IsAutoIncrement then begin
      Field := FDataSet.GetField(FieldDesc);
      if Field <> nil then
        Field.AutoGenerateValue := arAutoInc;
    end;
  end;
{$ENDIF}
end;

function TCustomPgDataSetService.DetectCanModify: boolean;
begin
  Result := inherited DetectCanModify or
    not FDataSet.ReadOnly and FIsAnyFieldCanBeModified;
end;

function TCustomPgDataSetService.GetCurrentSchema: string;
begin
  Result := TPgSQLConnection(TDBAccessUtils.GetIConnection(UsedConnection)).GetCachedSchema;
  // to preserve character case
  Result := '"' + Result + '"';
end;

function TCustomPgDataSetService.GetRecCount: integer;
var
  St: string;
  UpdateQuery: TCustomDADataSet;
  MonitorClass: TDASQLMonitorClass;
  MessageID: cardinal;
begin
  Result := 0;
  St := Trim(FDataSet.SQLRecCount.Text);
  if St = '' then
    St := FSQLGenerator.GenerateRecCountSQL;

  FUpdater.CheckUpdateQuery(stCustom);
  UpdateQuery := TCustomDADataSet(FUpdater.UpdateQuery);
  UpdateQuery.SQL.Text := St;
  UpdateQuery.Params.Assign(FDataSet.Params);

  MonitorClass := TDASQLMonitorClass(TDBAccessUtils.SQLMonitorClass(UsedConnection));
  if MonitorClass.HasMonitor or FDataSet.Debug then
    MonitorClass.SQLExecute(FDataSet, St, UpdateQuery.Params, 'Get RecordCount', MessageID, True);

  UpdateQuery.Open;
  if not UpdateQuery.EOF then
    Result := UpdateQuery.Fields[0].AsInteger;

  if MonitorClass.HasMonitor or FDataSet.Debug then
    MonitorClass.SQLExecute(FDataSet, St, UpdateQuery.Params, 'Get RecordCount', MessageID, False);
end;

function TCustomPgDataSetService.SequenceRequestOnInsert: boolean;
begin
  Result := (KeyGeneratorField <> nil) and (TCustomPgSQLGenerator(SQLGenerator).SequenceMode = _smInsert);
end;

function TCustomPgDataSetService.SequenceRequestOnPost: boolean;
begin
  Result := (KeyGeneratorField <> nil) and (TCustomPgSQLGenerator(SQLGenerator).SequenceMode = _smPost);
end;

function TCustomPgDataSetService.SequenceRequestUseReturning: boolean;
begin
  Result :=
    SequenceRequestOnPost and
    (FDataSet.SQLInsert.Text = '') and
    ((FUpdater.GetUpdateObject = nil) or
    ((FUpdater.GetUpdateObject.InsertObject = nil) and
    (FUpdater.GetUpdateObject.InsertSQL.Text = ''))) and
    TPgSQLConnection(TDBAccessUtils.GetIConnection(UsedConnection)).VersionIsEqualOrHigher(8, 2); 
end;

{ TPgServerEnumerator }

procedure TPgServerEnumerator.GetServerList(List: TStrings);
{$IFDEF MSWINDOWS}
var
  List1: TStringList;
{$ENDIF}
begin
{$IFDEF MSWINDOWS}
  List1 := TStringList.Create;
  try
    CRNetManager.GetServerList(List1, 'postgresql');
    AssignStrings(List1, List);
  finally
    List1.Free;
  end;
{$ENDIF}
end;

{ TCustomPgDumpProcessor }

constructor TCustomPgDumpProcessor.Create(Owner: TDADump);
begin
  inherited Create(Owner);
end;

destructor TCustomPgDumpProcessor.Destroy;
begin
  inherited;
end;

procedure TCustomPgDumpProcessor.CheckTables(const QueryText: string);
var
  TablesInfo: TCRTablesInfo;
begin
  if QueryText <> '' then begin
    CheckQuery;
    GetTables.Clear;
    TablesInfo := TCRTablesInfo.Create(TCRTableInfo);
    try
      SQLInfo.ParseTablesInfo(QueryText, TablesInfo);
      if TablesInfo.Count <> 1 then
        raise Exception.Create(SBackupQueryWrongTableCount);
      GetTables.Add(TablesInfo[0].TableName);
    finally
      TablesInfo.Free;
    end;
  end
  else
    inherited;
end;

procedure TCustomPgDumpProcessor.BackupObjects(const QueryText: string);
var
  i, p: integer;
  TableName, Schema: string;
  TablesList: TStringList;
  ExactNames: boolean;
begin
  CheckQuery;
  TablesList := TStringList.Create;
  try
    if GetTables.Count = 0 then begin
      GetConnection.GetTableNames(TablesList, False, True);
      ExactNames := True;
    end
    else begin
      TablesList.Assign(GetTables);
      ExactNames := False;
    end;

    FCurSchema := '';
    for i := 0 to TablesList.Count - 1 do begin
      TableName := TablesList[i];
      p := Pos('.', TableName);
      if (p > 0) and not SQLInfo.IsQuoted(TableName) then begin
        Schema := SQLInfo.NormalizeName(Copy(TableName, 1, p - 1), FOwner.Options.QuoteNames);
        TableName := Copy(TableName, p + 1, MaxInt);
      end
      else begin
        Schema := TPgSQLConnection(TDBAccessUtils.GetIConnection(GetConnection)).GetCachedSchema;
        Schema := QuoteName(Schema);
      end;

      if ExactNames then
        TableName := QuoteName(TableName)
      else
        TableName := SQLInfo.NormalizeName(TableName, FOwner.Options.QuoteNames);

      if FCurSchema <> Schema then begin
        FCurSchema := Schema;
        Add('');
        Add(Format('SET search_path = %s, pg_catalog;', [Schema]));
      end;

      BackupData(Schema, TableName, QueryText, i + 1, TablesList.Count);
    end;
  finally
    TablesList.Free;
  end;
end;

function TCustomPgDumpProcessor.CreateQuery: TCustomDADataSet;
begin
  Result := GetConnection.CreateDataSet;
  Result.ReadOnly := True;
  Result.UniDirectional := True;
  TDBAccessUtils.CheckConnection(Result);
  TDBAccessUtils.GetIRecordSet(Result).SetProp(prExtendedFieldsInfo, False);
  TDBAccessUtils.GetIRecordSet(Result).SetProp(prOIDAsInt, True);
end;

procedure TCustomPgDumpProcessor.BackupData(const Schema, TableName, QueryText: string;
  TableNum, TableCount: integer);
var
  Query: TCustomDADataSet;
  i: integer;
  FieldList, Sql, Header: string;
begin
  Query := CreateQuery;
  try
    //TDBAccessUtils.CheckConnection(Query);
    TDBAccessUtils.GetIRecordSet(Query).SetProp(prFieldsAsText, True);

    if QueryText <> '' then
      Query.SQL.Text := QueryText
    else
      Query.SQL.Text := 'SELECT * FROM ' + Schema + '.' + TableName;

    if Assigned(FOwner.OnBackupProgress) then
      Query.Options.QueryRecCount := true
    else
      Query.Options.QueryRecCount := false;

    Query.Open;

    Add('');
    if FOwner.Options.AddDrop then
      Add('DELETE FROM ' + TableName + ';');

    if Query.RecordCount = 0 then
      exit;

    Header := 'INSERT INTO ' + TableName;
    if FOwner.Options.CompleteInsert then begin
      FieldList := '';
      for i := 0 to Query.Fields.Count - 1 do begin
        if i > 0 then
          FieldList := FieldList + ', ';
        FieldList := FieldList + QuoteName(Query.Fields[i].FieldName);
      end;
      Header := Header + '(' + FieldList + ')';
    end;
    Header := Header + ' VALUES (';

    while not Query.Eof do begin
      Sql := '';
      for i := 0 to Query.Fields.Count - 1 do begin
        if i > 0 then
          Sql := Sql + ', ';
        if Query.Fields[i].IsNull then
          Sql := Sql + 'NULL'
        else begin
          Sql := Sql + string(TPgTextConverter.ValueToText(Query.Fields[i].Value, dtString, dtString, False, True, False,
            TPgSQLConnection(TDBAccessUtils.GetIConnection(Query.Connection)).VersionIsEqualOrHigher(9, 0)));
        end;
      end;
      Sql := Header + Sql + ');';
      Add(Sql);

      DoBackupProgress(TableName, TableNum, TableCount, Trunc((Query.RecNo / Query.RecordCount) * 100));

      Query.Next;
    end;
    Query.Close;
  finally
    Query.Free;
  end;
end;

end.
