Thrift-1401: JSON-protocol for Delphi XE Libraries
Client: delphi
Patch: Jens Geyer
Adds support for the JSON protocol to the existing Delphi XE libraries.
git-svn-id: https://svn.apache.org/repos/asf/thrift/trunk@1200538 13f79535-47bb-0310-9956-ffa450edef68
diff --git a/lib/delphi/src/Thrift.Server.pas b/lib/delphi/src/Thrift.Server.pas
index 23b6976..2d35c19 100644
--- a/lib/delphi/src/Thrift.Server.pas
+++ b/lib/delphi/src/Thrift.Server.pas
@@ -1,191 +1,191 @@
-(*
- * 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;
+(*
+ * 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
@@ -196,133 +196,133 @@
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.
+
+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.