diff options
author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-07 18:45:59 +0000 |
---|---|---|
committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-07 18:45:59 +0000 |
commit | 19fcec84d8d7d21e796c7624e521b60d28ee21ed (patch) | |
tree | 42d26aa27d1e3f7c0b8bd3fd14e7d7082f5008dc /src/jaegertracing/thrift/lib/delphi/test/multiplexed/Multiplex.Server.Main.pas | |
parent | Initial commit. (diff) | |
download | ceph-19fcec84d8d7d21e796c7624e521b60d28ee21ed.tar.xz ceph-19fcec84d8d7d21e796c7624e521b60d28ee21ed.zip |
Adding upstream version 16.2.11+ds.upstream/16.2.11+dsupstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'src/jaegertracing/thrift/lib/delphi/test/multiplexed/Multiplex.Server.Main.pas')
-rw-r--r-- | src/jaegertracing/thrift/lib/delphi/test/multiplexed/Multiplex.Server.Main.pas | 201 |
1 files changed, 201 insertions, 0 deletions
diff --git a/src/jaegertracing/thrift/lib/delphi/test/multiplexed/Multiplex.Server.Main.pas b/src/jaegertracing/thrift/lib/delphi/test/multiplexed/Multiplex.Server.Main.pas new file mode 100644 index 000000000..3860f5ace --- /dev/null +++ b/src/jaegertracing/thrift/lib/delphi/test/multiplexed/Multiplex.Server.Main.pas @@ -0,0 +1,201 @@ +(* + * 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 Multiplex.Server.Main; + +{$WARN SYMBOL_PLATFORM OFF} + +{.$DEFINE RunEndless} // activate to interactively stress-test the server stop routines via Ctrl+C + +interface + +uses + Windows, SysUtils, + Generics.Collections, + Thrift.Server, + Thrift.Transport, + Thrift.Transport.Pipes, + Thrift.Protocol, + Thrift.Protocol.Multiplex, + Thrift.Processor.Multiplex, + Thrift.Collections, + Thrift.Utils, + Thrift, + Benchmark, // in gen-delphi folder + Aggr, // in gen-delphi folder + Multiplex.Test.Common, + ConsoleHelper, + Contnrs; + +type + TTestServer = class + public type + ITestHandler = interface + ['{CAE09AAB-80FB-48E9-B3A8-7F9B96F5419A}'] + procedure SetServer( const AServer : IServer ); + end; + + protected type + TTestHandlerImpl = class( TInterfacedObject, ITestHandler) + private + FServer : IServer; + protected + // ITestHandler + procedure SetServer( const AServer : IServer ); + + property Server : IServer read FServer write SetServer; + end; + + TBenchmarkServiceImpl = class( TTestHandlerImpl, TBenchmarkService.Iface) + protected + // TBenchmarkService.Iface + function fibonacci(n: ShortInt): Integer; + end; + + + TAggrImpl = class( TTestHandlerImpl, TAggr.Iface) + protected + FList : IThriftList<Integer>; + + // TAggr.Iface + procedure addValue(value: Integer); + function getValues(): IThriftList<Integer>; + public + constructor Create; + destructor Destroy; override; + end; + + public + class procedure Execute( const args: array of string); + end; + + +implementation + + +{ TTestServer.TTestHandlerImpl } + +procedure TTestServer.TTestHandlerImpl.SetServer( const AServer: IServer); +begin + FServer := AServer; +end; + + +{ TTestServer.TBenchmarkServiceImpl } + +function TTestServer.TBenchmarkServiceImpl.fibonacci(n: ShortInt): Integer; +var prev, next : Integer; +begin + prev := 0; + result := 1; + while n > 0 do begin + next := result + prev; + prev := result; + result := next; + Dec(n); + end; +end; + +{ TTestServer.TAggrImpl } + +constructor TTestServer.TAggrImpl.Create; +begin + inherited Create; + FList := TThriftListImpl<Integer>.Create; +end; + + +destructor TTestServer.TAggrImpl.Destroy; +begin + try + FreeAndNil( FList); + finally + inherited Destroy; + end; +end; + + +procedure TTestServer.TAggrImpl.addValue(value: Integer); +begin + FList.Add( value); +end; + + +function TTestServer.TAggrImpl.getValues(): IThriftList<Integer>; +begin + result := FList; +end; + + +{ TTestServer } + +class procedure TTestServer.Execute( const args: array of string); +var + TransportFactory : ITransportFactory; + ProtocolFactory : IProtocolFactory; + ServerTrans : IServerTransport; + benchHandler : TBenchmarkService.Iface; + aggrHandler : TAggr.Iface; + benchProcessor : IProcessor; + aggrProcessor : IProcessor; + multiplex : IMultiplexedProcessor; + ServerEngine : IServer; +begin + try + // create protocol factory, default to BinaryProtocol + ProtocolFactory := TBinaryProtocolImpl.TFactory.Create( TRUE, TRUE); + servertrans := TServerSocketImpl.Create( 9090, 0, FALSE); + TransportFactory := TFramedTransportImpl.TFactory.Create; + + benchHandler := TBenchmarkServiceImpl.Create; + benchProcessor := TBenchmarkService.TProcessorImpl.Create( benchHandler); + + aggrHandler := TAggrImpl.Create; + aggrProcessor := TAggr.TProcessorImpl.Create( aggrHandler); + + multiplex := TMultiplexedProcessorImpl.Create; + multiplex.RegisterProcessor( NAME_BENCHMARKSERVICE, benchProcessor); + multiplex.RegisterProcessor( NAME_AGGR, aggrProcessor); + + ServerEngine := TSimpleServer.Create( multiplex, + ServerTrans, + TransportFactory, + ProtocolFactory); + + (benchHandler as ITestHandler).SetServer( ServerEngine); + (aggrHandler as ITestHandler).SetServer( ServerEngine); + + Console.WriteLine('Starting the server ...'); + ServerEngine.serve(); + + (benchHandler as ITestHandler).SetServer( nil); + (aggrHandler as ITestHandler).SetServer( nil); + + except + on E: Exception do + begin + Console.Write( E.Message); + end; + end; + Console.WriteLine( 'done.'); +end; + + +end. + |