THRIFT-2195 Delphi: Add event handlers for server and processing events
Patch: Jens Geyer
diff --git a/lib/delphi/src/Thrift.Protocol.pas b/lib/delphi/src/Thrift.Protocol.pas
index e88f1cf..5618d6f 100644
--- a/lib/delphi/src/Thrift.Protocol.pas
+++ b/lib/delphi/src/Thrift.Protocol.pas
@@ -497,6 +497,44 @@
end;
+type
+ IRequestEvents = interface
+ ['{F926A26A-5B00-4560-86FA-2CAE3BA73DAF}']
+ // Called before reading arguments.
+ procedure PreRead;
+ // Called between reading arguments and calling the handler.
+ procedure PostRead;
+ // Called between calling the handler and writing the response.
+ procedure PreWrite;
+ // Called after writing the response.
+ procedure PostWrite;
+ // Called when an oneway (async) function call completes successfully.
+ procedure OnewayComplete;
+ // Called if the handler throws an undeclared exception.
+ procedure UnhandledError( const e : Exception);
+ // Called when a client has finished request-handling to clean up
+ procedure CleanupContext;
+ end;
+
+
+ IProcessorEvents = interface
+ ['{A8661119-657C-447D-93C5-512E36162A45}']
+ // Called when a client is about to call the processor.
+ procedure Processing( const transport : ITransport);
+ // Called on any service function invocation
+ function CreateRequestContext( const aFunctionName : string) : IRequestEvents;
+ // Called when a client has finished request-handling to clean up
+ procedure CleanupContext;
+ end;
+
+
+ IProcessor = interface
+ ['{7BAE92A5-46DA-4F13-B6EA-0EABE233EE5F}']
+ function Process( const iprot :IProtocol; const oprot: IProtocol; const events : IProcessorEvents): Boolean;
+ end;
+
+
+
implementation
function ConvertInt64ToDouble( const n: Int64): Double;
diff --git a/lib/delphi/src/Thrift.Server.pas b/lib/delphi/src/Thrift.Server.pas
index 6d3ff38..8237a47 100644
--- a/lib/delphi/src/Thrift.Server.pas
+++ b/lib/delphi/src/Thrift.Server.pas
@@ -30,10 +30,26 @@
Thrift.Transport;
type
+ IServerEvents = interface
+ ['{9E2A99C5-EE85-40B2-9A52-2D1722B18176}']
+ // Called before the server begins.
+ procedure PreServe;
+ // Called when the server transport is ready to accept requests
+ procedure PreAccept;
+ // Called when a new client has connected and the server is about to being processing.
+ function CreateProcessingContext( const input, output : IProtocol) : IProcessorEvents;
+ end;
+
+
IServer = interface
- ['{CF9F56C6-BB39-4C7D-877B-43B416572CE6}']
+ ['{ADC46F2D-8199-4D1C-96D2-87FD54351723}']
procedure Serve;
procedure Stop;
+
+ function GetServerEvents : IServerEvents;
+ procedure SetServerEvents( const value : IServerEvents);
+
+ property ServerEvents : IServerEvents read GetServerEvents write SetServerEvents;
end;
TServerImpl = class abstract( TInterfacedObject, IServer )
@@ -48,9 +64,13 @@
FInputProtocolFactory : IProtocolFactory;
FOutputProtocolFactory : IProtocolFactory;
FLogDelegate : TLogDelegate;
+ FServerEvents : IServerEvents;
class procedure DefaultLogDelegate( const str: string);
+ function GetServerEvents : IServerEvents;
+ procedure SetServerEvents( const value : IServerEvents);
+
procedure Serve; virtual; abstract;
procedure Stop; virtual; abstract;
public
@@ -64,7 +84,7 @@
const ALogDelegate : TLogDelegate
); overload;
- constructor Create(
+ constructor Create(
const AProcessor :IProcessor;
const AServerTransport: IServerTransport
); overload;
@@ -122,7 +142,7 @@
InputTransFactory := TTransportFactoryImpl.Create;
OutputTransFactory := TTransportFactoryImpl.Create;
- //no inherited;
+ //no inherited;
Create(
AProcessor,
AServerTransport,
@@ -202,13 +222,27 @@
const AServerTransport: IServerTransport; const ATransportFactory: ITransportFactory;
const AProtocolFactory: IProtocolFactory);
begin
- //no inherited;
+ //no inherited;
Create( AProcessor, AServerTransport,
ATransportFactory, ATransportFactory,
AProtocolFactory, AProtocolFactory,
DefaultLogDelegate);
end;
+
+function TServerImpl.GetServerEvents : IServerEvents;
+begin
+ result := FServerEvents;
+end;
+
+
+procedure TServerImpl.SetServerEvents( const value : IServerEvents);
+begin
+ // if you need more than one, provide a specialized IServerEvents implementation
+ FServerEvents := value;
+end;
+
+
{ TSimpleServer }
constructor TSimpleServer.Create( const AProcessor: IProcessor;
@@ -267,6 +301,7 @@
OutputTransport : ITransport;
InputProtocol : IProtocol;
OutputProtocol : IProtocol;
+ context : IProcessorEvents;
begin
try
FServerTransport.Listen;
@@ -277,6 +312,9 @@
end;
end;
+ if FServerEvents <> nil
+ then FServerEvents.PreServe;
+
client := nil;
while (not FStop) do
begin
@@ -287,16 +325,34 @@
InputProtocol := nil;
OutputProtocol := nil;
- client := FServerTransport.Accept;
+ client := FServerTransport.Accept( procedure
+ begin
+ if FServerEvents <> nil
+ then FServerEvents.PreAccept;
+ end);
+
+ if client = nil then begin
+ if FStop
+ then Abort // silent exception
+ else raise TTransportException.Create( 'ServerTransport.Accept() may not return NULL' );
+ end;
+
FLogDelegate( 'Client Connected!');
InputTransport := FInputTransportFactory.GetTransport( client );
OutputTransport := FOutputTransportFactory.GetTransport( client );
InputProtocol := FInputProtocolFactory.GetProtocol( InputTransport );
OutputProtocol := FOutputProtocolFactory.GetProtocol( OutputTransport );
- while ( FProcessor.Process( InputProtocol, OutputProtocol )) do
- begin
- if FStop then Break;
+
+ if FServerEvents <> nil
+ then context := FServerEvents.CreateProcessingContext( InputProtocol, OutputProtocol)
+ else context := nil;
+
+ while not FStop do begin
+ if context <> nil
+ then context.Processing( client);
+ if not FProcessor.Process( InputProtocol, OutputProtocol, context)
+ then Break;
end;
except
@@ -311,6 +367,13 @@
FLogDelegate( E.ToString);
end;
end;
+
+ if context <> nil
+ then begin
+ context.CleanupContext;
+ context := nil;
+ end;
+
if InputTransport <> nil then
begin
InputTransport.Close;
diff --git a/lib/delphi/src/Thrift.Transport.Pipes.pas b/lib/delphi/src/Thrift.Transport.Pipes.pas
index bf07e1e..c2696f4 100644
--- a/lib/delphi/src/Thrift.Transport.Pipes.pas
+++ b/lib/delphi/src/Thrift.Transport.Pipes.pas
Binary files differ
diff --git a/lib/delphi/src/Thrift.Transport.pas b/lib/delphi/src/Thrift.Transport.pas
index 0d5b384..b567aef 100644
--- a/lib/delphi/src/Thrift.Transport.pas
+++ b/lib/delphi/src/Thrift.Transport.pas
@@ -129,19 +129,17 @@
end;
IServerTransport = interface
- ['{BF6B7043-DA22-47BF-8B11-2B88EC55FE12}']
+ ['{C43B87ED-69EA-47C4-B77C-15E288252900}']
procedure Listen;
procedure Close;
- function Accept: ITransport;
+ function Accept( const fnAccepting: TProc): ITransport;
end;
TServerTransportImpl = class( TInterfacedObject, IServerTransport)
protected
- function AcceptImpl: ITransport; virtual; abstract;
- public
procedure Listen; virtual; abstract;
procedure Close; virtual; abstract;
- function Accept: ITransport;
+ function Accept( const fnAccepting: TProc): ITransport; virtual; abstract;
end;
ITransportFactory = interface
@@ -226,7 +224,7 @@
FUseBufferedSocket : Boolean;
FOwnsServer : Boolean;
protected
- function AcceptImpl: ITransport; override;
+ function Accept( const fnAccepting: TProc) : ITransport; override;
public
constructor Create( const AServer: TTcpServer ); overload;
constructor Create( const AServer: TTcpServer; AClientTimeout: Integer); overload;
@@ -518,17 +516,6 @@
inherited Create(msg);
end;
-{ TServerTransportImpl }
-
-function TServerTransportImpl.Accept: ITransport;
-begin
- Result := AcceptImpl;
- if Result = nil then
- begin
- raise TTransportException.Create( 'accept() may not return NULL' );
- end;
-end;
-
{ TTransportFactoryImpl }
function TTransportFactoryImpl.GetTransport( const ATrans: ITransport): ITransport;
@@ -557,11 +544,10 @@
Create( APort, 0 );
end;
-function TServerSocketImpl.AcceptImpl: ITransport;
+function TServerSocketImpl.Accept( const fnAccepting: TProc): ITransport;
var
- ret : TCustomIpClient;
- ret2 : IStreamTransport;
- ret3 : ITransport;
+ client : TCustomIpClient;
+ trans : IStreamTransport;
begin
if FServer = nil then
begin
@@ -570,29 +556,28 @@
end;
try
- ret := TCustomIpClient.Create(nil);
- if ( not FServer.Accept( ret )) then
+ client := TCustomIpClient.Create(nil);
+
+ if Assigned(fnAccepting)
+ then fnAccepting();
+
+ if ( not FServer.Accept( client)) then
begin
- ret.Free;
+ client.Free;
Result := nil;
Exit;
end;
- if ret = nil then
+ if client = nil then
begin
Result := nil;
Exit;
end;
- ret2 := TSocketImpl.Create( ret );
- if FUseBufferedSocket then
- begin
- ret3 := TBufferedTransportImpl.Create(ret2);
- Result := ret3;
- end else
- begin
- Result := ret2;
- end;
+ trans := TSocketImpl.Create( client);
+ if FUseBufferedSocket
+ then result := TBufferedTransportImpl.Create( trans)
+ else result := trans;
except
on E: Exception do
diff --git a/lib/delphi/src/Thrift.pas b/lib/delphi/src/Thrift.pas
index 44f12d7..f4b47ed 100644
--- a/lib/delphi/src/Thrift.pas
+++ b/lib/delphi/src/Thrift.pas
@@ -28,11 +28,6 @@
Version = '1.0.0-dev';
type
- IProcessor = interface
- ['{B1538A07-6CAC-4406-8A4C-AFED07C70A89}']
- function Process( const iprot :IProtocol; const oprot: IProtocol): Boolean;
- end;
-
TApplicationException = class( SysUtils.Exception )
public
type
diff --git a/lib/delphi/test/TestServer.pas b/lib/delphi/test/TestServer.pas
index 7b74e58..656fa15 100644
--- a/lib/delphi/test/TestServer.pas
+++ b/lib/delphi/test/TestServer.pas
@@ -39,6 +39,7 @@
Thrift.Test,
Thrift,
TestConstants,
+ TestServerEvents,
Contnrs;
type
@@ -482,7 +483,7 @@
UseBufferedSockets : Boolean;
UseFramed : Boolean;
Port : Integer;
- AnonPipe : Boolean;
+ AnonPipe, ServerEvents : Boolean;
sPipeName : string;
testHandler : ITestHandler;
testProcessor : IProcessor;
@@ -505,6 +506,7 @@
UseBufferedSockets := False;
UseFramed := False;
AnonPipe := FALSE;
+ ServerEvents := FALSE;
protType := prot_Binary;
Port := 9090;
sPipeName := '';
@@ -549,8 +551,12 @@
Break;
end;
end;
- end else
+ end
+ else if ( s = '-events' ) then
begin
+ ServerEvents := True;
+ end
+ else begin
// Fall back to the older boolean syntax
UseBufferedSockets := StrToBoolDef( args[1], UseBufferedSockets);
end
@@ -607,6 +613,12 @@
testHandler.SetServer( ServerEngine);
+ // test events?
+ if ServerEvents then begin
+ Console.WriteLine('- server events test enabled');
+ ServerEngine.ServerEvents := TServerEventsImpl.Create;
+ end;
+
// start the client now when we have the anon handles, but before the server starts
if AnonPipe
then LaunchAnonPipeChild( ExtractFilePath(ParamStr(0))+'client.exe', anonymouspipe);
diff --git a/lib/delphi/test/TestServerEvents.pas b/lib/delphi/test/TestServerEvents.pas
new file mode 100644
index 0000000..8e931c4
--- /dev/null
+++ b/lib/delphi/test/TestServerEvents.pas
@@ -0,0 +1,174 @@
+(*
+ * Licensed to the Apache Software Foundation (ASF) under one
+ * or more contributor license agreements. See the NOTICE file
+ * distributed with this work for additional information
+ * regarding copyright ownership. The ASF licenses this file
+ * to you under the Apache License, Version 2.0 (the
+ * "License"); you may not use this file except in compliance
+ * with the License. You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing,
+ * software distributed under the License is distributed on an
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+ * KIND, either express or implied. See the License for the
+ * specific language governing permissions and limitations
+ * under the License.
+ *)
+
+unit TestServerEvents;
+
+interface
+
+uses
+ SysUtils,
+ Thrift,
+ Thrift.Protocol,
+ Thrift.Transport,
+ Thrift.Server,
+ Thrift.Console;
+
+type
+ TRequestEventsImpl = class( TInterfacedObject, IRequestEvents)
+ protected
+ FStart : TDateTime;
+ // IRequestProcessingEvents
+ procedure PreRead;
+ procedure PostRead;
+ procedure PreWrite;
+ procedure PostWrite;
+ procedure OnewayComplete;
+ procedure UnhandledError( const e : Exception);
+ procedure CleanupContext;
+ public
+ constructor Create;
+ end;
+
+
+ TProcessorEventsImpl = class( TInterfacedObject, IProcessorEvents)
+ protected
+ FReqs : Integer;
+ // IProcessorEvents
+ procedure Processing( const transport : ITransport);
+ function CreateRequestContext( const aFunctionName : string) : IRequestEvents;
+ procedure CleanupContext;
+ public
+ constructor Create;
+ end;
+
+
+ TServerEventsImpl = class( TInterfacedObject, IServerEvents)
+ protected
+ // IServerEvents
+ procedure PreServe;
+ procedure PreAccept;
+ function CreateProcessingContext( const input, output : IProtocol) : IProcessorEvents;
+ end;
+
+
+implementation
+
+{ TServerEventsImpl }
+
+procedure TServerEventsImpl.PreServe;
+begin
+ Console.WriteLine('ServerEvents: Server starting to serve requests');
+end;
+
+
+procedure TServerEventsImpl.PreAccept;
+begin
+ Console.WriteLine('ServerEvents: Server transport is ready to accept incoming calls');
+end;
+
+
+function TServerEventsImpl.CreateProcessingContext(const input, output: IProtocol): IProcessorEvents;
+begin
+ result := TProcessorEventsImpl.Create;
+end;
+
+
+{ TProcessorEventsImpl }
+
+constructor TProcessorEventsImpl.Create;
+begin
+ inherited Create;
+ FReqs := 0;
+ Console.WriteLine('ProcessorEvents: Client connected, processing begins');
+end;
+
+procedure TProcessorEventsImpl.Processing(const transport: ITransport);
+begin
+ Console.WriteLine('ProcessorEvents: Processing of incoming request begins');
+end;
+
+
+function TProcessorEventsImpl.CreateRequestContext( const aFunctionName: string): IRequestEvents;
+begin
+ result := TRequestEventsImpl.Create;
+ Inc( FReqs);
+end;
+
+
+procedure TProcessorEventsImpl.CleanupContext;
+begin
+ Console.WriteLine( 'ProcessorEvents: completed after handling '+IntToStr(FReqs)+' requests.');
+end;
+
+
+{ TRequestEventsImpl }
+
+
+constructor TRequestEventsImpl.Create;
+begin
+ inherited Create;
+ FStart := Now;
+ Console.WriteLine('RequestEvents: New request');
+end;
+
+
+procedure TRequestEventsImpl.PreRead;
+begin
+ Console.WriteLine('RequestEvents: Reading request message ...');
+end;
+
+
+procedure TRequestEventsImpl.PostRead;
+begin
+ Console.WriteLine('RequestEvents: Reading request message completed');
+end;
+
+procedure TRequestEventsImpl.PreWrite;
+begin
+ Console.WriteLine('RequestEvents: Writing response message ...');
+end;
+
+
+procedure TRequestEventsImpl.PostWrite;
+begin
+ Console.WriteLine('RequestEvents: Writing response message completed');
+end;
+
+
+procedure TRequestEventsImpl.OnewayComplete;
+begin
+ Console.WriteLine('RequestEvents: Oneway message processed');
+end;
+
+
+procedure TRequestEventsImpl.UnhandledError(const e: Exception);
+begin
+ Console.WriteLine('RequestEvents: Unhandled exception of type '+e.classname);
+end;
+
+
+procedure TRequestEventsImpl.CleanupContext;
+var millis : Double;
+begin
+ millis := (Now - FStart) * (24*60*60*1000);
+ Console.WriteLine( 'Request processing completed in '+IntToStr(Round(millis))+' ms');
+end;
+
+
+end.
diff --git a/lib/delphi/test/codegen/run-Pascal-Codegen-Tests.bat.tmpl b/lib/delphi/test/codegen/run-Pascal-Codegen-Tests.bat.tmpl
index 6ccd260..8007470 100644
--- a/lib/delphi/test/codegen/run-Pascal-Codegen-Tests.bat.tmpl
+++ b/lib/delphi/test/codegen/run-Pascal-Codegen-Tests.bat.tmpl
@@ -58,7 +58,7 @@
echo.
echo Generating code, please wait ...
cd "%TARGET%"
-for %%a in (*.thrift) do "%BIN%\thrift.exe" -v --gen delphi:ansistr_binary,register_types "%%a" 2>> "%LOGFILE%"
+for %%a in (*.thrift) do "%BIN%\thrift.exe" -v --gen delphi:ansistr_binary,register_types,constprefix,events "%%a" 2>> "%LOGFILE%"
REM * for %%a in (*.thrift) do "%BIN%\thrift.exe" -v --gen cpp "%%a" >> NUL:
cmd /c start notepad "%LOGFILE%"
cd ..
diff --git a/lib/delphi/test/server.dpr b/lib/delphi/test/server.dpr
index ca485af..7cf26a4 100644
--- a/lib/delphi/test/server.dpr
+++ b/lib/delphi/test/server.dpr
@@ -24,6 +24,7 @@
uses
SysUtils,
TestServer in 'TestServer.pas',
+ TestServerEvents in 'TestServerEvents.pas',
Thrift.Test, // in gen-delphi folder
Thrift in '..\src\Thrift.pas',
Thrift.Transport in '..\src\Thrift.Transport.pas',