unit uDARemoteDataAdapter;

{----------------------------------------------------------------------------}
{ 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
  Classes,
  uRODynamicRequest, uROClasses, uRORemoteService,
  DataAbstract4_Intf, uDADataAdapter, uDADataTable,
  uDARemoteDataAdapterRequests,uDADataStreamer;

const
  // from uDADataAdapter
  fbNone = uDADataAdapter.fbNone;
  fbRaiseException = uDADataAdapter.fbRaiseException;
  fbShowReconcile = uDADataAdapter.fbShowReconcile;
  fbBoth = uDADataAdapter.fbBoth;
type
  TDAReconcileDialogAction = uDADataAdapter.TDAReconcileDialogAction;

type
  TDARequestEvent = procedure(Sender: TObject; Request: TRODynamicRequest) of object;

  { TDARemoteDataAdapter }
  TDARemoteDataAdapter = class(TDABaseDataAdapter)
  private
    fGetDataCall: TDAGetDataRequest;
    fGetSchemaCall: TDAGetSchemaRequest;
    fUpdateDataCall: TDAUpdateDataRequest;
    fGetScriptsCall: TDAGetScriptsRequest;
    fRemoteService: TRORemoteService;
    fBeforeGetDataCall,    fAfterGetDataCall,
    fBeforeGetSchemaCall,  fAfterGetSchemaCall,
    fBeforeGetScriptsCall, fAfterGetScriptsCall,
    fBeforeUpdateDataCall, fAfterUpdateDataCall: TDARequestEvent;
    procedure DoGetSchemaCall;
    procedure FillTableNamesParam(aTables: array of TDADataTable; aParam: TRORequestParam);
    procedure SetRemoteService(const Value: TRORemoteService);
    procedure FillTableParams(aTables: array of TDADataTable; aParam: TRORequestParam);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Loaded; override;

    function InternalFillSchema(var aStream: TROBinaryMemoryStream): TRODataType; override;
    procedure InternalApplyUpdates(aTables,aTablesWithDetails: array of TDADataTable); override;
    function InternalFillScripts(aTables: array of TDADataTable): UTF8String; override;
    function InternalReadSchema: UTF8String;  override;
    procedure InternalFill(aTableArray: array of TDADataTable; aArray: TableRequestInfoArray; const aIncludeSchema, aAppendMode: boolean; aSavedOptions: TDATableOptionsArray);override;

    { backward compatibility: to provide access to these in the legacy events in TDADataTable}
    function Get_GetSchemaCall: TDARemoteRequest; override;
    function Get_GetDataCall: TDARemoteRequest; override;
    function Get_UpdateDataCall: TDARemoteRequest; override;
    function Get_GetScriptsCall: TDARemoteRequest; override;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure SetupDefaultRequestV3;
    procedure SetupDefaultRequest;
    procedure CheckProperties; override;
  published
    property GetSchemaCall: TDAGetSchemaRequest read fGetSchemaCall;
    property GetDataCall: TDAGetDataRequest read fGetDataCall;
    property UpdateDataCall: TDAUpdateDataRequest read fUpdateDataCall;
    property GetScriptsCall: TDAGetScriptsRequest read fGetScriptsCall;
    property RemoteService: TRORemoteService read fRemoteService write SetRemoteService;
    property CacheSchema;
    property DataStreamer;

    property BeforeGetDataCall: TDARequestEvent    read fBeforeGetDataCall    write fBeforeGetDataCall;
    property AfterGetDataCall: TDARequestEvent     read fAfterGetDataCall     write fAfterGetDataCall;
    property BeforeGetSchemaCall: TDARequestEvent  read fBeforeGetSchemaCall  write fBeforeGetSchemaCall;
    property AfterGetSchemaCall: TDARequestEvent   read fAfterGetSchemaCall   write fAfterGetSchemaCall;
    property BeforeGetScriptsCall: TDARequestEvent read fBeforeGetScriptsCall write fBeforeGetScriptsCall;
    property AfterGetScriptsCall: TDARequestEvent  read fAfterGetScriptsCall  write fAfterGetScriptsCall;
    property BeforeUpdateDataCall: TDARequestEvent read fBeforeUpdateDataCall write fBeforeUpdateDataCall;
    property AfterUpdateDataCall: TDARequestEvent  read fAfterUpdateDataCall  write fAfterUpdateDataCall;
  end;

implementation

uses
  SysUtils;

{ TDARemoteDataAdapter }

procedure TDARemoteDataAdapter.FillTableNamesParam(aTables: array of TDADataTable; aParam: TRORequestParam);
var
  lArray: StringArray;
  i: integer;
begin
  case aParam.DataType of
    rtString: begin // v3 style string
        if Length(aTables) <> 1 then
          raise Exception.Create('The current GetDataCall configuration does not allow fetching multiple data tables at once.');
        aParam.AsString := aTables[Low(aTables)].LogicalName;
      end;
    rtUserDefined: begin // v4 style string array
        lArray := StringArray.Create();
        lArray.Resize(Length(aTables));
        for i := Low(aTables) to High(aTables) do
          lArray[i-Low(aTables)] := UTF8Encode(aTables[i].LogicalName);
        aParam.AsComplexType := lArray;
        aParam.OwnsComplexType := true;
      end;
    rtUTF8String: aParam.AsUTF8String := GetTableNamesAsCommaText(aTables);
  end;
end;

procedure TDARemoteDataAdapter.FillTableParams(
  aTables: array of TDADataTable; aParam: TRORequestParam);
var
  lArray: DataParameterArray;
  lParam: DataParameter;
  lTable: TDADataTable;
  j: integer;
  lList: TStringList;
begin
  lArray:=nil; // prevert "W1036 Variable 'lArray' might not have been initialized"
  case aParam.DataType of
    rtString: begin // v3 style string
      if Length(aTables) <> 1 then raise Exception.Create('The current GetDataCall configuration does not allow fetching multiple data tables');
      with aTables[Low(aTables)].Params do begin
        if Count<>0 then begin
          lList:= TStringList.Create;
          try
            for j := 0 to Count - 1 do
              lList.Values[Params[j].Name]:=Params[j].AsString;
            aParam.AsString:= lList.Text;
          finally
            lList.Free;
          end;
        end;
      end;
    end;
    rtUserDefined: begin
      if aParam.TypeName = 'DataParameterArray' then
        lArray := DataParameterArray.Create();

        lTable := aTables[Low(aTables)];
        for j := 0 to lTable.Params.Count-1 do begin
          lParam := lArray.Add();
          lParam.Name := AnsiToUtf8(lTable.Params[j].Name);
          lParam.Value := lTable.Params[j].Value;
        end;

        aParam.AsComplexType := lArray;
        aParam.OwnsComplexType := true;
    end;
  end;
end;

procedure TDARemoteDataAdapter.DoGetSchemaCall;
begin
  //ToDo: handle aFilter parameter?
  if Assigned(fBeforeGetSchemaCall) then fBeforeGetSchemaCall(Self, GetSchemaCall);
  GetSchemaCall.Execute();
  if Assigned(fAfterGetSchemaCall) then fAfterGetSchemaCall(Self, GetSchemaCall);
end;

function TDARemoteDataAdapter.InternalFillScripts(aTables: array of TDADataTable): UTF8String;
var
  lParam: TDARemoteRequestParam;
  lResultParam: TRORequestParam;
begin
  if GetScriptsCall.MethodName = '' then
    raise Exception.Create('GetScriptsCall.MethodName must be configured to retrieve scripts.');
  try
    lParam := GetScriptsCall.Params.FindParam(GetScriptsCall.OutgoingTableNamesParameter);
    if assigned(lParam) then FillTableNamesParam(aTables, lParam);

    GetScriptsCall.Execute();

    lResultParam := GetScriptsCall.Params.FindParam(GetScriptsCall.IncomingScriptParameter);

    if not assigned(lResultParam) or not (lResultParam.DataType in [rtUTF8String, rtString]) then
      raise Exception.Create('Result parameter of GetScriptsCall is not properly defined.');

    if Assigned(fBeforeGetScriptsCall) then fBeforeGetScriptsCall(Self, GetScriptsCall);
    GetScriptsCall.Execute();
    if Assigned(fAfterGetScriptsCall) then fAfterGetScriptsCall(Self, GetScriptsCall);
    Result := UTF8String(lResultParam.AsAnsiString); { TODO : .AsUtf8String ? }
  finally
    lParam := GetScriptsCall.Params.FindParam(GetScriptsCall.OutgoingTableNamesParameter);
    if assigned(lParam) then lParam.ClearValue;
    lParam := GetScriptsCall.Params.FindParam(GetScriptsCall.IncomingScriptParameter);
    if assigned(lParam) then lParam.ClearValue;
  end;
end;


function TDARemoteDataAdapter.InternalReadSchema: UTF8String;
var
  lResultParam: TRORequestParam;
begin
  CheckProperties;
  lResultParam := GetSchemaCall.Params.FindParam(GetSchemaCall.IncomingSchemaParameter);
  try
    if not assigned(lResultParam) then
      raise Exception.Create('Result parameter of GetSchemaCall is not defined.');
    if not (lResultParam.DataType in [rtUTF8String,rtString]) then
      raise Exception.Create('Result parameter of GetSchemaCall is not properly defined as String.');
    DoGetSchemaCall();
    Result := UTF8String(lResultParam.AsAnsiString); //{ TODO : .ASUtf8String ? }
  finally
    if Assigned(lResultParam) then lResultParam.ClearValue;
  end;
end;

{$IFDEF FPC}
procedure List_Union(List1,List2: TList);
var
  i: integer;
begin
  if List1 = List2 then Exit;
  for i := 0 to List2.Count-1 do
    if List1.IndexOf(List2[i])=-1 then
       List1.Add(List2[i]);
end;
{$ENDIF}

procedure TDARemoteDataAdapter.InternalApplyUpdates(aTables,aTablesWithDetails: array of TDADataTable);
var
  i: integer;
  lParam, lResultparam: TRORequestParam;
begin
  try
    { Fill Input Parameters }
    lParam := UpdateDataCall.Params.FindParam(UpdateDataCall.OutgoingDeltaParameter);
    if not assigned(lParam) or (lParam.DataType <> rtBinary) then
      raise Exception.Create('OutgoingDeltaParameter parameter of UpdateDataCall is not properly defined.');
    lParam.ClearValue();

    DataStreamer.Initialize(lParam.AsBinary, aiWrite);
    try
      for i := Low(aTables) to High(aTables) do
        aTables[i].WriteDeltaToStream(DataStreamer);
    finally
      DataStreamer.Finalize;
    end;

    { Make call }
    if DataStreamer.DeltaCount > 0 then begin
      if Assigned(fBeforeUpdateDataCall) then fBeforeUpdateDataCall(Self, UpdateDataCall);
      UpdateDataCall.Execute();
      if Assigned(fAfterUpdateDataCall) then fAfterUpdateDataCall(Self, UpdateDataCall);

      { Get Output Parameters }
      if UpdateDataCall.IncomingDeltaParameter <> '' then begin // If the result parameter isn't set, we shouldn't check for a result.

        lResultParam := UpdateDataCall.Params.FindParam(UpdateDataCall.IncomingDeltaParameter);
        if not assigned(lResultParam) or (lResultParam.DataType <> rtBinary) then
          raise Exception.Create('IncomingDeltaParameter parameter of UpdateDataCall is not properly defined.');

        // Reads the incoming delta, including the details
        if assigned(lResultParam.AsBinary) and (lResultParam.AsBinary.Size > 0) then begin
            DataStreamer.Initialize(lResultParam.AsBinary, aiReadFromBeginning);
            try
              for i := Low(aTables) to High(aTables) do
                aTables[i].ReadDeltaFromStream(DataStreamer);
            finally
              DataStreamer.Finalize;
            end;
        end;
      end;
    end;
  finally
    lResultParam := UpdateDataCall.Params.FindParam(UpdateDataCall.IncomingDeltaParameter);
    if assigned(lResultParam) then lResultParam.ClearValue;
    lParam := UpdateDataCall.Params.FindParam(UpdateDataCall.OutgoingDeltaParameter);
    if assigned(lParam) then lParam.ClearValue;
  end;
end;

constructor TDARemoteDataAdapter.Create(aOwner: TComponent);
begin
  inherited;
  fGetSchemaCall := TDAGetSchemaRequest.Create(self);
  fGetDataCall := TDAGetDataRequest.Create(self);
  fUpdateDataCall := TDAUpdateDataRequest.Create(self);
  fGetScriptsCall := TDAGetScriptsRequest.Create(self);

  fGetSchemaCall.Name := 'GetSchemaCall';
  fGetDataCall.Name := 'GetDataCall';
  fUpdateDataCall.Name := 'UpdateDataCall';
  fGetScriptsCall.Name := 'GetScriptsCall';
  SetupDefaultRequest;
end;

destructor TDARemoteDataAdapter.Destroy;
begin
  RemoteService := nil;
  FreeAndNil(fGetSchemaCall);
  FreeAndNil(fGetDataCall);
  FreeAndNil(fUpdateDataCall);
  FreeAndNil(fGetScriptsCall);
  inherited;
end;

procedure TDARemoteDataAdapter.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = RemoteService) then fRemoteService := nil;
end;


