(* * 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, ConsoleHelper; 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.