unit uROAsync;

{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Core Library                                      }
{                                                                            }
{ compiler: Delphi 5 and up, Kylix 2 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Using this code requires a valid license of the RemObjects SDK             }
{ which can be obtained at http://www.remobjects.com.                        }
{----------------------------------------------------------------------------}

{$I RemObjects.inc}

interface

uses Classes, SyncObjs, SysUtils,
     uROClientIntf, uROClasses, uROThread, uROTypes, uROClient;

type
  IROAsyncInterface = interface
    ['{E858979E-78C4-4AE1-A708-9E6766FDD9B4}']
    function GetBusy:Boolean;
    function GetMessageID:string;
    procedure SetMessageID(aMessageID:string);
    function GetAnswerReceived:Boolean;
    function GetAnswerReceivedEvent:TROEvent;
    property Busy:Boolean read GetBusy;
    property MessageID:string read GetMessageID write SetMessageID;
    property AnswerReceived:Boolean read GetAnswerReceived;
    property AnswerReceivedEvent:TROEvent read GetAnswerReceivedEvent;
  end;

  IROAsyncTransportChannel = interface
    ['{206811E7-ABE9-41E6-893C-33DA14E44FF6}']
    function InvokeRequest(aRequest:TStream; iGetResponse:boolean=true):string;
    procedure RetrieveResponse(const iMessageID:string; aResponse:TStream);
    function CheckStatus(const iMessageID:string):boolean;
  end;

  IROActiveAsyncTransportChannel = interface(IROAsyncTransportChannel)
    ['{3FC70749-3F4C-4D6A-AB30-01E0E03A25F4}']
    function InvokeRequest(aRequest:TStream; aGetResponse:boolean=true; aEvent: TROEvent=nil):string;
  end;

  IROTransportChannelEx = interface
    ['{96C85DD3-6372-49DF-B259-04BCD5C0E369}']
    procedure BeforeDispatch(aMessage: IROMessage);
  end;

  EROAsyncException = class(EROException);
  EROAsyncNoAnswerYet = class(EROAsyncException);
  EROAsyncNoMoreAnswers = class(EROAsyncException);

  TROAsyncProxy = class;

  TROAsyncProxyThread = class(TROThread)
  private
    fOwner:TROAsyncProxy;
    fGetResponse:boolean;
    fRequest:TStream;
  protected
    procedure Execute; override;
  public
    constructor Create(iOwner:TROAsyncProxy; const iName:string; iRequest:TStream; iGetResponse:boolean);
    destructor Destroy; override;
  end;

  TROAsyncProxy = class(TInterfacedObject, IUnknown, IROAsyncInterface)
  private
    fCriticalSection:TCriticalSection;
    fMessage:IROMessage;
    fTransportChannel:IROTransportChannel;
    fAsyncTransportChannel:IROAsyncTransportChannel;
    fActiveAsyncTransportChannel:IROActiveAsyncTransportChannel;
    fBeforeDispatch: IROTransportChannelEx;
    fBusy:Boolean;
    fAnswerReceived:Boolean;
    fAnswerReceivedEvent: TROEvent;
    fMethodName:string;
    fMessageID:string;
    fResponse:TStream;

  protected
    procedure __AssertProxyNotBusy(const iMethodName:string);
    procedure __DispatchAsyncRequest(const iMethodName:string; iRequest:TStream; iGetResponse:boolean=true); overload;
    procedure __DispatchAsyncRequest(const iMethodName:string; iRequest:IROMessage; iGetResponse:boolean=true); overload;
    function __RetrieveAsyncResponse(const iMethodName:string):TStream;
    property __Message:IROMessage read fMessage;
    property __TransportChannel:IROTransportChannel read fTransportChannel;

    function __GetInterfaceName:string; virtual; abstract;

    function GetBusy:Boolean;
    function GetMessageID:string;
    procedure SetMessageID(aMessageID:string);
    function GetAnswerReceived:Boolean;
    function GetAnswerReceivedEvent:TROEvent;
    property __InterfaceName:string read __GetInterfaceName;

    property __CriticalSection: TCriticalSection read fCriticalSection;

  public
    constructor Create(const aMessage : IROMessage; const aTransportChannel : IROTransportChannel); virtual;
    destructor Destroy; override;
    property Busy:Boolean read fBusy;
    property AnswerReceived:Boolean read fAnswerReceived;
    property MessageID:string read GetMessageID write SetMessageID;
  end;

const
  REQUEST_MESSAGE_PREFIX  = 'ROSDK REQUEST';
  RESPONSE_MESSAGE_PREFIX = 'ROSDK RESPONSE';

implementation

{ TROAsyncProxy }

constructor TROAsyncProxy.Create(const aMessage: IROMessage; const aTransportChannel: IROTransportChannel);
begin
  fMessage := aMessage;
  fTransportChannel := aTransportChannel;
  Supports(fTransportChannel, IROAsyncTransportChannel, fAsyncTransportChannel);
  Supports(fTransportChannel, IROActiveAsyncTransportChannel, fActiveAsyncTransportChannel);
  Supports(fTransportChannel, IROTransportChannelEx, fBeforeDispatch);

  fCriticalSection := TCriticalSection.Create();
  fAnswerReceivedEvent := TROEvent.Create(nil,false,false,'');
end;

destructor TROAsyncProxy.Destroy;
begin
  //Todo: important: we MUST wait for and free the worker thread here!!!
  FreeAndNil(fResponse);
  FreeAndNil(fCriticalSection);
  FreeAndNil(fAnswerReceivedEvent);
  inherited;
end;

function TROAsyncProxy.GetAnswerReceived: Boolean;
begin
  fCriticalSection.Enter();
  try
    if Assigned(fAsyncTransportChannel) then begin
      result := fAsyncTransportChannel.CheckStatus(fMessageID);
    end
    else begin
      Result := fAnswerReceived;
    end;
  finally
    fCriticalSection.Leave();
  end;
end;

function TROAsyncProxy.GetAnswerReceivedEvent: TROEvent;
begin
  if assigned(fAsyncTransportChannel) and not assigned(fActiveAsyncTransportChannel) then
    raise EROAsyncException.Create('TransportChannel does not support to receive responses without explicit polling.');
  result := fAnswerReceivedEvent;
end;

function TROAsyncProxy.GetBusy: Boolean;
begin
  fCriticalSection.Enter();
  try
    Result := fBusy;
  finally
    fCriticalSection.Leave();
  end;
end;

function TROAsyncProxy.GetMessageID: string;
begin
  result := fMessageID;
end;

procedure TROAsyncProxy.SetMessageID(aMessageID: string);
begin
  fMessageID := aMessageID;
end;

procedure TROAsyncProxy.__AssertProxyNotBusy(const iMethodName: string);
begin
  if (Busy) then
    raise EROChannelBusy.CreateFmt('There''s already an async request to %s in progress.',[fMethodName]);
end;

procedure TROAsyncProxy.__DispatchAsyncRequest(const iMethodName:string; iRequest:TStream; iGetResponse:boolean=true);
begin
  fCriticalSection.Enter();
  try

    fAnswerReceivedEvent.ResetEvent();
    __AssertProxyNotBusy(iMethodName);

    if iGetResponse then begin
      fMethodName := iMethodName;
    end;
    fAnswerReceived := False;

    if Assigned(fActiveAsyncTransportChannel) then begin
      fMessageID := fActiveAsyncTransportChannel.InvokeRequest(iRequest, iGetResponse, fAnswerReceivedEvent)
    end
    else if Assigned(fAsyncTransportChannel) then begin
      fMessageID := fAsyncTransportChannel.InvokeRequest(iRequest, iGetResponse);
    end
    else begin
      fBusy := true;
      TROAsyncProxyThread.Create(Self,Format('TROAsyncProxyThread for %s calling %s',[ClassName,iMethodName]),iRequest,iGetResponse);
    end;

  finally
    fCriticalSection.Leave();
  end;
end;

procedure TROAsyncProxy.__DispatchAsyncRequest(const iMethodName: string;
  iRequest: IROMessage; iGetResponse: boolean);
var
  lRequest: TStream;
begin
  if fBeforeDispatch <> nil then
    fBeforeDispatch.BeforeDispatch(iRequest);
  lRequest := TMemoryStream.Create;

  iRequest.WriteToStream(lRequest);

  __DispatchAsyncRequest(iMethodName, lRequest, iGetResponse);
end;

function TROAsyncProxy.__RetrieveAsyncResponse(const iMethodName: string): TStream;
begin
  result := nil;

  fCriticalSection.Enter();
  try

    { Only check the Methodname if we actually preserved one before. depending on
      the call history, that might have gotten lost. }
    if (fMethodName <> '') and (fMethodName <> iMethodName) then
      raise EROAsyncException.CreateFmt('Call to Retrieve_%s does not match previous call to Invoke_%s.',[iMethodName,fMethodName]);

    if Assigned(fAsyncTransportChannel) then begin
      fResponse := TMemoryStream.Create();
      try
        fAsyncTransportChannel.RetrieveResponse(fMessageID,fResponse);
      except
        FreeAndNil(fResponse);
        raise;
      end;
    end
    else begin
      //fResponse was created by thread.
      if not fAnswerReceived then
        raise EROAsyncNoAnswerYet.CreateFmt('Answer for %s has not been received yet.',[iMethodName]);
    end;

    Assert(Assigned(fResponse));

    Result := fResponse;
    fResponse := nil;

    fBusy := False;
    fAnswerReceived := False;
    fMethodName := '';

  finally
    fCriticalSection.Leave();
  end;
end;

{ TROAsyncProxyThread }

constructor TROAsyncProxyThread.Create(iOwner:TROAsyncProxy; const iName: string; iRequest:TStream; iGetResponse:boolean);
begin
  inherited Create(True,iName);
  FreeOnTerminate := true;
  fOwner := iOwner;
  fGetResponse := iGetResponse;
  fRequest := iRequest;
  Resume();
end;

destructor TROAsyncProxyThread.Destroy;
begin
  FreeAndNil(fRequest);
  inherited;
end;

procedure TROAsyncProxyThread.Execute;
var
  lResponse:TStream;
begin
  inherited;
  try
  
    lResponse := TMemoryStream.Create();
    try
      fOwner.__TransportChannel.Dispatch(fRequest, lResponse);

      fOwner.fCriticalSection.Enter();
      try
        if fGetResponse then begin
          fOwner.fResponse := lResponse;
          lResponse := nil;
          fOwner.fAnswerReceived := True;
          fOwner.fAnswerReceivedEvent.SetEvent();
        end
        else begin
          fOwner.fBusy := False;
        end;
      finally
        fOwner.fCriticalSection.Leave();
      end;


    finally
      FreeAndNil(lResponse);
    end;

  except
    on E: Exception do begin
      fOwner.fBusy := False; 
      //ToDo: marshal exception to main thread.
    end;
  end;
end;

end.