procedure TDARemoteDataAdapter.SetRemoteService(const Value: TRORemoteService);
begin
  if Value <> fRemoteService then begin
    if assigned(fRemoteService) then fRemoteService.RORemoveFreeNotification(self);
    fRemoteService := Value;
    GetSchemaCall.RemoteService := fRemoteService;
    GetDataCall.RemoteService := fRemoteService;
    UpdateDataCall.RemoteService := fRemoteService;
    GetScriptsCall.RemoteService := fRemoteService;
    if assigned(fRemoteService) then fRemoteService.ROFreeNotification(self);
  end;
end;

{ Schema }
function TDARemoteDataAdapter.Get_GetDataCall: TDARemoteRequest;
begin
  result := GetDataCall;
end;

function TDARemoteDataAdapter.Get_GetSchemaCall: TDARemoteRequest;
begin
  result := GetSchemaCall;
end;

function TDARemoteDataAdapter.Get_GetScriptsCall: TDARemoteRequest;
begin
  result := GetScriptsCall;
end;

function TDARemoteDataAdapter.Get_UpdateDataCall: TDARemoteRequest;
begin
  result := UpdateDataCall; 
end;

procedure TDARemoteDataAdapter.SetupDefaultRequest;
begin
  GetSchemaCall.SetupDefaultRequest();
  GetDataCall.SetupDefaultRequest();
  UpdateDataCall.SetupDefaultRequest();
  GetScriptsCall.SetupDefaultRequest();
