Thrift-1366: Delphi generator, lirbrary and unit test.
Client: delphi
Patch: Kenjiro Fukumitsu
Adding delphi XE generator, lib and unit tests.
git-svn-id: https://svn.apache.org/repos/asf/thrift/trunk@1185688 13f79535-47bb-0310-9956-ffa450edef68
diff --git a/lib/delphi/src/Thrift.Server.pas b/lib/delphi/src/Thrift.Server.pas
new file mode 100644
index 0000000..0a7fdc6
--- /dev/null
+++ b/lib/delphi/src/Thrift.Server.pas
@@ -0,0 +1,325 @@
+(*
+ * 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 Thrift.Server;
+
+interface
+
+uses
+ SysUtils,
+ Thrift,
+ Thrift.Protocol,
+ Thrift.Transport;
+
+type
+ IServer = interface
+ ['{CF9F56C6-BB39-4C7D-877B-43B416572CE6}']
+ procedure Serve;
+ procedure Stop;
+ end;
+
+ TServerImpl = class abstract( TInterfacedObject, IServer )
+ public
+ type
+ TLogDelegate = reference to procedure( str: string);
+ protected
+ FProcessor : IProcessor;
+ FServerTransport : IServerTransport;
+ FInputTransportFactory : ITransportFactory;
+ FOutputTransportFactory : ITransportFactory;
+ FInputProtocolFactory : IProtocolFactory;
+ FOutputProtocolFactory : IProtocolFactory;
+ FLogDelegate : TLogDelegate;
+
+ class procedure DefaultLogDelegate( str: string);
+
+ procedure Serve; virtual; abstract;
+ procedure Stop; virtual; abstract;
+ public
+ constructor Create(
+ AProcessor :IProcessor;
+ AServerTransport: IServerTransport;
+ AInputTransportFactory : ITransportFactory;
+ AOutputTransportFactory : ITransportFactory;
+ AInputProtocolFactory : IProtocolFactory;
+ AOutputProtocolFactory : IProtocolFactory;
+ ALogDelegate : TLogDelegate
+ ); overload;
+
+ constructor Create( AProcessor :IProcessor;
+ AServerTransport: IServerTransport); overload;
+
+ constructor Create(
+ AProcessor :IProcessor;
+ AServerTransport: IServerTransport;
+ ALogDelegate: TLogDelegate
+ ); overload;
+
+ constructor Create(
+ AProcessor :IProcessor;
+ AServerTransport: IServerTransport;
+ ATransportFactory : ITransportFactory
+ ); overload;
+
+ constructor Create(
+ AProcessor :IProcessor;
+ AServerTransport: IServerTransport;
+ ATransportFactory : ITransportFactory;
+ AProtocolFactory : IProtocolFactory
+ ); overload;
+ end;
+
+ TSimpleServer = class( TServerImpl)
+ private
+ FStop : Boolean;
+ public
+ constructor Create( AProcessor: IProcessor; AServerTransport: IServerTransport); overload;
+ constructor Create( AProcessor: IProcessor; AServerTransport: IServerTransport;
+ ALogDel: TServerImpl.TLogDelegate); overload;
+ constructor Create( AProcessor: IProcessor; AServerTransport: IServerTransport;
+ ATransportFactory: ITransportFactory); overload;
+ constructor Create( AProcessor: IProcessor; AServerTransport: IServerTransport;
+ ATransportFactory: ITransportFactory; AProtocolFactory: IProtocolFactory); overload;
+
+ procedure Serve; override;
+ procedure Stop; override;
+ end;
+
+
+implementation
+
+{ TServerImpl }
+
+constructor TServerImpl.Create(AProcessor: IProcessor;
+ AServerTransport: IServerTransport; ALogDelegate: TLogDelegate);
+var
+ InputFactory, OutputFactory : IProtocolFactory;
+ InputTransFactory, OutputTransFactory : ITransportFactory;
+
+begin
+ InputFactory := TBinaryProtocolImpl.TFactory.Create;
+ OutputFactory := TBinaryProtocolImpl.TFactory.Create;
+ InputTransFactory := TTransportFactoryImpl.Create;
+ OutputTransFactory := TTransportFactoryImpl.Create;
+
+ Create(
+ AProcessor,
+ AServerTransport,
+ InputTransFactory,
+ OutputTransFactory,
+ InputFactory,
+ OutputFactory,
+ ALogDelegate
+ );
+end;
+
+constructor TServerImpl.Create(AProcessor: IProcessor;
+ AServerTransport: IServerTransport);
+var
+ InputFactory, OutputFactory : IProtocolFactory;
+ InputTransFactory, OutputTransFactory : ITransportFactory;
+
+begin
+ InputFactory := TBinaryProtocolImpl.TFactory.Create;
+ OutputFactory := TBinaryProtocolImpl.TFactory.Create;
+ InputTransFactory := TTransportFactoryImpl.Create;
+ OutputTransFactory := TTransportFactoryImpl.Create;
+
+ Create(
+ AProcessor,
+ AServerTransport,
+ InputTransFactory,
+ OutputTransFactory,
+ InputFactory,
+ OutputFactory,
+ DefaultLogDelegate
+ );
+end;
+
+constructor TServerImpl.Create(AProcessor: IProcessor;
+ AServerTransport: IServerTransport; ATransportFactory: ITransportFactory);
+var
+ InputProtocolFactory : IProtocolFactory;
+ OutputProtocolFactory : IProtocolFactory;
+begin
+ InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+ OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+
+ Create( AProcessor, AServerTransport, ATransportFactory, ATransportFactory,
+ InputProtocolFactory, OutputProtocolFactory, DefaultLogDelegate);
+end;
+
+constructor TServerImpl.Create(AProcessor: IProcessor;
+ AServerTransport: IServerTransport; AInputTransportFactory,
+ AOutputTransportFactory: ITransportFactory; AInputProtocolFactory,
+ AOutputProtocolFactory: IProtocolFactory;
+ ALogDelegate : TLogDelegate);
+begin
+ FProcessor := AProcessor;
+ FServerTransport := AServerTransport;
+ FInputTransportFactory := AInputTransportFactory;
+ FOutputTransportFactory := AOutputTransportFactory;
+ FInputProtocolFactory := AInputProtocolFactory;
+ FOutputProtocolFactory := AOutputProtocolFactory;
+ FLogDelegate := ALogDelegate;
+end;
+
+class procedure TServerImpl.DefaultLogDelegate( str: string);
+begin
+ Writeln( str );
+end;
+
+constructor TServerImpl.Create(AProcessor: IProcessor;
+ AServerTransport: IServerTransport; ATransportFactory: ITransportFactory;
+ AProtocolFactory: IProtocolFactory);
+begin
+
+end;
+
+{ TSimpleServer }
+
+constructor TSimpleServer.Create(AProcessor: IProcessor;
+ AServerTransport: IServerTransport);
+var
+ InputProtocolFactory : IProtocolFactory;
+ OutputProtocolFactory : IProtocolFactory;
+ InputTransportFactory : ITransportFactory;
+ OutputTransportFactory : ITransportFactory;
+begin
+ InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+ OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+ InputTransportFactory := TTransportFactoryImpl.Create;
+ OutputTransportFactory := TTransportFactoryImpl.Create;
+
+ inherited Create( AProcessor, AServerTransport, InputTransportFactory,
+ OutputTransportFactory, InputProtocolFactory, OutputProtocolFactory, DefaultLogDelegate);
+end;
+
+constructor TSimpleServer.Create(AProcessor: IProcessor;
+ AServerTransport: IServerTransport; ALogDel: TServerImpl.TLogDelegate);
+var
+ InputProtocolFactory : IProtocolFactory;
+ OutputProtocolFactory : IProtocolFactory;
+ InputTransportFactory : ITransportFactory;
+ OutputTransportFactory : ITransportFactory;
+begin
+ InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+ OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+ InputTransportFactory := TTransportFactoryImpl.Create;
+ OutputTransportFactory := TTransportFactoryImpl.Create;
+
+ inherited Create( AProcessor, AServerTransport, InputTransportFactory,
+ OutputTransportFactory, InputProtocolFactory, OutputProtocolFactory, ALogDel);
+end;
+
+constructor TSimpleServer.Create(AProcessor: IProcessor;
+ AServerTransport: IServerTransport; ATransportFactory: ITransportFactory);
+begin
+ inherited Create( AProcessor, AServerTransport, ATransportFactory,
+ ATransportFactory, TBinaryProtocolImpl.TFactory.Create, TBinaryProtocolImpl.TFactory.Create, DefaultLogDelegate);
+end;
+
+constructor TSimpleServer.Create(AProcessor: IProcessor;
+ AServerTransport: IServerTransport; ATransportFactory: ITransportFactory;
+ AProtocolFactory: IProtocolFactory);
+begin
+ inherited Create( AProcessor, AServerTransport, ATransportFactory,
+ ATransportFactory, AProtocolFactory, AProtocolFactory, DefaultLogDelegate);
+end;
+
+procedure TSimpleServer.Serve;
+var
+ client : ITransport;
+ InputTransport : ITransport;
+ OutputTransport : ITransport;
+ InputProtocol : IProtocol;
+ OutputProtocol : IProtocol;
+begin
+ try
+ FServerTransport.Listen;
+ except
+ on E: Exception do
+ begin
+ FLogDelegate( E.ToString);
+ end;
+ end;
+
+ client := nil;
+ InputTransport := nil;
+ OutputTransport := nil;
+ InputProtocol := nil;
+ OutputProtocol := nil;
+
+ while (not FStop) do
+ begin
+ try
+ client := FServerTransport.Accept;
+ 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;
+ end;
+ except
+ on E: TTransportException do
+ begin
+ if FStop then
+ begin
+ FLogDelegate('TSimpleServer was shutting down, caught ' + E.ClassName);
+ end;
+ end;
+ on E: Exception do
+ begin
+ FLogDelegate( E.ToString );
+ end;
+ end;
+ if InputTransport <> nil then
+ begin
+ InputTransport.Close;
+ end;
+ if OutputTransport <> nil then
+ begin
+ OutputTransport.Close;
+ end;
+ end;
+
+ if FStop then
+ begin
+ try
+ FServerTransport.Close;
+ except
+ on E: TTransportException do
+ begin
+ FLogDelegate('TServerTranport failed on close: ' + E.Message);
+ end;
+ end;
+ FStop := False;
+ end;
+end;
+
+procedure TSimpleServer.Stop;
+begin
+ FStop := True;
+ FServerTransport.Close;
+end;
+
+end.