1 (*
2 * Licensed to the Apache Software Foundation (ASF) under one
3 * or more contributor license agreements. See the NOTICE file
4 * distributed with this work for additional information
5 * regarding copyright ownership. The ASF licenses this file
6 * to you under the Apache License, Version 2.0 (the
7 * "License"); you may not use this file except in compliance
8 * with the License. You may obtain a copy of the License at
9 *
10 * http://www.apache.org/licenses/LICENSE-2.0
11 *
12 * Unless required by applicable law or agreed to in writing,
13 * software distributed under the License is distributed on an
14 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
15 * KIND, either express or implied. See the License for the
16 * specific language governing permissions and limitations
17 * under the License.
18 *)
19
20 unit TestServerEvents;
21
22 interface
23
24 uses
25 SysUtils,
26 Thrift,
27 Thrift.Protocol,
28 Thrift.Transport,
29 Thrift.Server,
30 ConsoleHelper;
31
32 type
33 TRequestEventsImpl = class( TInterfacedObject, IRequestEvents)
34 protected
35 FStart : TDateTime;
36 // IRequestProcessingEvents
37 procedure PreRead;
38 procedure PostRead;
39 procedure PreWrite;
40 procedure PostWrite;
41 procedure OnewayComplete;
42 procedure UnhandledError( const e : Exception);
43 procedure CleanupContext;
44 public
45 constructor Create;
46 end;
47
48
49 TProcessorEventsImpl = class( TInterfacedObject, IProcessorEvents)
50 protected
51 FReqs : Integer;
52 // IProcessorEvents
53 procedure Processing( const transport : ITransport);
CreateRequestContextnull54 function CreateRequestContext( const aFunctionName : string) : IRequestEvents;
55 procedure CleanupContext;
56 public
57 constructor Create;
58 end;
59
60
61 TServerEventsImpl = class( TInterfacedObject, IServerEvents)
62 protected
63 // IServerEvents
64 procedure PreServe;
65 procedure PreAccept;
CreateProcessingContextnull66 function CreateProcessingContext( const input, output : IProtocol) : IProcessorEvents;
67 end;
68
69
70 implementation
71
72 { TServerEventsImpl }
73
74 procedure TServerEventsImpl.PreServe;
75 begin
76 Console.WriteLine('ServerEvents: Server starting to serve requests');
77 end;
78
79
80 procedure TServerEventsImpl.PreAccept;
81 begin
82 Console.WriteLine('ServerEvents: Server transport is ready to accept incoming calls');
83 end;
84
85
TServerEventsImpl.CreateProcessingContextnull86 function TServerEventsImpl.CreateProcessingContext(const input, output: IProtocol): IProcessorEvents;
87 begin
88 result := TProcessorEventsImpl.Create;
89 end;
90
91
92 { TProcessorEventsImpl }
93
94 constructor TProcessorEventsImpl.Create;
95 begin
96 inherited Create;
97 FReqs := 0;
98 Console.WriteLine('ProcessorEvents: Client connected, processing begins');
99 end;
100
101 procedure TProcessorEventsImpl.Processing(const transport: ITransport);
102 begin
103 Console.WriteLine('ProcessorEvents: Processing of incoming request begins');
104 end;
105
106
TProcessorEventsImpl.CreateRequestContextnull107 function TProcessorEventsImpl.CreateRequestContext( const aFunctionName: string): IRequestEvents;
108 begin
109 result := TRequestEventsImpl.Create;
110 Inc( FReqs);
111 end;
112
113
114 procedure TProcessorEventsImpl.CleanupContext;
115 begin
116 Console.WriteLine( 'ProcessorEvents: completed after handling '+IntToStr(FReqs)+' requests.');
117 end;
118
119
120 { TRequestEventsImpl }
121
122
123 constructor TRequestEventsImpl.Create;
124 begin
125 inherited Create;
126 FStart := Now;
127 Console.WriteLine('RequestEvents: New request');
128 end;
129
130
131 procedure TRequestEventsImpl.PreRead;
132 begin
133 Console.WriteLine('RequestEvents: Reading request message ...');
134 end;
135
136
137 procedure TRequestEventsImpl.PostRead;
138 begin
139 Console.WriteLine('RequestEvents: Reading request message completed');
140 end;
141
142 procedure TRequestEventsImpl.PreWrite;
143 begin
144 Console.WriteLine('RequestEvents: Writing response message ...');
145 end;
146
147
148 procedure TRequestEventsImpl.PostWrite;
149 begin
150 Console.WriteLine('RequestEvents: Writing response message completed');
151 end;
152
153
154 procedure TRequestEventsImpl.OnewayComplete;
155 begin
156 Console.WriteLine('RequestEvents: Oneway message processed');
157 end;
158
159
160 procedure TRequestEventsImpl.UnhandledError(const e: Exception);
161 begin
162 Console.WriteLine('RequestEvents: Unhandled exception of type '+e.classname);
163 end;
164
165
166 procedure TRequestEventsImpl.CleanupContext;
167 var millis : Double;
168 begin
169 millis := (Now - FStart) * (24*60*60*1000);
170 Console.WriteLine( 'Request processing completed in '+IntToStr(Round(millis))+' ms');
171 end;
172
173
174 end.
175