end;

procedure TDARemoteDataAdapter.SetupDefaultRequestV3;
begin
  GetSchemaCall.SetupDefaultRequestV3();
  GetDataCall.SetupDefaultRequestV3();
  UpdateDataCall.SetupDefaultRequestV3();
  GetScriptsCall.SetupDefaultRequestV3();
end;

procedure TDARemoteDataAdapter.Assign(Source: TPersistent);
var
  lSource: TDARemoteDataAdapter;
begin
  inherited;
  if Source is TDARemoteDataAdapter then begin
    lSource := TDARemoteDataAdapter(Source);

    AfterGetDataCall := lSource.AfterGetDataCall;
    AfterGetSchemaCall := lSource.AfterGetSchemaCall;
    AfterGetScriptsCall := lSource.AfterGetScriptsCall;
    AfterUpdateDataCall := lSource.AfterUpdateDataCall;
    BeforeGetDataCall := lSource.BeforeGetDataCall;
    BeforeGetSchemaCall := lSource.BeforeGetSchemaCall;
    BeforeGetScriptsCall := lSource.BeforeGetScriptsCall;
    BeforeUpdateDataCall := lSource.BeforeUpdateDataCall;
    GetDataCall.Assign(lSource.GetDataCall);
    GetSchemaCall.Assign(lSource.GetSchemaCall);
    GetScriptsCall.Assign(lSource.GetScriptsCall);
    RemoteService := lSource.RemoteService;
    UpdateDataCall.Assign(lSource.UpdateDataCall);
  end;
