THRIFT-2195 Delphi: Add event handlers for server and processing events
Patch: Jens Geyer
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',