TwstFPHttpListener : add options to control execution in threads.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1781 8e941d3f-bd1b-0410-a28a-d453659cc2b4

wst/trunk/fpc_http_server.pas

@@ -22,14 +22,20 @@ uses
 
 type
 
-  { TwstFPHttpListener }
+  { TFPWorkerObject }
 
-  TwstFPHttpListener = class(TwstListener)
+  TFPWorkerObject = class
   private
     FHTTPServerObject: TFPHTTPServer;
     FRootAddress : string;
     FServerSoftware : String;
+    FOnNotifyMessage : TListnerNotifyMessage;
   private
+    function GetHandleRequestInThread : Boolean;
+    function GetListeningPort : Integer;
+    procedure SetHandleRequestInThread(const AValue : Boolean);
+    procedure SetListeningPort(const AValue : Integer);
+
     procedure ProcessWSDLRequest(
           ARequest  : TRequest;
           AResponse : TResponse;
@@ -41,9 +47,46 @@ type
       var APath     : string
     );
   private
-    procedure RequestHandler(Sender: TObject; 
+    procedure RequestHandler(
-                Var ARequest: TFPHTTPConnectionRequest;
+          Sender    : TObject;
-                Var AResponse : TFPHTTPConnectionResponse);
+      Var ARequest  : TFPHTTPConnectionRequest;
+      Var AResponse : TFPHTTPConnectionResponse
+    );
+  public
+    constructor Create();
+    destructor Destroy(); override;
+    procedure Start();
+    procedure Stop();
+    function IsActive : Boolean;
+
+    property RootAddress : string read FRootAddress write FRootAddress;
+    property ServerSoftware : string read FServerSoftware write FServerSoftware;
+    property ListeningPort : Integer read GetListeningPort write SetListeningPort;
+    property OnNotifyMessage : TListnerNotifyMessage read FOnNotifyMessage write FOnNotifyMessage;
+    property HandleRequestInThread : Boolean read GetHandleRequestInThread write SetHandleRequestInThread;
+  end;
+
+  { TServerListnerThread }
+
+  TServerListnerThread = class(TThread)
+  private
+    FWorkerObject : TFPWorkerObject;
+  public
+    constructor Create(AWorkerObject : TFPWorkerObject);
+    procedure Execute(); override;
+  end;
+
+  TListenerOption = (loExecuteInThread, loHandleRequestInThread);
+  TListenerOptions = set of TListenerOption;
+
+  { TwstFPHttpListener }
+
+  TwstFPHttpListener = class(TwstListener)
+  private
+    FOptions : TListenerOptions;
+    FWorkerObject : TFPWorkerObject;
+  protected
+    procedure SetOnNotifyMessage(const AValue : TListnerNotifyMessage);override;
   public
     constructor Create(
       const AServerIpAddress   : string  = '127.0.0.1';
@@ -56,11 +99,13 @@ type
     procedure Start();override;
     procedure Stop();override;
     function IsActive : Boolean; override;
-  end;
 
+    property Options : TListenerOptions read FOptions write FOptions;
+  end;
 
 implementation
 uses
+  wst_consts,
   base_service_intf, server_service_intf, server_service_imputils, metadata_wsdl;
 
 {$IFDEF WST_DBG}
@@ -91,9 +136,26 @@ begin
   end;
 end;
 
-{ TwstFPHttpListener }
+{ TServerListnerThread }
 
-procedure TwstFPHttpListener.ProcessWSDLRequest(
+constructor TServerListnerThread.Create(AWorkerObject : TFPWorkerObject);
+begin
+  FreeOnTerminate := True;
+  FWorkerObject := AWorkerObject;
+  inherited Create(False);
+end;
+
+procedure TServerListnerThread.Execute();
+begin
+  try
+    FWorkerObject.Start();
+  except
+  end;
+end;
+
+{ TFPWorkerObject }
+
+procedure TFPWorkerObject.ProcessWSDLRequest(
       ARequest  : TRequest;
       AResponse : TResponse;
   var APath     : string
@@ -107,21 +169,21 @@ begin
     locRepName := ExtractNextPathElement(APath);
   strBuff := GenerateWSDL(locRepName,FRootAddress);
   i:=Length(strBuff);
-  if (StrBuff<>'') then 
+  if (StrBuff<>'') then
     begin
     AResponse.ContentType := 'text/xml';
     AResponse.Content:=strBuff;
     end
   else
-    begin  
+    begin
     AResponse.ContentType := 'text/html';
     AResponse.Content := GenerateWSDLHtmlTable();
     end;
-  if AResponse.ContentLength=0 then  
+  if AResponse.ContentLength=0 then
-    AResponse.ContentLength:=Length(AResponse.Content);  
+    AResponse.ContentLength:=Length(AResponse.Content);
 end;
 
-procedure TwstFPHttpListener.ProcessServiceRequest(
+procedure TFPWorkerObject.ProcessServiceRequest(
       ARequest  : TRequest;
       AResponse : TResponse;
   var APath     : string
@@ -132,7 +194,7 @@ var
   inStream : TStringStream;
 begin
   trgt := ExtractNextPathElement(APath);
-  if AnsiSameText(sWSDL,trgt) then 
+  if AnsiSameText(sWSDL,trgt) then
     begin
     ProcessWSDLRequest(ARequest,AResponse,APath);
     Exit;
@@ -154,16 +216,28 @@ begin
     end;
   except
     on e : Exception do begin
-      NotifyMessage('ProcessData()>> Exception = '+e.Message);
+      if Assigned(FOnNotifyMessage) then
+        FOnNotifyMessage(Self,'ProcessData()>> Exception = '+e.Message);
       raise;
     end;
   end;
 end;
 
-procedure TWstFPHttpListener.RequestHandler(Sender: TObject; 
+function TFPWorkerObject.GetHandleRequestInThread : Boolean;
-                Var ARequest: TFPHTTPConnectionRequest;
+begin
-                Var AResponse : TFPHTTPConnectionResponse);
+  Result := FHTTPServerObject.Threaded;
+end;
 
+function TFPWorkerObject.GetListeningPort : Integer;
+begin
+  Result := FHTTPServerObject.Port;
+end;
+
+procedure TFPWorkerObject.RequestHandler(
+      Sender    : TObject;
+  var ARequest  : TFPHTTPConnectionRequest;
+  var AResponse : TFPHTTPConnectionResponse
+);
 var
 {$IFDEF WST_DBG}
   s : string;
@@ -174,19 +248,73 @@ begin
   AResponse.Server:=FServerSoftware;
   locPath := ARequest.URL;
   locPathPart := ExtractNextPathElement(locPath);
-  if AnsiSameText(sSERVICES_PREFIXE,locPathPart)  then 
+  if AnsiSameText(sSERVICES_PREFIXE,locPathPart)  then
     ProcessServiceRequest(ARequest,AResponse,locPath)
   else
     ProcessWSDLRequest(ARequest,AResponse,locPath);
   try
     AResponse.SendContent;
-  finally  
+  finally
-    If Assigned(AResponse.ContentStream) then
+    if Assigned(AResponse.ContentStream) then begin
-      begin
+      AResponse.ContentStream.Free();
-      AResponse.ContentStream.Free;
+      AResponse.ContentStream := nil;
-      AResponse.ContentStream:=Nil;
+    end;
-      end;
+  end;
-  end;  
+end;
+
+procedure TFPWorkerObject.SetHandleRequestInThread(const AValue : Boolean);
+begin
+  if FHTTPServerObject.Active then
+    raise Exception.CreateFmt(SERR_ObjectStateDoesNotAllowOperation,['SetHandleRequestInThread']);
+  FHTTPServerObject.Threaded := AValue;
+end;
+
+procedure TFPWorkerObject.SetListeningPort(const AValue : Integer);
+begin
+  if FHTTPServerObject.Active then
+    raise Exception.CreateFmt(SERR_ObjectStateDoesNotAllowOperation,['SetListeningPort']);
+  FHTTPServerObject.Port := AValue;
+end;
+
+constructor TFPWorkerObject.Create();
+begin
+  inherited Create();
+  FHTTPServerObject := TFPHTTPServer.Create(nil);
+  FHTTPServerObject.OnRequest := @RequestHandler;
+end;
+
+destructor TFPWorkerObject.Destroy();
+begin
+  if (FHTTPServerObject <> nil) then
+    FHTTPServerObject.Active := False;
+  FreeAndNil(FHTTPServerObject);
+  inherited Destroy();
+end;
+
+procedure TFPWorkerObject.Start();
+begin
+  if not FHTTPServerObject.Active then
+    FHTTPServerObject.Active := True;
+end;
+
+procedure TFPWorkerObject.Stop();
+begin
+  if FHTTPServerObject.Active then
+    FHTTPServerObject.Active := False;
+end;
+
+function TFPWorkerObject.IsActive : Boolean;
+begin
+  Result := FHTTPServerObject.Active;
+end;
+
+{ TwstFPHttpListener }
+
+procedure TwstFPHttpListener.SetOnNotifyMessage(const AValue : TListnerNotifyMessage);
+begin
+  inherited SetOnNotifyMessage(AValue);
+  if (FWorkerObject <> nil) then
+    FWorkerObject.OnNotifyMessage := AValue;
 end;
 
 constructor TwstFPHttpListener.Create(
@@ -198,42 +326,50 @@ constructor TwstFPHttpListener.Create(
 
 begin
   inherited Create();
-  FHTTPServerObject := TFPHTTPServer.Create(nil);
+  FWorkerObject := TFPWorkerObject.Create();
-//  b.IP := AServerIpAddress;
+  FWorkerObject.RootAddress := AServerIpAddress;
-  FHTTPServerObject.port := AListningPort;
+  FWorkerObject.ServerSoftware := AServerSoftware;
-  FRootAddress := Format('http://%s:%d/',[AServerIpAddress,AListningPort]);
+  FWorkerObject.ListeningPort := AListningPort;
-  FServerSoftware := AServerSoftware;
-  FHTTPServerObject.OnRequest := @RequestHandler;
 end;
 
 destructor TwstFPHttpListener.Destroy();
 begin
-  if ( FHTTPServerObject <> nil ) then
+  if (FWorkerObject <> nil) then
     Stop();
-  FreeAndNil(FHTTPServerObject);
+  FreeAndNil(FWorkerObject);
   inherited Destroy();
 end;
 
 procedure TwstFPHttpListener.Start();
 begin
-  if not FHTTPServerObject.Active then
+  if not FWorkerObject.IsActive() then begin
-    FHTTPServerObject.Active := True;
+    FWorkerObject.HandleRequestInThread := (loHandleRequestInThread in Options);
+    if (loExecuteInThread in Options) then begin
+      // The thread is create with "FreeOnTerminate := True"
+      TServerListnerThread.Create(FWorkerObject);
+    end else begin
+      FWorkerObject.Start();
+    end;
+  end;
 end;
 
 procedure TwstFPHttpListener.Stop();
 begin
-  if FHTTPServerObject.Active then
+  if FWorkerObject.IsActive() then begin
-    FHTTPServerObject.Active := False;
+    //In case of the thread(loExecuteInThread in Options),
+    //this will make the thread exit and free itself as "FreeOnTerminate := True"
+    FWorkerObject.Stop();
+  end;
 end;
 
-class function TwstFPHttpListener.GetDescription: string;
+class function TwstFPHttpListener.GetDescription() : string;
 begin
   Result := 'WST FP HTTP Listener';
 end;
 
 function TwstFPHttpListener.IsActive: Boolean;
 begin
-  Result := FHTTPServerObject.Active;
+  Result := FWorkerObject.IsActive();
 end;
 
 initialization

wst/trunk/server_listener.pas

@@ -27,16 +27,20 @@ type
 
   TListnerNotifyMessage = procedure(Sender : TObject; const AMsg : string) of object;
 
+  { TwstListener }
+
   TwstListener = class(TObject)
   private
     FOnNotifyMessage: TListnerNotifyMessage;
+  protected
+    procedure SetOnNotifyMessage(const AValue : TListnerNotifyMessage);virtual;
   public
     class function GetDescription() : string;virtual;
     procedure Start();virtual;abstract;
     procedure Stop();virtual;abstract;
     function IsActive : Boolean; virtual;abstract;
     procedure NotifyMessage(const AMsg : string);
-    property OnNotifyMessage : TListnerNotifyMessage read FOnNotifyMessage write FOnNotifyMessage;
+    property OnNotifyMessage : TListnerNotifyMessage read FOnNotifyMessage write SetOnNotifyMessage;
   end;
 
   function GenerateWSDLHtmlTable(const AServicesModulePath : string=''): string;
@@ -87,6 +91,13 @@ end;
 
 { TwstListener }
 
+procedure TwstListener.SetOnNotifyMessage(const AValue : TListnerNotifyMessage);
+begin
+  if (FOnNotifyMessage = AValue) then
+    exit;
+  FOnNotifyMessage := AValue;
+end;
+
 class function TwstListener.GetDescription() : string;
 begin
   Result := ClassName;

wst/trunk/wst_consts.pas

@@ -81,6 +81,7 @@ resourcestring
   SERR_NoScope                     = 'There is no scope.';  
   SERR_NoSerializerFoThisType      = 'No serializer for this type : "%s".';
   SERRE_ObjectCreationTimeOut      = 'Unable to create the object : Timeout expired.';
+  SERR_ObjectStateDoesNotAllowOperation = 'Object'' state does not allow this operation : "%s".';
   SERR_OperationNotAllowedOnActivePool = 'Operation not allowed on an active pool.';
   SERR_ParamaterNotFound           = 'Parameter non found : "%s".';
   SERR_Parsing                     = 'Parsing "%s" ...';