end;

procedure TDARemoteDataAdapter.CheckProperties;
begin
  inherited;
  Check(not assigned(DataStreamer), Name + '.DataStreamer must be assigned.');
  Check(not assigned(RemoteService), Name + '.RemoteService must be assigned.');
  RemoteService.CheckProperties();
end;

procedure TDARemoteDataAdapter.Loaded;
begin
  inherited;
  {$IFDEF DELPHI6}
  // Delphi 6 doesn't call Loaded of any of the sub components.
  fGetDataCall.Loaded;
  fGetSchemaCall.Loaded;
  fUpdateDataCall.Loaded;
  fGetScriptsCall.Loaded;
  {$ENDIF}
end;


procedure TDARemoteDataAdapter.InternalFill(aTableArray: array of TDADataTable;
  aArray: TableRequestInfoArray; const aIncludeSchema, aAppendMode: boolean; aSavedOptions: TDATableOptionsArray);
var
  lParam, lResultParam: TRORequestParam;
  lHasTableNamesParameter: Boolean;
  i: integer;
  ltbl: TDADataTable;
  lLogicalName: string;
begin
  try
    lParam := GetDataCall.Params.FindParam(GetDataCall.OutgoingTableNamesParameter);
    lHasTableNamesParameter := assigned(lParam);
    if lHasTableNamesParameter then
      FillTableNamesParam(aTableArray, lParam)
    else if Length(aTableArray) <> 1 then
      raise Exception.Create('The current GetDataCall configuration does not allow fetching multiple data tables');

    if Length(GetDataCall.OutgoingTableRequestInfosParameter) > 0 then begin
      lParam := GetDataCall.Params.FindParam(GetDataCall.OutgoingTableRequestInfosParameter);
      if Assigned(lParam) then begin
        if (lParam.DataType = rtUserDefined) and (lParam.TypeName = 'TableRequestInfoArray') then begin
          lParam.AsComplexType := aArray;
        end;
      end;
    end;

    if (GetDataCall.OutgoingParamsParameter <> '') then begin // v3 style call
      lParam := GetDataCall.Params.FindParam(GetDataCall.OutgoingParamsParameter);
      if Assigned(lParam) then
        FillTableParams(aTableArray, lParam);
    end;

    if (GetDataCall.OutgoingMaxRecordsParameter <> '') then begin // v3 style call
      if Length(aTableArray) <> 1 then
        for i := 0 to High(aTableArray) do
          if aTableArray[i].MaxRecords <> -1 then
            raise Exception.Create('The current GetDataCall configuration does not allow fetching multiple data tables with a limited record count.');
      lParam := GetDataCall.Params.FindParam(GetDataCall.OutgoingMaxRecordsParameter);
      if Assigned(lParam) and (Length(aTableArray) > 0) then lParam.AsInteger := aTableArray[0].MaxRecords;
    end;

    if (GetDataCall.OutgoingIncludeSchemaParameter <> '') then begin // v3 style call
      lParam := GetDataCall.Params.FindParam(GetDataCall.OutgoingIncludeSchemaParameter);
      if Assigned(lParam) then lParam.AsBoolean := aIncludeSchema;
    end;

    if Assigned(fBeforeGetDataCall) then fBeforeGetDataCall(Self, GetDataCall);

    GetDataCall.Execute();
    lResultParam := GetDataCall.Params.FindParam(GetDataCall.IncomingDataParameter);

    if Assigned(fAfterGetDataCall) then fAfterGetDataCall(Self, GetDataCall);

    if not assigned(lResultParam) or (lResultParam.DataType <> rtBinary) then
      raise Exception.Create('Result parameter of GetDataCall is not properly defined.');

    if not assigned(lResultParam.AsBinary) then raise Exception.Create('The server returned a nil buffer.');

    // Reads the data
    DataStreamer.Initialize(lResultParam.AsBinary, aiRead);
    try
      // part 1 - reading schema
      for i := Low(aTableArray) to High(aTableArray) do
      begin
        ltbl:= aTableArray[i];
        if aArray[i].IncludeSchema  and not (soIgnoreStreamSchema in ltbl.StreamingOptions) then begin
          aSavedOptions[i].AppendMode := False;
          if not lHasTableNamesParameter and (DataStreamer.DatasetCount = 1) then
            DataStreamer.ReadDataset(DataStreamer.DatasetNames[0],  ltbl, true, false)
          else
            DataStreamer.ReadDataset(ltbl.LogicalName,  ltbl, true, false);
        end;
        if not ltbl.Active then  ltbl.InitializeDataTable;
        //end;
      end;
      if AutoFillScripts then FillScripts(aTableArray);
      // part 2 - reading data
      for i := Low(aTableArray) to High(aTableArray) do begin
        ltbl:= aTableArray[i];

        if not lHasTableNamesParameter and (DataStreamer.DatasetCount = 1) then
          lLogicalName:=DataStreamer.DatasetNames[0]
        else
          lLogicalName:=ltbl.LogicalName;

        DataStreamer.ReadDataset(lLogicalName,  ltbl, false, true, aSavedOptions[i].AppendMode);
        if not aAppendMode and (moAllInOneFetch in ltbl.MasterOptions) then ltbl.DoCascadeOperation(DataStreamer, moAllInOneFetch);
      end;
    finally
      DataStreamer.Finalize;
    end;


  finally
    lParam := GetDataCall.Params.FindParam(GetDataCall.OutgoingTableRequestInfosParameter);
    if Assigned(lParam) then lParam.ClearValue;
    lParam := GetDataCall.Params.FindParam(GetDataCall.OutgoingParamsParameter);
    if Assigned(lParam) then lParam.ClearValue;
    lParam := GetDataCall.Params.FindParam(GetDataCall.IncomingDataParameter);
    if Assigned(lParam) then lParam.ClearValue;
  end;
end;

function TDARemoteDataAdapter.InternalFillSchema(var aStream: TROBinaryMemoryStream): TRODataType;
var
  lResultParam: TRORequestParam;
begin
  lResultParam := GetSchemaCall.Params.FindParam(GetSchemaCall.IncomingSchemaParameter);
  if not assigned(lResultParam) then raise Exception.Create('Result parameter of GetSchemaCall is not defined.');
  Result := lResultParam.DataType;
  try
    case Result of
      rtBinary:begin
          DoGetSchemaCall();
          if not assigned(lResultParam.AsBinary) or (lResultParam.AsBinary.Size = 0 ) then
            raise Exception.Create('Server returned an empty buffer for schema.');
          aStream := TROBinaryMemoryStream.Create;
          aStream.CopyFrom(lResultParam.AsBinary,0);
        end;
      rtString, rtUTF8String: begin
          Schema;
        end;
    end;
  finally
    if Assigned(lResultParam) then lResultParam.ClearValue;
  end;
end;

end.